Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-07 - 43,50455/strmac.mac
There are 2 other files named strmac.mac in the archive. Click here to see a list.
								REPEAT 0,<
UNV:STRMAC.UNV DEFINES THE FOLLOWING ACCUMULATOR ASSIGNMENTS.

R0=0		FOR VERY TEMPORARY USE
T1-T4=1-4	FOR TEMPORARY USE, NOT USUALLY PRESERVED IN SUBROUTINES
P1-P4=5-10	NORMALLY PRESERVED IF USED IN A SUBROUTINE
R1-R4=11-14	USUALLY DEDICATED WITH GLOBAL SIGNIFICANCE THROUGHOUT PROGRAM
LP=15		LOCAL PUSHDOWN STORAGE POINTER, USED BY LOCAL MACRO
PC=16		PARAMETER LIST POINTER, USED BY CALL MACRO AND FORTRAN
P=17		PUSHDOWN POINTER, USED BY CALL MACRO AND FORTRAN

UNV:STRMAC.UNV DEFINES THE FOLLOWING MACROS FOR GENERAL USE.

STRIN.	HGHSEG
		SHOULD ALWAYS BE USED WHEN STRMAC IS USED.
		INITIALIZES VARIOUS SYMBOLS USED BY OTHER MACROS AND REQUESTS
		LINK TO LOAD REL:STRSUB WHICH CONTAINS THE FOLLOWING ROUTINES:
			SKP.RT	DOES A SKIP RETURN FOR THE SRETURN MACRO
			RST.PC	RESTORES PC FOR THE SUBR MACRO
			RST.LP	RESTORES LP FOR THE LOCAL MACRO
			CAL.FS	CALLS FORTRAN SUBROUTINES FOR THE CALL$F MACRO
			S.RXRY	SAVES AC'S RX THROUGH RY, THE FOLLOWING
				ROUTINES ARE IN STRSUB: S.R0R0,
					S.T1T1, S.T1T2, S.T1T3, S.T1T4,
					S.P1P1, S.P1P2, S.P1P3, S.P1P4,
					S.P1R1, S.P1R2, S.P1R3, S.P1R4,
					S.R1R1, S.R1R2, S.R1R3, AND S.R1R4.
		IF THE ARGUMENT IS GIVEN AS "HGHSEG", STRSUB IS LOADED INTO
		THE HIGH SEGMENT.  IF THE ARGUMENT IS NOT GIVEN, STRSUB IS
		LOADED INTO THE LOW SEGMENT.

DFN	SYM,VAL
		DEFINES SYM=VAL

BLK	SYM,SIZ,<SYMLST>
		ALLOCATES A BLOCK OF SIZ WORDS LABELED SYM.
		IF SIZ IS NOT PRESENT BLOCK SIZE IS 1.
		THE BLOCK IS ALLOCATED IN THE LOW SEG WHETHER OR NOT
		THE CURRENT LOCATION COUNTER IS IN THE HIGH OR LOW SEG.
		IF SYMLST IS PRESENT, THE 1ST SYMBOL IN THE LIST IS EQUATED TO
		THE LOCATION OF THE 2ND WORD OF THE BLOCK,  THE 2ND SYMBOL TO
		THE 3RD LOCATION, THE 3RD TO THE 4TH, ETC.

PROG	PRGNAM,PDLSIZ,RUNOFF,RUNFLS
		DEFINES SYMBOL PRGNAM FOR START OF PROGRAM AND ENDPRG MACRO.
		GENERATES TDZA T1,T1 AND MOVEI T1,1 FOR RUN OFFSET.
		IF RUNOFF IS PRESENT, ALLOCATES A BLOCK OF 1 WORD LABELED
		RUNOFF AND GENERATES A MOVEM T1,RUNOFF TO STORE THE OFFSET.
		IF RUNFLS IS PRESENT, ALLOCATES A BLOCK OF 4 WORDS LABELED
		RUNFLS AND GENERATES MOVEMS TO STORE AC'S 11,0,17,7 IN THE
		BLOCK TO SAVE THE DEV,FIL,EXT, AND PPN FROM THE RUN UUO.
		IF PDLSIZ IS PRESENT, ALLOCATES A BLOCK OF PDLSIZ WORDS LABELED
		PDL AND GENERATES A MOVE P,[IOWD PDLSIZ,PDL].

