Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/comp/cgrk.mac
There are 2 other files named cgrk.mac in the archive. Click here to see a list.
00100
00200 ; ******
00300 SUBTTL *CGRK*
00400 ; ******
00500
00600 COMMENT;
00700
00800 AUTHOR: REIDAR KARLSSON
00900
01000 VERSION: 4 [5,25,146,202,233]
01100
01200 CONTENTS: CGAC
01300 CGIM, CGIM1, CGMO, CGMO1, .IN, .IS, .QUA, .QUAL
01400 CGAROP, .PLUS, .MINUS, .MULT, .DIV, .IDIV
01500 .UNMIN, .POW
01600 CGREOP, .EQ, .GRT, .LESS, .NEQ, .NGRT, .NLESS, .DEQ, .NDEQ
01700 CGBOOP, .AND, .EQV, .IMP, .OR
01800
01900 ;
02000
02100 SEARCH SIMMAC, SIMMC2, SIMMCR
02200 CTITLE CGRK
02300
02400 SALL
02500
02600 INTERNAL CGAC
02700 INTERNAL CGIM, CGIM1, CGMO, CGMO1, .IN, .IS, .QUA, .QUAL
02800 INTERNAL .PLUS, .MINUS, .MULT, .DIV, .IDIV, .UNMIN, .POW
02900 INTERNAL .EQ, .GRT, .LESS, .NEQ, .NGRT, .NLESS, .DEQ, .NDEQ
03000 INTERNAL .AND, .EQV, .IMP, .OR
03100
03200 EXTERNAL CGVA, CGAD, CGCA, CGCC, CGCO
03300 EXTERNAL YCGACT, YACTAB, YLXIAC, YTAC
03400 EXTERNAL YQRELR, YQRELT, YRELCD, YRELPT, YO2ADI, YOPCOD
03500 edit(322)
03700 EXTERNAL CADS,CGG2,CGG3,CGG4,CGR2,CGR3,CGR4
03800 EXTERNAL O2AD,O2CF,O2DF,O2GA,O2GF,O2GI,O2GR,O2GW,O2GWD,O2IV
03900 EXTERNAL CGLO, CGLO1
04000
04100
04200 QOPACM= 777740 ;OPERATION AND AC FIELD MASK
04300 QIMBIT= 1K ;IMMEDIATE MODE BIT
04400 QCOMMO= 4K ;COMPARE MODE COMPLEMENT BIT
04500 QSKCAD= (<SKIP> - CAM) ;DIFFERENCE IN OPERATION CODE FOR SKIP AND CAM
04600
04700 OPDEF ACFIRH [POINT 4,0,30] ;Ac field for instr. code in right half
04800 DEFINE FIRSTOP=<LF XP1,ZNSZNO(XCUR)>
04900
05000
05100 TWOSEG
05200 RELOC 400K
05300
05400 MACINIT
05500 CGINIT
00100 SUBTTL CGAC
00200
00300 COMMENT;
00400
00500 PURPOSE: TO CONSTRUCT AND OUTPUT A ZAM RECORD FROM YACTAB (THE REGISTER
00600 ALLOCATION TABLE)
00700
00800 ENTRY: CGAC
00900
01000 INPUT ARGUMENTS: THE CONTENTS OF YACTAB AND YTAC THAT POINTS TO THE FIRST
01100 ENTRY IN YACTAB THAT SHOULD NOT BE SAVED
01200
01300 NORMAL EXIT: RETURN
01400
01500 OUTPUT ARGUMENTS: THE ZAM WORD
01600 ------------------+--------------------
01700 [ FLAGS REAL AC:S I FLAGS PSEUDO AC:S ]
01800 ------------------+--------------------
01900 IS OUTPUT TO THE CONSTANT STREAM AND
02000 THE WORD
02100 XWD N,ADMAP
02200 IS OUTPUT TO THE CODE STREAM
02300 WHERE N IS THE NUMBER OF AC:S TO BE SAVED
02400 AND ADMAP IS THE ADDRESS OF THE ZAM RECORD
02500 THE RELOCATION FLAGS IN THE ZAM WORD OCCUPIE ONE BIT
02600 FOR EACH AC SO THAT BIT 0 ANSWERS TO XWAC1 AND BIT 1
02700 TO XWAC2 ETC. FOR REAL AC:S AND BIT 18 ANSWERS TO
02800 FIRST PSEUDO AC AND BIT 19 TO SECOND PSEUDO AC ETC.
02900 IF THE FLAG IS SET TO ONE IT INDICATES THAT THE RIGHT HALF
03000 OF ITS AC CONTAINS A DYNAMIC POINTER THAT SHOLD BE
03100 RELOCATED BY GARBAGE COLLECTOR
03200
03300
03400
03500 CALL FORMAT: EXEC CGAC
03600
03700 USED ROUTINES: CGACRF, GENABS, GENWRD, GENREL
03800
03900
04000
04100
04200 SUBROUTINE CGACRF
04300
04400 PURPOSE: TO DETERMINE THE RELOCATION FLAG FOR A REGISTER
04500 FROM THE THE TYPE OF THE ZNO NODE POINTED TO
04600 BY THE LEFT HALF OF THE YACTAB ENTRY
04700
04800 ENTRY: CGACRF
04900
05000 INPUT ARGUMENTS: X3 CONTAINS THE AC NUMBER
05100 X4 POINTS TO THE ZNO NODE
05200
05300 NORMAL EXIT: RETURN
05400
05500 OUTPUT ARGUMENTS: A 1-BIT MASK IS ORED INTO REG. X1 AT A POSITION
05600 DETERMINED BY THE AC NUMBER IN X3
05700
05800 CALL FORMAT: EXEC CGACRF
05900
06000 ;
06100
06200
06300 CGACRF:
06400 ;THE FOLLOWING DECISION TABLE IS CODED
06500
06600 ; ZNN NODE NO NO NO NO NO YES
06700 ; KIND SIMPLE YES YES
06800 ; KIND ARRAY YES
06900 ; KIND PROCEDURE YES YES
07000 ; SYSTEM PROCEDURE YES NO
07100 ; TYPE REF TEXT OR LABEL YES NO
07200 ; --------------------------------------------------------------
07300 ; X6 := 1 0 1 1 0 1
07400
07500 SETZ X6,
07600 IF
07700 RECTYPE(X4) IS ZNN
07800 GOTO FALSE
07900 THEN
08000 LI X6,1
08100 ELSE
08200 LF X0,ZIDKND(X4)
08300 IF
08400 CAIE X0,QSIMPLE
08500 GOTO FALSE
08600 THEN
08700 LF X0,ZIDTYP(X4)
08800 IF
08900 CAIE X0,QREF
09000 CAIN X0,QTEXT
09100 GOTO TRUE
09200 CAIE X0,QLABEL
09300 GOTO FALSE
09400 THEN
09500 LI X6,1
09600 FI
09700 ELSE
09800 IF
09900 CAIE X0,QPROCEDURE
10000 GOTO FALSE
10100 THEN
10200 IFON ZIDSYS(X4)
10300 LI X6,1
10400 ELSE
10500 ASSERT<
10600 IF
10700 CAIN X0,QARRAY
10800 GOTO FALSE
10900 THEN
11000 RFAIL WRONG KIND FOUND IN CGACRF
11100 FI
11200 >
11300
11400 LI X6,1
11500 FI
11600 FI
11700 FI
11800
11900 ;THE MASK IS LEFT JUSTIFIED
12000 ; AND THEN ORED INTO THE ZAM WORD IN X1
12100
12200 LI X4,XWAC1
12300 SUB X4,X3 ;X4 := XWAC1-ACNUMBER=-(ACNUMBER-XWAC1)
12400
12500 ROT X6,-1(X4) ;-1 - (ACNUMBER - XWAC1)
12600 ; -1 WILL SHIFT THE MASK TO THE BEGINNING
12700 ; OF THE WORD, WHICH IS THE APPROPRIATE
12800 ; POSITION FOR XWAC1. THEN, IF THE
12900 ; ACNUMBER IS GREATER THAN XWAC1, IT
13000 ; WILL BE SHIFTED RIGHT
13100 ; ACNUMBER-XWAC1 STEPS
13200 OR X1,X6
13300 RETURN
13400
13500
13600
13700
13800
13900 CGAC: PROC
14000 SAVE <X2,X3,X4,X5,X6>
14100
14200 SETZB X1,YLXIAC ; XIAC DESTROYED AT RUN TIME
14300 LI X5,YACTAB+QNAC
14400 IF
14500 CAMG X5,YTAC
14600 GOTO FALSE
14700 THEN
14800 ;PSEUDOAC:S NOT USED
14900
15000 LI X2,YACTAB ;FIRST REAL AC IS FOUND AT
15100 ; TOP OF YACTAB
15200 WHILE
15300 CAMN X2,YTAC ;YTAC POINTS TO THE FIRST AC
15400 ; NOT TO BE SAVED
15500 GOTO FALSE
15600 DO
15700 ;FIND ZAM WORD FOR USED REAL AC:S TO BE SAVED
15800
15900 HRRZ X3,(X2)
16000 ASSERT< CAILE X3,XWACL
16100 RFAIL (FIXUP INDEX FOUND WHEN PSEUDO AC:S NOT USED IN CGAC)>
16200 HLRZ X4,(X2)
16300 SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
16400 EXEC CGACRF ;DETERMINE RELOCATION FLAG
16500 AOS X2
16600 OD
16700 L X0,X1 ;X0=FLAGS FOR REAL AC:S IN LEFT HALF
16800 ; AND RIGHT HALF = FLAGS FOR
16900 ; PSEUDO AC:S = 0
17000 ELSE
17100 ;PSEUDO AC:S ARE USED
17200 ; FIRST REAL AC ENTRY IS FOUND AT TOP OF THE SECOND HALF
17300 ; OF YACTAB
17400
17500 LI X2,YACTAB+QNAC
17600 WHILE
17700 CAML X2,YTAC
17800 GOTO FALSE
17900 DO
18000 ;REAL AC:S IN SECOND HALF OF YACTAB ARE HANDLED
18100
18200 HRRZ X3,(X2)
18300 HLRZ X4,(X2)
18400 SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
18500 EXEC CGACRF ;DETERMINE RELOCATION FLAG
18600 AOS X2
18700 OD
18800 SUBI X2,QNAC
18900 WHILE
19000 HRRZ (X2)
19100 CAIG XWACL
19200 GOTO FALSE
19300 DO ; SKIP SAVED QUANT:S
19400 AOJ X2,
19500 OD
19600 ;X2 POINTS TO THE FIRST REAL AC ENTRY
19700 ; IN THE FIRST HALF OF YACTAB
19800 L X5,X2
19900 LOOP
20000 ;REAL AC ENTRIES IN FIRST HALF OF YACTAB ARE HANDLED
20100
20200 HRRZ X3,(X2)
20300 ASSERT< CAILE X3,XWACL
20400 RFAIL (AC NUMBER NOT FOUND IN CGAC)>
20500 HLRZ X4,(X2)
20600 CAMN X4,X2
20700 GOTO L1 ;SKIPPED ENTRY
20800 SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
20900 EXEC CGACRF ;DETERMINE RELOCATION FLAG
21000 AS
21100 AOS X2
21200 CAIE X2,YACTAB+QNAC ;END OF FIRST HALF OF YACTAB
21300 GOTO TRUE
21400 SA
21500 L1(): STACK X1 ;SAVE ZAM WORD FOR REAL AC:S
21600 SETZ X1, ;CLEAR X1
21700 LI X2,YACTAB ;FIRST PSEUDO AC ENTRY IS FOUND AT TOP
21800 ; OF YACTAB
21900 LI X3,XWAC1 ;ACNUMBER OF FIRST PSEUDO AC
22000 LOOP
22100 ;PSEUDO AC ENTRIES ARE HANDLED
22200
22300 ASSERT< HRRZ X4,(X2)
22400 CAIG X4,XWACL
22500 RFAIL (PSEUDO AC FIXUP INDEX NOT FOUND IN CGAC)>
22600 HLRZ X4,(X2)
22700 SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
22800 EXEC CGACRF ;DETERMINE RELOCATION FLAG
22900 AOS X2
23000 AOS X3
23100 AS
23200 CAME X2,X5 ;LAST PSEUDO AC HANDLED?
23300 GOTO TRUE
23400 SA
23500 UNSTK X0 ;ZAM FLAGS FOR REAL AC:S IN LEFT HALF
23600 HLR X0,X1 ; AND FOR PSEUDO AC:S IN RIGHT HALF
23700 FI
23800 L X2,YTAC
23900 SUBI X2,YACTAB ;X2=NUMBER OF USED ENTRIES IN YACTAB
24000 ; INCLUDING POSSIBLE GAPS FOR SKIPPED AC:S
24100 IF
24200 SKIPE X2
24300 GOTO FALSE
24400 THEN
24500 SETZ
24600 GENABS
24700 ELSE
24800 GENWRD ;ZAM WORD IS OUTPUT TO THE CONSTANT STREAM AND THE
24900 ; ZAM ADDRESS IS RETURNED IN X0
25000 HRL X0,X2
25100 GENREL ;XWD N,ADMAP
25200 FI
25300 RETURN
25400 EPROC
00100 SUBTTL CGIM, CGIM1
00200
00300 COMMENT;
00400
00500 PURPOSE: TO DETERMINE IF A NODE REPRESENTS AN IMMEDIATE OPERAND
00600
00700 ENTRY: CGIM, CGIM1
00800
00900 INPUT ARGUMENTS: XP1 POINTS TO THE NODE
01000
01100 NORMAL EXIT: SKIP RETURN OR RETURN
01200
01300 OUTPUT ARGUMENTS: CGIM WILL RETURN WITH A SKIP IF THE NODE WAS AN
01400 IMMEDIATE OPERAND, AND CGIM1 WILL RETURN WITH A SKIP IF
01500 THE NODE WAS NOT AN IMMEDIATE OPERAND
01600
01700 CALL FORMAT: EXEC CGIM (IMMOP)
01800 EXEC CGIM1 (IFIMMO)
01900
02000 ;
02100
02200
02300 ;INTEGER CONSTANTS WITH LEFT HALFWORD ZERO
02400 ; REAL " " RIGHT " " AND
02500 ; ALL OTHER CONSTANTS NOT OF TYPE TEXT OR LONG REAL
02600 ; EXCEPT TRUE ARE CONSIDERED AS IMMEDIATE OPERANDS
02700 CGIM:
02800 IF
02900 RECTYPE(XP1) IS ZCN
03000 GOTO FALSE
03100 THEN
03200 LF X0,ZCNTYP(XP1)
03300 IF
03400 CAIE X0,QINTEGER
03500 GOTO FALSE
03600 THEN
03700 LF X0,ZCNVAL(XP1)
03800 TLNN X0,-1
03900 AOS (XPDP) ;INTEGER CONSTANT WITH LEFT
04000 ; HALF ZERO
04100 ELSE
04200 IF
04300 CAIE X0,QREAL
04400 GOTO FALSE
04500 THEN
04600 LF X0,ZCNVAL(XP1)
04700 TRNN X0,-1
04800 AOS (XPDP) ;REAL CONSTANT WITH
04900 ; RIGHT HALF ZERO
05000 ELSE
05100 IF
05200 CAIE X0,QTEXT
05300 CAIN X0,QLREAL
05400 GOTO FALSE
05500 THEN
05600 LF X0,ZCNVAL(XP1)
05700 SKIPL ; SKIP FOR TRUE
05800 AOS (XPDP) ;CONSTANT NOT OF TYPE
05900 ; INTEGER, REAL,
06000 ; LONG REAL OR TEXT
06100 FI
06200 FI
06300 FI
06400 FI
06500 RETURN
06600
06700
06800 CGIM1: EXEC CGIM
06900
07000 AOS (XPDP) ;NON-SKIP RETURN FROM CGIM = SKIP RETURN FROM CGIM1
07100 RETURN ;SKIP RETURN FROM CGIM = NON-SKIP RETURN FROM CGIM1
00100 SUBTTL CGMO, CGMO1
00200
00300 COMMENT;
00400
00500 PURPOSE: TO DETERMINE IF A NODE REPRESENTS A MEMORY OPERAND
00600
00700 ENTRY: CGMO, CGMO1
00800
00900 INPUT ARGUMENTS: XP1 POINTS TO THE NODE
01000
01100 NORMAL EXIT: SKIP RETURN OR RETURN
01200
01300 OUTPUT ARGUMENTS: CGMO WILL RETURN WITH A SKIP IF THE NODE WAS
01400 A MEMORY OPERAND, AND CGMO1 WILL RETURN WITH A SKIP IF
01500 THE NODE WAS NOT A MEMORY OPERAND
01600
01700 CALL FORMAT: EXEC CGMO (MEMOP)
01800 EXEC CGMO1 (IFMEMO)
01900
02000 ;
02100
02200
02300 ;CONSTANTS AND SIMPLE IDENTIFIERS NOT OF MODE NAME OR TYPE LABEL ARE
02400 ; CONSIDERED TO BE MEMORY OPERANDS
02500 CGMO: IF
02600 WHEN XP1,ZCN
02700 GOTO TRUE
02800 WHENNOT XP1,ZID
02900 GOTO FALSE
03000 IFEQF XP1,ZIDMOD,QNAME
03100 GOTO FALSE
03200 IFNEQF XP1,ZIDKND,QSIMPLE
03300 GOTO FALSE
03400 IFEQF XP1,ZIDTYP,QLABEL
03500 GOTO FALSE
03600 THEN
03700 AOS (XPDP) ;SKIP RETURN IF CONSTANT OR ID NOT OF MODE NAME
03800 FI
03900 RETURN
04000
04100
04200 CGMO1: EXEC CGMO
04300 AOS (XPDP) ;NON-SKIP RETURN FROM CGMO = SKIP RETURN FROM CGMO1
04400 RETURN ;SKIP RETURN FROM CGMO = NON-SKIP RETURN FROM CGMO1
00100 SUBTTL CGQU
00200
00300 COMMENT;
00400
00500 PURPOSE: Check the expression "x QUA c". Straight return
00600 if the qualification need not be checked at run time
00700 (just check for NONE then), otherwise skip return.
00800 It has already been checked that x CAN be c, i e the qualification of x
00900 is either a subclass of c or a prefix class of c.
01000 Skip return thus means that the qualification must be checked at
01100 run time, straight return means run time check for NONE only.
01200
01300 ENTRY: CGQU
01400
01500 INPUT ARGUMENTS:
01600 XP1 points to the node for x.
01700 XCUR points to the QUA node.
01800
01900 NORMAL EXIT: RETURN OR SKIP RETURN
02000
02100 OUTPUT ARGUMENTS: SEE PURPOSE
02200
02300 CALL FORMAT: EXEC CGQU
02400
02500 ;
02600
02700
02800
02900
03000 CGQU: PROC
03100 LF X1,ZNSZQU(XCUR)
03200 LF ,ZQUZB(X1) ;ZHB for qualification (c) to X0
03300 LF X1,ZIDZDE(XP1)
03400 LF X1,ZQUZB(X1) ;ZHB for qualification of x
03500 ; or NONE if x is the constant NONE
03600 EDIT(233)
03700 CAIN X1,NONE ;[233] Accept NONE as if subclass
03800 GOTO L9 ;[233]
03900
04000 ;SEARCH IN THE PREFIX CHAIN OF FIRST OPERAND FOR A MATCH
04100
04200 WHILE
04300 JUMPE X1,FALSE
04400 DO
04500 CAIN (X1) ;[233]
04600 GOTO L9 ;[233] x IN c
04700 LF X1,ZHBZHB(X1)
04800 OD
04900 AOS (XPDP) ;[233] x may not be IN c
05000 L9():! RETURN
05100 EPROC
00100 SUBTTL .IN
00200
00300 COMMENT;
00400
00500 PURPOSE: TO GENERATE CODE FOR THE %IN OPERATOR
00600
00700 ENTRY: .IN
00800
00900 ENTRY CONDITION: %IN(OBJ-EXP,CL-ID)
01000
01100 EXIT: RETURN
01200
01300 ;
01400
01500
01600 .IN: PROC
01700 SAVE <XP2>
01800 FIRSTOP
01900 COMPVAL
02000 L X4,YLINK
02100 L XP2,@YTAC
02200
02300 LI NONE
02400 OP (CAIN)
02500 DPB XP2,[ACFIELD]
02600 GENABS ;CAIN XWAC,NONE
02700
02800 L X3,YQRELR
02900 LI X1,QRELCD
03000 ST X1,YQRELR
03100 L X2,YRELCD
03200
03300 LI 8(X2)
03400 OP (JRST)
03500 GENREL ;JRST FALSE PATH
03600
03700 L [LF ,ZBIZPR()]
03800 DPB XP2,[ACFIELD]
03900 DPB XP2,[INDEXFIELD]
04000 GENABS ;LF XWAC,ZBIZPR(XWAC)
04100
04200 LI 5(X2)
04300 OP (JRST)
04400 GENREL ;JRST .+3
04500
04600 L [SKIPN ,OFFSET(ZCPZCP)]
04700 DPB XP2,[ACFIELD]
04800 DPB XP2,[INDEXFIELD]
04900 GENABS ;SKIPN XWAC,ZCPZCP(XWAC)
05000
05100 LI 8(X2)
05200 OP (JRST)
05300 GENREL ;JRST FALSE PATH
05400
05500 NEXTOP
05600 LF X1,ZIDZQU(XP1)
05700 LF ,ZQUIND(X1)
05800 OP (CAIE)
05900 DPB XP2,[ACFIELD]
06000 GENFIX ;CAIE XWAC, PROTOTYPE FIXUP 2:ND OPERAND
06100
06200 LI 3(X2)
06300 OP (JRST)
06400 GENREL ;JRST .-3
06500
06600 ST X3,YQRELR
06700
06800 IF ;BOOLEAN RESULT REQUIRED?
06900 IFOFFA SVALUE(X4)
07000 GOTO FALSE
07100 THEN
07200 SETO
07300 GENWRD ;[-1] = [TRUE]
07400
07500 OP (SKIPA)
07600 DPB XP2,[ACFIELD]
07700 GENREL ;SKIPA XWAC,[TRUE]
07800
07900 MOVSI (SETZ)
08000 DPB XP2,[ACFIELD]
08100 GENABS ;SETZ XWAC,
08200 ELSE
08300 IF
08400 IFOFFA SCONDI(X4) ;THE CONDITION HAS BEEN REVERSED
08500 GOTO FALSE ; I.E. COND.SKIP
08600 ; JRST TRUE
08700 ; FALSE:
08800 THEN
08900 MOVSI (SKIPA)
09000 GENABS ;SKIPA
09100 FI
09200 FI
09300
09400 RETURN
09500 EPROC
00100 SUBTTL .IS
00200 COMMENT;
00300
00400 PURPOSE: TO GENERATE CODE FOR THE %IS OPERATOR
00500
00600 ENTRY: .IS
00700
00800 ENTRY CONDITION: %IS(OBJ-EXP, CL-ID)
00900
01000 EXIT: RETURN
01100
01200 ;
01300
01400
01500
01600 .IS: PROC
01700 SAVE <XP1,XP2>
01800 FIRSTOP
01900 COMPVAL
02000 L X4,YLINK
02100 L XP2,@YTAC
02200
02300 LI NONE
02400 OP (CAIN)
02500 DPB XP2,[ACFIELD]
02600 GENABS ;CAIN XWAC,NONE
02700
02800 L X2,YQRELR
02900 LI QRELCD
03000 ST YQRELR
03100 L X1,YRELCD
03200
03300 LI 3(X1) ;.+3
03400 IFONA SCCOND(X4)
03500 AOJ ;.+4 IF REVERSED CONDITION
03600 OP (JRST)
03700 GENREL ;JRST .+3 OR .+4
03800
03900 ST X2,YQRELR ;RESTORE RELOCATION RIGHT HALF
04000
04100 L [LF XSAC,ZBIZPR()]
04200 DPB XP2,[INDEXFIELD]
04300 GENABS ;LF XSAC,ZBIZPR(XWAC)
04400
04500 NEXTOP
04600 LF X1,ZIDZQU(XP1)
04700 LF ,ZQUIND(X1)
04800 OP (CAIE XSAC,)
04900 IFONA SCCOND(X4)
05000 TLC X0,QCOMMO ;COMPLEMENT COMPARE MODE
05100 GENFIX ;CAIE OR CAIN XSAC,PROTOTYPE FIXUP 2:ND OPERAND
05200
05300 IF ;BOOLEAN RESULT REQUIRED?
05400 IFOFFA SVALUE(X4)
05500 GOTO FALSE
05600 THEN
05700 L XP2
05800 OP (TDZA)
05900 DPB XP2,[ACFIELD]
06000 GENABS ;TDZA XWAC,XWAC
06100
06200 MOVSI (SETO)
06300 DPB XP2,[ACFIELD]
06400 GENABS ;SETO XWAC,
06500
06600 FI
06700
06800 RETURN
06900 EPROC
00100 SUBTTL .QUA
00200
00300 COMMENT;
00400
00500 PURPOSE: TO GENERATE CODE FOR THE %QUA OPERATOR
00600
00700 ENRY: .QUA
00800
00900 ENTRY CONDITION: %QUA (OBJ-EXP, CL-ID)
01000
01100 EXIT: RETURN
01200
01300 ;
01400
01500
01600
01700 .QUA: PROC
01800 SAVE <XP1,XP2>
01900 FIRSTOP
02000 COMPVAL
02100 IFOFF YSWQ ;No code generated if /-Q was specified
02200 GOTO L9
02300
02400 EDIT(233) ;Cause "OBJECT NONE" if OBJ-EXP == NONE
02500 L [LF XSAC,ZBIZPR()]
02600 L XP2,@YTAC
02700 DPB XP2,[INDEXFIELD]
02800 GENABS ;LF XSAC,ZBIZPR(Xtop)
02900
03000 EXEC CGQU ;Check qualification of OBJ-EXP
03100 GOTO L9 ;Qualification ok (OBJ-EXP in CL-ID)
03200
03300 NEXTOP
03400 LF X1,ZIDZQU(XP1)
03500 LF ,ZQUIND(X1)
03600 OP (CAIN XSAC,)
03700 GENFIX ;CAIN XSAC,Prototype fixup of CL-ID
03800
03900 L X2,YQRELR
04000 LI X1,QRELCD
04100 ST X1,YQRELR
04200
04300 L X3,YRELCD
04400 LI 4(X3)
04500 OP (JRST)
04600 GENREL ;JRST .+4
04700
04800 L [SKIPN XSAC,OFFSET(ZCPZCP)(XSAC)]
04900 GENABS ;SKIPN XSAC,ZCPZCP(XSAC)
05000
05100 L [RTSERR QQUAERROR]
05200 GENABS ;QUA CHECK ERROR
05300
05400 LI -1(X3)
05500 OP (JRST)
05600 GENREL ;JRST .-4
05700
05800 ST X2,YQRELR
05900
06000 L9():! RETURN
06100 EPROC
00100 SUBTTL .QUAL
00200
00300 COMMENT;
00400
00500 PURPOSE: TO GENERATE CODE FOR THE %QUAL OPERATOR
00600
00700 ENTRY: .QUAL
00800
00900 ENTRY CONDITION: %QUAL (REF-ID)
01000
01100 EXIT: RETURN
01200
01300 ;
01400
01500
01600
01700 .QUAL: PROC
01800 SAVE <XP2>
01900 FIRSTOP
02000 COMPVAL
02100 IFOFF YSWQ ;Code generated for QUA check only if /Q holds
02200 GOTO L9
02300 edit(322)
02400 LF ,ZNSZQU(XCUR) ;[322] Accept "undeclared" qual
02500 JUMPE L9 ;[322] without any checking
02700 LF X1,ZNSZQU(XP1)
02800 IFOFF ZQUSYS(X1)
02900 WARNING 5,IMPLICIT QUA CHECK
03000
03100 L XP2,@YTAC
03200
03300 L [CAIN ,NONE]
03400 DPB XP2,[ACFIELD]
03500 GENABS ;CAIN Xtop,NONE
03600
03700 L X3,YQRELR
03800 LI X1,QRELCD
03900 ST X1,YQRELR
04000
04100 L X2,YRELCD
04200 LI 7(X2)
04300 OP (JRST)
04400 GENREL ;JRST .+7
04500
04600 EDIT(146)
04700 IF ;[146]
04800 LF ,ZIDKND(XP1)
04900 CAIE QARRAY
05000 GOTO FALSE
05100 THEN
05200 L [LF XSAC,ZARZPR()]
05300 ELSE
05400 L [LF XSAC,ZBIZPR()]
05500 FI
05600 DPB XP2,[INDEXFIELD]
05700 GENABS ;LF XSAC,ZBIZPR(XWAC)
05800
05900 LF X1,ZNSZQU(XCUR)
06000 LF ,ZQUIND(X1)
06100 OP (CAIN XSAC,)
06200 GENFIX ;CAIN XSAC,PROTOTYPE FIXUP
06300
06400 LI 7(X2)
06500 OP (JRST)
06600 GENREL ;JRST .+4
06700
06800 L [SKIPN XSAC,OFFSET(ZCPZCP)(XSAC)]
06900 GENABS ;SKIPN XSAC,ZCPZCP(XSAC)
07000
07100 L [RTSERR QREFASERROR]
07200 GENABS ;REF ASSIGN ERROR
07300
07400 LI 2(X2)
07500 OP (JRST)
07600 GENREL ;JRST .-4
07700
07800 ST X3,YQRELR
07900
08000 L9():! RETURN
08100 EPROC
00100 SUBTTL .PLUS .MINUS .MULT .DIV .IDIV
00200
00300 COMMENT;
00400
00500 PURPOSE: COMPILE ARITHMETIC OPERATORS
00600
00700 ENTRIES: .PLUS, .MINUS, .MULT, .DIV, .IDIV
00800
00900 NORMAL EXIT: RETURN
01000
01100 USED ROUTINE: CGAROP
01200
01300 ENTRY CONDITION: ARITHM. OPERATOR(ARITHM.EXP. , ARITHM.EXP.)
01400 XCUR POINTS TO THE OPERATOR NODE
01500
01600 EXIT CONDITION: THE RESULT HAS BEEN COMPILED TO @YTAC OR IF LONG REAL
01700 TO @YTAC AND @YTAC+1
01800
01900 ;
02000
02100
02200
02300 .PLUS: EXEC CGAROP,<[<ADD> + <(FADR)>B26 + (DFAD)]>
02400 RETURN
02500
02600 .MINUS: EXEC CGAROP,<[<SUB> + <(FSBR)>B26 + (DFSB)]>
02700 RETURN
02800
02900 .MULT: EXEC CGAROP,<[<IMUL>+ <(FMPR)>B26 + (DFMP)]>
03000 RETURN
03100
03200 .DIV:
03300 .IDIV: EXEC CGAROP,<[<IDIV>+ <(FDVR)>B26 + (DFDV)]>
03400 RETURN
03500
00100 SUBTTL CGAROP
00200
00300 COMMENT;
00400
00500 PURPOSE: TO GENERATE CODE FOR THE ARITHMETIC OPERATORS
00600 %PLUS, %MINUS, %MUL, %DIV AND %IDIV
00700
00800 ENTRY: CGAROP
00900
01000 INPUT ARGUMENTS: XCUR POINTS TO THE OPERATOR NODE
01100 AROPCO= BYTE(9) FIXED POINT INSTR. CODE,
01200 FLOATING AND ROUND INSTR. CODE,
01300 DOUBLE FLOATING INSTR. CODE
01400 E.G. FOR %PLUS
01500 -------------------------------------
01600 AROPCO= \ ADD \ FADR \ DFAD \ 0 \
01700 -------------------------------------
01800 0 8 9 17 18 26 27 35
01900
02000 NORMAL EXIT: RETURN
02100
02200 CALL FORMAT: EXEC CGAROP,<AROPCO>
02300
02400 EXPLANATION OF SHORT NOTES IN COMMENTS:
02500 FOP = FIRST OPERAND
02600 SOP = SECOND OPERAND
02700 MEOP = MEMORY OPERAND
02800 IMOP = IMMEDIATE OPERAND
02900
03000 ARIN = ARITHMETIC INSTRUCTION
03100 IARIN = IMMEDIATE ARITHMETIC INSTR.
03200 DFARIN = DOUBLE FLOATING ARITHMETIC INSTR.
03300
03400 IDAD = IDENTIFIER ADDRESS
03500 LIAD = LITERAL ADDRESS
03600
03700 ;
03800
03900
04000
04100 CGAROP: PROC <AROPCO>
04200 SAVE <XP1,XL1>
04300
04400 GETAC4
04500 L XL1,@YTAC ;TARGET AC
04600
04700 FIRSTOP
04800 COMPVAL ;COMPILE FOP TO XWAC AND IF LONG REAL
04900 ; TO XWAC AND XWAC+1
05000 NEXTOP
05100 L X0,AROPCO
05200 LF X1,ZNSTYP(XCUR)
05300 CAIN X1,QREAL
05400 ASH X0,9 ;SHIFT OPCODE FOR REAL OPERANDS TO
05500 ; CORRECT POSITION IN X0
05600 DPB XL1,[ACFIELD] ;SET ACFIELD TO TARGET AC IN BOTH
05700 DPB XL1,[ACFIRH] ; HALVES OF X0
05800 IF
05900 CAIE X1,QLREAL
06000 GOTO FALSE
06100 THEN
06200 HRLZM X0,AROPCO ;AROPCO=OPCODE FOR LONG REAL OPERANDS
06300 IF
06400 MEMOP
06500 GOTO FALSE
06600 THEN
06700 ;SOP IS A LONG REAL MEOP
06800
06900 IF
07000 RECTYPE(XP1) IS ZID
07100 GOTO FALSE
07200 THEN
07300 ;SOP IS A ZID LONG REAL MEOP
07400
07500 LF X1,ZIDZQU(XP1)
07600 GETAD
07700 L X0,AROPCO
07800 ST X0,YOPCOD
07900 GENOP ;DFARIN XWAC,IDAD
08000 ELSE
08100 ;SOP IS A ZCN LONG REAL MEOP
08200
08300 LF X1,ZCNVAL(XP1) ;X1=ADDRESS DWORD CONST.
08400 L X0,(X1) ;X0=FIRST WORD
08500 L X1,1(X1) ;X1=SECOND WORD
08600 GENDW ;PUT INTO LITERAL TABLE
08700 ; AND RETURN LIAD IN X0
08800 HLL X0,AROPCO
08900 GENREL ;DFARIN XWAC,LIAD
09000 FI
09100 ELSE
09200 ;LONG REAL SOP IS NOT A MEOP
09300
09400 AOS YTAC
09500 AOS YTAC
09600 COMPVAL ;COMPILE SOP TO XWACX AND XWACX+1
09700 L X0,AROPCO
09800 HRR X0,@YTAC
09900 GENABS ;DFARIN XWAC,XWACX
10000 SOS YTAC
10100 SOS YTAC
10200 FI
10300 ELSE
10400 ;INTEGER OR REAL OPERATION
10500
10600 HRLI XL1,QOPACM ;MASK FOR OPERATION AND AC FIELD
10700 AND X0,XL1
10800 ST X0,AROPCO ;CORRECT INSTR. CODE IN AROPCO
10900 IF
11000 MEMOP
11100 GOTO FALSE
11200 THEN
11300 IF
11400 IMMOP
11500 GOTO FALSE
11600 THEN
11700 ;SOP IS IMOP
11800
11900 LF X0,ZCNVAL(XP1) ;X0=SOP VALUE
12000 CAIN X1,QREAL
12100 MOVS X0,X0 ;SWAP IF SOP REAL
12200 HLL X0,AROPCO
12300 TLO X0,QIMBIT ;SET IMMEDIATE MODE
12400 GENABS ;IARIN XWAC,IMOP
12500 ELSE
12600 IF
12700 RECTYPE(XP1) IS ZID
12800 GOTO FALSE
12900 THEN
13000 ;SOP IS A ZID MEOP
13100
13200 LF X1,ZIDZQU(XP1)
13300 GETAD
13400 L X0,AROPCO
13500 ST X0,YOPCOD
13600 GENOP ;ARIN XWAC,IDAD
13700 ELSE
13800 ;SOP IS A ZCN MEOP
13900
14000 LF X0,ZCNVAL(XP1) ;X0 = SOP VALUE
14100 GENWRD ;PUT INTO LITERAL TABLE
14200 ; AND RETURN LIAD IN X0
14300 HLL X0,AROPCO
14400 GENREL ;ARIN XWAC,LIAD
14500 FI
14600 FI
14700 ELSE
14800 ;SOP IS NOT A MEOP
14900
15000 AOS YTAC
15100 COMPVAL ;COMPILE SOP TO XWAC+1
15200 L X0,AROPCO
15300 HRR X0,@YTAC
15400 GENABS ;ARIN XWAC,XWAC+1
15500 SOS YTAC
15600 FI
15700 FI
15800 RELAC4
15900 RETURN
16000 EPROC
00100 SUBTTL .POW
00200
00300 COMMENT;
00400
00500 PURPOSE: TO GENERATE CODE FOR THE OPERATOR %POW
00600
00700 ENTRY: .POW
00800
00900 NORMAL EXIT: RETURN
01000
01100 ENTRY CONDITION: %POW (ARITHM. EXPR. , ARITHM. EXPR.)
01200
01300 EXIT CONDITION: THE RESULT HAS BEEN COMPILED TO @YTAC (AND IF LONG
01400 REAL TO @YTAC AND @YTAC+1)
01500 ;
01600
01700
01800
01900
02000 .POW: PROC
02100
02200 XVAL= X2
02300 XTOP= XP2
02400
02500 EDIT(202)
02600 XVAL1==XVAL+1 ;[202]
02700 SAVE <XP1,XL1,XL2,XV2,XVAL,XVAL1,XTOP> ;[202]
02800
02900 GETAC4
03000 L XTOP,@YTAC
03100 STACK YTAC
03200
03300 FIRSTOP
03400 LF XL1,ZIDTYP(XP1)
03500
03600 EDIT(5) ;[5]
03700 ;EVALUATE 2^CONSTANT IF FIRST OP IS INTEGER
03800 ;FIRST OPERAND WILL BE REAL OR LREAL IN ALL OTHER CASES
03900 IF
04000 CAIE XL1,QINTEGER
04100 GOTO FALSE
04200 THEN
04300 NEXTOP
04400 LF XV2,ZCNVAL(XP1)
04500 LI 1
04600 ASH (XV2)
04700 IF TLNE -1
04800 GOTO FALSE
04900 THEN ; IMMEDIATE LOAD POSSIBLE
05000 OP (LI)
05100 ADD YCGACT
05200 GENABS
05300 ELSE ; NOT HALFWORD VALUE
05400 GENWRD
05500 OP (L)
05600 ADD YCGACT
05700 GENREL
05800 FI
05900 GOTO POWEX
06000 FI
06100 NEXTOP
06200 LF XL2,ZIDTYP(XP1)
06300
06400 ;CHECK FIRST IF SECOND OPERAND (SOP) IS AN INTEGER CONSTANT GE 0
06500
06600 IF
06700 CONST
06800 GOTO FALSE
06900 CAIE XL2,QINTEGER
07000 GOTO FALSE
07100 LF XV2,ZCNVAL(XP1)
07200 JUMPL XV2,FALSE
07300 THEN
07400 ;FIND MULTIPLICATION OPERATION ACCORDING
07500 ; TO THE FIRST OPERAND TYPE
07600
07700 FIRSTOP
07800 L XL2,XTOP
07900 ;[5] GENERATION OF IMUL REMOVED
08000 IF
08100 CAIE XL1,QREAL
08200 GOTO FALSE
08300 THEN
08400 OP XL2,(FMPR)
08500 ELSE
08600 OP XL2,(DFMP)
08700 FI
08800
08900 ;OPTIMIZE IF SOP = 2
09000
09100 IF
09200 CAIE XV2,2
09300 GOTO FALSE
09400 THEN
09500 COMPVAL
09600 L X0,XL2
09700 DPB XTOP,[ACFIELD]
09800 GENABS ;MULOP XTOP,XTOP
09900 GOTO POWEX ;RETURN
10000 FI
10100
10200
10300 ;X^I = X^(B[N]*2^(N-1) + B[N-1]*2^(N-2) + ... + B[1]*2^0)
10400
10500 ; = [X^(B[N]*2^(N-1))] * [X^(B[N-1]*2^(N-2))] * ... * [X^(B[1]*2^0)]
10600
10700 ;THE BINARY COEFFICIENTS (B[N]) ARE FOUND BY SHIFTING THE EXPONENT RIGHT
10800 ; STARTING WITH B[1], AND IF B[N] = 1 THE CORRESPONDING POWER OF X
10900 ; ( X^2^(N-1) THAT IS OBTAINED BY MULTIPLYING X WITH ITSELF N-1 TIMES )
11000 ; IS MULTIPLIED TO THE RESULT AC THAT IS INITIALIZED TO ONE
11100
11200
11300 AOJ XL2, ;XTOP+1 IN ADDRESS FIELD
11400 ;[5] GEN OF START VAL =INT CONS =1 REMOVED
11500 L X0,[MOVSI (1.0)]
11600 DPB XTOP,[ACFIELD]
11700 GENABS ;MOVSI XTOP,(1.0)
11800 IF
11900 CAIE XL1,QLREAL
12000 GOTO FALSE
12100 THEN
12200 OPZ (SETZ)
12300 DPB XL2,[ACFIELD]
12400 GENABS ;SETZ XTOP+1,
12500 AOJ XL2, ;XTOP+2
12600 AOS YTAC
12700 FI
12800 AOS YTAC
12900 IF
13000 JUMPN XV2,FALSE ;EXP \= 0
13100 THEN
13200 ;EXP = 0
13300 ;COMPILE FIRST OPERAND IF IT HAS
13400 ; SIDE EFFECTS
13500
13600 WHENNOT XP1,ZNS
13700 GOTO POWEX
13800 IFOFF ZNSSEF(XP1)
13900 GOTO POWEX
14000 FI
14100 COMPVAL ;FOP TO XTOP+1 OR IF LONG REAL
14200 ; TO XTOP+2 AND XTOP+3
14300 L XVAL,XV2
14400 SETZ XVAL+1,
14500 LSHC XVAL,-1
14600 IF
14700 JUMPE XVAL+1,FALSE
14800 THEN
14900 HRR X0,XL2
15000 OP (L)
15100 CAIN XL1,QLREAL
15200 OP (DMOVE)
15300 DPB XTOP,[ACFIELD]
15400 GENABS ;L XTOP,XTOP+1
15500 ; OR LD XTOP,XTOP+2
15600 FI
15700 WHILE
15800 JUMPE XVAL,FALSE
15900 DO
16000 L X0,XL2
16100 DPB XL2,[ACFIELD]
16200 GENABS ;MULOP XTOP+1(2),XTOP+1(2)
16300 SETZ XVAL+1,
16400 LSHC XVAL,-1
16500 IF
16600 JUMPE XVAL+1,FALSE
16700 THEN
16800 L X0,XL2
16900 DPB XTOP,[ACFIELD]
17000 GENABS ;MULOP XTOP,XTOP+1(2)
17100 FI
17200 OD
17300 GOTO POWEX ;RETURN
17400 FI
17500
17600
17700 ; RUN TIME ROUTINE MARI, MALI, MARR OR MALL MUST BE CALLED
17800 ; FIRST THE ARGUMENTS ARE LOADED INTO YFARG AND YFAR2, THEN THE
17900 ; ARGUMENT ADDRESS YFADR IS LOADED INTO X16 AND THE PROPER
18000 ; ROUTINE IS CALLED WITH A PUSHJ XPDP,MAxx
18100
18200
18300 FIRSTOP
18400 COMPVAL
18500 AOS YTAC
18600 AOS YTAC
18700 NEXTOP
18800 COMPVAL
18900 LI X0,YFARG
19000 IF
19100 CAIE XL1,QLREAL
19200 GOTO FALSE
19300 THEN
19400 OP (DMOVEM)
19500 ELSE
19600 OP (ST)
19700 FI
19800 DPB XTOP,[ACFIELD]
19900 GENFIX ;ST(DMOVEM) XTOP,YFARG
20000
20100 EDIT(25)
20200 SETZM YLXIAC ;[25] Forget any old pointer to a block
20300 L X0,[LI X16,YFADR]
20400 GENFIX ;LI X16,YFADR
20500 LI X0,YFAR2
20600 ADDI XTOP,2
20700 IF
20800 CAIE XL2,QLREAL
20900 GOTO FALSE
21000 THEN
21100 ;SOP IS LONG REAL
21200 OP (DMOVEM)
21300 DPB XTOP,[ACFIELD]
21400 GENFIX ;STD XTOP,YFAR2
21500 GPUSHJ MALL ;PUSHJ XPDP,MALL
21600 ELSE
21700 OP (ST)
21800 DPB XTOP,[ACFIELD]
21900 GENFIX ;ST XTOP,YFAR2
22000 IF
22100 CAIE XL2,QREAL
22200 GOTO FALSE
22300 THEN
22400 ;SOP IS REAL
22500 GPUSHJ MARR ;PUSHJ XPDP,MARR
22600 ELSE
22700 ;SOP IS INTEGER
22800 IF
22900 CAIE XL1,QREAL
23000 GOTO FALSE
23100 THEN
23200 ;FOP IS REAL
23300 GPUSHJ MARI ;PUSHJ XPDP,MARI
23400 ELSE
23500 GPUSHJ MALI ;PUSHJ XPDP,MALI
23600 GOTO L2
23700 FI
23800 FI
23900 OPZ (L)
24000 SUBI XTOP,2
24100 GOTO L3
24200 FI
24300 L2(): SUBI XTOP,2
24400 OPZ (DMOVE)
24500 L3(): DPB XTOP,[ACFIELD]
24600 GENABS ;L(DMOVE) XTOP,X0
24700
24800 POWEX: UNSTK YTAC
24900 RELAC4
25000 RETURN
25100
25200 EPROC
00100 SUBTTL .UNMIN
00200
00300 COMMENT;
00400
00500 PURPOSE: GENERATE CODE FOR THE OPERATOR %UNMIN
00600
00700 ENTRY: .UNMIN
00800
00900 NORMAL EXIT: RETURN
01000
01100 ENTRY CONDITION: %UNMIN(ARITHMETIC EXP.)
01200 XCUR POINTS TO THE OPERATOR NODE
01300
01400 EXIT CONDITION: THE TOP AC (XWAC) CONTAINS THE NEGATED VALUE OF THE
01500 ARITHMETIC EXPRESION
01600
01700 ;
01800
01900
02000
02100 .UNMIN: PROC
02200 SAVE <XP1,XL1>
02300 GETAC4
02400 HRLZ XL1,@YTAC ;TARGET AC
02500 LSH XL1,5 ;TO AC FIELD POSITION
02600 FIRSTOP
02700 LF X1,ZNSTYP(XCUR)
02800 IF
02900 CAIE X1,QLREAL
03000 GOTO FALSE
03100 THEN
03200 ;THE NEGATED VALUE OF A LONG REAL IS OBTAINED BY A
03300 ; DOUBLE FLOATING SUBTRACT ( 0 - LONG REAL )
03400
03500 OP (SETZB)
03600 ADD X0,XL1
03700 HRR X0,@YTAC
03800 AOS X0
03900 GENABS ;SETZB XWAC,XWAC+1
04000 IF
04100 MEMOP
04200 GOTO FALSE
04300 THEN
04400 IF
04500 RECTYPE(XP1) IS ZID
04600 GOTO FALSE
04700 THEN
04800 ;FOP IS A ZID LONG REAL MEOP
04900
05000 LF X1,ZIDZQU(XP1)
05100 GETAD
05200 OP (DFSB)
05300 ADD X0,XL1
05400 ST X0,YOPCOD
05500 GENOP ;DFSB XWAC,IDAD
05600 ELSE
05700 ;FOP IS A ZCN LONG REAL MEOP
05800
05900 LF X1,ZCNVAL(XP1)
06000 L X0,(X1) ;FIRST WORD
06100 L X1,1(X1) ;SECOND WORD
06200 GENDW ;PUT INTO LIT. TABLE
06300 ;AND RETURN LIAD IN X0
06400 OP (DFSB)
06500 ADD X0,XL1
06600 GENREL ;DFSB XWAC,LIAD
06700 FI
06800 ELSE
06900 ;LONG REAL FOP IS NOT A MEOP
07000
07100 AOS YTAC
07200 AOS YTAC
07300 COMPVAL ;COMPILE FOP TO XWAC+2 AND XWAC+3
07400 L X0,@YTAC
07500 OP (DFSB)
07600 ADD X0,XL1
07700 GENABS ;DFSB XWAC,XWAC+2
07800 SOS YTAC
07900 SOS YTAC
08000 FI
08100 ELSE
08200 ;FOP OF TYPE INTEGER OR REAL
08300
08400 IF
08500 MEMOP
08600 GOTO FALSE
08700 THEN
08800 IF
08900 IMMOP
09000 GOTO FALSE
09100 THEN
09200 ;FOP IS A IMOP
09300
09400 LF X0,ZCNVAL(XP1)
09500 IF
09600 CAIE X1,QINTEGER
09700 GOTO FALSE
09800 THEN
09900 ;FOP IS AN INTEGER IMOP
10000
10100 OP (MOVNI)
10200 ADD X0,XL1
10300 GENABS ;MOVNI XWAC,-IMOP
10400 ELSE
10500 ;FOP IS A REAL IMOP
10600
10700 MOVN X0,X0
10800 MOVS X0,X0
10900 OP (MOVSI)
11000 ADD X0,XL1
11100 GENABS ;MOVSI XWAC,IMOP
11200 FI
11300 ELSE
11400 IF
11500 RECTYPE(XP1) IS ZID
11600 GOTO FALSE
11700 THEN
11800 ;FOP IS A ZID MEOP
11900
12000 LF X1,ZIDZQU(XP1)
12100 GETAD
12200 OP (MOVN)
12300 ADD X0,XL1
12400 ST X0,YOPCOD
12500 GENOP ;MOVN XWAC,IDAD
12600 ELSE
12700 ;FOP IS A ZCN MEOP
12800
12900 LF X0,ZCNVAL(XP1)
13000 GENWRD ;PUT INTO LIT. TABLE
13100 ; AND RETURN LIAD IN X0
13200 OP (MOVN)
13300 ADD X0,XL1
13400 GENREL ;MOVN XWAC,LIAD
13500 FI
13600 FI
13700 ELSE
13800 ;FOP IS NOT A MEOP
13900
14000 COMPVAL ;COMPILE FOP TO XWAC
14100 L X0,@YTAC
14200 OP (MOVN)
14300 ADD X0,XL1
14400 GENABS ;MOVN XWAC,XWAC
14500 FI
14600 FI
14700 RELAC4
14800 RETURN
14900 EPROC
00100 SUBTTL .DEQ .EQ .GRT .LESS .NDEQ .NEQ .NGRT .NLESS
00200
00300 COMMENT;
00400
00500 PURPOSE: COMPILE RELATION OPERATORS
00600
00700 ENTRIES: .DEQ, .EQ, .GRT, .LESS, .NDEQ, .NEQ, .NGRT, .NLESS
00800
00900 NORMAL EXIT: RETURN
01000
01100 USED ROUTINE: CGREOP
01200
01300 ENTRY CONDITION: RELATION OPERATOR( EXP NOT OF TYPE REF BOO OR LABEL,
01400 , EXP NOT OF TYPE REF BOO OR LABEL)
01500 XCUR POINTS TO THE OPERATOR NODE
01600
01700 EXIT CONDITION: IF A BOOLEAN RESULT IS REQUIRED IT WILL BE COMPILED TO @YTAC
01800 OTHERWISE NEXT INSTRUCTION WILL BE SKIPPED IF THE CONDITION
01900 IS SATISFIED
02000
02100 ;
02200
02300
02400
02500 .DEQ:
02600 .EQ: EXEC CGREOP,<[CAIE + (CAME)]>
02700 RETURN
02800
02900
03000 .GRT: EXEC CGREOP,<[CAIG + (CAMG)]>
03100 RETURN
03200
03300
03400 .LESS: EXEC CGREOP,<[CAIL + (CAML)]>
03500 RETURN
03600
03700
03800 .NDEQ:
03900 .NEQ: EXEC CGREOP,<[CAIN + (CAMN)]>
04000 RETURN
04100
04200
04300 .NGRT: EXEC CGREOP,<[CAILE+(CAMLE)]>
04400 RETURN
04500
04600
04700 .NLESS: EXEC CGREOP,<[CAIGE+(CAMGE)]>
04800 RETURN
00100 SUBTTL CGREOP
00200
00300 COMMENT;
00400
00500 PURPOSE: TO GENERATE CODE FOR THE RELATION OPERATORS
00600 %EQ, %GRT, %LESS, %NEQ, %NGRT, %NLESS, %DEQ AND %NDEQ
00700
00800 ENTRY: CGREOP
00900 INPUT ARGUMENTS: XCUR POINTS TO THE OPERATOR NODE
01000 REOPCO= IMMEDIATE COMPARE INSTR. ,, MEMORY COMPARE INSTR.
01100 E.G. FOR %EQ
01200 REOPCO= CAIE ,, CAME
01300
01400 NORMAL EXIT: RETURN
01500
01600 CALL FORMAT: EXEC CGREOP,<REOPCO>
01700
01800 EXPLANATION OF SHORT NOTES IN COMMENTS:
01900 FOP = FIRST OPERAND
02000 SOP = SECOND "
02100 MEOP = MEMORY "
02200 IMOP = IMMEDIATE "
02300
02400 CAMxx = RELATION INSTR.
02500 CAIxx = IMMEDIATE RELATION INSTR.
02600 SKIPxx = SKIP INSTR.
02700
02800 IDAD = IDENTIFIER ADDRESS
02900 LIAD = LITERAL ADDRESS
03000 PTAD = ADDRESS TO TEXT VARIABLE IN PROTOTYPE STREAM
03100
03200 ;
03300
03400
03500 CGREOP: PROC <REOPCO>
03600 SAVE <X4,XP1,XL1,XL2>
03700
03800 GETAC4
03900 L XL1,@YTAC
04000 L XL2,XL1
04100 AOS XL2
04200 L X0,REOPCO
04300 DPB XL1,[ACFIELD] ;SET ACFIELD IN BOTH HALVES OF X0
04400 DPB XL1,[ACFIRH] ; TO TARGET AC
04500 L X1,X0
04600 IF
04700 IFOFF SCCOND
04800 GOTO FALSE
04900 THEN
05000 ;COMPLEMENT COMPARE MODE TO ENABLE TEST ON REVERSED CONDITION
05100
05200 TLC X1,QCOMMO
05300 TRC X1,QCOMMO
05400 FI
05500 ST X1,REOPCO
05600
05700 FIRSTOP
05800 COMPVAL ;COMPILE FOP TO Xtop OR IF LONG REAL OR TEXT
05900 ; TO Xtop AND Xtop+1
06000 NEXTOP
06100 AOS YTAC
06200 AOS YTAC
06300 LF X4,ZIDTYP(XP1)
06400 IF
06500 CAIE X4,QTEXT
06600 GOTO FALSE
06700 THEN
06800 ;SOP IS OF TYPE TEXT
06900 ; IF OPERATOR = %DEQ AND SCCOND IS SET OR OPERATOR =%NDEQ AND
07000 ; SCCOND NOT IS SET THEN REOPCO IS CLEARED TO INDICATE THAT A
07100 ; SKIPA INSTRUCTION MUST BE INSERTED AFTER THE COMPARE
07200 ; INSTRUCTIONS
07300
07400 IF
07500 IFNEQF XCUR,ZNSGEN,%DEQ
07600 GOTO FALSE
07700 THEN
07800 IFON SCCOND
07900 SETZM REOPCO
08000 ELSE
08100 IF
08200 IFNEQF XCUR,ZNSGEN,%NDEQ
08300 GOTO FALSE
08400 THEN
08500 IFOFF SCCOND
08600 SETZM REOPCO
08700 ELSE
08800 ;TEXT VALUE RELATION
08900
09000 COMPVAL ;COMPILE SOP TO Xtop+2 AND Xtop+3
09100 LI X0,QSKCAD
09200 ADDM X0,REOPCO ;SKIP INSTR. CODE IN
09300 ; REOPCO RIGHT
09400 L X0,XL1
09500 OP (LI XTAC,)
09600 GENABS ;LI XTAC,Xtop
09700 SETZM YLXIAC
09800 GPUSHJ (TXRE) ;PUSHJ XPDP,TXRE
09900 ;WHEN CALLING TXRE THE TWO TEXTS
10000 ; THAT SHOULD BE COMPARED ARE
10100 ; COMPILED TO 4 CONSECUTIVE
10200 ; REGISTERS WITH THE NUMBER OF
10300 ; THE FIRST AC (Xtop) IN XTAC
10400 ;THE RESULT FROM THE COMPARISON
10500 ; ( 1 0 OR -1 ) IS RETURNED IN
10600 ; THIS FIRST REGISTER
10700
10800 GOTO L1 ;WHERE THE SKIP INSTR. IS
10900 ; GENERATED
11000 FI
11100 FI
11200
11300 ;TEXT REFERENCE RELATIONS %DEQ OR %NDEQ
11400
11500 IF
11600 MEMOP
11700 GOTO FALSE
11800 THEN
11900 IF
12000 RECTYPE(XP1) IS ZID
12100 GOTO FALSE
12200 THEN
12300 ;SOP IS A ZID TEXT MEOP
12400
12500 LF X1,ZIDZQU(XP1)
12600 GETAD
12700 AOS YO2ADI
12800 DPB XL2,[ACFIELD YO2ADI]
12900 OPZ (XOR)
13000 ST X0,YOPCOD
13100 GENOP ;XOR Xtop+1,IDAD+1
13200 LF X1,ZIDZQU(XP1)
13300 GETAD
13400 DPB XL1,[ACFIELD YO2ADI]
13500 OP (CAMN)
13600 ST X0,YOPCOD
13700 GENOP ;CAMN Xtop,IDAD
13800 ELSE
13900 ;SOP IS A ZCN TEXT MEOP
14000
14100 LF X4,ZCNVAL(XP1)
14200 IF
14300 JUMPE X4,FALSE ;SOP=NOTEXT
14400 THEN
14500 ASSERT<RFAIL ILLEGAL TEXT RELATION>
14600 ;SOP IS A TEXT STRING CONSTANT
14700
14800 STACK YQRELR
14900 STACK YQRELT
15000 LI X0,QRELPT
15100 ST X0,YQRELT
15200 HLRZ X0,X4
15300 GENREL ; 0 ,, START ADDRESS
15400 ; INTO PROTOTYPE STREAM
15500 LI X0,1
15600 HRL X0,X4
15700 SETZM YQRELR
15800 GENREL ;LENGTH,, 1
15900 ; INTO PROTOTYPE STREAM
16000 UNSTK YQRELT
16100 L X0,YRELPT
16200 SOS X0
16300 OP (XOR)
16400 DPB XL2,[ACFIELD]
16500 LI X1,QRELPT
16600 ST X1,YQRELR
16700 GENREL ;XOR Xtop+1,PTAD+1
16800 L X0,YRELPT
16900 SUBI X0,2
17000 OP (CAMN)
17100 DPB XL1,[ACFIELD]
17200 GENREL ;CAMN Xtop,PTAD
17300 UNSTK YQRELR
17400 FI
17500 FI
17600 ELSE
17700 ;TEXT SOP IS NOT A MEOP
17800
17900 COMPVAL ;COMPILE SOP TO Xtop+2 AND Xtop+3
18000 L X0,XL2
18100 ADDI X0,2
18200 OP (XOR)
18300 DPB XL2,[ACFIELD]
18400 GENABS ;XOR Xtop+1,Xtop+3
18500 L X0,XL2
18600 AOJ X0,
18700 OP (CAMN)
18800 DPB XL1,[ACFIELD]
18900 GENABS ;CAMN Xtop,Xtop+2
19000 FI
19100 LI X0,-1
19200 OP (TLNE)
19300 DPB XL2,[ACFIELD]
19400 GENABS ;TLNE Xtop+1,-1
19500 IF
19600 SKIPE REOPCO
19700 GOTO FALSE
19800 THEN
19900 ;INSERT A SKIPA IF REOPCO = 0
20000
20100 MOVSI (SKIPA)
20200 GENABS ;SKIPA
20300 FI
20400 ELSE
20500 ;SOP NOT TEXT
20600
20700 IF
20800 CAIE X4,QLREAL
20900 GOTO FALSE
21000 THEN
21100 ;SOP IS LONG REAL
21200
21300 LI X0,QSKCAD
21400 ADDM X0,REOPCO ;SKIPxx IN REOPCO RIGHT
21500 IF
21600 MEMOP
21700 GOTO FALSE
21800 THEN
21900 IF
22000 RECTYPE(XP1) IS ZID
22100 GOTO FALSE
22200 THEN
22300 ;SOP IS A LONG REAL ZID MEOP
22400
22500 LF X1,ZIDZQU(XP1)
22600 GETAD
22700 OP (DFSB)
22800 DPB XL1,[ACFIELD YO2ADI]
22900 ST X0,YOPCOD
23000 GENOP ;DFSB Xtop,IDAD
23100 ELSE
23200 ;SOP IS A LONG REAL ZCN MEOP
23300
23400 LF X1,ZCNVAL(XP1)
23500 L X0,(X1) ;X0=FIRST WORD
23600 L X1,1(X1) ;X1=SECOND WORD
23700 GENDW ;PUT INTO LIT. TABLE
23800 ; AND RETURN LIAD IN X0
23900 OP (DFSB)
24000 DPB XL1,[ACFIELD]
24100 GENREL ;DFSB Xtop,LIAD
24200 FI
24300 ELSE
24400 ;LONG REAL SOP IS NOT A MEOP
24500
24600 COMPVAL ;COMPILE SOP TO Xtop+2
24700 ; AND Xtop+3
24800 L X0,XL2
24900 AOJ X0,
25000 OP (DFSB)
25100 DPB XL1,[ACFIELD]
25200 GENABS ;DFSB Xtop,Xtop+2
25300 FI
25400 L1(): HRL X0,REOPCO
25500 HRR X0,XL1
25600 GENABS ;SKIPxx Xtop
25700 ELSE
25800 ;SOP NOT TEXT OR LONG REAL
25900
26000 IF
26100 MEMOP
26200 GOTO FALSE
26300 THEN
26400 IF
26500 IMMOP
26600 GOTO FALSE
26700 THEN
26800 IF
26900 CAIN X4,QREAL
27000 GOTO FALSE
27100 THEN
27200 ;SOP IMOP NOT OF TYPE REAL
27300
27400 LF X0,ZCNVAL(XP1)
27500 HLL X0,REOPCO
27600 GENABS ;CAIxx Xtop,IMOP
27700 ELSE
27800 GOTO L2 ;REAL IMOP SOP IS
27900 ; TREATED AS ZCN MEOP
28000 FI
28100 ELSE
28200 IF
28300 RECTYPE(XP1) IS ZID
28400 GOTO FALSE
28500 THEN
28600 ;SOP IS A ZID MEOP
28700
28800 LF X1,ZIDZQU(XP1)
28900 GETAD
29000 DPB XL1,[ACFIELD YO2ADI]
29100 HRL X0,REOPCO
29200 ST X0,YOPCOD
29300 GENOP ;CAMxx Xtop,IDAD
29400 ELSE
29500 ;SOP IS A ZCN MEOP
29600
29700 L2(): LF X0,ZCNVAL(XP1)
29800 GENWRD ;PUT INTO LIT. TABLE
29900 ; AND RETURN LIAD IN X0
30000 HRL X0,REOPCO
30100 GENREL ;CAMxx Xtop,LIAD
30200 FI
30300 FI
30400 ELSE
30500 ;SOP IS NOT A MEOP
30600
30700 SOS YTAC
30800 COMPVAL ;COMPILE SOP TO Xtop+1
30900 AOS YTAC
31000 HRL X0,REOPCO
31100 HRR X0,XL2
31200 GENABS ;CAMxx Xtop,Xtop+1
31300 FI
31400 FI
31500 FI
31600 IF
31700 IFOFF SVALUE
31800 GOTO FALSE
31900 THEN
32000 ;COMPILE A BOOLEAN RESULT INTO Xtop
32100
32200 OP (TDZA)
32300 DPB XL1,[ACFIELD]
32400 HRR X0,XL1
32500 GENABS ;TDZA Xtop,Xtop ;FALSE
32600 MOVSI (SETO)
32700 DPB XL1,[ACFIELD]
32800 GENABS ;SETO Xtop, ;TRUE
32900 FI
33000 SOS YTAC
33100 SOS YTAC
33200 RELAC4
33300 RETURN
33400 EPROC
33500
33600
00100 SUBTTL .AND .EQV .IMP .OR
00200
00300 COMMENT;
00400
00500 PURPOSE: COMPILE BOOLEAN OPERATORS
00600
00700 ENTRIES: .AND, .EQV, .IMP, .OR
00800
00900 NORMAL EXIT: RETURN
01000
01100 USED ROUTINE: CGBOOP
01200
01300 ENTRY CONDITION: BOOLEAN OPERATOR ( BOOLEXP. , BOOLEXP.)
01400 XCUR POINTS TO THE OPERATOR NODE
01500
01600 EXIT CONDITION: IF A BOOLEAN RESULT IS REQUIRED IT WILL BE COMPILED TO @YTAC
01700 OTHERWISE NEXT INSTRUCTION WILL BE SKIPED IF THE
01800 RESULT IS TRUE
01900
02000 ;
02100
02200
02300
02400 .AND: EXEC CGBOOP,<[AND]>
02500 RETURN
02600
02700
02800 .EQV: EXEC CGBOOP,<[EQV]>
02900 RETURN
03000
03100
03200 .IMP: EXEC CGBOOP,<[ORCA]>
03300 RETURN
03400
03500
03600 .OR: EXEC CGBOOP,<[OR]>
03700 RETURN
00100 SUBTTL CGBOOP
00200
00300 COMMENT;
00400
00500 PURPOSE: TO GENERATE CODE FOR THE BOOLEAN OPERATORS
00600 %AND, %EQV, %IMP AND %OR
00700
00800 ENTRY: CGBOOP
00900
01000 INPUT ARGUMENTS: XCUR POINTS TO THE OPERATOR NODE
01100 BOOPCO = INSTRUCTION CODE FOR THE BOOLEAN OPERATOR
01200
01300 NORMAL EXIT: RETURN
01400
01500 CALL FORMAT: EXEC CGBOOP,<BOOPCO>
01600
01700 EXPLANATION OF SHORT NOTES IN COMMENTS:
01800 FOP = FIRST OPERAND
01900 SOP = SECOND "
02000 MEOP = MEMORY "
02100
02200 BOIN = BOOLEAN INSTRUCTION
02300
02400 IDAD = IDENTIFIER ADDRESS
02500 LIAD = LITERAL "
02600
02700 ;
02800
02900
03000
03100
03200 CGBOOP: PROC <BOOPCO>
03300 SAVE <XP1,XL1>
03400
03500 GETAC2
03600 L XL1,@YTAC
03700 DPB XL1,[ACFIELD BOOPCO]
03800 FIRSTOP
03900 COMPVAL ;COMPILE FOP TO XWAC
04000 NEXTOP
04100 IF
04200 MEMOP
04300 GOTO FALSE
04400 THEN
04500 IF
04600 RECTYPE(XP1) IS ZID
04700 GOTO FALSE
04800 THEN
04900 ;SOP IS A ZID MEOP
05000
05100 LF X1,ZIDZQU(XP1)
05200 GETAD
05300 L X0,BOOPCO
05400 ST X0,YOPCOD
05500 GENOP ;BOIN XWAC,IDAD
05600 ELSE
05700 ;SOP IS A ZCN MEOP
05800
05900 LF X0,ZCNVAL(XP1)
06000 GENWRD ;PUT INTO LIT.TABLE
06100 ; AND RETURN LIAD IN X0
06200 HLL X0,BOOPCO
06300 GENREL ;BOIN XWAC,LIAD
06400 FI
06500 ELSE
06600 ;SOP IS NOT A MEOP
06700
06800 AOS YTAC
06900 COMPVAL ;COMPILE SOP TO XWAC+1
07000 L X0,BOOPCO
07100 HRR X0,@YTAC
07200 GENABS ;BOIN XWAC,XWAC+1
07300 SOS YTAC
07400 FI
07500 IF
07600 IFOFF SCONDI
07700 GOTO FALSE
07800 THEN
07900 OP (SKIPN)
08000 HRR X0,XL1
08100 GENABS ;SKIPN XWAC
08200 ELSE
08300 IF
08400 IFOFF SCCOND
08500 GOTO FALSE
08600 THEN
08700 OP (SKIPE)
08800 HRR X0,XL1
08900 GENABS ;SKIPE XWAC
09000 FI
09100 FI
09200 RELAC2
09300 RETURN
09400 EPROC
09500
09600
09700 LIT
09800
09900 END