Google
 

Trailing-Edge - PDP-10 Archives - TRAFFIC-20_V4_840514 - traffic-source/tfrcal.mac
There are no other files named tfrcal.mac in the archive.
	UNIVERSAL	TFRCAL

;
;This file contains macros which can be used by MACRO programmers when
;calling TRAFFIC-20 routines. Each macro is explained separately.
;

DEFINE	$ARGL(ARG,LEN)<
	%CNT=0
	%CCC=0
	IFE	%ASM,<
	   EXP   0
ARG:>
	IFN	%ASM,<
	   MOVEI 16,ARG>
>

DEFINE	$NARG(ARG,LBL)<
	IFB	<ARG>,<
	 IFE	%ASM,<$ZARG	0,LBL>
	>
	IFNB	<ARG>,<
	 .IF	ARG,ASSIGNMENT,<$ZARG	ARG,LBL>
	 .IF	ARG,NUMERIC,<$ZARG	ARG,LBL>
	 .IF	ARG,RELOCATABLE,<
	  IFE	%ASM,<
	   EXP   ARG>
	  IFN	%ASM,<
	   MOVE  0,ARG
	   MOVEM 0,@%CNT(16)
	   %CCC=%CCC+1>
	 >
	>
	%CNT=%CNT+1
>

DEFINE	$SARG(ARG)<
	IFB	<ARG>,<
	 IFE	%ASM,<
	   EXP   17B12>
	>
	IFNB	<ARG>,<
	 .IFN	ARG,SYMBOL,<
	  IFE	%ASM,<
	   EXP   17B12+[ASCIZ ARG]>
	  IFN	%ASM,<
	   MOVE  0,[17B12+[ASCIZ ARG]]>
	 >
	 .IF	ARG,SYMBOL,<
	  IFE	%ASM,<
	   EXP   17B12+ARG>
	  IFN	%ASM,<
	   MOVE  0,[17B12+ARG]>
	 >
	 IFN	%ASM,<
	   MOVEM 0,%CNT(16)
	   %CCC=%CCC+1>
	>
	%CNT=%CNT+1
>

DEFINE	$IARG(ARG,LBL)<
	IFB	<ARG>,<
	 IFE	%ASM,<$ZARG	0,LBL>
	>
	IFNB	<ARG>,<
	 IFE	%ASM,<
	   EXP   ARG>
	 IFN	%ASM,<
	   MOVEI 0,ARG
	   MOVEM 0,%CNT(16)
	   %CCC=%CCC+1>
	>
	%CNT=%CNT+1
>

DEFINE	$FARG(ARG,LBL)<
	IFB	<ARG>,<
	 IFE	%ASM,<$ZARG	0,LBL>
	>
	IFNB	<ARG>,<
	 %FL1=0
	 %FL2=0
	 IRPC	ARG,<IFIDN <ARG><">,<%FL1=1>>
	 .IF	ARG,NUMERIC,<
	  IFE	%FL1,<
	   %FL2=1
	   $ZARG	ARG,LBL>
	 >
	 IFE	%FL2,<
	  .IF	ARG,LOCAL,<$ZARG	ARG,LBL>
	  .IF	ARG,LABEL,<
	   IFE	%ASM,<
	   EXP   ARG>
	   IFN	%ASM,<
	   MOVE  0,ARG
	   MOVEM 0,@%CNT(16)
	   %CCC=%CCC+1>
	  >
	  .IFN	ARG,SYMBOL,<
	   IFE	%ASM,<
	   EXP   17B12+[ASCIZ ARG]>
	   IFN	%ASM,<
	   MOVE  0,[17B12+[ASCIZ ARG]]
	   MOVEM 0,%CNT(16)
	   %CCC=%CCC+1>
	  >
	 >
	>
	%CNT=%CNT+1
	PURGE	%FL1,%FL2
>

DEFINE	$ZARG(ARG,LBL)<
	IFE	%ASM,<
	   EXP   %%L'LBL+%CCC
	 IF2	<
	   RELOC	%%L'LBL+%CCC
	   EXP   ARG
	   RELOC>
	 %CCC=%CCC+1
	>
	IFN	%ASM,<
	   MOVX  0,ARG
	   MOVEM 0,@%CNT(16)
	   %CCC=%CCC+1
	>
>