ENDPRG		GENERATES A MACRO END STATEMENT TO END THE PROGRAM AND
		SET THE PROGRAM BEGIN ADDRESS TO THE LABEL IN THE PROG MACRO.
CALL	SUBNAM,<ARGLST>
		GENERATES A PUSHJ TO SUBNAM.
		IF ARGLST IS PRESENT, AN ARGUMENT LIST IS GENERATED AND
		A HRRI IS GENERATED TO LOAD PC WITH THE ADDRESS OF THE
		ARGUMENT LIST.  HRRI IS USED BECAUSE OF THE SYSTEM WHICH
		AUTOMATICALLY RESTORES PC TO WHAT IT WAS BEFORE THE CALL.
		IF THERE IS NO ARGLST, PC IS NOT ALTERED.
		THE ARG LIST GENERATED IS ACCEPTABLE TO FORTRAN BUT DOES
		NOT FOLLOW THE FORTRAN STANDARD.  THERE ARE NO ARG TYPES AND
		THE ARG COUNT WORD IS NOT PRESENT PRECEEDING THE ARG LIST.
		IF FORTRAN EVER DEMANDS THESE FEATURES, THE MACRO CAN EASILY
		BE CHANGED TO CREATE THEM WITHOUT ANY OTHER PROGRAM CHANGES.

CALL$R	SUBNAM,<ARGLST>
		THIS IS EXACTLY LIKE CALL EXCEPT THAT A JRST IS GENERATED
		INSTEAD OF A PUSHJ. CALL$R IS LIKE A CALL FOLLOWED BY A RETURN.

CALL$F	SUBNAM,<ARGLST>
		THIS IS SIMILAR TO CALL BUT IS USED FOR CALLING FORTRAN
		SUBROUTINES WHEN IT IS IMPORTANT THAT THE AC'S ARE NOT
		DESTROYED.  CALL$F CALLS CAL.FS IN STRSUB WHICH CALLS SUBNAM.
		CALL.FS SAVES AND RESTORES AC'S P1-P4, R1-R4, LP, AND PC.

SUBR	SUBNAM,<ARGLST>
		DEFINES SYMBOL SUBNAM FOR START OF SUBROUTINE.
		IF ARGLST IS PRESENT A MACRO IS DEFINED FOR EACH ARG IN ARGLST.
		THE NAME OF THE ARG MACRO IS THE ARG AND THE DEFINITION IS
		@X(PC) WHERE X IS 0,1,2,ETC FOR THE 1ST,2ND,3RD,3TC ARG.  IN
		THE SUBROUTINE, THE ARG NAME CAN BE USED TO REFERENCE THE ARG.
		IF ARGLST IS PRESENT, THE PC IS SAVED ON ENTRY AND THE PC THAT
		THE CALLING PROGRAM HAD BEFORE THE CALL IS AUTOMATICALLY
		RESTORED ON RETURN BY RST.PC IN STRSUB.

RETURN		GENERATES POPJ P,

SRETURN		DOES A SKIP RETURN BY JRSTING TO SKP.RT IN STRSUB.

ENDSUB		GENERATES NO CODE BUT MAY BE USED AT THE END OF A SUBROUTINE
		TO CHECK THE STACK LEVEL TO FIND STRUCTURING ERRORS.

LOCAL	<<VAR1,INI1>,<VAR2,INI2>,...>
		GENERATES CODE TO ALLOCATE STORAGE ON THE PDL FOR A LIST
		OF LOCAL VARIABLES.  FOR EACH LOCAL VARIABLE, A MACRO IS
		DEFINED BY THE SAME NAME OF THE FORM X(LP) WHICH ALLOWS
		THE VARIABLE TO BE REFERENCED IN LOCAL STORAGE.
		IF INI? IS PRESENT, VAR? IS INITIALIZED TO INI?.
		CODE IS ALSO GENERATED TO CAUSE THE STORAGE TO BE
		AUTOMATICALLY FREED ON RETURN FROM THE SUBROUTINE.
		NOTE: LOCAL VARIABLES MAY BE PASSED TO SUBROUTINES AS
		PARAMETERS BUT THE CALLING SUBROUTINE MAY ONLY USE THE
		CORRESPONDING PARAMETER UP UNTIL THE POINT WHERE IT SETS UP
		ITS LOCAL STORAGE.  THE PARAMETER WHICH CORESPONDS TO A LOCAL
		VARIABLE IN THE CALLING SUBROUTINE MAY HOWEVER BE USED TO
		INITIALIZE A LOCAL VARIABLE IN THE CALLED SUBROUTINE.
