Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0130/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