DEFINE	$XARG(ARG,RTN,LBL)<
	IFE	%ASM,<
	   RELOC	ARG-1
	   XWD   -%CNT,0
	 IF1	<
	  RELOC	ARG+%CNT
%%L'LBL:   BLOCK	%CCC
	 >
	 IF2	<RELOC	ARG+%CNT+%CCC>
	 %LBL=%LBL+1
	>
	IFN	%ASM,<
	 IFN	%CCC,<
	   MOVSI 0,-%CNT
	   MOVEM 0,-1(16)>
	   EXTERN RTN
	   PUSHJ 17,RTN
	>
	IF2	<
	 PURGE		%CNT,%CCC,%ASM
	>
>
;
;The following macros may be used if certain rules are observed. These are:
;
; 1.	The macro TFZZZ$ must be called before any other macro in order to
;	preset a counter and SEARCH the file MACSYM.UNV.
;
; 2.	The program must SEARCH TFRCAL.UNV.
;
; 3.	String arguments must be contained in double quotes.

;
;$TFBLK - CALL TFRBLK
;
;NO ARGUMENTS

DEFINE	$TFBLK<
	EXTERN	TFRBLK
	PUSHJ	17,TFRBLK
>

;
;TFCHG$ AND $TFCHG - CALL TFRCHG
;
;THIS CAN ONLY BE CALLED WITH THREE ARGUMENTS. IF YOU WISH TO PASS
;MORE THAN THIS THEN THE ARGUMENT 'ATR' MUST BE A LIST ENCLOSED IN
;ANGLE BRACKETS.
;
;FLD = FIELD NUMBER
;ATR = ATTRIBUTE STRING IN QUOTES
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFCHG(ARG,FLD,ATR,ERR)<
	%ASM=1
	$ARGL(ARG,3)
	$FARG(FLD)
	IRP	ATR,<$SARG(ATR)>
	$IARG(ERR)
	$XARG(ARG,TFRCHG)
>
DEFINE	TFCHG$(ARG,FLD,ATR,ERR)<
	%ASM=0
	$ARGL(ARG,3)
	$FARG(FLD,\%LBL)
	IRP	ATR,<$SARG(ATR)>
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRCHG,\%LBL)
>

;
;TFCLR$ AND $TFCLR - CALL TFRCLR
;
;FLD = FIELD NUMBER
;ERR = ADDRESS OF FIELD INDICATOR

DEFINE	$TFCLR(ARG,FLD,ERR)<
	%ASM=1
	IFNB <ARG>,<
	   $ARGL(ARG,2)
	   $FARG(FLD)
	   $IARG(ERR)>
	IFB  <ARG>,<
	   $ARGL(ARG,0)>
	$XARG(ARG,TFRCLR)
>
DEFINE	TFCLR$(ARG,FLD,ERR)<
	%ASM=0
	IFNB <ARG>,<
	   $ARGL(ARG,2)
	   $FARG(FLD,\%LBL)
	   $IARG(ERR,\%LBL)>
	IFB  <ARG>,<
	   $ARGL(ARG,0)>
	$XARG(ARG,TFRCLR,\%LBL)
>

;
;TFERR$ AND $TFERR - CALL TFRERR
;
;MSG = QUOTED MESSAGE STRING
;FLD = FIELD NUMBER

DEFINE	$TFERR(ARG,MSG,FLD)<
	%ASM=1
	$ARGL(ARG,2)
	$SARG(MSG)
	$FARG(FLD)
	$XARG(ARG,TFRERR)
>
DEFINE	TFERR$(ARG,MSG,FLD)<
	%ASM=0
	$ARGL(ARG,2)
	$SARG(MSG)
	$FARG(FLD,\%LBL)
	$XARG(ARG,TFRERR,\%LBL)
>

;
;TFFNO$ AND $TFFNO - CALL TFRFNO
;
;FLN = QUOTED FIELD NAME STRING
;FLD = ADDRESS OF FIELD NUMBER
;ERR = ADDRESS OF ERROR INDICATOR


DEFINE	$TFFNO(ARG,FLN,FLD,ERR)<
	%ASM=1
	$ARGL(ARG,3)
	$SARG(FLN)
	$IARG(FLD)
	$IARG(ERR)
	$XARG(ARG,TFRFNO)