UNV:STRMAC.UNV DEFINES THE FOLLOWING MACROS USEFUL FOR STRUCTURED PROGRAMMING.

IFSKIP		MAY BE USED TO BEGIN AN IF-TYPE CONDITIONAL STRUCTURE.  IFSKIP
		GENERATES A JRST TO THE ASSOCIATED ELSE PART OR IF THERE IS
		NO ASSOCIATED ELSE GENERATES A JRST TO THE ASSOCIATED ENDIF.
		IFSKIP USUALLY FOLLOWS AN INSTRUCTION WHICH CONDITIONALLY
		SKIPS.

IFNOSKIP	MAY BE USED TO BEGIN AN IF-TYPE CONDITIONAL STRUCTURE.
		IFNOSKIP IS SIMILAR TO IFSKIP EXCEPT A CAIA IS GENERATED FIRST
		SO THAT THE TRUE PART IS ENTERED IF THERE IS NO SKIP FROM THE
		INSTRUCTION BEFORE THE IFNOSKIP.

IFNOT	<TSTINS>
		MAY BE USED TO BEGIN AN IF-TYPE CONDITIONAL STRUCTURE.  TSTINS
		IS A CONDITIONAL JUMP INSTRUCTION.  IFNOT GENERATES THE
		JUMP ADDRESS FOR TSTINS TO THE ASSOCIATED ELSE PART OR IF
		THERE IS NO ASSOCIATED ELSE TO THE ASSOCIATED ENDIF.
		IF THE CONDITION OF TSTINS IS NOT TRUE THE TRUE PART IS
		ENTERED, OTHERWISE TSTINS JUMPS TO THE ELSE PART OR THE ENDIF.

ELSE		MAY BE USED IN AN IF-TYPE CONDITIONAL STRUCTURE TO END
		THE TRUE PART AND BEGIN THE FALSE PART.  ELSE GENERATES
		A JRST TO THE ASSOCIATED ENDIF MACRO AND A LABEL FOR
		THE ASSOCIATED IF MACRO TO JRST TO.
ENDIF		MUST BE USED TO END AN IF-TYPE CONDITIONAL STRUCTURE.  ENDIF
		GENERATES A LABEL WHICH IS THE TARGET OF A JRST IN AN
		ASSOCIATED IF OR ELSE.

SELECT	AC,OF,N
		MUST BE USED TO BEGIN A CASE-TYPE CONDITIONAL STRUCTURE.
		A CASE-TYPE CONDITIONAL STRUCTURE IS A STRUCTURE WHICH
		CONTAINS SEVERAL CASES.  EACH CASE IS PRECEEDED BY
		EITHER THE CASE MACRO, THE CASEIF MACRO, THE CASENOT MACRO
		OR THE ELSECASE MACRO.  AT MOST ONE OF THE CASES IS SELECTED
		THEN A JRST IS MADE TO THE END OF THE CASE-TYPE CONDITIONAL
		STRUCTURE.
		THERE ARE 2 TYPES OF CASE-TYPE CONDITIONAL STRUCTURES.
		IN A DISPATCH TYPE SELECT, THE CASE SELECTOR IS A POSITIVE
		INTEGER IN THE SPECIFIED AC RANGING FROM 1 TO N.  CODE IS
		GENERATED TO CHECK THAT THE CONTENTS OF THE AC IS IN RANGE
		OTHERWISE THE CODE JRSTS TO THE ELSECASE IF IT IS PRESENT OR
		TO THE ENDSEL ENDING THE STRUCTURE.  THE DISPATCH IS MADE
		BY JUMPING THROUGH A VECTOR OF ADDRESSES OF THE VARIOUS
		CASES.  EACH CASE IS HEADED BY A CASE MACRO WHOSE ARGUMENT
		IS A LIST OF ONE OR MORE INTEGERS IN THE RANGE 1 TO N.  THAT
		CASE IS ENTERED WHEN AC HAS ONE OF THE VALUES IN THE LIST.
		IF ONE OF THE VALUES IN THE RANGE 1 TO N DOES NOT HAVE AN
		ASSOCIATED CASE, THEN THE ELSECASE IS SELECTED OR IF THERE
		IS NO ELSECASE, THE CASE-TYPE CONDITIONAL STRUCTURE IS
		EXITED BY JRSTING TO THE ENDSEL.
		IN A CHECKING CHAIN TYPE SELECT, THE SPECIFIED AC MAY CONTAIN
		ANY VALUE.  IN THIS CASE THE SELECT MACRO GENERATES NO CODE.
		INSTEAD, CODE IS GENERATED AT THE BEGINNING OF EACH CASE TO
		CHECK WHETHER OR NOT TO EXECUTE THAT CASE.
