perm filename HEADER[GEM,BGB] blob sn#051794 filedate 1973-08-08 generic text, type T, neo UTF8
00100	COMMENT ⊗   VALID 00005 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00002 00002	ALTERNATE PDP-10 MNEMONICS.
00500	C00005 00003	MACROS.
00600	C00009 00004	CHAIN TOGETHER INITIALIZING CODE
00700	C00010 00005	ROUTINES TO PUSH AND POP THE ACCUMULATORS.
00800	C00013 ENDMK
00900	C⊗;
     

00100	;ALTERNATE PDP-10 MNEMONICS.
00200	
00300		DEFINE O(A,B){OPDEF A[B]}
00400		O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
00500		O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
00600		O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
00700		O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
00800		O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
00900		O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
01000		O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
01100		O DZM,SETZM↔O DOM,SETOM↔O ZAC,SETZ↔O WAC,SETO
01200		O FLOAT,FSC 233↔O FLO,FSC 225↔O FIXX,FIX 233000
01300	
01400	;SAIL LIKE SUBROUTINE LINKAGE.
01500	
01600		↓P←←17
01700		DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
01800	
01900	;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
02000	
02100		DEFINE POP0J <POPJ 17,>
02200		↓POP1J.:SUB 17,[2(2)]↔GO@2(17)↔DEFINE POP1J<GO POP1J.>
02300		↓POP2J.:SUB 17,[3(3)]↔GO@3(17)↔DEFINE POP2J<GO POP2J.>
02400		↓POP3J.:SUB 17,[4(4)]↔GO@4(17)↔DEFINE POP3J<GO POP3J.>
02500		↓POP4J.:SUB 17,[5(5)]↔GO@5(17)↔DEFINE POP4J<GO POP4J.>
02600	
02700	;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
02800	
02900		DEFINE DECLARE (LIST){
03000		FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
03100		DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
     

00100	;MACROS.
00200		DEFINE CAT $(A,B){A$B}		;CONCATENATION.
00300		FOR @$ I←0,16<AC.$I←I↔>		;ACCUMULATOR NAMES FOR RAID.
00400		$←400000
00500		.PLEVEL←←0	;PDL BACK POINTER.
00600		.SLEVEL←←0	;DEPTH OF NESTED SUBROUTINE DECLARATIONS.
00700	
00800	;SUBROUTINE DECLARATIONS.
00900	;MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
01000	; (Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
01100	
01200		DEFINE $UBR(NAME,X1,X2,X3,X4,X5)
01300	{BEGIN NAME
01400		INTERN NAME
01500		GLOBAL .PLEVEL
01600		GLOBAL .SLEVEL
01700		.SLEVEL←←.SLEVEL+1
01800		CAT(.SBR,→.SLEVEL)←←.PLEVEL
01900		.PLEVEL←←.PLEVEL+1
02000		IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
02100		IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
02200		IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
02300		IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1
02400		IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔ .PLEVEL←.PLEVEL+1}}}}}
02500		XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
02600	↓NAME:	;}
02700	
02800	;DEFINE AN ARGUMENT
02900		DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
03000	
03100	;END OF SUBROUTINE
03200		DEFINE ENDR
03300	{	.PLEVEL←←CAT(.SBR,→.SLEVEL)
03400		.SLEVEL←←.SLEVEL-1
03500		LIT
03600		BLOCK 0
03700		BEND }
03800	
03900	;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
04000		DEFINE CALL(NAME,X1,X2,X3,X4,X5)
04100	{	GLOBAL .SLEVEL,.PLEVEL
04200		.SLEVEL←←.SLEVEL+1
04300		CAT(.SBR,→.SLEVEL)←←.PLEVEL
04400		IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
04500		IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
04600		IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
04700		IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
04800		IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1 }}}}}
04900		IFDIF <><NAME>{PUSHJ P,NAME }
05000		.PLEVEL←←CAT(.SBR,→.SLEVEL)
05100		.SLEVEL←←.SLEVEL-1
05200	}
05300	;PUSH SOMETHING ONTO STACK
05400		DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
05500		DEFINE POPP(ARG) {POP  P,ARG↔.PLEVEL←←.PLEVEL-1}
05600		DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
05700	
05800	;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
05900	
06000		DEFINE ACCUMULATORS(LIST){ACPTR←←2
06100		FOR AC⊂(LIST)<AC←ACPTR
06200		 ACPTR←←ACPTR+1↔>}
06300	
06400	;FATAL ERROR MESSAGE.
06500	
06600		DEFINE FATAL(STR){PUSHJ 17,FATAL.↔JFCL [ASCIZ/STR/]}
06700		DEFINE WARNING(STR){PUSHJ 17,WARN.↔JFCL [ASCIZ/STR/]}
06800		EXTERNAL FATAL.,WARN.
06900	
     

00100	;CHAIN TOGETHER INITIALIZING CODE
00200		DEFINE INITCODE
00300	<IFAVL	.INITLINK
00400	<	GLOBAL .INITLINK
00500		PUSHJ P,.+2
00600		JRST .INITLINK
00700	 	↑.INITLINK←←.-2
00800	;> ↑.INITLINK←←.
00900	>
01000	
01100	;CHAIN TOGETHER BIT TABLES
01200		DEFINE BITDEFS(BITS)
01300	<IFNDEF .BTLNK < .BTLNK←←0 
01400	;>	.BTLNK
01500		.BTLNK←←.BTLNK*1000000+$.
01600		.BTABL←←$.
01700		FOR BIT⊂(BITS)
01800	<IFIDN <><BIT>< 0
01900	;>	RADIX50 0,BIT
02000	>	BLOCK =36+.BTABL-$.
02100	>
02200	
02300		DEFINE TAIL
02400	<DOINIT:
02500		IFDEF .INITLINK < PUSHJ P,.INITLINK
02600	>	IFDEF .BTLNK < EXTERNAL $M
02700		MOVE [.BTLNK]
02800		SKIPE [$M]
02900		MOVEM $M+3
03000		POP0J
03100	>>
     

00100	;ROUTINES TO PUSH AND POP THE ACCUMULATORS.
00200	IFNDEF PUSHIT<
00300	DEFINE PUSHACS	<PUSHJ P,PUSHIT↔GLOBAL .PLEVEL↔.PLEVEL←←.PLEVEL+20
00400	>
00500	DEFINE POPACS	<PUSHJ P,POPIT↔GLOBAL .PLEVEL↔.PLEVEL←←.PLEVEL-20
00600	>>
00700	EXTERNAL PUSHIT,POPIT
00800	
00900	;MAKE RAID KNOW THE FOLLOWING
01000		O FIX,FIX↔O HALT,HALT
01100		O INCHRW,INCHRW↔O INCHWL,INCHWL
01200		O OUTCHR,OUTCHR↔O OUTSTR,OUTSTR
01300		O(JRSTF,{JRST 2,})↔O(JCALL,{JRST 1,})↔O(PGCLR,{PGIOT 2,})
01400		IODEND←←20000
01500		EXTERNAL JOBFF,JOBREL,JOBSA,JOBREN,JOBSYM,JOBDDT,JOBOPC,JOBHRL