>
DEFINE	TFFNO$(ARG,FLN,FLD,ERR)<
	%ASM=0
	$ARGL(ARG,3)
	$SARG(FLN)
	$IARG(FLD,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRFNO,\%LBL)
>

;
;TFGET$ AND $TFGET - CALL TFRGET
;
;FLD = FIELD NAME OR NUMBER
;ELM = ELEMENT NUMBER
;DST = DESTINATION BUFFER ADDRESS
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFGET(ARG,FLD,ELM,DST,ERR)<
	%ASM=1
	$ARGL(ARG,4)
	$FARG(FLD)
	$NARG(ELM)
	$IARG(DST)
	$IARG(ERR)
	$XARG(ARG,TFRGET)
>
DEFINE	TFGET$(ARG,FLD,ELM,DST,ERR)<
	%ASM=0
	$ARGL(ARG,4)
	$FARG(FLD,\%LBL)
	$NARG(ELM,\%LBL)
	$IARG(DST,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRGET,\%LBL)
>

;
;TFINI$ AND $TFINI - CALL TFRINI
;
;REC = ADDRESS OF THE DATA BUFFER
;FRM = FORM NAME STRING IN DOUBLE QUOTES
;FLD = FIELD NUMBER OR 0 FOR THE FORM OR -N FOR SECTION N
;ERR = ADDRESS OF THE ERROR INDICATOR

DEFINE	$TFINI(ARG,REC,FRM,FLD,ERR)<
	%ASM=1
	$ARGL(ARG,4)
	$IARG(REC)
	$SARG(FRM)
	$FARG(FLD)
	$IARG(ERR)
	$XARG(ARG,TFRINI)
>
DEFINE	TFINI$(ARG,REC,FRM,FLD,ERR)<
	%ASM=0
	$ARGL(ARG,4)
	$IARG(REC,\%LBL)
	$SARG(FRM)
	$FARG(FLD,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRINI,\%LBL)
>

;
;TFMSG$ AND $TFMSG - CALL TFRMSG
;
;MSG = ASCIZ MESSAGE TO BE OUTPUT
;FLG = NON-ZERO TO APPEND <CR><LF>

DEFINE	$TFMSG(ARG,MSG,FLG)<
	%ASM=1
	$ARGL(ARG,2)
	$SARG(MSG)
	$NARG(FLG)
	$XARG(ARG,TFRMSG)
>
DEFINE	TFMSG$(ARG,MSG,FLG)<
	%ASM=0
	$ARGL(ARG,2)
	$SARG(MSG)
	$NARG(FLG,\%LBL)
	$XARG(ARG,TFRMSG,\%LBL)
>

;
;TFPUT$ AND $TFPUT - CALL TFRPUT
;
;FLD = FIELD NAME OR NUMBER
;ELM = ELEMENT NUMBER
;SRC = SOURCE STRING
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFPUT(ARG,FLD,ELM,SRC,ERR)<
	%ASM=1
	$ARGL(ARG,4)
	$FARG(FLD)
	$NARG(ELM)
	$SARG(SRC)
	$IARG(ERR)
	$XARG(ARG,TFRPUT)
>
DEFINE	TFPUT$(ARG,FLD,ELM,SRC,ERR)<
	%ASM=0
	$ARGL(ARG,4)
	$FARG(FLD,\%LBL)
	$NARG(ELM,\%LBL)
	$SARG(SRC)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRPUT,\%LBL)
>

;
;TFRRD$ AND $TFRRD - CALL TFRRD
;
;FLD = FIELD NUMBER
;END = ADDRESS OF END INDICATOR
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFRRD(ARG,FLD,END,ERR)<
	%ASM=1
	$ARGL(ARG,3)
	$FARG(FLD)
	$IARG(END)
	$IARG(ERR)
	$XARG(ARG,TFRRD)
>
DEFINE	TFRRD$(ARG,FLD,END,ERR)<
	%ASM=0
	$ARGL(ARG,3)
	$FARG(FLD,\%LBL)
	$IARG(END,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRRD,\%LBL)
>

;
;TFRSL$ AND $TFRSL - CALL TFRRSL
;
;LIN = LINE NUMBER
;COL = COLUMN NUMBER
;BUF = ADDRESS OF BUFFER TO RETURN DATA
;OFS = OFFSET INTO BUFFER
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFRSL(ARG,LIN,COL,BUF,OFS,ERR)<
	%ASM=1
	$ARGL(ARG,5)
	$NARG(LIN)
	$NARG(COL)
	$IARG(BUF)
	$NARG(OFS)
	$IARG(ERR)
	$XARG(ARG,TFRRSL)