CASE	<VALUE-LIST>
		MUST BE USED TO HEAD A CASE FOR A DISPATCH TYPE SELECT.
		MAY BE USED TO HEAD A CASE FOR A CHECKING CHAIN TYPE SELECT.
		A JRST IS GENERATED FIRST SO THAT THE PRECEEDING CASE WILL
		EXIT TO THE ENDSEL ENDING THE STRUCTURE.
		FOR DISPATCH SELECT, EACH VALUE IN THE VALUE LIST MUST BE IN
		THE RANGE 1 TO N WHERE N IS FROM THE SELECT MACRO.
		A LABEL IS GENERATED FOR EACH VALUE IN THE LIST WHICH IS
		JUMPED TO FROM A JUMP VECTOR IN THE SELECT.
		FOR A CHECKING TYPE SELECT, THE LIST MAY CONTAIN ANY VALUES.
		A LABEL IS GENERATED SO THAT THE PRECEEDING CASE CAN JUMP
		TO THIS CASE IF THE CHECKING CODE ON IT FAILS.  THEN CAI OR
		CAM INSTRUCTIONS ARE GENERATED TO COMPARE THE AC SPECIFIED IN
		THE SELECT MACRO WITH THE VALUES IN THE LIST.  IF NONE OF
		THE VALUES MATCH, A JRST IS GENERATED TO THE NEXT CASE, OR
		THE ELSECASE, OR THE ENDSEL DEPENDING ON WHICH IS NEXT.
		IF THIS TYPE OF CASE IS NOT USED IN A CHECKING CHAIN TYPE OF
		SELECT, THEN THE AC DOES NOT NEED TO BE GIVEN ON THE SELECT.

CASEIF	<SKPINS>
		MAY BE USED TO HEAD A CASE FOR A CHECKING CHAIN TYPE SELECT.
		A JRST IS GENEARATED FIRST SO THAT THE PRECEEDING CASE WILL
		EXIT TO THE ENDSEL ENDING THE STRUCTURE.
		A LABEL IS THEN GENERATED SO THAT THE PRECEEDING CASE CAN
		JUMP TO THIS CASE IF THE CHECKING CODE ON IT FAILS.  THEN
		SKPINS IS GENERATED WHICH SHOULD BE A CONDITIONAL SKIP TYPE
		INSTRUCTION WHICH WILL SKIP IF THIS CASE SHOULD BE ENTERED.
		THEN A JRST IS GENERATED WHICH WILL JUMP TO THE NEXT CASE,
		ELSECASE OR ENDSEL IF SKPINS DOES NOT SKIP.

CASENOT	<TSTINS>
		MAY BE USED TO HEAD A CASE FOR A CHECKING CHAIN TYPE SELECT.
		THIS MACRO IS SIMILAR TO CASEIF EXCEPT THAT INSTEAD OF A
		CONDITIONAL SKIP INSTRUCTION THE ARG IS A CONDITIONAL JUMP
		INSTRUCTION.  THE MACRO GENERATES THE JUMP ADDRESS SUCH THAT
		IF THE CONDITION IS TRUE IT JUMPS TO CHECK THE NEXT CASE,
		OTHERWISE THIS CASE IS ENTERED.

