Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/13/cgsa.mac
There are 2 other files named cgsa.mac in the archive. Click here to see a list.
SUBTTL CODE GENERATION
SALL
COMMENT;
AUTHORS: STEFAN ARNBORG, LARS ENDERIN 1-AUG-73
VERSION: 4 [11,14,20,26,32,33,56,65,142,210,251]
PURPOSE: CODE GENERATION
CONTENTS: GENERATORS FOR NODES IN EXPRESSION TREE:
ZID, ZCN AND ZNS NODES EXCEPT %PCALL, %NEW, %BEGPB, ETC.
;
SEARCH SIMMAC,SIMMC2,SIMMCR,SIMRPA
CTITLE CGSA
; COMPILE OPDEFS
EXTERN CADS,CAUD,CGACSA,CGPD,CGRA
EXTERN CGAS,CGG1,CGG2,CGG3,CGG4,CGG5,CGG7,CGR2,CGR3,CGR4
EXTERN CGIACT ;[14]
EXTERN CGAC
IFN QDEBUG,<
EXTERN DBDT
>
EXTERN O2AD,O2AF,O2GI
EXTERN CGIM,CGMO1,CGIM1,CGMO
EXTERN O2CF,O2DF,O2GA,O2GF,O2GR,O2GW,O2GWD,O2IV
EXTERN QOPSTZ
EXTERN YBKSTP,YELIN2,YGAP,YCGXAC,YCGSWC,YLXIAC,YCGACT,YEXPL,YEXPP,YOPST
EXTERN YCGFX1,YACTAB,YCGFX2,YFORSI,YO2ADI,YO2ADF,YOPCOD,YO2FIX
EXTERN YOPSTB,YOPSTP,YORFOR,YQRELR,YQRELT,YRELPT,YZHET,YRELCD
EXTERN YSYSI,YWARCT
EXTERN .AND,.DEQ,.DIV,.EQ,.EQV,.GRT,.IDIV,.IMP,.LESS,.MINUS
EXTERN .MULT,.NDEQ,.NGRT,.NLESS,.POW,.OR,.PLUS,.UNMIN,.NEQ
EXTERN .BEGPB,.NEW,.PCALL,.IN,.IS,.QUA,.QUAL
EXTERN YCGINS,YORACT,YORFX,YTAC,YZHBXC
INTERN CGAA,CGCCCH,CGEN,CGVA,CGCC,CGCO,CGAD,CGCA,CGPU,CGRN,CGRD,CGLO,CGLO1
IFN QDEBUG,<INTERN CGDB>
EXTERN YCGFOX,YCGICR,YCGISG
DSW SCGFOX,YCGFOX,36
DSW SFORSI,YFORSI,36
OPDEF ALFIX [PUSHJ XPDP,O2AF]
OPDEF GENRLD [PUSHJ XPDP,CGRD]
OPDEF IFLR [CAIN X6,QLREAL]
OPDEF LR [CAIE X6,QLREAL]
; MACROS
DEFINE FIRSTOP=<LF XP1,ZNSZNO(XCUR)>
MACINIT
CGINIT
TWOSEG
RELOC 400K
SUBTTL CG ENTRY POINTS
COMMENT;
PURPOSE: ENTRY POINTS FOR CODE GENERATION
ENTRIES: CGEN INITIALIZE FOR COMPILATION OF
A ROOT NODE
CGAD COMPILE ABSOLUTE ADDRESS OF QUANTITY REPRESENTED
BY A NODE OF THE EXPRESSION TREE
TO THE CURRENT TOP OF STACK ACCUMULATOR
CGCA COMPILE DYNAMIC (I.E. MOVABLE) ADDRESS OF A QUANTITY
CGCC COMPILE A BOOLEAN EXPRESSION SO THAT THE NEXT
INSTRUCTION IS SKIPPED IF THE VALUE IS FALSE
CGCO SAME AS CGCC BUT SKIP IF VALUE IS TRUE
CGVA COMPILE VALUE OF EXPRESSION
ENTRY CONDITIONS: CGEN THE ROOT NODE OF THE STATEMENT TO BE COMPILED IS
IN THE BOTTOM OF THE OPERAND STACK
CGAD...CGVA
XP1 CONTAINS THE ADDRESS OF THE ROOT OF THE SUB-
EXPRESSION, YTAC POINTS TO THE LOGICAL (AND INDIRCTLY
TO THE PHYSICAL) ACCUMULATOR OF THE DESTINATION
OF THE RESULT
ACCUMULATORS X1-X6 WILL NOT BE RESTORED
;
DEFINE INITI(A)=<
STACK YLINK
HRRZM XPDP,YLINK
SETON A
BRANCH CGCM> ; DUMP TREE
CGEN: ASSERT< IFON SCGDB1
EXEC DBDT
>
IFON SCERFL
BRANCH CGPU
LI YACTAB ; START AT BOTTOM ACCUMULATOR
ST YTAC
LI XWAC1 ; WHICH IS PHYSICALLY XWAC1
HRL YOPSTB
ST @YTAC ; AND WILL GET THE ROOT NODE RESULT (IF ANY)
SETZB XCUR,YLINK ; END OF YLINK CHAIN
L XP1,YOPSTB
EXEC CGVA
BRANCH CGPU
CGAD: INITI(SADDRE)
CGCA: INITI(SCADDR)
CGCC: INITI(SCCOND)
CGCO: INITI(SCONDI)
CGVA: INITI(SVALUE)
CGCM: L X4,YLINK
STACK XCUR
STACK YTAC
STACK YCGACT
HRLZ @YTAC
LSH 5
ST YCGACT
L XCUR,XP1
HRLM XCUR,@YTAC
LF X1,ZID%F(XCUR) ; DISCRIMINATE ON NODE TYPE
XCT CGCM.T(X1)
UNSTK YCGACT
UNSTK YTAC
HRLM XCUR,@YTAC
L XP1,XCUR ; RESET XP1
UNSTK XCUR
ASSERT< HRRZ YLINK
CAIE (XPDP)
RFAIL PDSTACK MISMATCH
>
UNSTK YLINK
RETURN
CGCM.T: RFAI [ASCIZ/ZOS NODE IN TREE/]
RFAI [ASCIZ/ZLI NODE IN TREE/]
EXEC ZCN.
EXEC ZID.
EXEC ZNS.
RFAIL ZNN NODE IN TREE BEFORE COMPILATION
SUBTTL ZCN. : LOAD A CONSTANT
COMMENT;
PURPOSE: LOAD A CONSTANT TO REGISTER @YTAC
FUNCTION: THE CONSTANT IS LOADED WITH L OR LD, OR, FOR SHORT OPERANDS
SETZ,,MOVEI,MOVNI OR MOVSI
ENTRY CONDITION: XCUR ADDRESS OF ZCN NODE
X4 FLAGS (SVALUE ETC. ) AND YLINK
XV1 PARAMETER DESCRIPTOR FLAGS IF CALLED FROM CGPAGC
;
ZCN.: LF X1,ZCNTYP(XCUR)
LF X2,ZCNVAL(XCUR)
IF ; LONG REAL?
CAIE X1,QLREAL
GOTO FALSE
THEN
;***UWOBEG
;SUPPLY ACCUMULATOR FOR LD MACRO
LD X0,(X2) ; GET VALUE TO X0-X1
;***UWOEND
GENDW ; OUTPUT DOUBLE CONSTANT
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
OP (DMOVE)
;***UWOEND
ADD YCGACT
GENREL
ASSERT< IFOFF SVALUE
RFAIL LONG REAL CONSTANT ADDRESS REQUESTED
>
RETURN
FI
IF ; TEXT?
CAIE X1,QTEXT
GOTO FALSE
THEN
IF ; STRING?
HRRZ X2
JUMPE FALSE
THEN
STACK YQRELR
STACK YQRELT
LI QRELPT
ST YQRELT
HLRZ X2
GENREL ; 0,,START ADDRESS
HRLZ X2
SETZM YQRELR
GENREL ; LENGTH,,0
UNSTK YQRELT
L YRELPT
SUBI 2
IF
IFOFFA SVALUE(X4)
GOTO FALSE
THEN
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
OP (DMOVE)
;***UWOEND
ELSE
IFOFFA SADDRE(X4)
OP (LI)
FI
ADD YCGACT
IFONA SADDRE(X4)
HLL XV1 ; COMMUNICATES WITH THUNK COMPILATION
LI X1,QRELPT
ST X1,YQRELR
GENREL
UNSTK YQRELR
RETURN
FI
; NOTEXT
SETZB X1
GENDW
HLL XV1 ; COMMUNICATES WITH PARAMETER DESCRIPTOR COMPILATION
IF
IFOFFA SVALUE(X4)
GOTO FALSE
THEN
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
OP (DMOVE)
;***UWOEND
ADD YCGACT
ELSE
IF IFONA SADDRE(X4)
GOTO FALSE
THEN ; COMPILE ADDRESS
OP (LI)
ADD YCGACT
FI
FI
GENREL
RETURN
FI
CAIN X1,QREF ;[26] ZERO QUAL. IN LH IF NONE
LI X2,NONE
; ONE WORD CONSTANT: IMMEDIATE INSTRUCTION PREFERRED
ASSERT< IFONA SADDRE(X4)
RFAIL ADDRESS OF LITERAL REQUESTED
IFONA SCADDR(X4)
RFAIL COMPUTED ADDRESS REQUESTED FOR LITERAL
>
IF IFOFFA SVALUE(X4)
GOTO FALSE
THEN ; VALUE
IF JUMPN X2,FALSE
THEN ; ZERO LOAD
MOVSI (SETZ)
GOTO [ADD YCGACT
GENABS
RETURN]
FI
IF TRNE X2,-1
GOTO FALSE
THEN ; RIGHT HALF ZERO
HLR X2
OP (MOVSI)
GOTO [ADD YCGACT
GENABS
RETURN]
FI
IF TLNE X2,-1
GOTO FALSE
THEN ; LEFT HALF ZERO
HRR X2
OP (LI)
GOTO [ADD YCGACT
GENABS
RETURN]
FI
IF MOVN X2
TLNE -1
GOTO FALSE
THEN ; NEGATIVE IMMEDIATE
OP (MOVNI)
GOTO [ADD YCGACT
GENABS
RETURN]
FI
FI
; NO OPTIMIZED (I.E. IMMEDIATE) LOAD
L X2
GENWRD
OP (L)
ADD YCGACT
GENREL
IF IFOFFA SCONDI(X4)
GOTO FALSE
THEN
;WARNING 2,REDUNDANT BOOLEAN CONSTANT ;[20] REMOVED
OP (SKIPN)
GOTO [HRR @YTAC
GENABS
RETURN]
FI
IF IFOFFA SCCOND(X4)
GOTO FALSE
THEN
;WARNING 2,REDUNDANT BOOLEAN CONSTANT ;[20] REMOVED
OP (SKIPE)
GOTO [HRR @YTAC
GENABS
RETURN]
FI
RETURN
; END ZCN.
SUBTTL ZID. : LOAD AN IDENTIFIER VALUE OR ADDRESS
COMMENT;
PURPOSE: COMPILE AN IDENTIFIER
;
ZID.:
L X1,XCUR
IF MEMOP
GOTO FALSE
THEN
LF X1,ZIDZQU(XCUR)
GETAD
IF IFOFFA SVALUE(X4)
GOTO FALSE
THEN ; COMPILE LOAD
LF X1,ZIDTYP(XCUR)
MOVSI (L)
CAIE X1,QLREAL
CAIN X1,QTEXT
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
OP (DMOVE)
;***UWOEND
ELSE
IF IFOFFA SCONDI(X4)
GOTO FALSE
THEN
MOVSI (SKIPN) ; SKIP IF TRUE
ELSE
IF IFOFFA SCCONDI(X4)
GOTO FALSE
THEN
MOVSI (SKIPE) ; SKIP IF FALSE
ELSE
LI X1,ZNN%V
SF X1,ZNOTYP(XCUR)
LI X1,QCODVA
SF X1,ZNNCOD(XCUR)
IF IFOFFA SCADDR(X4)
GOTO FALSE
THEN ; COMPUTED ADDRESS
ZF ZNNCOD(XCUR)
LDB X2,[INDEXFIELD YO2ADI]
MOVSI (HRLI)
DPB ,[INDEXFIELD YO2ADI]
ST YOPCOD
GENOP ; LOADS OFFSET TO LEFT HALF
L X2
OP (HRR)
ADD YCGACT
GENABS
ELSE
SETZM YOPCOD
SETZM YO2ADI
FI
RETURN
FI
FI
FI
ST YOPCOD
GENOP
ELSE
XZHE=X6
XZQU=X5
XKND=X3
XMOD=X2
XTYP=X4
LF XZQU,ZIDZQU(XCUR)
LF XZHE,ZQUZHE(XZQU)
LF XMOD,ZQUMOD(XZQU)
LF XKND,ZQUKND(XZQU)
LF XTYP,ZQUTYP(XZQU)
L X1,X5 ; USED BY GETAD
IF CAIE XMOD,QNAME
GOTO FALSE
THEN ; NAME MODE PARAMETER
LF X1,ZIDZQU(XCUR)
GETAD
HLLZ YO2ADI
OR [LI 0]
GENABS
SETZB YLXIAC
DPB [INDEXFIELD YO2ADI]
OP (HRLI)
ST YOPCOD
GENOP
SETZM YLXIAC ; XIAC DESTROYED BY PARAMETER ROUTINES;
LI PHFV ; FORMAL VALUE IS STANDARD
LF X1,ZIDZQU(XCUR)
LF X2,ZQUKND(X1)
CAIN X2,QSIMPLE
CAIN XTYP,QLABEL
LI PHFM ; BUT PHFM FOR NON-SIMPLE PARAMETERS
L X2,YLINK
IF IFONA SADDRE(X2)
GOTO TRUE
IFOFFA SCADDRE(X2)
GOTO FALSE
THEN ; ADDRESS REQUESTED
ZF ZNNCOD(XCUR) ;QCODCA
LI X1,ZNN%V
SF X1,ZNOTYP(XCUR)
LI PHFA
FI
LF X1,ZIDTYP(XCUR)
IF CAIE X1,QTEXT
GOTO FALSE
THEN ;THIS SUBTLE PIECE OF CODE DETERMINES THE CORRECT
;PARAMETER HANDLING ROUTINE FOR TEXTS CALLED BY NAME
; DISTINGUISHED CASES ARE:
;T.PUTCHAR, ETC. COMPAD PHFT
;...:-T COMPVAL PHFT,LD
;REMAINING COMPAD PHFA
;REMAINING COMPVAL PHFV
L X2,X0 ; SAVES PHF?
L X1,YLINK ; PATH TO PARENT
L X1,1(X1) ;PARENT NODE ADDRESS
LF ,ZNSGEN(X1)
IF CAIE %DENOT
GOTO FALSE
THEN ;PHFT IF LAST OPERAND
IFOFF ZNOLST(XCUR)
GOTO CGOUT
ASSERT< IFOFF SVALUE
RFAIL TEXT PARAMS
>
LI PHFT
OP (PUSHJ XPDP,)
GENFIX
EXEC CGAC
HRRZ @YTAC
ADD YCGACT ;[YTAC,YTAC(0)]
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
ADD [DMOVE @1]
;***UWOEND
GENABS
RETURN
ELSE ; NOT DENOTES
IFON ZNOLST(XCUR)
GOTO CGOUT
IFON SVALUE
GOTO CGOUT
ZF ZNNCOD(XCUR) ;QCODCA
LI X1,ZNN%V
SF X1,ZNOTYP(XCUR)
LI X2,PHFT
FI
CGOUT: L X2
FI
OP (PUSHJ XPDP,)
IFL <PHFA-400K>,<
GENFIX>
IFG <PHFA-400K>,<
GENABS> ; WARNINGG: PARAMETER ROUTINES MUST ALL BE IN HIGH OR LOW SEGMENT
EXEC CGAC
EXEC CGCCCH ; COMPILE SKIP IF CONDITIONAL
ELSE
IF CAIE XKND,QARRAY
GOTO FALSE
THEN
GETAD
MOVSI (L)
ST YOPCOD
GENOP
IF CAIE XTYP,QREF
GOTO FALSE
THEN
AOS YTAC
LF X1,ZQUZQU(XZQU)
GETAD
MOVSI (LI)
ST YOPCOD
GENOP
SOS YTAC
FI
ELSE
IF CAIE XMOD,QREFER
GOTO FALSE
THEN ; REFERENCE MODE PARAMETER
GETAD ; LOAD ZFL INTO @YTAC
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
MOVSI (DMOVE)
;***UWOEND
ST YOPCOD
GENOP
ELSE ; DECLARED OR VIRTUAL LABEL,SWITCH OR PROCEDURE
LF XZHE,ZQUZHE(XZQU)
IF IFOFF SADDRE
GOTO FALSE
THEN ; LOAD DECLARING BLOCK TO @YTAC
LF ,ZHEDLV(XZHE)
IF SKIPN
GOTO FALSE
THEN ; NOT IN BASICIO
HRLI (HRRZ (XCB))
ELSE ; BASICIO
; ZHB OF DECLARING CLASS IN XZHE
L [LOWADR(XSAC)]
GENABS
LI YSYSIN
L X2,YSYSI
LF X2,ZQUZQU(X2) ; INFILE ZQU
LF X2,ZQUZB(X2) ; INFILE ZHB
CAME X2,XZHE ; SKIP IF SYSIN
LI YSYSOUT
OP (L (XSAC))
FI
ADD YCGACT
GENABS
RETURN
FI
GETAD
MOVSI (HRLZI)
ST YOPCOD
CAIE XMOD,QVIRTUAL
GENOP
ASSERT< CAIN XMOD,QVIRTUAL
SETZM YO2ADI
>
IF CAIE XKND,QPROCE
GOTO FALSE
THEN ; SWITCH OR PROCEDURE
IF CAIE XTYP,QLABEL
GOTO FALSE
THEN ; SWITCH
;FIND BLOCK TO LOAD
L X1,YBKSTP
LF ,ZHEDLV(XZHE)
POP X1,X2
LF X3,ZHEDLV(X2)
CAMLE X0,X3 ; NOTE QUANTS ARE POSITIVE
;(NOT SIGN EXT)
GOTO .-3 ; FIND DECLARING BLOCK
; FIND BLOCK THAT CAN BE LOADED
IF IFOFF ZQUIS(XZQU)
GOTO FALSE
THEN ; WARNING FOR INSPECTED SWITCH
LF X1,ZQULID(XZQU)
SETZM YELIN2
ERRI1 QW,Q2.WAR+^D9
ASSERT<NOP [ASCIZ/CONNECTED SWITCH/]
>
ELSE
WHILE LF ,ZHETYP(X2)
CAIE QRBLOC
CAIN QUBLOC ; NOT BLOCKS
GOTO TRUE
CAIN QINSPE ; NOT INSPECT
GOTO TRUE
CAIE QFOR ; AND NOT FOR STMT
GOTO FALSE
DO
POP X1,X2
OD
FI
LF ,ZHEDLV(X2)
SKIPN
LI -2
OP (HRR (XCB))
ADD YCGACT
GENABS
ELSE ; DECLARED OR VIRTUAL PROCEDURE
IF ;[210] System or quick proc
IFON ZQUSYS(XZQU)
GOTO TRUE
LF X1,ZQUZB(XZQU)
LF ,ZHBMFO(X1)
CAIE QEXMQI
GOTO FALSE
THEN
LF X1,ZQULID(XZQU)
ERROR1 15,X1,SYSTEM OR "QUICK" PROCEDURE X PASSED AS PARAMETER
FI ;[210]
LF ,ZHEDLV(XZHE)
ADD YCGACT
ADD [L 1,(XCB)]
; NOTE DISPLAY IN RIGHT HALFWDS
GENABS
IF IFOFF ZQUIS(XZQU)
GOTO FALSE
THEN ; CONNECTED PROCEDURE
LF XZQU,ZHBZQU(XZHE)
IF ;[65] Connected qual.
IFOFF ZQUIS(XZQU)
GOTO FALSE
THEN ;Use DLV
LF X1,ZQUZHE(XZQU)
LF ,ZHEDLV(X1)
ELSE ;Use SBL of proc
LF XZHE,ZQUZB(XZQU)
LF ,ZHBSBL(XZHE)
SKIPN
LI 2
MOVN
FI ;[65]
OP (HRR (XCB))
ELSE
L [HRR ,XCB]
FI
ADD YCGACT
GENABS
FI
ELSE
IF SKIPE XTYP
SKIPN XKND
GOTO FALSE
THEN; LABEL
ASSERT< CAIE XTYP,QLABEL
RFAIL ZID COMPILATION CODE MISSING
>
IF IFON ZQUIS(XZQU)
GOTO FALSE
THEN
LF ,ZHEEBL(XZHE)
MOVN
ELSE
LF X1,ZQULID(XZQU)
SETZM YELIN2
ERRI1 QW,Q2.WAR+^D9
ASSERT<NOP [ASCIZ/CONNECTED LABEL/]
>
LF ,ZHEDLV(XZHE)
FI
OP (HRR (XCB))
ADD YCGACT
GENABS
SETZ
LF X1,ZHEDLV(XZHE)
MOVN
HRRZ
SF X1,ZLDEBL(,-1)
LF X1,ZHEBNM(XZHE)
SF X1,ZDLBNM(,-1)
GENWRD
OP (L 1,)
ADD YCGACT
GENREL
ELSE ; UNDECLARED OR ILLEGAL OPERAND
L [RTSERR QDSCON,QSORCERR] ;[41]
GENABS
FI
FI
FI
FI
FI
PURGE XTYP,XMOD,XKND,XZHE,XZQU
FI
RETURN
SUBTTL ZNS. : LOAD AN EXPRESSION
ZNS.: LF X1,ZNSGEN(XCUR)
IF IFOFFA SADDRE(X4)
GOTO FALSE
CAIN X1,%DOT
GOTO FALSE ; DECENT ADDRESSES CAN
CAIN X1,%RP
GOTO FALSE ; BE COMPILED FOR %RP AND %DOT
THEN ; ADDRESS OF TEXT: COPY AND STORE DESCRIPTOR
; WITH COMPUTED ADDRESS IN @YTAC
ASSERT<LF ,ZNSTYP(XCUR)
CAIE QTEXT
RFAIL ADDRESS OF NONTEXT EXPR
>
L XP1,XCUR
COMPVAL ; VALUE TO @YTAC
GPUSHJ(TXDA)
EXEC CGAC
; TRANSFORM TO ZNN NODE
LI ZNN%V
SF ,ZNOTYP(XCUR)
LI QCODCA
SF ,ZNNCOD(XCUR)
LI X1,ZID%S(XCUR)
REPEAT 0,<;[251] Does not always work correctly
IFOFF ZNOLST(X1)
RETURN
HRRZ @YTAC
ADD [L 1]
ADD YCGACT
GENABS
LI QCODAA
SF ,ZNNCOD(XCUR)
>;[251] End REPEAT 0
RETURN
FI
GOTO GENTAB(X1)
; GENTAB IS A TABLE WITH ADDRESSES TO THE VARIOUS GENERATORS
; THE SYMBOL 'S' IS COMPILED AT LABEL '.S'
SUBTTL CGAA
COMMENT;
PURPOSE: COMPILE AN ABSOLUTE ADDRESS FROM AN INTERMEDIATE
RELOCATABLE QUANTITY PRODUCED BY COMPAD (CGAD)
ENTRY: CGAA
OPDEF: MAKEAD
INPUT ARGUMENT: X0 AC TO WHICH THE RESULT WILL BE COMPILED
X1 POINTER TO YACTAB ENTRY DESCRIBING
THE INTERMEDIATE RESULT (X1 HAS THE VALUE OF YTAC WHEN
THE QUANTITY WAS COMPILED).
NORMAL EXIT: RETURN
OUTPUT CONDITION: THE ZNN NODE IS MODIFIED (ZNNCOD=QCODAA) AND CODE FOR THE
COMPUTATION HAS BEEN EMITTED
;
CGAA: PROC
SAVE <X2,X3,X4,X5>
L X5,X1
L X2,
HLRZ X3,(X5)
LF X4,ZNNCOD(X3)
IF CAIE X4,QCODCA
GOTO FALSE
THEN
; COMPUTED ADDRESS
HRRZ(X5)
IF CAIE (X2)
GOTO FALSE
THEN ; SOURCE SAME AS TARGET
OP (HLRZ X0,)
GENABS
L X2
OP (ADDM)
GENABS
ELSE ; SOURCE NOT SAME AS TARGET
OP (HLRZ)
DPB X2,[ACFIELD]
ST X4
GENABS
L X4
AND [Z 17,@-1(17)] ; MASK
OR [ADD]
GENABS
FI
ELSE
IF CAIE X4,QCODAR
GOTO FALSE
THEN ; ARRAY ELEMENT
HRLZ X4,(X5)
L X4
LSH 5
ADD X4
ADD [ADD 1,OFFSET(ZARBAD)]
GENABS
HRRZ (X5)
AOS
IF CAMN X0,X2
GOTO FALSE
THEN ; MOVE TO TARGET
OP (L)
DPB X2,[ACFIELD]
GENABS
FI
ELSE
IF CAIE X4,QCODVA
GOTO FALSE
THEN ; VARIABLE
LF X1,ZNNZQU(X3)
GETAD
DPB X2,[ACFIELD YO2ADI]
OPZ (LI)
ST YOPCOD
GENOP
ELSE
IF CAIE X4,QCODAA
GOTO FALSE
THEN ; ADDRESS ALREADY IN @X5
HRRZ (X5)
CAIN (X2)
GOTO FALSE ; SOURCE=TARGET
OP (L)
DPB X2,[ACFIELD]
GENABS
ELSE
IF CAIE X4,QCODRA
GOTO FALSE
THEN
; REMOTE ADDRESS
LF X4,ZNNZNO(X3)
STEP X4,ZID
ASSERT<
EXCH X4,XP1
MEMOP
RFAIL MAKEAD CALLED FOR NONSIMPLE ATTRIBUTE
EXCH X4,XP1
>
LF X4,ZIDZQU(X4)
LF ,ZQUIND(X4)
OP (LI)
DPB X2,[ACFIELD]
HRLZ X4,(X1)
ADD X4
GENABS
ELSE
ASSERT<
CAIE X4,QCODAA
RFAIL INVALID ZNNCOD IN MAKEAD
>
FI
FI
FI
FI
FI
LI QCODAA
SF ,ZNNCOD(X3)
RETURN
EPROC
SUBTTL CGARCH
COMMENT;
PURPOSE: CHECK THAT ARRAY BOUNDS DO NOT USE LOCAL QUANTITIES
ENTRY CONDITION: FIRST ENTRY: FIRST BOUNDS NODE ADDRESS IN X0
RECURSIVE ENTRIES: NODE IN X0
;
CGARCH: PROC
SAVE XP1
L XP1,X0
LOOP ; CHECK THIS NODE AND SIBLINGS
IF WHENNOT XP1,ZNS
GOTO FALSE
THEN ; CHECK ZNS FOR LOCAL OBJECT (%THIS)
LF ,ZNSGEN(XP1)
IF CAIE %THIS
GOTO FALSE
THEN ; CHECK IF %THIS REFERS TO CURRENT BLOCK
L X1,YZHET
LF ,ZHETYP(X1)
IF CAIE QCLASB
GOTO FALSE ; NOT CURRENT IF NOT CLASS
THEN LF ,ZHEDLV(X1)
LF X1,ZNSZNO(XP1)
CAMN X1
ERROR2 52,LOCAL OBJECT IN ARRAY DECLARATION
FI
ELSE
LF ,ZNSZNO(XP1)
EXEC CGARCH ; RECURSIVE ENTRY
FI
ELSE
IF WHENNOT XP1,ZID
GOTO FALSE
LF ,ZIDMOD(XP1)
CAIE QDECLARED
GOTO FALSE ; NO WARNING FOR PARAMETERS
THEN
LF X1,ZIDZQU(XP1)
LF ,ZQUZHE(X1)
CAMN YZHET
ERROR2 52,LOCAL OBJECT IN ARRAY DECLARATION
FI
FI
AS IFON ZNOLST(XP1)
GOTO FALSE
STEP XP1,ZNS
GOTO TRUE
SA
RETURN
EPROC
SUBTTL CGCCCH
COMMENT;
PURPOSE: GENERATE SKIPS FOR CGCC/CGCO AFTER VALUE IS COMPUTED
;
CGCCCH: L X0,YLINK
IFONA SVALUE(X0)
RETURN
IF IFOFFA SCONDI(X0)
GOTO FALSE
THEN L @YTAC
OP (SKIPN) ; SKIP IF TRUE
GENABS
ELSE
IF IFOFFA SCCOND(X0)
GOTO FALSE
THEN
L @YTAC
OP (SKIPE)
GENABS
FI
FI
RETURN
SUBTTL CGDB
COMMENT;
PURPOSE: CG DEBUG HANDLING
ENTRY: CGDB
INPUT ARGUMENT: DEBUG CODE IN X1
OUTPUT ARGUMENT: RELEVANT SWITCH(ES) (RE)SET:
CODE MEANING
0 RESET ALL CGDB SWITCHES
1 CODE GENERATOR NOT ENTERED (CGPU CALLED)
2 PRINT TREE BEFORE GENERATION
;
IFN <QDEBUG>,<
CGDB: IF
JUMPN X1,FALSE
THEN
SETZM YCGDB ; RESET DEBUG SWITCHES
ELSE
IF CAIE X1,1
GOTO FALSE
THEN
SETON SCERFL
SETON SCGDB1
ELSE
RFAIL INVALID DEBUG CODE TO CG
FI
FI
RETURN
>
SUBTTLE CGLO
COMMENT;
PURPOSE: DETERMINE IF A ZNO NODE CORRESPONDS TO A DOUBLE
LENGTH QUANTITY AT RUN TIME
FUNCTION: ZNO NODE ADDRESS IN X1
CGLO SKIPS IF LONG,
CGLO1 SKIPS IF NOT LONG
;
CGLO1: STACK X2
AOS -1(XPDP)
HRREI X2,-1
JRST .+3
CGLO: STACK X2
LI X2,1
IF
WHEN X1,ZNN
GOTO FALSE
THEN ; ZNS,ZID OR ZCN
LF ,ZNSTYP(X1)
CAIN QLREAL
ADDM X2,-1(XPDP)
CAIN QTEXT
ADDM X2,-1(XPDP)
ELSE
; THIS CODE IS ONLY USED WHEN ACCUMULATORS OVERFLOW
; CALL FROM CGIW
LF ,ZNNCOD(X1)
IF
CAIN QCODAR
GOTO TRUE
CAIE QCODCA
GOTO FALSE
LF ,ZNNTYP(X1)
CAIE QREF
GOTO FALSE
THEN
ADDM X2,-1(XPDP)
FI
FI
UNSTK X2
RETURN
SUBTTLE CGPU
COMMENT;
PURPOSE: PURGE OPERAND STACK AND TREE AREA FOR A STATEMENT CONTAINING
SERIOUS ERRORS, RESET SCERFL IF NOT SCGDB1 IS ON
ENTRY: CGPU
;
CGPU: LF X3,ZNSGEN(,YOPST)
; RESET TREE AND OPERAND STACK
L YEXPL
ST YEXPP
L [QOPSTZ,,YOPST-1]
ST YOPSTP
IF ; CHECK IF CONTROLLED VARIABLE SHOULD
; BE IN THE OPERAND STACK
CAIN X3,%FORST
GOTO TRUE
CAIN X3,%FORSI
GOTO TRUE
CAIN X3,%FORWH
GOTO TRUE
CAIN X3,%CVDE
GOTO TRUE
CAIE X3,%CVBE
GOTO FALSE
THEN
LI X3,YOPST
WHENNOT X3,ZNS
GOTO FALSE
;***UWOBEG
;SPECIFY REGISTER FOR LD MACRO
LD X0,YORFOR
;***UWOEND
L X2,YOPSTP
PUSH X2,
PUSH X2,X1
ST X2,YOPSTP
FI
SETOFF SCERFL
IF L YTAC
CAIN YACTAB
GOTO FALSE
THEN ; ERROR IN CODE GENERATION,RESET AC TABLE
EXEC CGIACT ;[14] INITIATE YCATAB, YTAC, YCGXAC
HRRZ X1,YLINK
WHILE SKIPN (X1)
GOTO FALSE
JUMPE X1,FALSE
DO HRRZ X1,(X1)
OD
; END OF LINKS REACHED
SOJLE X1,FALSE
WHILE CAIL X1,(XPDP)
GOTO FALSE
DO SUB XPDP,[1,,1]
OD
FI
ASSERT<
IF IFOFF SCGDB1
GOTO FALSE
THEN
SETON SCERFL
FI
>
RETURN
SUBTTL CGRD,CGRN
COMMENT; OUTPUT WORD TO CODE WHICH IS RELOCATED TO
THE CODE AND CONSTANT STREAMS, RESPECTIVELY
;
CGRD: STACK YQRELR
STACK X0
LI QRELCD
CGRM: ST YQRELR
UNSTK X0
GENREL
UNSTK YQRELR
RETURN
CGRN: STACK YQRELR
STACK X0
LI QRELCN
JRST CGRM
SUBTTL CGSG
COMMENT;
PURPOSE: DETERMINE IF OPTIMIZABLE GOTO STATEMENT PRESENT
ENTRY: CGSG
ENTRY CONDITION: XP1 CONTAINS THE NODE FOR THE DESIGNATIONAL EXPRESSION
YZHBXC POINTS TO THE ZHB CORRESPONDING TO XCB AT RUN TIME
OUTPUT ARGUMENT: X0 CONTAINS:
O NONOPTIMIZABLE CASES
1 XCB NOT CHANGED BUT ZBIBNM CHANGED (TRANSFER
THROUGH REDUCED BLOCKS)
2 ENVIRONMENT NOT CHANGED BY TRANSFER (JRST ONLY)
;
CGSG: PROC
SAVE <X2,X3,X4,X5,X6>
SETZ X6, ; OUTPUT PARAMETER
IF LF X1,ZNOTYP(XP1)
CAIE X1,ZID%V
GOTO FALSE
LF X1,ZIDMOD(XP1)
CAIE X1,QDECLARED
GOTO FALSE ; NO OPTIMIZATION FOR PARAMETER LABELS
THEN ; ZID OF DECLARED MODE
LF X1,ZIDZQU(XP1)
L X2,YZHBXC
LF X3,ZQUZHE(X1)
LF X4,ZHEDLV(X2)
LF X5,ZHEDLV(X3)
IF CAIE X4,(X5)
GOTO FALSE
IFON ZQUIS(X1)
GOTO FALSE ;NO OPTIMIZATION FOR INSPECTEDLABEL
THEN ; SAME DISPLAY RECORD
AOS X6
LF X4,ZHEBNM(X2)
LF X5,ZHEBNM(X3)
CAIN X4,(X5)
AOS X6
FI
FI
L X6
RETURN
EPROC
SUBTTL GENERATOR FOR %ACTIV
COMMENT;
PURPOSE: COMPILE AN ACTIVATION STATEMENT
ENTRY: ACTIV.
ENTRY CONDITION: %ACTIV(EXPR,EXPR)
%ACTIV(EXPR)
THE ACTIVATE MASK IS IN YORACT
;
.ACTIV: FIRSTOP
GETAC2
COMPVAL ; COMPILE PROCESS TO XWAC1
IF ; MORE OPERANDS?
IFON ZNOLST(XP1)
GOTO FALSE
THEN ; PROCESS OR TIME TO XWAC2
AOS YTAC
STEP XP1,ZNS
COMPVAL
SOS YTAC
FI
L YORACT
OP (LI)
GENABS ; ACTIVATE MASK TO AC0
GPUSHJ (SUAC)
RELAC2
RETURN
SUBTTL GENERATOR FOR %ADEC
COMMENT;
PURPOSE: COMPILE AN ARRAY DECLARATION SEGMENT
ENTRY: ADEC.
ENTRY CONDITION: %ADEC(%ID,%ID,...%BOUNDS(EXPR,EXPR),%BOUNDS(EXPR,EXPR),...)
;
.ADEC: FIRSTOP
HRRZ YO2FIX
ST YO2FIX
LF X2,ZIDZQU(XP1)
ASSERT<
WHENNOT XP1,ZID
RFAIL ARRAY NOT ZID
IFNEQF X2,ZQUKND,QARRAY
RFAIL OPERAND OF ADEC NOT ARRAY
>
LF X1,ZQUNSB(X2)
ASSERT<
CAILE X1,QNAC
RFAIL TOO MANY SUBSCRIPTS
>
MOVN XL1,XL1
; STEP FORWARD TO FIRST BOUNDS PAIR
LOOP
STEP XP1,ZID
AS
WHEN XP1,ZID
GOTO TRUE
SA
L XL2,XP1
; CHECK LOCAL QUANTITIES IN BOUNDS EXPRESSION
L XP1
EXEC CGARCH ; RECURSIVE SEARCH IN CODE TREE
; COMPILE AND SAVE BOUNDS
LOOP
GETAC2 ;[14] RESERVE REG. IN PAIRS AND BEFORE COMPVAL
LF XP1,ZNSZNO(XL2)
LOOP ; COMPUTE BOUNDS TO CONSECUTIVE AC:S
COMPVAL
AOS YTAC
AS
IFON ZNOLST(XP1)
GOTO FALSE
ASSERT<WHEN XP1,ZCN
NOP
>
STEP XP1,ZID
GOTO TRUE
SA
AS
IFON ZNOLST(XL2)
GOTO FALSE
STEP XL2,ZID
GOTO TRUE
SA
; ALLOCATE FIRST ARRAY IN SEGMENT
FIRSTOP
LF X2,ZIDZQU(XP1)
LF XP2,ZQUTYP(X2)
IF CAIE XP2,QREF
GOTO FALSE
THEN ; OUTPUT PROTOTYPE POINTER
LF X1,ZQUZQU(X2)
LF ,ZQUIND(X1)
OP (LI XSAC,)
GENFIX
FI
LF XL2,ZQUNSB(X2)
HRL XL2,XP2
GPUSHJ (CSNA)
EXEC CGIACT ;[14] INITIATE YACTAB AND YTAC
L XL2
GENABS ; NOTE CHANGED CALLING SEQUENCE (CAP 3.5.2)
; NEW CALL: [LI XSAC,PROT] ONLY REF ARRAY
; PUSHJ XPDP,CSNA
; XWD TYPE,NDIM
LOOP
LF X1,ZIDZQU(XP1)
GETAD
OPZ (ST)
ST YOPCOD
GENOP
AS
; ALLOCATE FOLLOWING ARRAYS WITH COPY
STEP XP1,ZID
WHENNOT XP1,ZID
; FINISHED
GOTO FALSE
GPUSHJ (CSCA)
GOTO TRUE
SA
RETURN
SUBTTL GENERATOR FOR %BECOM
COMMENT;
PURPOSE: GENERATE CODE FOR ASSIGNMENT
ENTRY: .BECOM
NORMAL EXIT: RETURN
USED ROUTINE: CGAS
;
.BECOM: GETAC4
LF X1,ZNSZNO(XCUR) ; LHS
LI X2,ZNS%S(X1)
EXEC CGAS
RELAC4
RETURN
SUBTTL GENERATOR FOR %CONVE
COMMENT;
PURPOSE: GENERATE CODE FOR ARITHMETIC (IMPLICIT) CONVERSION
ENTRY: .CONVE
NORMAL EXIT: RETURN
USED ROUTINES: O2GA,O2GF
;
.CONVE: PROC
SAVE <XL1>
FIRSTOP
LF XL1,ZNSTYP(XP1)
COMPVAL
LF X4,ZNSTYP(XCUR)
ASSERT< CAIN X4,(XL1)
RFAIL SOURCE AND TARGET TYPES EQUAL IN CONVERT
L X4
CAIGE X4,(XL1)
L XL1
CAILE QLREAL
RFAIL NONARITHMETIC TYPES IN CONVERT
>
SETZ
HRRZ X5,@YTAC
IF CAIE X4,QINTEGER
GOTO FALSE
THEN ; TARGET TYPE INTEGER
IF CAIE XL1,QREAL
GOTO FALSE
THEN ; NOT LONG REAL, I.E REAL
OPZ (FIXR)
ELSE ; LONG REAL
ASSERT< LF ,ZNSTYP(XP1)
CAIE QLREAL
RFAIL XL1 DESTROYED OVER COMPVAL
>
WARNING 3,IMPLICIT ARITHMETIC CONVERSION
OPZ (LI XTAC,)
HRR @YTAC
GENABS
GPUSHJ (MACI) ;LONG REAL TO INTEGER CONVERSION
SETZ
FI
ELSE
IF CAIE X4,QREAL
GOTO FALSE
THEN ; TARGET REAL
IF
CAIE XL1,QINTEGER
GOTO FALSE
THEN ;Source integer
OPZ (FLTR)
ELSE ;[142] Source LONG REAL
; Generate:
; JUMPGE XTAC,.+3
; TDNN XTAC,[777,,-1]
; ADDI XTAC,1
OPZ (JUMPGE)
DPB X5,[ACFIELD]
ADDI 3
ADD YRELCD
GENRLD
HRLOI 777
GENWRD
OP (TDNN)
DPB X5,[ACFIELD]
GENREL
L [ADDI 1]
DPB X5,[ACFIELD]
GENABS
SETZ
FI
ELSE ; LONG REAL
IF CAIE XL1,QINTEGER
GOTO FALSE
THEN
ASSERT< CAIE X4,QLREAL
RFAIL X4 ERROR IN CONVE CGSA
>
WARNING 3,IMPLICIT ARITHMETIC CONVERSION
OPZ (LI XTAC,)
HRR X5
GENABS ; PARAMETER TO MACL
GPUSHJ (MACL)
SETZ
ELSE
L [SETZM 1]
FI
FI
FI
IF JUMPE FALSE
THEN ADD X5
DPB X5,[ACFIELD]
GENABS
FI
RETURN
EPROC
SUBTTL GENERATOR FOR %DOT
COMMENT;
PURPOSE: COMPILE A REMOTE IDENTIFIER
ENTRY: .DOT
NORMAL EXIT: RETURN
;
.DOT: GETAC3
FIRSTOP
NEXTOP
IF MEMOP
GOTO FALSE
THEN
FIRSTOP
COMPVAL ; COMPILE THE REFERENCE
L X4,YLINK
NEXTOP
LF X1,ZIDZQU(XP1)
LF X3,ZQUIND(X1)
HRLZ X2,@YTAC
L X2
LSH X2,5
ADD X2,
IFONA SCADDR(X4)
DPB ,[INDEXFIELD X2]
ADD X2,X3 ; MAKE Z @YTAC,OFFSET(@YTAC)
OPZ X3,(L)
L X1,XP1
IFLONG
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
OP X3,(DMOVE)
;***UWOEND
IFONA SCONDI(X4)
OP X3,(SKIPN)
IFONA SCCONDI(X4)
OP X3,(SKIPE)
IF IFOFFA SADDRE(X4)
GOTO FALSE
THEN
SETF (QZNN)ZNOTYP(XCUR) ; MAKE ZNN NODE
SETF (QCODRA)ZNNCOD(XCUR)
RELAC3
RETURN
FI
IF IFOFFA SCADDR(X4)
GOTO FALSE
THEN
LF ,ZNSZQU(XCUR) ;[1] PUT QUAL IN
SF ,ZNNZQU(XCUR) ; ZNNZQU FIELD
SETF (QZNN)ZNOTYP(XCUR)
SETF (QCODCA)ZNNCOD(XCUR)
OP X3,(HRLI)
FI
L X3
ADD X2
GENABS
ELSE ; NOT SIMPLE OPERAND
LF ,ZIDKND(XP1)
CAIN QARRAY
GOTO TRUE ; ARRAY TREATED AS SIMPLE
ASSERT< CAIE QPROCE
RFAIL REMOTE PROCEDURE EXPECTED
>
;Here, we must have "X.p", where p is PROCEDURE, X a REF expr.
AOS YTAC
FIRSTOP
LF ,ZNSZQU(XP1) ;[65] Save qualif of "X" in "X.p"
STACK ;[65]
COMPVAL
SOS YTAC
NEXTOP
LF X1,ZIDZQU(XP1)
L X2,X1
GETAD ;GETAD ASSUMES CLASS INST IN @YTAC+1
OPZ (HRLI)
ST YOPCOD
IF ;NOT virtual
LF ,ZIDMOD(XP1)
CAIN QVIRTUAL
GOTO FALSE
THEN GENOP
ASSERT<
ELSE
SETZM YO2ADI
>
FI
LF X1,ZQULID(X2)
IFON ZQUSYS(X2)
ERROR1 15,X1,SYSTEM PROCEDURE XXXX PASSED AS PARAMETER
UNSTK X1 ;[65] Recall qualif of "X"
IF ;[65] The qualifying class was inspected
IFOFF ZQUIS(X1)
GOTO FALSE
THEN ;[65] Use its offset in display
LF X1,ZQUZHE(X1)
LF ,ZHEDLV(X1)
ELSE ;Use SBL from proc ZHB
LF X2,ZQUZHE(X2)
LF ,ZHBSBL(X2)
IF ;No SBL given (standard proc)
JUMPN FALSE
THEN ;Use SBL=2
LI 2
FI
MOVN
FI
OP (HRR (XCB))
ADD YCGACT
GENABS
FI
RELAC3
RETURN
SUBTTL GENERATOR FOR %DENOT
COMMENT;
PURPOSE: COMPILE A DENOTES STATEMENT
ENTRY: .DENOT
NORMAL EXIT: RETURN
USED ROUTINES: .BECOM
;
.DENOT: BRANCH .BECOM ; REF DENOTES IS IDENTICAL TO BECOMES
; RETURN
SUBTTL FORSI, SIMPLE FOR ELEMENT
COMMENT; INPUT SYNTAX: <EXPR> FORSI
GENERATED CODE: control-var := <expr>
JSP XSAC,save return (=fixup(f+2))
;
.FORSI: SETZM YLXIAC
SETON SFORSI ;INDICATE PRESENCE OF SIMPLE FOR LIST ELEMENT
;NEEDS SPECIAL CODE IN FORDO
EXEC CGFOAS ;COMPUTE VALUE AND STORE
;IN CONTROLLED VARIABLE
L YORFX
ADDI 2
OP (JSP XSAC,)
GENFIX
RETURN
SUBTTL FORST, STEP-UNTIL ELEMENT IN FOR STATEMENT
COMMENT; INPUT SYNTAX: <EXPR><EXPR><EXPR> FORST
;
.FORST: SETZM YLXIAC
EXEC CGFORA ;STORE RETURN ADDRESS, ASSIGN INIT. VALUE
STEP (XP1,ZNS) ;POINT TO NODE FOR INCREMENT (STEP)
ALFIX ;FIXUP FOR LIMIT TEST
ST YCGFX2
CAIL X6,QINTEGER
CAILE X6,QLREAL
BRANCH CGPU ;UNDECLARED CONTROLLED VARIABLE
STACK X6 ;[32] SAVE X6 WITH TYPE INFO
SETOFF SCGFOX ;INCR IS CONSTANT ;[11]
IF ;[11] LONG REAL or not a constant
IFLR
GOTO TRUE
WHEN XP1,ZCN
GOTO FALSE ;[11]
THEN ;WE NEED A SUBROUTINE FOR THE INCREMENT
STEP (XP1,ZNS,XP2)
SETON SCGFOX
EXEC CGYTUP ;ACCOUNT FOR CONTROL VARIABLE
L X3,@YTAC ;RETURN AC (XWAC2 OR XWAC3)
AOS YTAC ;ACCOUNT FOR IT
;-------------------------;
; MOVEI xret,limit test ;
;-------------------------;
L YCGFX2
OP (MOVEI)
DPB X3,[ACFIELD]
GENFIX
;--FALLS THROUGH TO INCREMENT COMPUTATION
;-------------------------------------;
; SUBROUTINE TO COMPUTE THE INCREMENT ;
;-------------------------------------;
L YRELCD ;SAVE ADDR OF SUBR.
SETZM YLXIAC
ST YCGICR
COMPVAL ;INCR WILL BE COMPUTED TO
;XWAC3 OR (XWAC4,XWAC5)
;---------------;
; JRST (xret) ;
;---------------;
HRLZI (JRST)
L X3,@YTAC
SOJ X3,
DPB X3,[INDEXFIELD]
GENABS
ELSE ;[11] ONLY FOR CONSTANTS
L YCGFX2
OP (JRST)
GENFIX ;GOTO LIMIT TEST
FI
;--- CODE TO INCREMENT THE CONTROL VARIABLE ---
L X1,YCGFX1 ;DEFINE AND CLEAR FIXUP FOR INCREMENTATION CODE
DEFIX
CLFIX
SETZM YCGISG ;SIGN(INCREMENT) IF SIGN IS KNOWN,
;OTHERWISE ZERO
IF ;INCR DIRECTLY ADDRESSABLE
IFON SCGFOX
GOTO FALSE
THEN ;[11] INCR MUST BE A CONSTANT (and NOT long real)
;[11] IF ;CONSTANT
;[11] CONST
;[11] GOTO FALSE
;[11] THEN
LF X2,ZCNVAL(XP1)
IF ;NONNEGATIVE?
JUMPL X2,FALSE
THEN
IF ;[33] Zero constant
JUMPN X2,FALSE
THEN ;Note that, use (XPDP) LH as flag
HRROS (XPDP)
GOTO FORSTL ;Treat sign as unknown
FI ;[33]
AOS YCGISG
ELSE
SOS YCGISG
FI
;CHECK FOR STEP +1 OR -1
IF
CAME X2,YCGISG
GOTO FALSE
THEN
MOVSI (AOS)
SKIPGE YCGISG
MOVSI (SOS)
GOTO CGUPCV
FI
COMPVAL
;[11] ELSE ;[11] ID
;[11] COMPVAL
;[11] L [MOVE XWAC3,XWAC1] ;Must be available later
;[11] GENABS
;[11] FI
ELSE ;-- GENERAL CASE --- ;[11] INCR NOT A CONSTANT
;-----------------------;
; JSP Xret,incr.subr. ;
;-----------------------;
L YCGICR ;ADDR OF INCR SUBR
OP (JSP)
L X1,@YTAC ;RETURN REG
SOJ X1,
DPB X1,[ACFIELD]
GENRLD
SETZM YLXIAC
;---INCREMENT TO XWAC1 OR SUM TO (XWAC1-XWAC2)
L [MOVE XWAC1,XWAC3]
HRRZ X6,(XPDP) ;[32] TYPE INFO TO X6
IF ;LONG REAL?
LR
GOTO FALSE
THEN
;----------------------------------;
; DMOVE XWAC1,control var ;
; DFAD XWAC1,XWAC4 ;
;----------------------------------;
LF X1,ZIDZQU(,YORFOR)
GETAD
;***UWOBEG
;IGNORE KA10WARNING SINCE DMOVE IS UUO
; KA10WARNING
;***UWOEND
MOVSI (DMOVE)
ST YOPCOD
LI X1,XWAC1
DPB X1,[ACFIELD YO2ADI]
GENOP
L [DFAD XWAC1,XWAC4]
FI
GENABS
FI
HRRZ X6,(XPDP) ;[32] TYPE INFO TO X6
EXEC CGYTUP
;***UWOBEG
;IGNORE KA10 WARNING SINCE DMOVEM IS UUO
; KA10WARNING
;***UWOEND
L -1+[ADDB ;INTEGER
FADRB ;REAL
DMOVEM ;LONG REAL
](X6)
CGUPCV: ;--- UPDATE CONTROL VARIABLE
;-----------------------------------------;
; op XWAC1,control variable ;
; op IS ONE OF: AOS SOS ADDB FADRB DMOVEM ;
;-----------------------------------------;
ST YOPCOD
LF X1,ZIDZQU(,YORFOR)
GETAD
LI X1,XWAC1
DPB X1,[ACFIELD YO2ADI]
GENOP
;--END OF INCREMENTATION SEQUENCE, COMPILE LIMIT TEST(S)
;--CONTROL VAR IS COMPUTED TO XWAC1(+XWAC2) AT THIS POINT
FORSTL: ;[33] Go here also if zero constant
STEP (XP1,ZNS)
L X1,YCGFX2 ;DEFINE AND RELEASE FIXUP
DEFIX
CLFIX
;--COMPILE LIMIT TO REGISTER(S) IF NOT DIRECTLY ADDRESSABLE
SETZM YO2ADF
HRRZ X6,(XPDP) ;[32] TYPE INFO TO X6
IF
MEMOP
GOTO FALSE
THEN
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
LF X1,ZIDZQU(XP1)
GETAD
ELSE
;CONSTANT
LF X3,ZCNVAL(XP1)
IF
IFIMMOP
CAIN X6,QREAL
GOTO FALSE
THEN
ST X3,YO2ADI
ELSE
IF
LR
GOTO FALSE
THEN
LD X0,(X3)
GENDW
ELSE
L X0,X3
GENWRD
FI
ST X0,YO2ADI
SOS YO2ADF
SOS YO2ADF
FI
FI
ELSE
AOS YTAC
IFLR
AOS YTAC ; COMPUTE LIMIT TO NEXT FREE AC
COMPVAL
L X0,@YTAC
HRRZ X6,(XPDP) ;[32] TYPE INFO TO X6
IFLR
SOS
SETZM YO2ADF
HRRZM X0,YO2ADI
WARNING 7,EXPRESSION AFTER UNTIL
FI
IF ;SIGN OF INCREMENT UNKNOWN
SKIPE YCGISG
GOTO FALSE
THEN ;-----------------------;
; JUMPE incr,ctrl stm ;
; JUMPGE incr,.+4 ;
;-----------------------;
L YORFX ;[33]
IF ;[33] Constant zero
SKIPL (XPDP)
GOTO FALSE
THEN ;Direct jump, no test needed
OP (JRST)
GENFIX
GOTO FORSTE
FI ;[33]
OP (JUMPE XWAC3,) ;[33]
IFLR ;[33]
OP (JUMPE XWAC4,) ;[33]
GENFIX ;[33]
LI 4
ADD YRELCD
OP (JUMPGE XWAC3,)
IFLR
OP (JUMPGE XWAC4,)
GENRLD
FI
MOVSI X3,(CAML) ;COMPARE INSTR FOR NEG BRANCH
IF
IFIMMOP
CAIN X6,QREAL
GOTO FALSE
THEN
MOVSI X3,(CAIL)
FI
LI XWAC1
DPB [ACFIELD YO2ADI]
L X5,YO2ADI ;SAVE ADDRESS FIELD
;FIRST COMPILE TEST FOR NEGATIVE INCREMENT, IF NEEDED
SKIPG YCGISG
EXEC CGLIM
;----------------------------------------------------;
; _ _ ;
; ! CAML | ;
; | CAIL | XWAC1,limit ;
; |_DFSB _| ;
; _ _ ;
; | JRST | ;
; |_JUMPGE XWAC1, _| controlled statement ;
;----------------------------------------------------;
IF ;BOTH TESTS ARE NEEDED
SKIPE YCGISG
GOTO FALSE
THEN ;------------;
; JRST .+3 ;
;------------;
L YRELCD
ADDI 3
OP (JRST)
GENRLD
ST X5,YO2ADI
FI
AOSE YCGISG ;COMPILE TEST FOR POS INCREMENT
EXEC CGLIM
;----------------------------------------------------;
; _ _ ;
; | CAMG | ;
; | CAIG | XWAC1,limit ;
; |_DFSB _| ;
; _ _ ;
; | JRST | ;
; |_JUMPLE XWAC1, _| controlled statement ;
;----------------------------------------------------;
FORSTE: UNSTK X6 ;[32]
RETURN
SUBTTL FORWH, WHILE ELEMENT IN FOR LOOP
COMMENT; INPUT SYNTAX: <EXPR><EXPR> FORWH
;
.FORWH: SETZM YLXIAC
L YRELCD ;----------------;
ADD [MOVEI XSAC,2] ; MOVEI XSAC,.+2 ;
STACK YQRELR ;----------------;
LI X1,QRELCD
ST X1,YQRELR
GENREL
UNSTK YQRELR
EXEC CGFORB ;STORE RETURN ADDRESS, ASSIGN CONTROLLED VAR
EXEC CGYTUP
STEP (XP1,ZNS) ;-----------------------;
COMPCC ; reversed boolean test ;
L YORFX ;-----------------------;
OP (JRST) ; JRST controlled stmt ;
GENFIX ;-----------------------;
RETURN
SUBTTL UTILITY ROUTINES USED IN FOR STATEMENT COMPILATION
CGFORA: PROC ;COMPILE CODE TO SAVE RETURN ADDR,
;THEN COMPILE INITIAL ASSIGNMENT
;---------------------------------;
; MOVEI XSAC,update contr.var. ;
; MOVEM XSAC,displacement (XCB) ;
;---------------------------------;
ALFIX ;GET FIXUP FOR UPDATING CONTROL VARIABLE
ST YCGFX1
OP (MOVEI XSAC,)
GENFIX
CGFORB: LF ,ZHEDLV(XZHE)
OP (MOVEM XSAC,(XCB))
GENABS
CGFOAS: ;--ASSIGNMENT TO CONTROL VARIABLE
FIRSTOP
L X1,XP1
LF X6,ZNSTYP(XP1)
STEP (XP1,ZNS)
L X2,XP1
EXEC CGAS ;ASSIGN THE VALUE
RETURN
EPROC
CGLIM: PROC ;COMPILE CHECK AGAINST LIMIT
CAMG=CAMG
CAML=CAML
SKIPLE YCGISG
ADD X3,[<CAMG-CAML>] ;CHANGE INSTR CODE FOR POS INCR
IFLR
MOVSI X3,(DFSB)
ST X3,YOPCOD
L YO2ADF
IF AOJL FALSE
THEN ; LIMIT NOT IN LITTAB
GENOP
ELSE
L YO2ADI
IOR YOPCOD
EXEC CGRN
ASSERT<SETZM YOPCOD
SETZM YO2ADI
>
FI
L YORFX
OP (JRST) ;JUMP TO CONTROLLED STATEMENT
IF ;LONG REAL?
LR
GOTO FALSE
THEN
OP (JUMPGE XWAC1,)
SKIPLE YCGISG
OP (JUMPLE XWAC1,)
FI
GENFIX
RETURN
EPROC
CGYTUP: PROC ;UPDATE YTAC
AOS YTAC
IFLR ;ONE MORE STEP IF LONG REAL
AOS YTAC
RETURN
EPROC
SUBTTL GENERATOR FOR %GOTO
COMMENT;
PURPOSE: COMPILE A GOTO STATEMENT
ENTRY: GOTO.
NORMAL EXIT: RETURN
USED ROUTINES: CGVA,CGSG
ENTRY CONDITION: XCUR POINTS TO A ZNS %GOTO NODE TO BE COMPILED
EXIT ASSERTION: CODE FOR THE GOTO STATEMENT HAS BEEN COMPILED
;
.GOTO: PROC
SAVE <XP1>
FIRSTOP
EXEC CGSG ; CHECK FOR LABEL CASE
IF JUMPE FALSE
THEN ; OPTIMIZABLE CASE
LF X3,ZIDZQU(XP1)
SOS
IF JUMPN FALSE
THEN ; SAME DISPLAY BUT STATE NUMBER IS CHANGED
; EMIT CODE TO UPDATE ZBIBNM
LF X1,ZQUZHE(X3)
LF X5,ZHEBNM(X1)
LI (X5)
OP (LI XWAC1,)
GENABS
L [$ZBIBNM]
GENWRD
OP (DPB XWAC1,)
GENREL
FI
; GENERATE JUMP
LF ,ZQUIND(X3)
OP (JRST)
GENFIX
RETURN
FI
; GENERAL CASE: USE CSGO
LF XP1,ZNSZNO(XCUR)
COMPVAL
GPUSHJ (CSGO)
RETURN
EPROC
SUBTTL GENERATOR FOR CONDITIONAL EXPRESSSIONS
COMMENT;
PURPOSE: COMPILE A CONDITIONAL EXPRESSION
ENTRY: IFEX1.
NORMAL EXIT: RETURN
USED ROUTINES: O2AF,CGVA,CGCO,
ENTRY CONDITION: %IFEX1(BOOLEXPR,%IFEX(EXPR,EXPR))
XCUR POINTS TO THE %IFEX1 NODE
EXIT ASSERTION: THE CONDITIONAL VALUE HAS BEEN COMPILED TO @YTAC
;
.IFEX1: PROC
SAVE <XP1,XL1,XL2>
FIRSTOP
COMPCO ; SKIPPED IF TRUE
EXEC O2AF
L XL2,
EXEC O2AF
L XL1,
OP (JRST)
GENFIX
STEP XP1,ZNS
LF XP1,ZNSZNO(XP1)
COMPVAL
L XL2
OP (JRST)
GENFIX
L X1,XL1
DEFIX
STEP XP1,ZNS
COMPVAL
L X1,XL2
DEFIX
L X1,XL1
CLFIX
L X1,XL2
CLFIX
EXEC CGCCCH
RETURN
EPROC
SUBTTL GENERATOR FOR CONDITIONAL STATEMENTS
COMMENT;
PURPOSE: COMPILE CONDITIONAL STATEMENTS
ENTRY: IFST.,IFTRE.,IFTRU.,
;
.IFST: ; %IFST(BOOLEXPR)
FIRSTOP
COMPCO
L YORFX
OP (JRST)
GENFIX
RETURN
.IFTRE: ; %IFTRE(BOOLEXPR,EXPR)
FIRSTOP
COMPCO
EXEC O2AF
L XL1,
OP (JRST)
GENFIX
LI X0,ZNS%S
ADDM X0,(XCUR) ;ZNSZNO POINTS TO SECOND OPERAND
EXEC .GOTO
L YORFX
OP (JRST)
GENFIX
L X1,XL1
DEFIX
L X1,XL1
CLFIX
RETURN
.IFTRU: ; %IFTRU(BOOLEXPR,EXPR)
FIRSTOP
STEP XP1,ZID
IF
EXEC CGSG ; SIMPLE GOTO?
CAIE 2
GOTO FALSE
THEN
FIRSTOP
COMPCC
STEP XP1,ZID
LF X1,ZIDZQU(XP1)
LF ,ZQUIND(X1)
OP (JRST)
GENFIX
RETURN
FI
FIRSTOP
COMPCO
EXEC O2AF
L XL1,
OP (JRST)
GENFIX
LI X0,ZNS%S
ADDM X0,(XCUR) ;ZNSZNO POINTS TO SECOND OPERAND
EXEC .GOTO
L X1,XL1
DEFIX
L X1,XL1
CLFIX
RETURN
SUBTTL GENERATOR FOR %INSPE
COMMENT;
PURPOSE: COMPILE CONNECTION
ENTRY: .INSPE
;
.INSPE: FIRSTOP
COMPVAL
L [CAIN XWAC1,NONE]
GENABS
L YORFX
OP (JRST)
GENFIX
; NOTE THAT THE OBJECT EXPRESSION IS STORED
; IN THE DISPLAY BY CODE EMITTED FOR %DO AND %WHEDO
RETURN
SUBTTL GENERATOR FOR %NOT
COMMENT;
PURPOSE: COMPILE NEGATION
ENTRY: .NOT
ENTRY CONDITION: %NOT(BOOLEXPR)
;
.NOT: FIRSTOP
IF IFOFFA SVALUE(X4)
GOTO FALSE
THEN
IF MEMOP
GOTO FALSE
THEN
WHENNOT XP1,ZID
GOTO FALSE ; WARNING HERE?
LF X1,ZIDZQU(XP1)
GETAD
MOVSI (SETCM)
ST YOPCOD
GENOP
ELSE
COMPVAL
HRRZ X1,@YTAC
MOVSI (SETCA)
DPB X1,[ACFIELD]
GENABS
FI
ELSE
IF IFOFFA SCCOND(X4)
GOTO FALSE
THEN
COMPCO
ELSE
IF IFOFFA SCONDI(X4)
GOTO FALSE
THEN
COMPCC
ASSERT<
ELSE RFAIL ADDRESS OF NON-ADDRESS EXPRESSION
>
FI
FI
FI
RETURN
PAREN:. FIRSTOP
COMPVAL
ASSERT<IFOFF SVALUE
RFAIL ADDRESS OR SKIP OF PARENTHESISED QUANTITY
>
RETURN
SUBTTL GENERATOR FOR SUBSCRIPTED VARIABLES AND SWITCHES
COMMENT;
PURPOSE: COMPILE CODE FOR SWITCH DESIGNATOR OR SUBSCRIPTED VARIABLE
ENTRY: RB.
NORMAL EXIT: RETURN
ERRORS GENERATED: NO
RUN TIME ERRORS: NUMBER OF SUBSCRIPTS, ARRAY BOUNDS ERROR
;
.RP:.RB: PROC
; LOCALS:
; XL1 ORDINAL OF CURRENT SUBSCRIPT
; XL2 TWICE NUMBER OF SUBSCRIPTS
; XP1 CURRENT SUBSCRIPT NODE ADDRESS
; XP2 ACCUMULATOR ARRAY ADDRESS AT RUN TIME
; XCUR RB NODE ADDRESS WITH ARRAY TYPE
SAVE <XP1,XP2,XL1,XL2>
GETAC3 ; RESERVE THREE CONSECUTIVE ACCUMULATORS
FIRSTOP
IF ; SWITCH: TYPE LABEL
LF ,ZIDTYP(XP1)
CAIE QLABEL
GOTO FALSE
THEN ; SWITCH
SETZ XL1,
IF HRRZ YTAC
CAIG YACTAB
GOTO FALSE
THEN ; NOT TO BOTTOM AC
EXEC CGACSA
EXEC CGPD
SETO XL1,
FI
COMPVAL
AOS YTAC
NEXTOP
COMPVAL
GPUSHJ (CSSC)
SKIPE XL1
EXEC CGRA
RETURN
FI
IF ;[56] REF ARRAY
LF ,ZNSTYP(XP1)
CAIE QREF
GOTO FALSE
THEN ;Copy ZIDZDE (=ZNSZQU) to ZNNZQU(XCUR)
LF ,ZIDZDE(XP1)
SF ,ZNNZQU(XCUR)
FI ;[56]
COMPVAL ;Array address
SETZB XL1,XL2
; DETERMINE NUMBER OF SUBSCRIPTS
L XP2,@YTAC ; FIRST WORK AC WITH ARRAY
L X1,XP1
LOOP
STEP X1,ZID
AOS XL2
AS
IFOFF ZNOLST(X1)
GOTO TRUE
SA
; DETERMINE IF SUBSCRIPT NUMBER CHECK NEEDED
LF X1,ZNSMOD(XP1)
IF CAIN X1,QDECLARED
GOTO FALSE
IFOFF YSWA
GOTO FALSE
THEN ; DYNAMIC SUBSCRIPT NUMBER CHECK
L [$ZARSUB]
DPB XP2,[INDEXFIELD] ; SET BASE AC IN INDEX FIELD OF POINTER
GENWRD
OP (LDB)
GENREL
OP (CAIE)
HRR XL2
GENABS
L [RTSERR QNSUBERR]
GENABS
FI
AOS YTAC ; FIRST SUBSCRIPT TO SECOND AC
ASH XL2,1 ; FROM NOW XL2 HAS 2*NSUBSCRIPTS
LOOP
AOS XL1 ; NEXT SUBSCRIPT
STEP XP1,ZID
COMPVAL
IF IFOFF YSWA
GOTO FALSE ; NO SUBSCRIPT CHECKING
THEN ; SUBSCRIPT CHECK
L [CAML OFFSET(ZARLOW)]
L X1,@YTAC
DPB X1,[ACFIELD]
DPB XP2,[INDEXFIELD]
ADD XL1
ADD XL1
ST YCGINS
GENABS
LI 1
ADD YCGINS
CAMLE=CAMLE ; THESE STATEMENTS ARE DUE TO UNKNOWN MACRO-10 FEATURES
CAML=CAML
ADD [<CAMLE-CAML>]
PURGE CAMLE,CAMGE
GENABS
L [RTSERR QBOUNDSERR]
GENABS
FI
IF CAIN XL1,1
GOTO FALSE
THEN ; NOT FIRST SUBSCRIPT
LI <<<OFFSET(ZARLOW)>+2+<OFFSET(ZARDOP)>>&77777>
OP (IMUL)
LI X1,2(XP2)
DPB X1,[ACFIELD]
DPB XP2,[INDEXFIELD]
ADD XL2
ADD XL1
GENABS
HRRZ XP2
DPB XP2,[ACFIELD]
ADD [ADD 1,2]
GENABS
ELSE ; HIGHER SUBSCRIPTS EVALUATED
AOS YTAC ; TO 3RD AC
FI
AS ; MORE SUBSCRIPTS?
IFOFF ZNOLST(XP1)
GOTO TRUE
SA
HRRZ XP2
DPB XP2,[ACFIELD]
ADD [ADD 1,1]
LF X1,ZNSTYP(XCUR)
CAIE X1,QTEXT
CAIN X1,QLREAL
GENABS ; DOUBLE INDEX FOR TEXT AND LONG REAL
IF IFON SADDRE
GOTO FALSE
THEN
SETZ
DPB XP2,[ACFIELD]
DPB XP2,[INDEXFIELD]
L XL1,
ADD [ADD 1,OFFSET(ZARBAD)]
GENABS
ELSE
LI QZNN
SF ,ZNOTYP(XCUR)
LI QCODAR
SF ,ZNNCOD(XCUR)
RELAC3
RETURN
FI
IF IFOFF SCADDR
GOTO FALSE
THEN ; COMPUTED ADDRESS
OPZ (SUBI 1,)
ADD XL1 ; [Z XTOP,(XTOP)]
GENABS
OPZ (HRLI (1))
ADD XL1
LI X1,QZNN
SF X1,ZNOTYP(XCUR)
LI X1,QCODCA
SF X1,ZNNCOD(XCUR)
ELSE ; COMPUTE ABSOLUTE ADDRESS
IF IFOFF SVALUE
GOTO FALSE
THEN
LF X1,ZNSTYP(XCUR)
L XL1
OPZ X2,(L (1))
CAIE X1,QLREAL
CAIN X1,QTEXT
;***UWOBEG
;GENERATE DMOVE INSTEAD OF LD MACRO EXPANSION
OPZ X2,(DMOVE (1))
;***UWOEND
ELSE
IF IFOFF SCCOND
GOTO FALSE
THEN
OPZ X2,(SKIPE (1))
ELSE
ASSERT< IFOFF SCONDI
RFAIL UNEXPECTED COMPCASE
>
OPZ X2,(SKIPN (1))
FI
FI
L XL1
ADD X2
FI
GENABS
RELAC3
RETURN
EPROC
SUBTTL %SWEL, SWITCH ELEMENT
COMMENT;
PURPOSE: COMPILE A SWITCH ELEMENT INTO A SWITCH RECORD
ENTRY: SWEL.
;
SIMPLELABEL=1B<%ZNOTER>+1B<%ZNOLST>+<QZID>B<%ZNOTYP>+<QSIMPLE>B<%ZIDKND>+<QLABEL>B<%ZIDTYP>
SIMPLE=SIMPLE+<QDECLARED>B<%ZIDMOD>
.SWEL:
STACK YGAP
LI QRELPT
ST YGAP
FIRSTOP
HLRZ (XP1)
IF CAIE (SIMPLELABEL)
GOTO FALSE
THEN
LF X2,ZIDZQU(XP1)
LF X3,ZQUZHE(XP1)
LF X0,ZQUIND(X2)
LF X1,ZHEEBL(X3)
MOVN X1,X1
HRL X1
GENFIX ; LABEL ADDRESS
IF
LF ,ZHETYP(X3)
CAIE QFOR
GOTO FALSE
THEN
HRRZ X1,YBKSTP
LOOP
SOJ X1,
LF X3,ZBSZHE(X1)
AS LF ,ZHETYP(X3)
CAIN QFOR
GOTO TRUE
SA
FI
LF X1,ZHEDLV(X3)
LF ,ZHEBNM(X3)
HRL X1
GENABS
UNSTK YGAP
ELSE
STACK YQRELT
LI QRELPT
ST YQRELT
L YRELCD
GENRLD
SETZ
GENABS
UNSTK YQRELT
UNSTK YGAP
SETZM YLXIAC
COMPVAL
GJRST (CSES) ; END SWITCH THUNK
FI
AOS YCGSWC
RETURN
SUBTTL THIS,WHEDO,WHILE
COMMENT;
PURPOSE: COMPILE A LOCAL OBJECT
ENTRY: THIS.
ENTRY CONDITION: THE DISPLAY LEVEL USED TO ACCESS THE OBJECT IS IN ZNSZQU
OF THE CURRENT (%THIS) NODE
;
.THIS: HRRZ X1,@YTAC
LF ,ZNSZNO(XCUR)
IORI 777000
OP (HRRZ ,(XCB))
DPB X1,[ACFIELD]
GENABS
RETURN
.WHEDO: ; WHEN CLAUSE ENTERED AT RUN TIME
; WITH NON-NULL OBJ.EXPRESSION
; IN XWAC1
LF ,ZHEDLV(XZHE)
OP (ST XWAC1,(XCB)) ; STORE EXPRESSION IN DISPLAY
GENABS
L [LF XWAC2,ZBIZPR(XWAC1)]
GENABS ; LOAD PROTOTYPE OF OBJ. EXPRESSION
FIRSTOP
LF X1,ZIDZQU(XP1)
LF ,ZQUIND(X1) ; PROTOTYPE FIXUP
OP (CAIN XWAC2,)
GENFIX
L X4,YRELCD
LI 4(X4)
OP (JRST)
L X3,YQRELR
LI X1,QRELCD
ST X1,YQRELR
GENREL ; JRST .+4
L [SKIPN XWAC2,OFFSET(ZCPZCP)(XWAC2)]
GENABS
L X1,YZHET
LF ,ZHEFIX(X1)
OP (JRST)
ADDI 2
GENFIX ; JRST NEXTWHEN
LI -1(X4)
OP (JRST)
GENREL ; JRST .-4
ST X3,YQRELR
RETURN
.WHILE: L X1,YORFX
DEFIX
FIRSTOP
IF WHENNOT XP1,ZCN
GOTO TRUE
LF ,ZCNVAL(XP1)
SKIPE ; SKIP IF FALSE
GOTO FALSE ; NOTHING IF WHILE TRUE DO
THEN
COMPCO
L YORFX
ADD [JRST 1]
GENFIX
FI
RETURN
SUBTTL GENERATOR TABLE
GENTAB:
DEFINE GENS(N,V,D2,D3)=<
IFG <%BBLK-V>,<
REPEAT <V-$$LC-1>,<
RFAI [ASCIZ/ILLEGAL GENERATOR IN CG/]>
$$LC=V
IFDEF .'N,<
GOTO .'N>
IFNDEF .'N,<
RFAI [ASCIZ/UNDEFINED GENERATOR IN CG/]
>
>>
$$LC=-1
SYMB 6,1,GENS
LIT
RELOC
VAR
END