>
DEFINE	TFRSL$(ARG,LIN,COL,BUF,OFS,ERR)<
	%ASM=0
	$ARGL(ARG,5)
	$NARG(LIN,\%LBL)
	$NARG(COL,\%LBL)
	$IARG(BUF,\%LBL)
	$NARG(OFS,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRRSL,\%LBL)
>

;
;$TFRST - CALL TFRRST
;
;NO ARGUMENTS

DEFINE	$TFRST<
	EXTERN	TFRRST
	PUSHJ	17,TFRRST
>

;
;$TFRWT - CALL TFRRWT
;
;NO ARGUMENTS

DEFINE	$TFRWT<
	EXTERN	TFRRWT
	PUSHJ	17,TFRRWT
>

;
;$TFSET - CALL TFRSET
;
;NO ARGUMENTS

DEFINE	$TFSET<
	EXTERN	TFRSET
	PUSHJ	17,TFRSET
>

;
;TFSTA$ AND $TFSTA - CALL TFRSTA
;
;TRM = [OPTIONAL] TERMINAL LOGICAL NAME

DEFINE	$TFSTA(ARG,TRM)<
	EXTERN	RESET.
	JSP	16,RESET.
	0
	IFNB	<ARG>,<
	 %ASM=1
	 $ARGL(ARG,1)
	 $SARG(TRM)
	 $XARG(ARG,TFRSTA)
	>
	IFB	<ARG>,<
	 MOVEI	16,[0]+1
	 EXTERN	TFRSTA
	 PUSHJ	17,TFRSTA
	>
>
DEFINE	TFSTA$(ARG,TRM)<
	IFNB	<TRM>,<
	 %ASM=0
	 $ARGL(ARG,1)
	 $SARG(TRM)
	 $XARG(ARG,TFRSTA,\%LBL)
	>
>

;
;$TFSTP - CALL TFRSTP
;
;NO ARGUMENTS

DEFINE	$TFSTP<
	EXTERN	TFRSTP
	PUSHJ	17,TFRSTP
>

;
;TFSYS$ AND $TFSYS - CALL TFRSYS
;
;VAR = VARIABLE NUMBER TO BE CHANGED
;NEW = NEW VALUE
;OLD = ADDRESS TO RETURN OLD VARIABLE
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFSYS(ARG,VAR,NEW,OLD,ERR)<
	%ASM=1
	$ARGL(ARG,4)
	$NARG(VAR)
	$NARG(NEW)
	$IARG(OLD)
	$IARG(ERR)
	$XARG(ARG,TFRSYS)
>
DEFINE	TFSYS$(ARG,VAR,NEW,OLD,ERR)<
	%ASM=0
	$ARGL(ARG,4)
	$NARG(VAR,\%LBL)
	$NARG(NEW,\%LBL)
	$IARG(OLD,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRSYS,\%LBL)
>

;
;TFWRT$ AND $TFWRT - CALL TFRWRT
;
;FLD = FIELD NUMBER
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFWRT(ARG,FLD,ERR)<
	%ASM=1
	$ARGL(ARG,2)
	$FARG(FLD)
	$IARG(ERR)
	$XARG(ARG,TFRWRT)
>
DEFINE	TFWRT$(ARG,FLD,ERR)<
	%ASM=0
	$ARGL(ARG,2)
	$FARG(FLD,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRWRT,\%LBL)
>

;
;TFWTL$ AND $TFWTL - CALL TFRWTL
;
;CTL = CONTROL VARIABLE
;ERR = ADDRESS OF ERROR INDICATOR

DEFINE	$TFWTL(ARG,CTL,ERR)<
	%ASM=1
	$ARGL(ARG,2)
	$NARG(CTL)
	$IARG(ERR)
	$XARG(ARG,TFRWTL)
>
DEFINE	TFWTL$(ARG,CTL,ERR)<
	%ASM=0
	$ARGL(ARG,2)
	$NARG(CTL,\%LBL)
	$IARG(ERR,\%LBL)
	$XARG(ARG,TFRWTL,\%LBL)
>