ELSECASE	MAY BE USED TO HEAD THE LAST CASE OF EITHER TYPE OF SELECT.
		ELSECASE IS OPTIONAL BUT IF PRESENT IT IS ENTERED IF FOR
		A DISPATCH TYPE SELECT THE VALUE IN THE AC IS LESS THAN 1 OR
		GREATER THAN N OR IF THERE IS NO CASE FOR THAT VALUE OR
		FOR A CHECKING TYPE SELECT IF NONE OF THE PRECEEDING CASES
		IN THE CHECKING CHAIN HAVE BEEN ENTERED YET.
		A JRST IS GENEARATED FIRST SO THAT THE PRECEEDING CASE WILL
		EXIT TO THE ENDSEL ENDING THE STRUCTURE.  THEN A LABEL
		IS GENERATED FOR EACH MISSING CASE IN A DISPATCH TYPE SELECT.

ENDSEL		MUST BE USED TO END A CASE-TYPE CONDITIONAL STRUCTURE.
		GENERATES A LABEL WHICH EACH CASE EXITS TO AND A LABEL
		FOR EACH MISSING CASE IN A DISPATCH TYPE SELECT IF THERE IS
		NO ELSECASE.
LOOP		MUST BE USED TO BEGIN A LOOP STRUCTURE.  GENERATES A LABEL
		FOR THE TOP OF THE LOOP.

WHILESKIP	MAY BE USED IN A LOOP STRUCTURE TO EXIT FROM LOOP.
		WHILESKIP IS USUALLY USED FOLLOWING A CONDITIONAL SKIP
		INSTRUCTION TO CONDITIONALLY EXIT FROM A LOOP WHEN THE
		INSTRUCTION DOES NOT SKIP.

WHILE	<TSTINS>
		MAY BE USED IN A LOOP STRUCTURE TO CONDITIONALLY EXIT FROM
		THE LOOP.  TSTINS IS A CONDITIONAL JUMP INSTRUCTION WHOSE
		ADDRESS IS GENERATED BY THE MACRO TO JUMP AROUND A JUMP OUT
		OF THE LOOP.  THEREFORE THE LOOP IS EXITED WHEN THE CONDITION
		IS NOT MET.

UNTILSKIP	MAY BE USED IN A LOOP STRUCTURE TO EXIT FROM LOOP.
		UNTILSKIP IS LIKE WHILESKIP EXCEPT THAT UNTILSKIP GENERATES
		A CAIA FIRST SO THAT THE LOOP IS EXITED WHEN THE PRECEEDING
		SKIP INSTRUCTION SKIPS.

UNTIL	<TSTINS>
		MAY BE USED IN A LOOP STRUCTURE TO CONDITIONALLY EXIT FROM
		THE LOOP.  TSTINS IS A CONDITIONAL JUMP INSTRUCTION WHOSE
		ADDRESS IS GENERATED BY THE MACRO TO JUMP OUT OF THE LOOP
		WHEN THE CONDITION IS MET.

EXITLOOP	MAY BE USED IN A LOOP STRUCTURE TO UNCONDITIONALLY EXIT
		FROM THE LOOP.

NEXTLOOP	MAY BE USED IN A LOOP STRUCTURE TO UNCONDITIONALLY JUMP TO
		THE TOP OF THE LOOP.

ENDLOOP	<TSTINS>
		MUST BE USED TO END A LOOP STRUCTURE.
		TSTINS IS OPTIONAL.  IF IT IS NOT PRESENT A JRST IS GENERATED
		TO THE TOP OF THE LOOP.  IF TSTINS IS PRESENT, IT SHOULD
		BE A CONDITIONAL JUMP INSTRUCTION WHICH IS GENERATED INSTEAD
		THE JRST TO THE TOP OF THE LOOP TO PROVIDE FOR CONDITIONAL
		EXIT FROM THE LOOP.
		A LABEL IS GENERATED AT THE END OF THE LOOP FOR ANY OF THE
		ABOVE LOOP EXIT MACROS TO JUMP TO.
UNV:STRMAC.UNV USES THE FOLLOWING INTERNAL DEFINITIONS.

VARIABLES USED INTERNALLY BY STRMAC, NOT FOR GENERAL USE.

.LBL		NEXT AVAILABLE LABEL NUMBER
.E		ENDSEL LABEL
.N		NUMBER OF CASES IN A DISPATCH TYPE SELECT
.R		AC TO USE IN A CHECKING CHAIN TYPE SELECT
.F		FLAGS FIRST CASE OF A CHECKING CHAIN TYPE SELECT
.L		LOOP LABEL
..		NEXT AVAILALBE LOCATION IN LOW SEG FOR BLK MACRO
.K		SCRATCH COUNTER
.S		USED TO SAVE LOCATION COUNTER IN BLK MACRO

