Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/13/cgrk.mac
There are 2 other files named cgrk.mac in the archive. Click here to see a list.
; ******
SUBTTL *CGRK*
; ******
COMMENT;
AUTHOR: REIDAR KARLSSON
VERSION: 4 [5,25,146,202,233]
CONTENTS: CGAC
CGIM, CGIM1, CGMO, CGMO1, .IN, .IS, .QUA, .QUAL
CGAROP, .PLUS, .MINUS, .MULT, .DIV, .IDIV
.UNMIN, .POW
CGREOP, .EQ, .GRT, .LESS, .NEQ, .NGRT, .NLESS, .DEQ, .NDEQ
CGBOOP, .AND, .EQV, .IMP, .OR
;
SEARCH SIMMAC, SIMMC2, SIMMCR
CTITLE CGRK
SALL
INTERNAL CGAC
INTERNAL CGIM, CGIM1, CGMO, CGMO1, .IN, .IS, .QUA, .QUAL
INTERNAL .PLUS, .MINUS, .MULT, .DIV, .IDIV, .UNMIN, .POW
INTERNAL .EQ, .GRT, .LESS, .NEQ, .NGRT, .NLESS, .DEQ, .NDEQ
INTERNAL .AND, .EQV, .IMP, .OR
EXTERNAL CGVA, CGAD, CGCA, CGCC, CGCO
EXTERNAL YCGACT, YACTAB, YLXIAC, YTAC
EXTERNAL YQRELR, YQRELT, YRELCD, YRELPT, YO2ADI, YOPCOD
EXTERNAL CADS,CGG2,CGG3,CGG4,CGR2,CGR3,CGR4
EXTERNAL O2AD,O2CF,O2DF,O2GA,O2GF,O2GI,O2GR,O2GW,O2GWD,O2IV
EXTERNAL CGLO, CGLO1
QOPACM= 777740 ;OPERATION AND AC FIELD MASK
QIMBIT= 1K ;IMMEDIATE MODE BIT
QCOMMO= 4K ;COMPARE MODE COMPLEMENT BIT
QSKCAD= (<SKIP> - CAM) ;DIFFERENCE IN OPERATION CODE FOR SKIP AND CAM
OPDEF ACFIRH [POINT 4,0,30] ;ACFIELD FOR INSTR. CODE IN RIGHT HALF
DEFINE FIRSTOP=<LF XP1,ZNSZNO(XCUR)>
TWOSEG
RELOC 400K
MACINIT
CGINIT
SUBTTL CGAC
COMMENT;
PURPOSE: TO CONSTRUCT AND OUTPUT A ZAM RECORD FROM YACTAB (THE REGISTER
ALLOCATION TABLE)
ENTRY: CGAC
INPUT ARGUMENTS: THE CONTENTS OF YACTAB AND YTAC THAT POINTS TO THE FIRST
ENTRY IN YACTAB THAT SHOULD NOT BE SAVED
NORMAL EXIT: RETURN
OUTPUT ARGUMENTS: THE ZAM WORD
------------------+--------------------
[ FLAGS REAL AC:S I FLAGS PSEUDO AC:S ]
------------------+--------------------
IS OUTPUT TO THE CONSTANT STREAM AND
THE WORD
XWD N,ADMAP
IS OUTPUT TO THE CODE STREAM
WHERE N IS THE NUMBER OF AC:S TO BE SAVED
AND ADMAP IS THE ADDRESS OF THE ZAM RECORD
THE RELOCATION FLAGS IN THE ZAM WORD OCCUPIE ONE BIT
FOR EACH AC SO THAT BIT 0 ANSWERS TO XWAC1 AND BIT 1
TO XWAC2 ETC. FOR REAL AC:S AND BIT 18 ANSWERS TO
FIRST PSEUDO AC AND BIT 19 TO SECOND PSEUDO AC ETC.
IF THE FLAG IS SET TO ONE IT INDICATES THAT THE RIGHT HALF
OF ITS AC CONTAINS A DYNAMIC POINTER THAT SHOLD BE
RELOCATED BY GARBAGE COLLECTOR
CALL FORMAT: EXEC CGAC
USED ROUTINES: CGACRF, GENABS, GENWRD, GENREL
SUBROUTINE CGACRF
PURPOSE: TO DETERMINE THE RELOCATION FLAG FOR A REGISTER
FROM THE THE TYPE OF THE ZNO NODE POINTED TO
BY THE LEFT HALF OF THE YACTAB ENTRY
ENTRY: CGACRF
INPUT ARGUMENTS: X3 CONTAINS THE AC NUMBER
X4 POINTS TO THE ZNO NODE
NORMAL EXIT: RETURN
OUTPUT ARGUMENTS: A 1-BIT MASK IS ORED INTO REG. X1 AT A POSITION
DETERMINED BY THE AC NUMBER IN X3
CALL FORMAT: EXEC CGACRF
;
CGACRF:
;THE FOLLOWING DECISION TABLE IS CODED
; ZNN NODE NO NO NO NO NO YES
; KIND SIMPLE YES YES
; KIND ARRAY YES
; KIND PROCEDURE YES YES
; SYSTEM PROCEDURE YES NO
; TYPE REF TEXT OR LABEL YES NO
; --------------------------------------------------------------
; X6 := 1 0 1 1 0 1
SETZ X6,
IF
RECTYPE(X4) IS ZNN
GOTO FALSE
THEN
LI X6,1
ELSE
LF X0,ZIDKND(X4)
IF
CAIE X0,QSIMPLE
GOTO FALSE
THEN
LF X0,ZIDTYP(X4)
IF
CAIE X0,QREF
CAIN X0,QTEXT
GOTO TRUE
CAIE X0,QLABEL
GOTO FALSE
THEN
LI X6,1
FI
ELSE
IF
CAIE X0,QPROCEDURE
GOTO FALSE
THEN
IFON ZIDSYS(X4)
LI X6,1
ELSE
ASSERT<
IF
CAIN X0,QARRAY
GOTO FALSE
THEN
RFAIL WRONG KIND FOUND IN CGACRF
FI
>
LI X6,1
FI
FI
FI
;THE MASK IS LEFT JUSTIFIED
; AND THEN ORED INTO THE ZAM WORD IN X1
LI X4,XWAC1
SUB X4,X3 ;X4 := XWAC1-ACNUMBER=-(ACNUMBER-XWAC1)
ROT X6,-1(X4) ;-1 - (ACNUMBER - XWAC1)
; -1 WILL SHIFT THE MASK TO THE BEGINNING
; OF THE WORD, WHICH IS THE APPROPRIATE
; POSITION FOR XWAC1. THEN, IF THE
; ACNUMBER IS GREATER THAN XWAC1, IT
; WILL BE SHIFTED RIGHT
; ACNUMBER-XWAC1 STEPS
OR X1,X6
RETURN
CGAC: PROC
SAVE <X2,X3,X4,X5,X6>
SETZB X1,YLXIAC ; XIAC DESTROYED AT RUN TIME
LI X5,YACTAB+QNAC
IF
CAMG X5,YTAC
GOTO FALSE
THEN
;PSEUDOAC:S NOT USED
LI X2,YACTAB ;FIRST REAL AC IS FOUND AT
; TOP OF YACTAB
WHILE
CAMN X2,YTAC ;YTAC POINTS TO THE FIRST AC
; NOT TO BE SAVED
GOTO FALSE
DO
;FIND ZAM WORD FOR USED REAL AC:S TO BE SAVED
HRRZ X3,(X2)
ASSERT< CAILE X3,XWACL
RFAIL (FIXUP INDEX FOUND WHEN PSEUDO AC:S NOT USED IN CGAC)>
HLRZ X4,(X2)
SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
EXEC CGACRF ;DETERMINE RELOCATION FLAG
AOS X2
OD
L X0,X1 ;X0=FLAGS FOR REAL AC:S IN LEFT HALF
; AND RIGHT HALF = FLAGS FOR
; PSEUDO AC:S = 0
ELSE
;PSEUDO AC:S ARE USED
; FIRST REAL AC ENTRY IS FOUND AT TOP OF THE SECOND HALF
; OF YACTAB
LI X2,YACTAB+QNAC
WHILE
CAML X2,YTAC
GOTO FALSE
DO
;REAL AC:S IN SECOND HALF OF YACTAB ARE HANDLED
HRRZ X3,(X2)
HLRZ X4,(X2)
SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
EXEC CGACRF ;DETERMINE RELOCATION FLAG
AOS X2
OD
SUBI X2,QNAC
WHILE
HRRZ (X2)
CAIG XWACL
GOTO FALSE
DO ; SKIP SAVED QUANT:S
AOJ X2,
OD
;X2 POINTS TO THE FIRST REAL AC ENTRY
; IN THE FIRST HALF OF YACTAB
L X5,X2
LOOP
;REAL AC ENTRIES IN FIRST HALF OF YACTAB ARE HANDLED
HRRZ X3,(X2)
ASSERT< CAILE X3,XWACL
RFAIL (AC NUMBER NOT FOUND IN CGAC)>
HLRZ X4,(X2)
CAMN X4,X2
GOTO L1 ;SKIPPED ENTRY
SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
EXEC CGACRF ;DETERMINE RELOCATION FLAG
AS
AOS X2
CAIE X2,YACTAB+QNAC ;END OF FIRST HALF OF YACTAB
GOTO TRUE
SA
L1(): STACK X1 ;SAVE ZAM WORD FOR REAL AC:S
SETZ X1, ;CLEAR X1
LI X2,YACTAB ;FIRST PSEUDO AC ENTRY IS FOUND AT TOP
; OF YACTAB
LI X3,XWAC1 ;ACNUMBER OF FIRST PSEUDO AC
LOOP
;PSEUDO AC ENTRIES ARE HANDLED
ASSERT< HRRZ X4,(X2)
CAIG X4,XWACL
RFAIL (PSEUDO AC FIXUP INDEX NOT FOUND IN CGAC)>
HLRZ X4,(X2)
SKIPE X4 ;NO ZNO POINTER IN LEFT HALF
EXEC CGACRF ;DETERMINE RELOCATION FLAG
AOS X2
AOS X3
AS
CAME X2,X5 ;LAST PSEUDO AC HANDLED?
GOTO TRUE
SA
UNSTK X0 ;ZAM FLAGS FOR REAL AC:S IN LEFT HALF
HLR X0,X1 ; AND FOR PSEUDO AC:S IN RIGHT HALF
FI
L X2,YTAC
SUBI X2,YACTAB ;X2=NUMBER OF USED ENTRIES IN YACTAB
; INCLUDING POSSIBLE GAPS FOR SKIPPED AC:S
IF
SKIPE X2
GOTO FALSE
THEN
SETZ
GENABS
ELSE
GENWRD ;ZAM WORD IS OUTPUT TO THE CONSTANT STREAM AND THE
; ZAM ADDRESS IS RETURNED IN X0
HRL X0,X2
GENREL ;XWD N,ADMAP
FI
RETURN
EPROC
SUBTTL CGIM, CGIM1
COMMENT;
PURPOSE: TO DETERMINE IF A NODE REPRESENTS AN IMMEDIATE OPERAND
ENTRY: CGIM, CGIM1
INPUT ARGUMENTS: XP1 POINTS TO THE NODE
NORMAL EXIT: SKIP RETURN OR RETURN
OUTPUT ARGUMENTS: CGIM WILL RETURN WITH A SKIP IF THE NODE WAS AN
IMMEDIATE OPERAND, AND CGIM1 WILL RETURN WITH A SKIP IF
THE NODE WAS NOT AN IMMEDIATE OPERAND
CALL FORMAT: EXEC CGIM (IMMOP)
EXEC CGIM1 (IFIMMO)
;
;INTEGER CONSTANTS WITH LEFT HALFWORD ZERO
; REAL " " RIGHT " " AND
; ALL OTHER CONSTANTS NOT OF TYPE TEXT OR LONG REAL
; EXCEPT TRUE ARE CONSIDERED AS IMMEDIATE OPERANDS
CGIM:
IF
RECTYPE(XP1) IS ZCN
GOTO FALSE
THEN
LF X0,ZCNTYP(XP1)
IF
CAIE X0,QINTEGER
GOTO FALSE
THEN
LF X0,ZCNVAL(XP1)
TLNN X0,-1
AOS (XPDP) ;INTEGER CONSTANT WITH LEFT
; HALF ZERO
ELSE
IF
CAIE X0,QREAL
GOTO FALSE
THEN
LF X0,ZCNVAL(XP1)
TRNN X0,-1
AOS (XPDP) ;REAL CONSTANT WITH
; RIGHT HALF ZERO
ELSE
IF
CAIE X0,QTEXT
CAIN X0,QLREAL
GOTO FALSE
THEN
LF X0,ZCNVAL(XP1)
SKIPL ; SKIP FOR TRUE
AOS (XPDP) ;CONSTANT NOT OF TYPE
; INTEGER, REAL,
; LONG REAL OR TEXT
FI
FI
FI
FI
RETURN
CGIM1: EXEC CGIM
AOS (XPDP) ;NON-SKIP RETURN FROM CGIM = SKIP RETURN FROM CGIM1
RETURN ;SKIP RETURN FROM CGIM = NON-SKIP RETURN FROM CGIM1
SUBTTL CGMO, CGMO1
COMMENT;
PURPOSE: TO DETERMINE IF A NODE REPRESENTS A MEMORY OPERAND
ENTRY: CGMO, CGMO1
INPUT ARGUMENTS: XP1 POINTS TO THE NODE
NORMAL EXIT: SKIP RETURN OR RETURN
OUTPUT ARGUMENTS: CGMO WILL RETURN WITH A SKIP IF THE NODE WAS
A MEMORY OPERAND, AND CGMO1 WILL RETURN WITH A SKIP IF
THE NODE WAS NOT A MEMORY OPERAND
CALL FORMAT: EXEC CGMO (MEMOP)
EXEC CGMO1 (IFMEMO)
;
;CONSTANTS AND SIMPLE IDENTIFIERS NOT OF MODE NAME OR TYPE LABEL ARE
; CONSIDERED TO BE MEMORY OPERANDS
CGMO: IF
WHEN XP1,ZCN
GOTO TRUE
WHENNOT XP1,ZID
GOTO FALSE
IFEQF XP1,ZIDMOD,QNAME
GOTO FALSE
IFNEQF XP1,ZIDKND,QSIMPLE
GOTO FALSE
IFEQF XP1,ZIDTYP,QLABEL
GOTO FALSE
THEN
AOS (XPDP) ;SKIP RETURN IF CONSTANT OR ID NOT OF MODE NAME
FI
RETURN
CGMO1: EXEC CGMO
AOS (XPDP) ;NON-SKIP RETURN FROM CGMO = SKIP RETURN FROM CGMO1
RETURN ;SKIP RETURN FROM CGMO = NON-SKIP RETURN FROM CGMO1
SUBTTL CGQU
COMMENT;
PURPOSE: Check the expression "x QUA c". Straight return
if the qualification need not be checked at runtime
(just check for NONE then), otherwise skip return.
It already has been checked that x CAN be c, i e the qualification of x
is either a subclass of c or a prefix class oc c.
Skip return thus means that the qualification must be checked at
run time, straight return means runtime check for NONE only.
ENTRY: CGQU
INPUT ARGUMENTS:
XP1 points to the node for x.
XCUR points to the QUA node.
NORMAL EXIT: RETURN OR SKIP RETURN
OUTPUT ARGUMENTS: SEE PURPOSE
CALL FORMAT: EXEC CGQU
;
CGQU: PROC
LF X1,ZNSZQU(XCUR)
LF ,ZQUZB(X1) ;ZHB for qualification (c) to X0
LF X1,ZIDZDE(XP1)
LF X1,ZQUZB(X1) ;ZHB for qualification of x
; or NONE if x is the constant NONE
EDIT(233)
CAIN X1,NONE ;[233] Accept NONE as if a subclass
GOTO L9 ;[233]
;SEARCH IN THE PREFIX CHAIN OF FIRST OPERAND FOR A MATCH
WHILE
JUMPE X1,FALSE
DO
CAIN (X1) ;[233]
GOTO L9 ;[233] x IN c
LF X1,ZHBZHB(X1)
OD
AOS (XPDP) ;[233] x may not be IN c
L9():! RETURN
EPROC
SUBTTL .IN
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE %IN OPERATOR
ENTRY: .IN
ENTRY CONDITION: %IN(OBJ-EXP,CL-ID)
EXIT: RETURN
;
.IN: PROC
SAVE <XP2>
FIRSTOP
COMPVAL
L X4,YLINK
L XP2,@YTAC
LI NONE
OP (CAIN)
DPB XP2,[ACFIELD]
GENABS ;CAIN XWAC,NONE
L X3,YQRELR
LI X1,QRELCD
ST X1,YQRELR
L X2,YRELCD
LI 8(X2)
OP (JRST)
GENREL ;JRST FALSE PATH
L [LF ,ZBIZPR()]
DPB XP2,[ACFIELD]
DPB XP2,[INDEXFIELD]
GENABS ;LF XWAC,ZBIZPR(XWAC)
LI 5(X2)
OP (JRST)
GENREL ;JRST .+3
L [SKIPN ,OFFSET(ZCPZCP)]
DPB XP2,[ACFIELD]
DPB XP2,[INDEXFIELD]
GENABS ;SKIPN XWAC,ZCPZCP(XWAC)
LI 8(X2)
OP (JRST)
GENREL ;JRST FALSE PATH
NEXTOP
LF X1,ZIDZQU(XP1)
LF ,ZQUIND(X1)
OP (CAIE)
DPB XP2,[ACFIELD]
GENFIX ;CAIE XWAC, PROTOTYPE FIXUP 2:ND OPERAND
LI 3(X2)
OP (JRST)
GENREL ;JRST .-3
ST X3,YQRELR
IF ;BOOLEAN RESULT REQUIRED?
IFOFFA SVALUE(X4)
GOTO FALSE
THEN
SETO
GENWRD ;[-1] = [TRUE]
OP (SKIPA)
DPB XP2,[ACFIELD]
GENREL ;SKIPA XWAC,[TRUE]
MOVSI (SETZ)
DPB XP2,[ACFIELD]
GENABS ;SETZ XWAC,
ELSE
IF
IFOFFA SCONDI(X4) ;THE CONDITION HAS BEEN REVERSED
GOTO FALSE ; I.E. COND.SKIP
; JRST TRUE
; FALSE:
THEN
MOVSI (SKIPA)
GENABS ;SKIPA
FI
FI
RETURN
EPROC
SUBTTL .IS
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE %IS OPERATOR
ENTRY: .IS
ENTRY CONDITION: %IS(OBJ-EXP, CL-ID)
EXIT: RETURN
;
.IS: PROC
SAVE <XP1,XP2>
FIRSTOP
COMPVAL
L X4,YLINK
L XP2,@YTAC
LI NONE
OP (CAIN)
DPB XP2,[ACFIELD]
GENABS ;CAIN XWAC,NONE
L X2,YQRELR
LI QRELCD
ST YQRELR
L X1,YRELCD
LI 3(X1) ;.+3
IFONA SCCOND(X4)
AOJ ;.+4 IF REVERSED CONDITION
OP (JRST)
GENREL ;JRST .+3 OR .+4
ST X2,YQRELR ;RESTORE RELOCATION RIGHT HALF
L [LF XSAC,ZBIZPR()]
DPB XP2,[INDEXFIELD]
GENABS ;LF XSAC,ZBIZPR(XWAC)
NEXTOP
LF X1,ZIDZQU(XP1)
LF ,ZQUIND(X1)
OP (CAIE XSAC,)
IFONA SCCOND(X4)
TLC X0,QCOMMO ;COMPLEMENT COMPARE MODE
GENFIX ;CAIE OR CAIN XSAC,PROTOTYPE FIXUP 2:ND OPERAND
IF ;BOOLEAN RESULT REQUIRED?
IFOFFA SVALUE(X4)
GOTO FALSE
THEN
L XP2
OP (TDZA)
DPB XP2,[ACFIELD]
GENABS ;TDZA XWAC,XWAC
MOVSI (SETO)
DPB XP2,[ACFIELD]
GENABS ;SETO XWAC,
FI
RETURN
EPROC
SUBTTL .QUA
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE %QUA OPERATOR
ENRY: .QUA
ENTRY CONDITION: %QUA (OBJ-EXP, CL-ID)
EXIT: RETURN
;
.QUA: PROC
SAVE <XP1,XP2>
FIRSTOP
COMPVAL
IFOFF YSWQ ;No code generated if /-Q was specified
GOTO L9
EDIT(233) ;Cause "OBJECT NONE" if OBJ-EXP == NONE
L [LF XSAC,ZBIZPR()]
L XP2,@YTAC
DPB XP2,[INDEXFIELD]
GENABS ;LF XSAC,ZBIZPR(XTOP)
EXEC CGQU ;Check qualification of OBJ-EXP
GOTO L9 ;Qualification ok (OBJ-EXP in CL-ID)
NEXTOP
LF X1,ZIDZQU(XP1)
LF ,ZQUIND(X1)
OP (CAIN XSAC,)
GENFIX ;CAIN XSAC,Prototype fixup of CL-ID
L X2,YQRELR
LI X1,QRELCD
ST X1,YQRELR
L X3,YRELCD
LI 4(X3)
OP (JRST)
GENREL ;JRST .+4
L [SKIPN XSAC,OFFSET(ZCPZCP)(XSAC)]
GENABS ;SKIPN XSAC,ZCPZCP(XSAC)
L [RTSERR QQUAERROR]
GENABS ;QUA CHECK ERROR
LI -1(X3)
OP (JRST)
GENREL ;JRST .-4
ST X2,YQRELR
L9():! RETURN
EPROC
SUBTTL .QUAL
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE %QUAL OPERATOR
ENTRY: .QUAL
ENTRY CONDITION: %QUAL (REF-ID)
EXIT: RETURN
;
.QUAL: PROC
SAVE <XP2>
FIRSTOP
COMPVAL
IFOFF YSWQ ;Code generated for QUA check only if /Q holds
GOTO L9
LF X1,ZNSZQU(XP1)
IFOFF ZQUSYS(X1)
WARNING 5,IMPLICIT QUA CHECK
L XP2,@YTAC
L [CAIN ,NONE]
DPB XP2,[ACFIELD]
GENABS ;CAIN Xtop,NONE
L X3,YQRELR
LI X1,QRELCD
ST X1,YQRELR
L X2,YRELCD
LI 7(X2)
OP (JRST)
GENREL ;JRST .+7
EDIT(146)
IF ;[146]
LF ,ZIDKND(XP1)
CAIE QARRAY
GOTO FALSE
THEN
L [LF XSAC,ZARZPR()]
ELSE
L [LF XSAC,ZBIZPR()]
FI
DPB XP2,[INDEXFIELD]
GENABS ;LF XSAC,ZBIZPR(XWAC)
LF X1,ZNSZQU(XCUR)
LF ,ZQUIND(X1)
OP (CAIN XSAC,)
GENFIX ;CAIN XSAC,PROTOTYPE FIXUP
LI 7(X2)
OP (JRST)
GENREL ;JRST .+4
L [SKIPN XSAC,OFFSET(ZCPZCP)(XSAC)]
GENABS ;SKIPN XSAC,ZCPZCP(XSAC)
L [RTSERR QREFASERROR]
GENABS ;REF ASSIGN ERROR
LI 2(X2)
OP (JRST)
GENREL ;JRST .-4
ST X3,YQRELR
L9():! RETURN
EPROC
SUBTTL .PLUS .MINUS .MULT .DIV .IDIV
COMMENT;
PURPOSE: COMPILE ARITHMETIC OPERATORS
ENTRIES: .PLUS, .MINUS, .MULT, .DIV, .IDIV
NORMAL EXIT: RETURN
USED ROUTINE: CGAROP
ENTRY CONDITION: ARITHM. OPERATOR(ARITHM.EXP. , ARITHM.EXP.)
XCUR POINTS TO THE OPERATOR NODE
EXIT CONDITION: THE RESULT HAS BEEN COMPILED TO @YTAC OR IF LONG REAL
TO @YTAC AND @YTAC+1
;
.PLUS: EXEC CGAROP,<[<ADD> + <(FADR)>B26 + (DFAD)]>
RETURN
.MINUS: EXEC CGAROP,<[<SUB> + <(FSBR)>B26 + (DFSB)]>
RETURN
.MULT: EXEC CGAROP,<[<IMUL>+ <(FMPR)>B26 + (DFMP)]>
RETURN
.DIV:
.IDIV: EXEC CGAROP,<[<IDIV>+ <(FDVR)>B26 + (DFDV)]>
RETURN
SUBTTL CGAROP
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE ARITHMETIC OPERATORS
%PLUS, %MINUS, %MUL, %DIV AND %IDIV
ENTRY: CGAROP
INPUT ARGUMENTS: XCUR POINTS TO THE OPERATOR NODE
AROPCO= BYTE(9) FIXED POINT INSTR. CODE,
FLOATING AND ROUND INSTR. CODE,
DOUBLE FLOATING INSTR. CODE
E.G. FOR %PLUS
-------------------------------------
AROPCO= \ ADD \ FADR \ DFAD \ 0 \
-------------------------------------
0 8 9 17 18 26 27 35
NORMAL EXIT: RETURN
CALL FORMAT: EXEC CGAROP,<AROPCO>
EXPLANATION OF SHORT NOTES IN COMMENTS:
FOP = FIRST OPERAND
SOP = SECOND OPERAND
MEOP = MEMORY OPERAND
IMOP = IMMEDIATE OPERAND
ARIN = ARITHMETIC INSTRUCTION
IARIN = IMMEDIATE ARITHMETIC INSTR.
DFARIN = DOUBLE FLOATING ARITHMETIC INSTR.
IDAD = IDENTIFIER ADDRESS
LIAD = LITERAL ADDRESS
;
CGAROP: PROC <AROPCO>
SAVE <XP1,XL1>
GETAC4
L XL1,@YTAC ;TARGET AC
FIRSTOP
COMPVAL ;COMPILE FOP TO XWAC AND IF LONG REAL
; TO XWAC AND XWAC+1
NEXTOP
L X0,AROPCO
LF X1,ZNSTYP(XCUR)
CAIN X1,QREAL
ASH X0,9 ;SHIFT OPCODE FOR REAL OPERANDS TO
; CORRECT POSITION IN X0
DPB XL1,[ACFIELD] ;SET ACFIELD TO TARGET AC IN BOTH
DPB XL1,[ACFIRH] ; HALVES OF X0
IF
CAIE X1,QLREAL
GOTO FALSE
THEN
HRLZM X0,AROPCO ;AROPCO=OPCODE FOR LONG REAL OPERANDS
IF
MEMOP
GOTO FALSE
THEN
;SOP IS A LONG REAL MEOP
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;SOP IS A ZID LONG REAL MEOP
LF X1,ZIDZQU(XP1)
GETAD
L X0,AROPCO
ST X0,YOPCOD
GENOP ;DFARIN XWAC,IDAD
ELSE
;SOP IS A ZCN LONG REAL MEOP
LF X1,ZCNVAL(XP1) ;X1=ADDRESS DWORD CONST.
L X0,(X1) ;X0=FIRST WORD
L X1,1(X1) ;X1=SECOND WORD
GENDW ;PUT INTO LITERAL TABLE
; AND RETURN LIAD IN X0
HLL X0,AROPCO
GENREL ;DFARIN XWAC,LIAD
FI
ELSE
;LONG REAL SOP IS NOT A MEOP
AOS YTAC
AOS YTAC
COMPVAL ;COMPILE SOP TO XWACX AND XWACX+1
L X0,AROPCO
HRR X0,@YTAC
GENABS ;DFARIN XWAC,XWACX
SOS YTAC
SOS YTAC
FI
ELSE
;INTEGER OR REAL OPERATION
HRLI XL1,QOPACM ;MASK FOR OPERATION AND AC FIELD
AND X0,XL1
ST X0,AROPCO ;CORRECT INSTR. CODE IN AROPCO
IF
MEMOP
GOTO FALSE
THEN
IF
IMMOP
GOTO FALSE
THEN
;SOP IS IMOP
LF X0,ZCNVAL(XP1) ;X0=SOP VALUE
CAIN X1,QREAL
MOVS X0,X0 ;SWAP IF SOP REAL
HLL X0,AROPCO
TLO X0,QIMBIT ;SET IMMEDIATE MODE
GENABS ;IARIN XWAC,IMOP
ELSE
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;SOP IS A ZID MEOP
LF X1,ZIDZQU(XP1)
GETAD
L X0,AROPCO
ST X0,YOPCOD
GENOP ;ARIN XWAC,IDAD
ELSE
;SOP IS A ZCN MEOP
LF X0,ZCNVAL(XP1) ;X0 = SOP VALUE
GENWRD ;PUT INTO LITERAL TABLE
; AND RETURN LIAD IN X0
HLL X0,AROPCO
GENREL ;ARIN XWAC,LIAD
FI
FI
ELSE
;SOP IS NOT A MEOP
AOS YTAC
COMPVAL ;COMPILE SOP TO XWAC+1
L X0,AROPCO
HRR X0,@YTAC
GENABS ;ARIN XWAC,XWAC+1
SOS YTAC
FI
FI
RELAC4
RETURN
EPROC
SUBTTL .POW
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE OPERATOR %POW
ENTRY: .POW
NORMAL EXIT: RETURN
ENTRY CONDITION: %POW (ARITHM. EXPR. , ARITHM. EXPR.)
EXIT CONDITION: THE RESULT HAS BEEN COMPILED TO @YTAC (AND IF LONG
REAL TO @YTAC AND @YTAC+1)
;
.POW: PROC
XVAL= X2
XTOP= XP2
;EDIT(202)
XVAL1==XVAL+1 ;[202]
SAVE <XP1,XL1,XL2,XV2,XVAL,XVAL1,XTOP> ;[202]
GETAC4
L XTOP,@YTAC
STACK YTAC
FIRSTOP
LF XL1,ZIDTYP(XP1)
EDIT(5) ;[5]
;EVALUATE 2^CONSTANT IF FIRST OP IS INTEGER
;FIRST OPERAND WILL BE REAL OR LREAL IN ALL OTHER CASES
IF
CAIE XL1,QINTEGER
GOTO FALSE
THEN
NEXTOP
LF XV2,ZCNVAL(XP1)
LI 1
ASH (XV2)
IF TLNE -1
GOTO FALSE
THEN ; IMMEDIATE LOAD POSSIBLE
OP (LI)
ADD YCGACT
GENABS
ELSE ; NOT HALFWORD VALUE
GENWRD
OP (L)
ADD YCGACT
GENREL
FI
GOTO POWEX
FI
NEXTOP
LF XL2,ZIDTYP(XP1)
;CHECK FIRST IF SECOND OPERAND (SOP) IS AN INTEGER CONSTANT GE 0
IF
CONST
GOTO FALSE
CAIE XL2,QINTEGER
GOTO FALSE
LF XV2,ZCNVAL(XP1)
JUMPL XV2,FALSE
THEN
;FIND MULTIPLICATION OPERATION ACCORDING
; TO THE FIRST OPERAND TYPE
FIRSTOP
L XL2,XTOP
;[5] GENERATION OF IMUL REMOVED
IF
CAIE XL1,QREAL
GOTO FALSE
THEN
OP XL2,(FMPR)
ELSE
OP XL2,(DFMP)
FI
;OPTIMIZE IF SOP = 2
IF
CAIE XV2,2
GOTO FALSE
THEN
COMPVAL
L X0,XL2
DPB XTOP,[ACFIELD]
GENABS ;MULOP XTOP,XTOP
GOTO POWEX ;RETURN
FI
;X^I = X^(B[N]*2^(N-1) + B[N-1]*2^(N-2) + ... + B[1]*2^0)
; = [X^(B[N]*2^(N-1))] * [X^(B[N-1]*2^(N-2))] * ... * [X^(B[1]*2^0)]
;THE BINARY COEFFICIENTS (B[N]) ARE FOUND BY SHIFTING THE EXPONENT RIGHT
; STARTING WITH B[1], AND IF B[N] = 1 THE CORRESPONDING POWER OF X
; ( X^2^(N-1) THAT IS OBTAINED BY MULTIPLYING X WITH ITSELF N-1 TIMES )
; IS MULTIPLIED TO THE RESULT AC THAT IS INITIALIZED TO ONE
AOJ XL2, ;XTOP+1 IN ADDRESS FIELD
;[5] GEN OF START VAL =INT CONS =1 REMOVED
L X0,[MOVSI (1.0)]
DPB XTOP,[ACFIELD]
GENABS ;MOVSI XTOP,(1.0)
IF
CAIE XL1,QLREAL
GOTO FALSE
THEN
OPZ (SETZ)
DPB XL2,[ACFIELD]
GENABS ;SETZ XTOP+1,
AOJ XL2, ;XTOP+2
AOS YTAC
FI
AOS YTAC
IF
JUMPN XV2,FALSE ;EXP \= 0
THEN
;EXP = 0
;COMPILE FIRST OPERAND IF IT HAS
; SIDE EFFECTS
WHENNOT XP1,ZNS
GOTO POWEX
IFOFF ZNSSEF(XP1)
GOTO POWEX
FI
COMPVAL ;FOP TO XTOP+1 OR IF LONG REAL
; TO XTOP+2 AND XTOP+3
L XVAL,XV2
SETZ XVAL+1,
LSHC XVAL,-1
IF
JUMPE XVAL+1,FALSE
THEN
HRR X0,XL2
OP (L)
CAIN XL1,QLREAL
OP (DMOVE)
DPB XTOP,[ACFIELD]
GENABS ;L XTOP,XTOP+1
; OR LD XTOP,XTOP+2
FI
WHILE
JUMPE XVAL,FALSE
DO
L X0,XL2
DPB XL2,[ACFIELD]
GENABS ;MULOP XTOP+1(2),XTOP+1(2)
SETZ XVAL+1,
LSHC XVAL,-1
IF
JUMPE XVAL+1,FALSE
THEN
L X0,XL2
DPB XTOP,[ACFIELD]
GENABS ;MULOP XTOP,XTOP+1(2)
FI
OD
GOTO POWEX ;RETURN
FI
; RUN TIME ROUTINE MARI, MALI, MARR OR MALL MUST BE CALLED
; FIRST THE ARGUMENTS ARE LOADED INTO YFARG AND YFAR2, THEN THE
; ARGUMENT ADDRESS YFADR IS LOADED INTO X16 AND THE PROPER
; ROUTINE IS CALLED WITH A PUSHJ XPDP,MAxx
FIRSTOP
COMPVAL
AOS YTAC
AOS YTAC
NEXTOP
COMPVAL
LI X0,YFARG
IF
CAIE XL1,QLREAL
GOTO FALSE
THEN
OP (DMOVEM)
ELSE
OP (ST)
FI
DPB XTOP,[ACFIELD]
GENFIX ;ST(STD) XTOP,YFARG
EDIT(25)
SETZM YLXIAC ;[25] Forget any old pointer to a block
L X0,[LI X16,YFADR]
GENFIX ;LI X16,YFADR
LI X0,YFAR2
ADDI XTOP,2
IF
CAIE XL2,QLREAL
GOTO FALSE
THEN
;SOP IS LONG REAL
OP (DMOVEM)
DPB XTOP,[ACFIELD]
GENFIX ;STD XTOP,YFAR2
GPUSHJ MALL ;PUSHJ XPDP,MALL
ELSE
OP (ST)
DPB XTOP,[ACFIELD]
GENFIX ;ST XTOP,YFAR2
IF
CAIE XL2,QREAL
GOTO FALSE
THEN
;SOP IS REAL
GPUSHJ MARR ;PUSHJ XPDP,MARR
ELSE
;SOP IS INTEGER
IF
CAIE XL1,QREAL
GOTO FALSE
THEN
;FOP IS REAL
GPUSHJ MARI ;PUSHJ XPDP,MARI
ELSE
GPUSHJ MALI ;PUSHJ XPDP,MALI
GOTO L2
FI
FI
OPZ (L)
SUBI XTOP,2
GOTO L3
FI
L2(): SUBI XTOP,2
OPZ (DMOVE)
L3(): DPB XTOP,[ACFIELD]
GENABS ;L(DMOVE) XTOP,X0
POWEX: UNSTK YTAC
RELAC4
RETURN
EPROC
SUBTTL .UNMIN
COMMENT;
PURPOSE: GENERATE CODE FOR THE OPERATOR %UNMIN
ENTRY: .UNMIN
NORMAL EXIT: RETURN
ENTRY CONDITION: %UNMIN(ARITHMETIC EXP.)
XCUR POINTS TO THE OPERATOR NODE
EXIT CONDITION: THE TOP AC (XWAC) CONTAINS THE NEGATED VALUE OF THE
ARITHMETIC EXPRESION
;
.UNMIN: PROC
SAVE <XP1,XL1>
GETAC4
HRLZ XL1,@YTAC ;TARGET AC
LSH XL1,5 ;TO AC FIELD POSITION
FIRSTOP
LF X1,ZNSTYP(XCUR)
IF
CAIE X1,QLREAL
GOTO FALSE
THEN
;THE NEGATED VALUE OF A LONG REAL IS OBTAINED BY A
; DOUBLE FLOATING SUBTRACT ( 0 - LONG REAL )
OP (SETZB)
ADD X0,XL1
HRR X0,@YTAC
AOS X0
GENABS ;SETZB XWAC,XWAC+1
IF
MEMOP
GOTO FALSE
THEN
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;FOP IS A ZID LONG REAL MEOP
LF X1,ZIDZQU(XP1)
GETAD
OP (DFSB)
ADD X0,XL1
ST X0,YOPCOD
GENOP ;DFSB XWAC,IDAD
ELSE
;FOP IS A ZCN LONG REAL MEOP
LF X1,ZCNVAL(XP1)
L X0,(X1) ;FIRST WORD
L X1,1(X1) ;SECOND WORD
GENDW ;PUT INTO LIT. TABLE
;AND RETURN LIAD IN X0
OP (DFSB)
ADD X0,XL1
GENREL ;DFSB XWAC,LIAD
FI
ELSE
;LONG REAL FOP IS NOT A MEOP
AOS YTAC
AOS YTAC
COMPVAL ;COMPILE FOP TO XWAC+2 AND XWAC+3
L X0,@YTAC
OP (DFSB)
ADD X0,XL1
GENABS ;DFSB XWAC,XWAC+2
SOS YTAC
SOS YTAC
FI
ELSE
;FOP OF TYPE INTEGER OR REAL
IF
MEMOP
GOTO FALSE
THEN
IF
IMMOP
GOTO FALSE
THEN
;FOP IS A IMOP
LF X0,ZCNVAL(XP1)
IF
CAIE X1,QINTEGER
GOTO FALSE
THEN
;FOP IS AN INTEGER IMOP
OP (MOVNI)
ADD X0,XL1
GENABS ;MOVNI XWAC,-IMOP
ELSE
;FOP IS A REAL IMOP
MOVN X0,X0
MOVS X0,X0
OP (MOVSI)
ADD X0,XL1
GENABS ;MOVSI XWAC,IMOP
FI
ELSE
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;FOP IS A ZID MEOP
LF X1,ZIDZQU(XP1)
GETAD
OP (MOVN)
ADD X0,XL1
ST X0,YOPCOD
GENOP ;MOVN XWAC,IDAD
ELSE
;FOP IS A ZCN MEOP
LF X0,ZCNVAL(XP1)
GENWRD ;PUT INTO LIT. TABLE
; AND RETURN LIAD IN X0
OP (MOVN)
ADD X0,XL1
GENREL ;MOVN XWAC,LIAD
FI
FI
ELSE
;FOP IS NOT A MEOP
COMPVAL ;COMPILE FOP TO XWAC
L X0,@YTAC
OP (MOVN)
ADD X0,XL1
GENABS ;MOVN XWAC,XWAC
FI
FI
RELAC4
RETURN
EPROC
SUBTTL .DEQ .EQ .GRT .LESS .NDEQ .NEQ .NGRT .NLESS
COMMENT;
PURPOSE: COMPILE RELATION OPERATORS
ENTRIES: .DEQ, .EQ, .GRT, .LESS, .NDEQ, .NEQ, .NGRT, .NLESS
NORMAL EXIT: RETURN
USED ROUTINE: CGREOP
ENTRY CONDITION: RELATION OPERATOR( EXP NOT OF TYPE REF BOO OR LABEL,
, EXP NOT OF TYPE REF BOO OR LABEL)
XCUR POINTS TO THE OPERATOR NODE
EXIT CONDITION: IF A BOOLEAN RESULT IS REQUIRED IT WILL BE COMPILED TO @YTAC
OTHERWISE NEXT INSTRUCTION WILL BE SKIPPED IF THE CONDITION
IS SATISFIED
;
.DEQ:
.EQ: EXEC CGREOP,<[CAIE + (CAME)]>
RETURN
.GRT: EXEC CGREOP,<[CAIG + (CAMG)]>
RETURN
.LESS: EXEC CGREOP,<[CAIL + (CAML)]>
RETURN
.NDEQ:
.NEQ: EXEC CGREOP,<[CAIN + (CAMN)]>
RETURN
.NGRT: EXEC CGREOP,<[CAILE+(CAMLE)]>
RETURN
.NLESS: EXEC CGREOP,<[CAIGE+(CAMGE)]>
RETURN
SUBTTL CGREOP
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE RELATION OPERATORS
%EQ, %GRT, %LESS, %NEQ, %NGRT, %NLESS, %DEQ AND %NDEQ
ENTRY: CGREOP
INPUT ARGUMENTS: XCUR POINTS TO THE OPERATOR NODE
REOPCO= IMMEDIATE COMPARE INSTR. ,, MEMORY COMPARE INSTR.
E.G. FOR %EQ
REOPCO= CAIE ,, CAME
NORMAL EXIT: RETURN
CALL FORMAT: EXEC CGREOP,<REOPCO>
EXPLANATION OF SHORT NOTES IN COMMENTS:
FOP = FIRST OPERAND
SOP = SECOND "
MEOP = MEMORY "
IMOP = IMMEDIATE "
CAMxx = RELATION INSTR.
CAIxx = IMMEDIATE RELATION INSTR.
SKIxx = SKIP INSTR.
IDAD = IDENTIFIER ADDRESS
LIAD = LITERAL ADDRESS
PTAD = ADDRESS TO TEXT VARIABLE IN PROTOTYPE STREAM
;
CGREOP: PROC <REOPCO>
SAVE <X4,XP1,XL1,XL2>
GETAC4
L XL1,@YTAC
L XL2,XL1
AOS XL2
L X0,REOPCO
DPB XL1,[ACFIELD] ;SET ACFIELD IN BOTH HALVES OF X0
DPB XL1,[ACFIRH] ; TO TARGET AC
L X1,X0
IF
IFOFF SCCOND
GOTO FALSE
THEN
;COMPLEMENT COMPARE MODE TO ENABLE TEST ON REVERSED CONDITION
TLC X1,QCOMMO
TRC X1,QCOMMO
FI
ST X1,REOPCO
FIRSTOP
COMPVAL ;COMPILE FOP TO Xtop OR IF LONG REAL OR TEXT
; TO Xtop AND Xtop+1
NEXTOP
AOS YTAC
AOS YTAC
LF X4,ZIDTYP(XP1)
IF
CAIE X4,QTEXT
GOTO FALSE
THEN
;SOP IS OF TYPE TEXT
; IF OPERATOR = %DEQ AND SCCOND IS SET OR OPERATOR =%NDEQ AND
; SCCOND NOT IS SET THEN REOPCO IS CLEARED TO INDICATE THAT A
; SKIPA INSTRUCTION MUST BE INSERTED AFTER THE COMPARE
; INSTRUCTIONS
IF
IFNEQF XCUR,ZNSGEN,%DEQ
GOTO FALSE
THEN
IFON SCCOND
SETZM REOPCO
ELSE
IF
IFNEQF XCUR,ZNSGEN,%NDEQ
GOTO FALSE
THEN
IFOFF SCCOND
SETZM REOPCO
ELSE
;TEXT VALUE RELATION
COMPVAL ;COMPILE SOP TO Xtop+2 AND Xtop+3
LI X0,QSKCAD
ADDM X0,REOPCO ;SKIP INSTR. CODE IN
; REOPCO RIGHT
L X0,XL1
OP (LI XTAC,)
GENABS ;LI XTAC,Xtop
SETZM YLXIAC
GPUSHJ (TXRE) ;PUSHJ XPDP,TXRE
;WHEN CALLING TXRE THE TWO TEXTS
; THAT SHOULD BE COMPARED ARE
; COMPILED TO 4 CONSECUTIVE
; REGISTERS WITH THE NUMBER OF
; THE FIRST AC (Xtop) IN XTAC
;THE RESULT FROM THE COMPARISON
; ( 1 0 OR -1 ) IS RETURNED IN
; THIS FIRST REGISTER
GOTO L1 ;WHERE THE SKIP INSTR. IS
; GENERATED
FI
FI
;TEXT REFERENCE RELATIONS %DEQ OR %NDEQ
IF
MEMOP
GOTO FALSE
THEN
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;SOP IS A ZID TEXT MEOP
LF X1,ZIDZQU(XP1)
GETAD
AOS YO2ADI
DPB XL2,[ACFIELD YO2ADI]
OPZ (XOR)
ST X0,YOPCOD
GENOP ;XOR Xtop+1,IDAD+1
LF X1,ZIDZQU(XP1)
GETAD
DPB XL1,[ACFIELD YO2ADI]
OP (CAMN)
ST X0,YOPCOD
GENOP ;CAMN Xtop,IDAD
ELSE
;SOP IS A ZCN TEXT MEOP
LF X4,ZCNVAL(XP1)
IF
JUMPE X4,FALSE ;SOP=NOTEXT
THEN
ASSERT<RFAIL ILLEGAL TEXT RELATION>
;SOP IS A TEXT STRING CONSTANT
STACK YQRELR
STACK YQRELT
LI X0,QRELPT
ST X0,YQRELT
HLRZ X0,X4
GENREL ; 0 ,, START ADDRESS
; INTO PROTOTYPE STREAM
LI X0,1
HRL X0,X4
SETZM YQRELR
GENREL ;LENGTH,, 1
; INTO PROTOTYPE STREAM
UNSTK YQRELT
L X0,YRELPT
SOS X0
OP (XOR)
DPB XL2,[ACFIELD]
LI X1,QRELPT
ST X1,YQRELR
GENREL ;XOR Xtop+1,PTAD+1
L X0,YRELPT
SUBI X0,2
OP (CAMN)
DPB XL1,[ACFIELD]
GENREL ;CAMN Xtop,PTAD
UNSTK YQRELR
FI
FI
ELSE
;TEXT SOP IS NOT A MEOP
COMPVAL ;COMPILE SOP TO Xtop+2 AND Xtop+3
L X0,XL2
ADDI X0,2
OP (XOR)
DPB XL2,[ACFIELD]
GENABS ;XOR Xtop+1,Xtop+3
L X0,XL2
AOJ X0,
OP (CAMN)
DPB XL1,[ACFIELD]
GENABS ;CAMN Xtop,Xtop+2
FI
LI X0,-1
OP (TLNE)
DPB XL2,[ACFIELD]
GENABS ;TLNE Xtop+1,-1
IF
SKIPE REOPCO
GOTO FALSE
THEN
;INSERT A SKIPA IF REOPCO = 0
MOVSI (SKIPA)
GENABS ;SKIPA
FI
ELSE
;SOP NOT TEXT
IF
CAIE X4,QLREAL
GOTO FALSE
THEN
;SOP IS LONG REAL
LI X0,QSKCAD
ADDM X0,REOPCO ;SKIPxx IN REOPCO RIGHT
IF
MEMOP
GOTO FALSE
THEN
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;SOP IS A LONG REAL ZID MEOP
LF X1,ZIDZQU(XP1)
GETAD
OP (DFSB)
DPB XL1,[ACFIELD YO2ADI]
ST X0,YOPCOD
GENOP ;DFSB Xtop,IDAD
ELSE
;SOP IS A LONG REAL ZCN MEOP
LF X1,ZCNVAL(XP1)
L X0,(X1) ;X0=FIRST WORD
L X1,1(X1) ;X1=SECOND WORD
GENDW ;PUT INTO LIT. TABLE
; AND RETURN LIAD IN X0
OP (DFSB)
DPB XL1,[ACFIELD]
GENREL ;DFSB Xtop,LIAD
FI
ELSE
;LONG REAL SOP IS NOT A MEOP
COMPVAL ;COMPILE SOP TO Xtop+2
; AND XWAC+3
L X0,XL2
AOJ X0,
OP (DFSB)
DPB XL1,[ACFIELD]
GENABS ;DFSB Xtop,Xtop+2
FI
L1(): HRL X0,REOPCO
HRR X0,XL1
GENABS ;SKIPxx Xtop
ELSE
;SOP NOT TEXT OR LONG REAL
IF
MEMOP
GOTO FALSE
THEN
IF
IMMOP
GOTO FALSE
THEN
IF
CAIN X4,QREAL
GOTO FALSE
THEN
;SOP IMOP NOT OF TYPE REAL
LF X0,ZCNVAL(XP1)
HLL X0,REOPCO
GENABS ;CAIxx Xtop,IMOP
ELSE
GOTO L2 ;REAL IMOP SOP IS
; TREATED AS ZCN MEOP
FI
ELSE
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;SOP IS A ZID MEOP
LF X1,ZIDZQU(XP1)
GETAD
DPB XL1,[ACFIELD YO2ADI]
HRL X0,REOPCO
ST X0,YOPCOD
GENOP ;CAMxx Xtop,IDAD
ELSE
;SOP IS A ZCN MEOP
L2(): LF X0,ZCNVAL(XP1)
GENWRD ;PUT INTO LIT. TABLE
; AND RETURN LIAD IN X0
HRL X0,REOPCO
GENREL ;CAMxx Xtop,LIAD
FI
FI
ELSE
;SOP IS NOT A MEOP
SOS YTAC
COMPVAL ;COMPILE SOP TO Xtop+1
AOS YTAC
HRL X0,REOPCO
HRR X0,XL2
GENABS ;CAMxx Xtop,Xtop+1
FI
FI
FI
IF
IFOFF SVALUE
GOTO FALSE
THEN
;COMPILE A BOOLEAN RESULT INTO Xtop
OP (TDZA)
DPB XL1,[ACFIELD]
HRR X0,XL1
GENABS ;TDZA Xtop,Xtop ;FALSE
MOVSI (SETO)
DPB XL1,[ACFIELD]
GENABS ;SETO Xtop, ;TRUE
FI
SOS YTAC
SOS YTAC
RELAC4
RETURN
EPROC
SUBTTL .AND .EQV .IMP .OR
COMMENT;
PURPOSE: COMPILE BOOLEAN OPERATORS
ENTRIES: .AND, .EQV, .IMP, .OR
NORMAL EXIT: RETURN
USED ROUTINE: CGBOOP
ENTRY CONDITION: BOOLEAN OPERATOR ( BOOLEXP. , BOOLEXP.)
XCUR POINTS TO THE OPERATOR NODE
EXIT CONDITION: IF A BOOLEAN RESULT IS REQUIRED IT WILL BE COMPILED TO @YTAC
OTHERWISE NEXT INSTRUCTION WILL BE SKIPED IF THE
RESULT IS TRUE
;
.AND: EXEC CGBOOP,<[AND]>
RETURN
.EQV: EXEC CGBOOP,<[EQV]>
RETURN
.IMP: EXEC CGBOOP,<[ORCA]>
RETURN
.OR: EXEC CGBOOP,<[OR]>
RETURN
SUBTTL CGBOOP
COMMENT;
PURPOSE: TO GENERATE CODE FOR THE BOOLEAN OPERATORS
%AND, %EQV, %IMP AND %OR
ENTRY: CGBOOP
INPUT ARGUMENTS: XCUR POINTS TO THE OPERATOR NODE
BOOPCO = INSTRUCTION CODE FOR THE BOOLEAN OPERATOR
NORMAL EXIT: RETURN
CALL FORMAT: EXEC CGBOOP,<BOOPCO>
EXPLANATION OF SHORT NOTES IN COMMENTS:
FOP = FIRST OPERAND
SOP = SECOND "
MEOP = MEMORY "
BOIN = BOOLEAN INSTRUCTION
IDAD = IDENTIFIER ADDRESS
LIAD = LITERAL "
;
CGBOOP: PROC <BOOPCO>
SAVE <XP1,XL1>
GETAC2
L XL1,@YTAC
DPB XL1,[ACFIELD BOOPCO]
FIRSTOP
COMPVAL ;COMPILE FOP TO XWAC
NEXTOP
IF
MEMOP
GOTO FALSE
THEN
IF
RECTYPE(XP1) IS ZID
GOTO FALSE
THEN
;SOP IS A ZID MEOP
LF X1,ZIDZQU(XP1)
GETAD
L X0,BOOPCO
ST X0,YOPCOD
GENOP ;BOIN XWAC,IDAD
ELSE
;SOP IS A ZCN MEOP
LF X0,ZCNVAL(XP1)
GENWRD ;PUT INTO LIT.TABLE
; AND RETURN LIAD IN X0
HLL X0,BOOPCO
GENREL ;BOIN XWAC,LIAD
FI
ELSE
;SOP IS NOT A MEOP
AOS YTAC
COMPVAL ;COMPILE SOP TO XWAC+1
L X0,BOOPCO
HRR X0,@YTAC
GENABS ;BOIN XWAC,XWAC+1
SOS YTAC
FI
IF
IFOFF SCONDI
GOTO FALSE
THEN
OP (SKIPN)
HRR X0,XL1
GENABS ;SKIPN XWAC
ELSE
IF
IFOFF SCCOND
GOTO FALSE
THEN
OP (SKIPE)
HRR X0,XL1
GENABS ;SKIPE XWAC
FI
FI
RELAC2
RETURN
EPROC
LIT
END