;
;TFZZZ$ - INITIALISE THE MACRO CALLS
;
;NO ARGUMENTS

DEFINE	TFZZZ$<
	SEARCH	MACSYM
	%LBL=0
>

;
;INDAT$ AND $INDAT - CALL INPDAT
;
;SRC - SOURCE STRING
;DST - DESTINATION STRING ADDRESS
;FMT - FORMAT OF SURCE STRING

DEFINE	$INDAT(ARG,SRC,DST,FMT)<
	%ASM=1
	$ARGL(ARG,3)
	$SARG(SRC)
	$IARG(DST)
	$NARG(FMT)
	$XARG(ARG,INPDAT)
>
DEFINE	INDAT$(ARG,SRC,DST,FMT)<
	%ASM=0
	$ARGL(ARG,3)
	$SARG(SRC)
	$IARG(DST)
	$NARG(FMT)
	$XARG(ARG,INPDAT)
>

;
;OUDAT$ AND $OUDAT - CALL OUTDAT
;
;SRC - SOURCE STRING
;DST - DESTINATION STRING ADDRESS
;FMT - DESTINATION STRING FORMAT

DEFINE	$OUDAT(ARG,SRC,DST,FMT)<
	%ASM=1
	$ARGL(ARG,3)
	$SARG(SRC)
	$IARG(DST)
	$NARG(FMT)
	$XARG(ARG,OUTDAT)
>
DEFINE	OUDAT$(ARG,SRC,DST,FMT)<
	%ASM=0
	$ARGL(ARG,3)
	$SARG(SRC)
	$IARG(DST)
	$NARG(FMT)
	$XARG(ARG,OUTDAT)
>
;
;ARGUMENT BLOCK OFFSETS FOR DATA VET ROUTINES
;

	V.DATA=0			;USER DATA POINTER
	V.ERCD=1			;ERROR CODE
	V.ERMS=2			;ERROR MESSAGE POINTER
	V.FNAM=3			;FIELD NAME POINTER

;
;ERROR CODE VALUES FOR DATA VET ROUTINES
;

	VE.RWT=1			;REWRITE FIELD
	VE.AOK=0			;ALL OK
	VE.RWM=-1			;REWRITE WITH MESSAGE
	VE.MSG=-2			;SEND MESSAGE ONLY
	VE.RRD=-3			;SEND MESSAGE AND REREAD FIELD
	VE.EXT=-4			;EXIT FROM READ
;
;The following codes are the error codes and terminatoin codes returned
;from TFRCOB after any operation.
;

	ERR.BA==1		;BAD ARGUMENT IN CALL
	ERR.UF==2		;UNDEFINED FILE-NAME
	ERR.NF==3		;FIELD-ID WAS NOT FOUND
	ERR.ND==4		;FIELD-ID IS NOT DISPLAYED
	ERR.IA==5		;INVALID ATTRIBUTE (TFRCHG)
	ERR.WL==7		;WRONG LENGTH RECD DESC IN PGM.
	ERR.DP==^D8		;PMAP FAILURE FROM FORM FILE.
	ERR.NC==^D10		;LIBOL DID NOT RETURN ENOUGH PAGES.
	ERR.IV=^D11		;TFRSYS CALL WITH BAD VARIABLE#
	ERR.NV=^D12		;TFRSYS CALL WITH NEW-VALUE NOT 0,-1.
	ERR.VA=^D13		;VET ROUTINE NOT ALLOWED ACCESS
	ERR.EM=^D14		;END OF MULTIPLE SECTION ON READ AFTER WRITE
	ERR.ML==^D15		;ATTEMPT TO READ OR WRITE FIELDS IN M.S.
	ERR.OV==^D16		;USING OLD VERSION OF TFR COMPILER
	ERR.NL==^D17		;NO TFRLPT: DEFINED ON CALL TO TFRWTL
	ERR.NO==^D18		;OPTIMISER IS TURNED OFF
	ERR.TT==^D19		;TERMINAL TYPE NOT ALLOWED IN FORM


	TRM.LN==1
	TRM.TB==2
	TRM.LF==3
	TRM.FF==4
	TRM.CR==5
	TRM.UA==6		;UP-ARROW
	TRM.DA==7		;DOWN-ARROW
	TRM.VE==10		;VET ROUTINE FORCED EXIT

	END