MACROS USED INTERNALLY BY STRMAC, NOT FOR GENERAL USE.

$XLIST		CLEANS UP LISTING, FOR FULL EXPANSION SYN LIST,$XLIST
$DEFARG		DEFINE SUBROUTINE ARGUMENTS
$VARDEF		DEFINE LOCAL VARIABLES
$VARDF2		DEFINE LOCAL VARIABLES
$PUSH		PUSH
$POP		POP
$DL		DEFINE A LABEL
$LR		REFERENCE A LABEL
$CMP		GENERATE A CAI OR CAM INSTRUCTION
$EC		GENERATE MISSING CASE LABELS FOR DISPATCH TYPE SELECT

******************************************************************************
* EXAMPLES * EXAMPLES * EXAMPLES * EXAMPLES * EXAMPLES * EXAMPLES * EXAMPLES *
******************************************************************************
EXAMPLE OF USING STRMAC AND THE STRIN., DFN, PROG, AND ENDPRG MACROS
****************************************************************
TITLE	TSTPRG
SEARCH	STRMAC			; GETS STRMAC DEFINITIONS
STRIN.				; INITIALIZES STRMAC
SALL

DFN	PDLSIZ,40		; DEFINES PDLSIZ=40

PROG	TSTPRG,PDLSIZ		; GENERATES LABEL TSTPRG AND ALLOCATES A BLOCK
				; OF 40 WORDS AND SETS UP AC P POINTING TO THE
				; THE BLOCK FOR A PUSHDOWN LIST
.
.
.
ENDPRG				; GENERATES MACRO END STATEMENT
				; WITH TSTPRG AS START ADDRESS
******************************************************************************
>;END REPEAT 0
UNIVER	STRMAC
PASS2
.DIRECT	.NOBIN
SYN	XLIST,$XLIST

DEFINE	DFN(SYM,VAL)<SYM=VAL>	; DEFINE A SYMBOL

DFN	R0,0
DFN	T1,R0+1		; TEMPORARY AC'S
DFN	T2,T1+1
DFN	T3,T2+1
DFN	T4,T3+1
DFN	P1,T4+1		; PRESERVED AC'S
DFN	P2,P1+1
DFN	P3,P2+1
DFN	P4,P3+1
DFN	R1,P4+1		; RESERVED AC'S
DFN	R2,R1+1
DFN	R3,R2+1
DFN	R4,R3+1
DFN	LP,R4+1		; LOCAL STORAGE POINTER
DFN	PC,16		; PARAMETER LIST ADDRESS FOR SUBR CALLS
DFN	P,17		; PDL POINTER
DEFINE	STRIN.(STRSEG)<
IFIDN	<STRSEG><HGHSEG>,<
  .TEXT	"/SEARCH REL:STRSUB"
>;END IFIDN
IFDIF	<STRSEG><HGHSEG>,<
  .TEXT	"/SEARCH/SEGMENT:LOW REL:STRSUB"
>;END IFDIF
IF1	,<DEFINE $END<END>>
.DIRECT	.XTABM
.LBL=1
.E=0
.N=0
.R=0
.F=0
.L=0
..=0
>;END DEFINE

DEFINE	BLK(SYM,SIZ,SYMLST)<
.S=.
IFGE	.S-400000,<
		RELOC	..
>;END IFG
SYM=.
.K=1
IRP	SYMLST,<
  SYMLST=.+.K
  .K=.K+1
>;END IRP
IFNB	<SIZ>,<
		BLOCK SIZ
>;END IFNB
IFB	<SIZ>,<
		BLOCK 1
>;END IFB
..=.
IFGE	.S-400000,<
		RELOC	.S
>;END IFG
>;END DEFINE
DEFINE	PROG(PRGNAM,PDLSIZ,RUNOFF,RUNFLS)<
IFNB	<RUNOFF>,<
  BLK RUNOFF
>;END IFNB
IFNB	<RUNFLS>,<
  BLK	RUNFLS,4
>;END IFNB
IFNB	<PDLSIZ>,<
  BLK	PDL,PDLSIZ
