UNIVERSAL TVRHDR	

;MACROS TO MAKE FAIL EASIER

IFNDEF STANSW,<↓STANSW←←1>

	DEFINE CAT $(A,B){A$B}

	↓P←←17
	$←400000

	.PLEVEL←←0
	.SLEVEL←←0
	.ALEVEL←←0

;SUBROUTINE DECLARATIONS.  MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
	DEFINE SUBR(NAME,X1,X2,X3,X4,X5,X6)
{	BEGIN NAME
	INTERN NAME
	XLIST
	GLOBAL .PLEVEL
	GLOBAL .SLEVEL
	GLOBAL .ALEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	.PLEVEL←←.PLEVEL+1
	CAT(.SBA,→.SLEVEL)←←.ALEVEL
IFDIF <><X1>{ DEFARG(X1,→.PLEVEL)
  .PLEVEL←.PLEVEL+1
 IFDIF <><X2>{ DEFARG(X2,→.PLEVEL)
   .PLEVEL←.PLEVEL+1
  IFDIF <><X3>{ DEFARG(X3,→.PLEVEL)
    .PLEVEL←.PLEVEL+1
   IFDIF <><X4>{ DEFARG(X4,→.PLEVEL)
     .PLEVEL←.PLEVEL+1
    IFDIF <><X5>{ DEFARG(X5,→.PLEVEL)
      .PLEVEL←.PLEVEL+1
     IFDIF <><X6>{ DEFARG(X6,→.PLEVEL)
       .PLEVEL←.PLEVEL+1
}}}}}}
	.ALEVEL←←.PLEVEL
LIST
↓NAME: ;}

;DEFINE AN ARGUMENT
	DEFINE DEFARG(NAME,LEVEL)
{ DEFINE NAME { LEVEL-.PLEVEL(17)}}

;DEFINE A LOCALS (AND IT BETTER WORK FOR A KA-10 AS WELL, DAMNIT)
	DEFINE LOCALS(LST)
{	XLIST
	.MTEMP←←.PLEVEL
	FOR LOC⊂(LST) < .PLEVEL←←.PLEVEL+1
	DEFARG(LOC,→.PLEVEL)↔>
IFG .PLEVEL-.MTEMP-3
<	CAML P,[XWD .MTEMP-.PLEVEL,-1]
	  PUSHJ P,PDLOVL
	ADD P,[XWD .PLEVEL-.MTEMP,.PLEVEL-.MTEMP]
>;IFG
IFLE .PLEVEL-.MTEMP-3
<REPEAT .PLEVEL-.MTEMP,
{	PUSH P,[0]
};REPEAT
>;IFLE
LIST }

;END OF SUBROUTINE
	DEFINE SUBREND
{	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.ALEVEL←←CAT(.SBA,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	BLOCK 0
	BEND }

;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUMENTS)
	DEFINE CALL(NAME,X1,X2,X3,X4,X5,X6){
	XLIST
	GLOBAL .SLEVEL,.PLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
 IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
  IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
   IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
    IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1
     IFDIF <><X6>{PUSH 17,X6↔.PLEVEL←.PLEVEL+1
}}}}}}
	PUSHJ P,NAME
	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	LIST}

;PUSH SOMETHING ONTO STACK
	DEFINE PUSHP(ARG)
<	PUSH P,ARG
	.PLEVEL←←.PLEVEL+1
>
	DEFINE POPP(ARG)
<	POP P,ARG
	.PLEVEL←←.PLEVEL-1
>
	DEFINE PUSHACS
<	PUSHJ P,PUSHIT↑
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL+20
>
	DEFINE POPACS
<	PUSHJ P,POPIT↑
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL-20
>

DEFINE RETURN <XLIST
.MTEMP←←.PLEVEL-CAT(.SBR,→.SLEVEL)
IFN .MTEMP-1,<JRST[SUB P,[XWD .PLEVEL-CAT(.SBR,→.SLEVEL),.PLEVEL-CAT(.SBR,→.SLEVEL)]
		   JRST @<.ALEVEL-CAT(.SBR,→.SLEVEL)>(P)]
>;IFN
IFE .MTEMP-1 <POPJ P,
>;IFE
LIST >;DEFINE RETURN


;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL. (OBSOLETE - USE RETURN)

IFNDEF POP0J
<	DEFINE POP0J <POPJ 17,>
	DEFINE POP1J<JRST POP1J.↑>
	DEFINE POP2J<JRST POP2J.↑>
	DEFINE POP3J<JRST POP3J.↑>
	DEFINE POP4J<JRST POP4J.↑>
	DEFINE POP5J<JRST POP5J.↑>
>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.

	DEFINE ACCUMULATORS(LIST){ ACPTR←←2
IFDEF TAC,<	ACPTR←←TAC >
	FOR AC⊂(LIST)<AC←ACPTR
	 ACPTR←←ACPTR+1↔>}

;CHAIN TOGETHER INITIALIZING CODE
	DEFINE INITCODE
<IFAVL	.INITLINK
<	GLOBAL .INITLINK
	PUSHJ P,.+2
	JRST .INITLINK
 	↑.INITLINK←←.-2
;> ↑.INITLINK←←.
>

;CHAIN TOGETHER BIT TABLES
	DEFINE BITDEFS(BITS)
<IFNDEF .BTLNK < .BTLNK←←0 
;>	.BTLNK
	.BTLNK←←.BTLNK*1000000+$.
	.BTABL←←$.
	FOR BIT⊂(BITS)
<IFIDN <><BIT>< 0
;>	RADIX50 0,BIT
>	BLOCK =36+.BTABL-$.
>

	DEFINE TAIL
<DOINIT:
	IFDEF .INITLINK < PUSHJ P,.INITLINK
>	IFDEF .BTLNK < EXTERNAL $M
	MOVE [.BTLNK]
	SKIPE [$M]
	MOVEM $M+3
	POP0J
>>


;MAKE RAID KNOW THE FOLLOWING
	OPDEF HALT   [HALT]
	OPDEF JRSTF  [JRST 2,]

	IODEND←←20000
	EXTERNAL JOBFF,JOBREL,JOBSA,JOBREN,JOBSYM,JOBDDT,JOBOPC

	END