>;END IFNB
DEFINE	$END<END PRGNAM>
PRGNAM:
$XLIST
		TDZA T1,T1
		MOVEI T1,1
IFNB	<RUNOFF>,<
		MOVEM T1,RUNOFF
>;END IFNB
IFNB	<RUNFLS>,<
		MOVEM 11,RUNFLS
		MOVEM  0,RUNFLS+1
		MOVEM 17,RUNFLS+2
		MOVEM  7,RUNFLS+3
>;END IFNB
IFNB	<PDLSIZ>,<
		MOVE P,[IOWD PDLSIZ,PDL]
>;END IFNB
		SETZ PC,
LIST>;END DEFINE

DEFINE	ENDPRG<
PURGE	.LBL,.E,.N,.R,.F,.L,..,.K,.S
$END
>;END DEFINE

DEFINE	CALL(SUBNAM,ARGLST)<$XLIST
IFNB	<ARGLST>,<
		HRRI PC,[
  IRP ARGLST,<
		Z ARGLST
  >;END IRP
		]
>;END IFNB
		PUSHJ P,SUBNAM
LIST>;END DEFINE
DEFINE	CALL$R(SUBNAM,ARGLST)<$XLIST
IFNB	<ARGLST>,<
		HRRI PC,[
  IRP ARGLST,<
		ARGLST
  >;END IRP
		]
>;END IFNB
		JRST SUBNAM
LIST>;END DEFINE

DEFINE	CALL$F(SUBNAM,ARGLST)<
		EXTERN SUBNAM
		PUSHJ P,CAL.FS##
		[
		SUBNAM
IFNB	<ARGLST>,<
  IRP ARGLST,<
		ARGLST
  >;END IRP
>;END IFNB
		]+1
>;END DEFINE

DEFINE	SUBR(SUBNAM,ARGLST)<
SUBNAM:		ENTRY SUBNAM
$XLIST
IFNB	<ARGLST>,<
  .K=0
  IRP	ARGLST,<
    $DEFARG(ARGLST,\.K)
    .K=.K+1
  >;END IRP
		PUSH P,PC
		HRL PC,P
		PUSH P,RST.PC##
>;END IFNB
LIST>;END DEFINE

DEFINE	$DEFARG(ARG,DSP)<
DEFINE ARG<@DSP(PC)>
>;END DEFINE

OPDEF	RETURN	[POPJ P,]
OPDEF	SRETURN	[JRST SKP.RT##]

DEFINE	ENDSUB<
IF2	,<
  IFN	.E+.L,<
    PRINTX ERROR IN PROGRAM STRUCTURE
  >;END IFN
>;END IF2
>;END DEFINE
DEFINE	LOCAL(VARLST)<$XLIST
		PUSH P,P
.K=0
IRP	VARLST,<
  .K=.K+1
  $VARDEF(\<.K+1>,VARLST)
>;END IRP
		EXCH LP,-.K(P)
		PUSH P,RST.LP##
LIST>;END DEFINE

DEFINE	$VARDEF(DSP,VARVAL)<
$VARDF2(DSP,VARVAL)
>;END DEFINE

DEFINE	$VARDF2(DSP,VAR,VAL)<
DEFINE	VAR<DSP(LP)>
		PUSH P,VAL
>;END DEFINE
DEFINE	$DL(LBLNUM)<$L'LBLNUM:>

DEFINE	$LR(LBLNUM)<$L'LBLNUM>

DEFINE	$DC(LBLNUM)<IFNDEF $L'LBLNUM,<$L'LBLNUM:>>

DEFINE	IFSKIP<
$PUSH	.E
.E=.LBL
.LBL=.LBL+1
		JRST $LR(\.E)
>;END DEFINE

DEFINE	IFNOSKIP<$XLIST
$PUSH	.E
.E=.LBL
.LBL=.LBL+1
		CAIA
		JRST $LR(\.E)
LIST>;END DEFINE

DEFINE	IFNOT(TSTINS)<
$PUSH	.E
.E=.LBL
.LBL=.LBL+1
		TSTINS $LR(\.E)
>;END DEFINE

DEFINE	ELSE<
		JRST $LR(\.LBL)
$DL(\.E)
.E=.LBL
.LBL=.LBL+1
>;END DEFINE

DEFINE	ENDIF<
$DL(\.E)
$POP	.E
>;END DEFINE
DEFINE	SELECT(AC,OF,N)<$XLIST
$PUSH	.E,.N,.R
IFNB	<N>,<
  .E=.LBL+1
  .N=N
  .R=-1
  .LBL=.LBL+N+2
		JUMPLE AC,$LR(\<.E-1>)
		CAILE AC,N
		JRST $LR(\<.E-1>)
		JRST @.(AC)
  REPEAT	N,<
    .E=.E+1
		$LR(\.E)
  >;END REPEAT
  .E=.E-N
>;END IFNB
IFB	<N>,<
  .E=.LBL
  .N=.LBL+1
  .R=AC
  .LBL=.LBL+2
  .F=1
>;END IFB
LIST>;END DEFINE
DEFINE	CASE(C)<$XLIST
IFL	.R,<
		JRST $LR(\.E)
  IRP	C,<
    $DL(\<.E+C>)
  >;END IRP
>;END IFL
IFGE	.R,<
  IFE	.F,<
		JRST $LR(\.E)
    $DL(\.N)
    .N=.LBL
    .LBL=.LBL+1
  >;END IFE
  .F=0
  .K=-1
  IRP	C,<
    .K=.K+1
  >;END IRP
  IFE	.K,<
    $CMP(E,.R,C)
		JRST $LR(\.N)
  >;END IFE
  IFG	.K,<
    IRP	C,<
      $CMP(N,.R,C)
		JRST $LR(\.LBL)
    >;END IRP
		JRST $LR(\.N)
    $DL(\.LBL)
    .LBL=.LBL+1
  >;END IFG
>;END IFGE
LIST>;END DEFINE

DEFINE	$CMP(C,AC,V)<
IFE	<-1B17&V>,<
		CAI'C AC,V
>;END IFE
IFN	<-1B17&V>,<
		CAM'C AC,[V]
>;END IFN
>;END DEFINE
DEFINE	CASEIF(SKPCHK)<$XLIST
IFE	.F,<
		JRST $LR(\.E)
  $DL(\.N)
  .N=.LBL
  .LBL=.LBL+1
>;END IFE
.F=0
		SKPCHK
		JRST $LR(\.N)
LIST>;END DEFINE

DEFINE	CASENOT(TSTINS)<$XLIST
IFE	.F,<
		JRST $LR(\.E)
  $DL(\.N)
  .N=.LBL
  .LBL=.LBL+1
>;END IFE
.F=0
		TSTINS $LR(\.N)
LIST>;END DEFINE

DEFINE	$EC<
$DC(\<.E-1>)
REPEAT	.N,<
  .E=.E+1
  $DC(\.E)
>;END REPEAT
.E=.E-.N
>;END DEFINE

DEFINE	ELSECASE<
		JRST $LR(\.E)
IFL	.R,<
  $EC
>;END IFL
IFGE	.R,<
  $DL(\.N)
>;END IFGE
>;END DEFINE

DEFINE	ENDSEL<
IFL	.R,<
  $EC
>;END IFL
IFGE	.R,<
  $DC(\.N)
>;END IFGE
$DL(\.E)
$POP	.R,.N,.E
>;END DEFINE
DEFINE	LOOP<
$PUSH	.L
.L=.LBL
.LBL=.LBL+2
$DL	\.L
>;END DEFINE

DEFINE	WHILESKIP<
		JRST $LR(\<.L+1>)
>;END DEFINE

DEFINE	WHILE(TSTINS)<$XLIST
		TSTINS .+2
		JRST $LR(\<.L+1>)
LIST>;END DEFINE

DEFINE	UNTILSKIP<$XLIST
		CAIA
		JRST $LR(\<.L+1>)
LIST>;END DEFINE

DEFINE	UNTIL(TSTINS)<
		TSTINS $LR(\<.L+1>)
>;END DEFINE

DEFINE	EXITLOOP<
		JRST $LR(\<.L+1>)
>;END DEFINE

DEFINE	NEXTLOOP<
		JRST $LR(\.L)
>;END DEFINE

DEFINE	ENDLOOP(TSTINS)<
IFB	<TSTINS>,<
		JRST $LR(\.L)
>;END IFB
IFNB	<TSTINS>,<
		TSTINS $LR(\.L)
>;END IFNB
$DL	\<.L+1>
$POP	.L
>;END DEFINE

END