Trailing-Edge
-
PDP-10 Archives
-
bb-4157h-bm_fortran20_v10_16mt9
-
fortran-compiler/cgexpr.bli
There are 26 other files named cgexpr.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!AUTHOR: S. MURPHY/HPW/DCE/TFV/EDS/RVM/AHM/CDM/AlB
MODULE CGEXPR(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
GLOBAL BIND CGEXPV = #10^24 + 0^18 + #2464; ! Version Date: 10-Oct-84
%(
***** Begin Revision History *****
63 ----- ----- DECLARE CODE GENERATORS FOR DABS IN LINE
EXTERNAL
64 ----- ----- MAKE IN LINE EXPONEN TO MEMORY WORK
65 ----- ----- MAKE IN LINE EXPONEN OF DP AND OF IMMED
LOOP INDEX WORK
66 ----- ----- REMOVE ALL REFERENCES TO SQUARE,CUBE,P4
67 ----- ----- IN "CGVBOOL", SHOULD NOT SKIP THE CALL
TO CGOPGEN TO GET THE VAL OF ARG1
IF A1NOTFLG OR A1NEGFLG IS SET
68 ----- ----- CLEAN UP "CGCBOOL"
69 ----- ----- FIX BUG IN EDIT 68
70 ----- ----- IN CGVBOOL, WHEN ARG1 IS A MASK, ARG2 OF TYPE
CONTROL, SHOULD NOT GENERATE CODE TO STORE
THE VALUE OF ARG1 INTO A TMP IF "A1SAMEFLG"
IS SET (INDICATING THAT ITS ALREADY THERE)
71 337 17305 IN CGOPGEN, ROUND UP REAL IMMEDIATE CONSTANTS
BEFORE SENDING TO LISTING, (DCE)
72 554 22324 FIX CODE GEN FOR AND NODE WITH A1NOTFLG SET, (DCE)
***** Begin Version 6 *****
73 761 TFV 1-Mar-80 -----
Choose index fo code generation based on /GFLOATING
74 1006 TFV 1-Jul-80 ------
Move KISNGL to UTIL.BLI. (It was also in OUTMOD.BLI.)
Fix listings of immediate mode constants.
75 1037 EDS 29-Dec-80 10-30396
Fix initialization of logical assignment variable.
76 1064 EDS 28-Apr-81 Q20-01483
Remove Edit 1037. The fix is in ALCTVBOOL.
***** Begin Version 7 *****
77 1251 CKS 7-Aug-81
Handle character ARRAYREF nodes
78 1411 RVM 31-Oct-81
Edit 1272 caused the macro code listed for files compiled
with GFLOATING to be bad, but only if there was no object
file requested. This occured because the compiler knew
that ALCCON did not convert constants if there was to be no
REL file, and so would convert the constants when producing
the list file. Edit 1272 caused constants to be converted
twice, and thus equal zero.
79 1431 CKS 15-Dec-81
Add CGSUBSTR to generate code for substring nodes
1474 TFV 12-Feb-82
Add CGCONCAT to generate code for concatenation nodes. For
CONCTF nodes (fixed length result), a call to CONCT. is
generated. For CONCTM nodes (known maximum length result) a
call to CONCM. is generated. For CONCTV nodes (dynamic length
result) an internal compiler error occurs for now.
1533 TFV 17-May-82
Modify CGCONCAT for CONCTV nodes. Generate a call to CONCD.
which allocates run-time space for the concatenation node and
does the concatenation. Write CGCHMRK and CGCHUNW to generate
calls to CHMRK. and CHUNW..
1551 AHM 4-Jun-82
Remove code in CGCONCAT which set the psect index of STEs for
COMCM. and CONCF. to PSCODE because external references don't
need psect indices.
1567 CDM 24-Jun-82
Correct MRFARREF to handle character arrays.
1607 TFV 4-Aug-82
Fix CGCHMRK to reuse one argument block for many IOLST. calls in
a single statement.
2244 CDM 13-Dec-83
Eliminate AOBJN DO loop register indexes into large arrays
(arrays in .LARG.) during code generation. Create a new
STORECLS node, STRHAOBJN to copy the right hand half of the
AOBJN register into another register. Otherwise, the negative
left half of the AOBJN register will appear to be an invalid
section number. This is to catch the cases that the skeleton
optimizer (edit 2243) can not.
2315 AHM 26-Feb-84
Temporarily disable peephole optimization under /EXTEND. Do
it by making OBUFF's call to PEEPOP conditional. It should be
enabled again as soon as PEEPOP is taught about instructions
that reference EFIWs.
2317 AHM 2-Mar-84
Create GENREF to construct address fields for operand
references and buffer the result, including references to
large numeric variables. Delete MRFDATA, MRFARREF, MRFEXPR
and MRFCSB, and make CGOPGEN use GENREF instead.
2326 AHM 18-Mar-84
Fix bug in edit 2317. TARGADDR fields of ARRAYREF nodes are
18 bit signed integers. GENREF needed to sign extend the
value extracted from TARGADDR fields of large ARRAYREF nodes
which MAKEFIW uses for the 30 bit EFY field of EFIWs.
2351 AHM 30-Apr-84
Fix another bug in edit 2317. GENREF was not adding the
contents of PBOPWD[OBJADDR] to the target fields of DATAOPRs
ARRAYREFs and random targets when computing an EFIW's Y field.
This made references to the second word of DP variables fail.
Also, clear PBOPWD[OBJADDR] when referencing EFIWs, since this
will make PEEPOP recognize more identical references.
2354 RVM 2-May-84
Re-enable the peephole optimizer. (Undo edit 2315.)
2444 AlB 6-Aug-84
Recognize the /EXTEND:CODE switch:
o In GENREF, set LARGE to be true if a DATAOPR is an external FNNAME.
This will cause EFIW entries to be created for function and
subroutine references.
o In CGOPGEN, add code 'implicit function name' and 'implicit
function name list' cases that will create Symbol Table and
EFIW Table entries for the functions.
2450 AlB 14-Aug-84
Fix GENREF to recognize the fact that an external function is of
type CHARACTER, and thus does not want an EFIW, since it should
reference the local character header.
2462 AHM 2-Oct-84
Use execrable TRUE/FALSE/TRUTH/FALSITY miasma for boolean in
GENREF and its callers to satisfy programming conventions.
2463 AHM 8-Oct-84
Interpret TARGADDR of ARRAYREFs differently depending on
OPERSP when generating operand references in GENREF.
2464 AHM 10-Oct-84
Restructure EFIW generation for ARRAYREFs in GENREF. Make
EFIWs for ARREFBIG nodes, and arrays in PSLARGE.
***** End V10 Development *****
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
! The below is for putting through RUNOFF to get a PLM file.
!++
!.LITERAL
!--
FORWARD
OBUFF,
OBUFFA,
CGEXCIOP,
CGETVAL,
%2317% GENREF, ! Generate operand references
CGOPGEN,
CGARGEVAL,
CGILF,
CGSUBSTR, ![1431] New
CGCONCAT,
%1533% CGCHMRK(1),
%1533% CGCHUNW(1),
CGVBOOL,
CGCBOOL(2),
CGREL1(1),
CGJMPC(2),
DEFLAB(1);
EXTERNAL
A1LABEL,
A1NODE,
A2LABEL,
A2NODE,
A3LABEL,
ADDLAB,
%1533% ARGLINKPT,
C1H,
%1533% CALLER,
CGARREF,
CGERR,
CGSBPRGM,
CSTMNT,
E193,
FATLERR,
GBYSREGS,
GENLAB,
ISN,
%2317% MAKEFIW, ! Creates EFIW table entries
NEWENTRY,
%1251% OPCHIX,
%761% OPCMGET,
%761% OPCUBI,
OPDSPIX, ! Index for code generation
OPGALT,
%761% OPGARG, ! Indices for /GFLOATING code generation
%761% OPGARI,
OPGBOO,
%1533% OPGCHM, ! Index for CHMRK. call
%1533% OPGCHU, ! Index for CHUNW. call
OPGDB1, ! For DABS in line
OPGDBF, ! For DABS in line
%1251% OPGENDISP,
%761% OPGETI,
OPGEX,
OPGEXM,
OPGEXS,
%761% OPGIL1,
%761% OPGILF,
%761% OPGILI,
%1474% OPGLD2, ! Index for DMOVE ac,loc
%761% OPGN1I,
%761% OPGN2I,
OPGREL,
OPGSET,
%761% OPGSPG, ! Indices for /GFLOATING code generation
%761% OPGSPI,
%761% OPGSPM,
%1251% OPGST1,
%1474% OPGST2, ! Index for DMOVEM ac,loc
%761% OPGSTC,
OPGSTD,
%761% OPGSTI,
%761% OPGTCG, ! Indices for /GFLOATING code generation
OPGTCI,
OPGVTS,
%761% OPGXG, ! Indices for /GFLOATING code generation
%761% OPGXGM, ! Indices for /GFLOATING code generation
%761% OPGXGS, ! Indices for /GFLOATING code generation
OPGXPI,
%2244% OPMOVI, ! Points to MOVEI instruction
%761% OPP21I,
%1251% OPSSEP,
OUTMDA,
OUTMOD,
PBFPTR,
%2317% OBJECTCODE PBOPWD, ! Word to be stored in the peephole buffer
PBUFF,
PC,
PEEPOPTIMZ,
PEEPPTR,
PROPNEG, ! Routine to propagate a neg over arithmetic and
! TYPECNV nodes
%2317% BASE PSYMPTR, ! Holds STE for instruction in PBOPWD
REGFORCOMP,
RESNAME,
%1474% TBLSEARCH, ! Routine to lookup a symbol table entry
TREEPTR;
OWN PEXPRNODE REFNODE; ! Indicates which expression node
! specifies the memref field to be used
! (may be arg1, arg2, or parent)
! Map structures onto the global pointers used to look at the
! current node in the tree and its two subnodes
MAP
PEXPRNODE A1NODE,
PEXPRNODE A2NODE,
BASE CSTMNT,
PEXPRNODE TREEPTR;
! Set up peephole buffer
MAP
VECTOR PBUFF,
PEEPFRAME PBUFF,
PPEEPFRAME PBFPTR; ! Pointer to next available word in
! peephole buffer (when the buffer is
! full, this points to an extra word
! after the end of the buffer). This
! word will often contain a label
! corresponding to the next instruction
! to be generated
! Setup pointer to the word after the end of the last entry in
! the peephole buffer
BIND PBFEND = PBUFF + PBFENTSIZE * PBFENTCT;
GLOBAL ROUTINE OBUFF=
%(***************************************************************************
ROUTINE TO OUTPUT INSTRUCTIONS TO THE PEEPHOLE BUFFER.
CALLED WITH THE GLOBALS
PBOPWD - THE INSTRUCTION WORD TO GO INTO THE PEEPHOLE BUFFER
PSYMPTR - PTR TO THE SYMBOL TABLE ENTRY CORRESPONDING
TO THE ADDRESS FIELD OF THE INSTRUCTION TO BE GENERATED
(OR 0 IF ADDR FIELD IS A LABEL, 1 IF ADDR FIELD
IS NOT A SYMBOL - EG IS A REGISTER)
PUTS THE INSTR IN THE PEEPHOLE BUFFER AND CALLS THE PEEPHOLER
***************************************************************************)%
BEGIN
%(****IF PEEPHOLE-BUFFER IS FULL, OUTPUT THE TOP BLOCK
OF INSTRUCTIONS. THE NUMBER OF INSTRS PROCESSED AT A TIME
IS SPECIFIED BY "PBFOUTCT" WHICH IS BOUND IN "TABLES.BLI".
MOVE UP THE REST OF THE INSTRS IN THE BUFFER (MUST LEAVE
ENOUGH INSTRS IN THE BUFFER TO USE IN PEEPHOLING NEW INSTRS
THAT WILL BE ADDED).*********)%
IF .PBFPTR GEQ PBFEND
THEN
BEGIN
OUTMOD(PBUFF,PBFOUTCT);
BLOCKTR((PBUFF+PBFOUTSIZ),PBUFF,(PBFSIZE-PBFOUTSIZ));
PBFPTR_PBUFF+(PBFENTCT-PBFOUTCT)*PBFENTSIZE; !PTR TO THE START OF
! OF THE FIRST ENTRY AFTER THE SET OF ENTRIES
! THAT WERE MOVED UP IN THE BUFFER
END;
%(****WRITE THE NEW INSTR IN THE FIRST AVAILABLE SLOT****)%
PBFPTR[PBFSYMPTR]_.PSYMPTR;
PBFPTR[PBFINSTR]_.PBOPWD;
PBFPTR_.PBFPTR+PBFENTSIZE;
%(***INIT THE LABEL FIELD OF THE NEXT INSTR TO 0*****)%
PBFPTR[PBFLABEL]_0;
%(***INIT THE ISN (SEQ NUMBER FOR STMNT) FIELD OF THE NEXT INSTR TO CODE FOR
"NO ISN ON THIS INSTR" ***)%
PBFPTR[PBFISN]_NOISN;
%(****PERFORM ANY PEEPHOLE OPTIMIZATIONS TRIGGERED BY THIS INSTRUCTION****)%
%(***IF THERE ARE FEWER THAN 5 INSTRS IN THE BUFFER, DO NOT
PEEPHOLE OPTIMIZE YET***)%
IF (.PBFPTR-PBUFF) GEQ 5*PBFENTSIZE
THEN
BEGIN
PEEPPTR_.PBFPTR-3*PBFENTSIZE; !PTR TO WD OFF WHICH
!PEEPHOLES WILL BE KEYED
%2354% PEEPOPTIMZ(); ! Call peephole optimizer
END;
END; ! of OBUFF
GLOBAL ROUTINE OBUFFA=
%(***************************************************************************
ROUTINE TO OUTPUT ARGBLOCK ELEMENTS INTO THE PEEPHOLE BUFFER.
CALLS THE OUTPUT MODULE FOR EVERY 25 ARGS.
CALLED WITH THE GLOBALS
PBOPWD - THE ARGUMENT WD TO BE OUTPUT
PSYMPTR - PTR TO THE SYMBOL TABLE ENTRY FOR THE
SYMBOL IN THE RIGHT HALF OF THE ARG-WD
OR:
"PBF2NOSYM" - IF BOTH HALVES OF THE WD ARE
OCTAL CONSTANTS
"PBF2LABREF" - IF BOTH HALVES OF THE WD ARE PTRS
TO LABEL TABLE ENTRIES
"PBFLABREF" - IF LEFT HALF IS AN OCTAL CONSTANT,
RIGHT HALF IS A PTR TO A LABEL TABLE
ENTRY
IF PSYMPTR IS A PTR TO A SYMBOL TABLE ENTRY, THEN
CAN ASSUME THAT THE LEFT HALF OF THE ARGWD IS AN OCTAL
CONSTANT
***************************************************************************)%
BEGIN
%(***ADD THIS WD TO THE BUFFER***)%
PBFPTR[PBFSYMPTR]_.PSYMPTR;
PBFPTR[PBFINSTR]_.PBOPWD;
PBFPTR_.PBFPTR+PBFENTSIZE;
%(***IF THE BUFFER IS FULL, OUTPUT ITS CONTENTS**)%
IF .PBFPTR EQL PBFEND
THEN
BEGIN
OUTMDA(PBUFF,PBFENTCT);
PBFPTR_PBUFF;
END;
%(***INIT THE LABEL FIELD OF THE NEXT INSTR TO 0***)%
PBFPTR[PBFLABEL]_0;
END; ! of OBUFFA
GLOBAL ROUTINE CGEXCIOP=
%(**********************************************************************
ROUTINE TO GENERATE CODE FOR SPECOP EXCIOP
CALLED WITH TREEPTR, A1NODE, A2NODE, REGFORCOMP
SET UP
**********************************************************************)%
BEGIN
REGISTER CN[2];
LOCAL MULDPIX;
LOCAL EXPDPIX;
LOCAL MULMIX; !TO MULTIPLY TO MEMORY
LOCAL TYP; !VALTP1 OF THE OPERAND
MACHOP LSHC=#246;
TYP_.A1NODE[VALTP1]; !INTEGER,REAL,OR DP(DP ON KI ONLY)
IF .TREEPTR[MEMCMPFLG] !IF THIS OP IS TO BE DONE TO MEMORY
THEN
BEGIN
![761] Indices for /GFLOATING code generation
%[761]% IF .GFLOAT
%[761]% THEN MULMIX_OPGXGM+.TYP
%[761]% ELSE MULMIX_OPGEXM+.TYP;
IF .A2NODE EQL 2 !SQUARE IS AN EXCEPTION IN THAT
THEN ! IT CAN BE DONE TO MEMORY EVEN THO AN EVEN POWER
BEGIN
OPDSPIX_.MULMIX;
CGOPGEN(); !GENERATE THE MULTIPLY TO MEMORY FORI=I**2
RETURN
END;
END;
IF .TREEPTR[A1IMMEDFLG]
THEN MULDPIX_OPGXPI ! TO MULTIPLY AN IMMED LP INDEX
ELSE ! TO MULTIPLY BY THE VAR
![761] Indices for /GFLOATING code generation
%[761]% IF .GFLOAT
%[761]% THEN MULDPIX_OPGXG+.TYP
%[761]% ELSE MULDPIX_OPGEX+.TYP;
![761] Indices for /GFLOATING code generation
%[761]% IF .GFLOAT !TO MULTIPLY BY SELF
%[761]% THEN EXPDPIX_OPGXGS+.TYP
%[761]% ELSE EXPDPIX_OPGEXS+.TYP;
CN[0]_0; !CLEAR GENERATOR
CN[1]<18,18>_.A2NODE; !LOAD PATTERN
WHILE .CN[0] NEQ 1 DO LSHC(CN,1); !JUSTIFY PATTERN
IF .CN[0] EQL .A2NODE THEN RETURN ELSE DO
BEGIN
LSHC(CN,1); !GET NEXT POWER
OPDSPIX_.EXPDPIX; !MULTIPLY BY SELF
CGOPGEN(); !GENERATE MULTIPLY
IF .CN THEN
BEGIN
IF .CN[0] EQL .A2NODE !IF THIS IS THE LAST MULTIPLY
AND .TREEPTR[MEMCMPFLG] ! AND RESULT IS TO GO TO MEMORY
THEN OPDSPIX_.MULMIX
ELSE
OPDSPIX_.MULDPIX; !MULTIPLY BY MEMORY
CGOPGEN() !GENERATE MULTIPLY
END;
END
WHILE .CN[0] NEQ .A2NODE;
END; ! of CGEXCIOP
GLOBAL ROUTINE CGETVAL=
%(*****************************************************************
ROUTINE TO GET THE VALUE ASSOCIATED WITH A GIVEN NODE WITHIN
REACH OF ONE INSTRUCTION
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE NODE TO
BE EVALUATED
********************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE; !PTR TO NODE BEING PROCESSED
CNODE_.TREEPTR;
%(*****DISPATCH TO A ROUTINE TO PROCESS NODES OF THIS OPERATOR CLASS*****)%
CASE .CNODE[OPRCLS] OF SET
%(****FOR BOOLEANS****)%
CGVBOOL();
%(****FOR DATA ITEMS****)%
RETURN;
%(*****FOR RELATIONALS*****)%
BEGIN
%(***INIT VAL TO TRUE***)%
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_SETLOGIX(CNODE,TRUE);
CGOPGEN();
%(***GENERATE CODE TO SKIP ON RELATIONAL TRUE***)%
CGREL1(TRUE);
%(***GENERATE 1 INSTR TO SET VAL FALSE***)%
TREEPTR_.CNODE;
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_SETLOGIX(CNODE,FALSE);
CGOPGEN();
END;
%(*****FOR FUNCTION CALLS*****)%
CGSBPRGM(.CNODE[ARG2PTR],.CNODE[ARG1PTR]);
%(*****FOR ARITHMETIC OPERATIONS*****)%
BEGIN
%(***GET RID OF "A2NEGFLG" BY -
A+(-B)= A-B
A-(-B)= A+B
A*(-B)= (-A)*B
A/(-B)= (-A)/B
*******)%
IF .CNODE[A2NEGFLG]
THEN
BEGIN
IF ADDORSUB(CNODE)
THEN
BEGIN
CMPLSP(CNODE);
CNODE[A2NEGFLG]_0;
END
ELSE
IF MULORDIV(CNODE)
THEN
BEGIN
CNODE[A1NEGFLG]_NOT .CNODE[A1NEGFLG];
CNODE[A2NEGFLG]_0;
END;
END;
%(***IF A1NEGFLG IS NOW SET, AND ARG1 IS AN EXPRESSION, TRY TO
PROPAGATE THE NEGATIVE OVER ARG1 (SO THAT WONT HAVE TO
COMPUTE ARG1 AND THEN NEGATE IT)
****)%
IF .CNODE[A1NEGFLG] AND NOT .CNODE[A1VALFLG]
THEN
BEGIN
IF PROPNEG(.CNODE[ARG1PTR])
THEN CNODE[A1NEGFLG]_0;
END;
%(***EVALUATE THE ARGS UNDER THIS NODE - AND SET UP GLOBALS A1NODE AND A2NODE***)%
CGARGEVAL();
%(***GET ARG1 INTO LOC FOR COMPUTATION***)%
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_GETA1OPIX(CNODE,A1NODE);
CGOPGEN();
%(***USE OPGENTABLE TO EVALUATE PARENT***)%
OPDSPIX_ARITHOPIX(CNODE);
CGOPGEN();
END;
%(*****FOR TYPE CONVERSION*****)%
BEGIN
%(***EVALUATE THE SINGLE ARGUMENT OF THIS NODE***)%
IF NOT .CNODE[A2VALFLG]
THEN
%(**UNLESS ARG IS ALREADY EVALUATED***)%
BEGIN
TREEPTR_.CNODE[ARG2PTR];
CGETVAL();
END;
%(***UNLESS NO CODE NEEDS TO BE GENERATED FOR THE "CONVERSION",
GET THE VAL OF THE SUBNODE INTO A REG AND CONVERT IT***)%
IF NOT NOCNV(CNODE)
THEN
BEGIN
REGFORCOMP_GETTAC(CNODE);
%(***GENERATE CODE TO GET ARG2 INTO A REGISTER***)%
TREEPTR_.CNODE;
A1NODE_.CNODE[ARG2PTR];
OPDSPIX_GETA2OPIX(CNODE,A1NODE);
CGOPGEN();
%(***GENERATE CODE TO CONVERT THE VALUE***)%
A2NODE_.CNODE[ARG2PTR];
OPDSPIX_TPCNVIX(CNODE,A1NODE);
CGOPGEN();
END;
END;
%(****FOR AN ARRAY REFERENCE*******)%
BEGIN ! ARRAYREF
%(***EVALUATE THE EXPRESSION FOR THE ADDRESS CALC***)%
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
TREEPTR_.CNODE[ARG2PTR];
CGETVAL();
END;
%(***GET THE PART OF THE ADDRESS WHICH MUST BE COMPUTED AT RUN TIME
INTO THE INDEX-REG USED IN ACCESSING THE VAL OF CNODE***)%
IF .CNODE[ARG2PTR] NEQ 0 !UNLESS THE SUBSCRPIT CALC WAS
!ENTIRELY A COMPILE-TIME CONSTANT
THEN
BEGIN
%1251% IF .CNODE[VALTYPE] EQL CHARACTER
%1251% THEN REGFORCOMP_GETTAC(CNODE)
ELSE REGFORCOMP_GETTXF(CNODE);
A1NODE_.CNODE[ARG2PTR];
TREEPTR_.CNODE;
OPDSPIX_GETA2OPIX(CNODE,A1NODE);
CGOPGEN();
END;
%(***FOR CHARACTER ARRAY REFERENCE, GENERATE
ADJBP TO DO THE INDEXING AND MOVE/MOVEM TO COPY
LENGTH WORD***)%
%1251% IF .CNODE[VALTYPE] EQL CHARACTER
%1251% THEN
%1251% BEGIN
%1251% A1NODE _ .CNODE[ARG1PTR];
%1251% A2NODE _ .CNODE[TARGADDR];
%1251% TREEPTR _ .CNODE;
%1251% OPDSPIX _ OPCHIX;
%1251% CGOPGEN();
%1251% END;
END; ! ARRAYREF
%(***FOR A COMMON SUBEXPRESSION - SHOULD NEVER WALK DOWN HERE***)%
RETURN;
%(***FOR NEG/NOT NODE (A FEW OF THEM WILL BE LEFT)***)%
BEGIN
%(***IF ARG IS NOT A SIMPLE VAR, GENERATE CODE TO EVAL IT***)%
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
TREEPTR_.CNODE[ARG2PTR];
CGETVAL();
END;
TREEPTR_.CNODE;
REGFORCOMP_GETTAC(CNODE);
A1NODE_.CNODE[ARG2PTR];
A2NODE_.CNODE[ARG2PTR];
%(***IF A2NEG,A2NOT,OR A2SAME FLAG IS SET, USE GETA2OPIX TO
GET THE ARG INTO REGFORCOMP***)%
IF .CNODE[A2NEGFLG] OR .CNODE[A2NOTFLG] OR .CNODE[A2SAMEFLG]
THEN
BEGIN
OPDSPIX_GETA2OPIX(CNODE,A1NODE);
CGOPGEN();
OPDSPIX_NEGNOT1IX(CNODE);
CGOPGEN();
END
ELSE
BEGIN
OPDSPIX_NEGNOT2IX(CNODE);
CGOPGEN();
END;
END;
%(***FOR SPECIAL OPERATORS INTRODUCED BY PHASE 2 SKEL***)%
BEGIN
%(***COMPUTE THE VAL OF ARG1*******)%
IF NOT .CNODE[A1VALFLG]
THEN
BEGIN
TREEPTR_.CNODE[ARG1PTR];
CGETVAL();
END;
TREEPTR_.CNODE;
A1NODE_.CNODE[ARG1PTR];
REGFORCOMP_GETTAC(CNODE);
%(***GET ARG1 INTO THE REG FOR COMPUTATION OF THIS NODE***)%
OPDSPIX_GETA1OPIX(CNODE,A1NODE);
CGOPGEN();
%(***GENERATE CODE TO PERFORM THE OPERATION*****)%
IF .CNODE[OPERSP] NEQ EXPCIOP THEN
BEGIN
OPDSPIX_SPECOPIX(CNODE);
CGOPGEN()
END
ELSE
%(***GENERATE CODE FOR IN LINE EXPONENTIATION
***)%
BEGIN
TREEPTR_.CNODE;
A2NODE_.CNODE[ARG2PTR];
CGEXCIOP()
END;
END;
%(***FOR FIELDREF - NOT IMPLEMENTED IN RELEASE 1 OF FORTRAN***)%
BEGIN
END;
BEGIN ! STORECLS
%2244% IF .CNODE[OPERSP] EQL STRHAOBJN
%2244% THEN
%2244% BEGIN ! STRHAOBJN
%2244%
%2244% ! Create MOVEI ac1,0(ac2) instruction
%2244% ! for copying the right half of the
%2244% ! AOBJN word.
%2244%
%2244% TREEPTR = .CNODE; ! STORCLS node
%2244% REGFORCOMP = GETTAC(CNODE); ! Register
%2244% A1NODE = .TREEPTR[ARG2PTR]; ! Address
%2244% OPDSPIX = OPMOVI; ! MOVEI
%2244%
%2244% CGOPGEN(); ! Generate instruction
%2244%
%2244% END ! STRHAOBJN
%2244% ELSE
%2244% BEGIN ! Not STRHAOBJN
! These are nodes to cause a ptr to an
! array element or the contents of an
! array element to be stored in a
! temporary
! Evaluate the expression to be stored
TREEPTR = .CNODE[ARG2PTR];
CGETVAL();
TREEPTR = .CNODE;
A2NODE = .CNODE[ARG2PTR];
REGFORCOMP = GETTAC(CNODE);
OPDSPIX = STCLSOPIX(CNODE);
CGOPGEN();
%2244% END; ! Not STRHAOBJN
END; ! STORECLS
%(***FOR REGCONTENTS NODE - SHOULD RARELY WALK DOWN ON THEM***)%
BEGIN END;
%(***FOR LABOP - SHOULD ONLY GET HERE FOR LABELS USED AS ARGS***)%
BEGIN END;
%(***FOR STATEMENT - SHOULD NEVER GET HERE*********)%
CGERR();
%(***FOR AN IOLIST ELEMENT - SHOULD NEVER GET HERE***)%
CGERR();
%(***FOR AN IN-LINE FUNCTION*****************)%
CGILF();
%1431% %(***FOR SUBSTRING***)%
%1431% CGSUBSTR();
%1474% %(***FOR CONCATENATION***)%
%1474% CGCONCAT();
TES;
%(****IF FLAG IS SET IN CNODE INDICATING THAT THE VALUE OF THIS
NODE MUST BE STORED AFTER IT IS COMPUTED, DO SO***)%
IF .CNODE[STOREFLG]
THEN
BEGIN
TREEPTR_.CNODE;
REGFORCOMP_(IF .CNODE[OPRCLS] EQL FNCALL
THEN RETREG^23 !FOR FN CALL STORE RETURN REG
ELSE GETTAC(CNODE)); !OTHERWISE, THE TARGET REG
OPDSPIX_STOROPIX(CNODE);
CGOPGEN();
END;
END; ! of CGETVAL
GLOBAL ROUTINE GENREF(EXPR, ARGFLAG) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Generates address fields for operand references in an
! expression tree. Fills I, X and Y fields of PBOPWD from
! information referenced by EXPR. Places the result in the
! peephole buffer.
!
! Use EXPR[OPRCLS] to decide what kind of node is being handled.
! DATAOPR, ARRAYREF, REGCONTENTS, LABOP and CMNSUB nodes use
! special algorithms to construct their references. All other
! nodes are handled in a uniform manner.
!
! DATAOPR, ARRAYREF and the regular nodes with uniform
! references can result in references to EFIWs.
!
! FORMAL PARAMETERS:
!
! EXPR Pointer to an operand reference.
!
! ARGFLAG TRUTH if word being built in PBOPWD is an
! argument list entry, FALSITY if it is an
! instruction. Used to decide whether to call
! OBUFF or OBUFFA to place PBOPWD in the
! peephole buffer, and controls generation of
! indirection for formal array references.
!
! IMPLICIT INPUTS:
!
! PBOPWD Partially constructed instruction or argument
! word. Initialized by caller. May contain an
! opcode, argument keyword or type bits, etc.
!
! IMPLICIT OUTPUTS:
!
! EFIWTBL Hash table of EFIWs may get a new entry.
!
! PBOPWD Filled with completed instruction or argument word.
!
! PBUFF Peephole buffer gets the finished instruction.
!
! PSYMPTR Filled with pointer to a symbol, constant,
! literal or EFIW table entry or one of the
! special values such as PBFLABREF or PBFNOSYM.
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! May dynamically allocate an EFIW table entry.
!
! May flush the peephole buffer into the object and listing files.
!
!--
![2317] New
BEGIN
MAP
BASE EXPR; ! Points to expression for reference
REGISTER
%2464% BASE CONST, ! Constant from ARRAYREF's TARGADDR
DEFAULT, ! Flag for normal OPRCLS found in CASE
LARGE; ! Flag for large data item
%2462% DEFAULT = FALSE; ! Assume OPRCLS is special
CASE .EXPR[OPRCLS] OF SET ! Decide what kind of node EXPR is
! BOOLEAN
%2462% DEFAULT = TRUE;
BEGIN ! DATAOPR
IF .EXPR[OPERSP] EQL CONSTANT ! Is this a constant?
THEN LARGE = 0 ! Yes, they don't have psects
%2450% ELSE IF .EXPR[OPERSP] NEQ FNNAME
%2450% THEN LARGE = .EXPR[IDPSECT] EQL PSLARGE ! Variable
%2450% ELSE
%2450% BEGIN ! FNNAME
%2450% ! If this is an external non-character subprogram,
%2450% ! we want an EFIW if we are compiling /EXTEND:CODE
%2450% LARGE = 0; ! Assume not large
%2450% IF EXTENDCODE
%2450% THEN IF .EXPR[VALTYPE] NEQ CHARACTER
%2450% THEN IF NOT .EXPR[IDATTRIBUTE(SFN)]
%2450% THEN LARGE=1 ! It is external non-character routine
%2450% END; ! FNNAME
! For most DATAOPRs, the IDADDR/TARGET field specifies
! the memory reference for the instruction, and the
! pointer to the node is the symbol table pointer to
%2450% ! output. However, external non-character routines and
%2450% ! large variables may be referenced through EFIWs.
IF .LARGE
THEN
BEGIN ! LARGE
PSYMPTR = MAKEFIW(.PBOPWD[OTSIND],0, ! I, X
%2351% EXTSIGN(.PBOPWD[OBJADDR]) ! Y
+.EXPR[IDADDR],
.EXPR); ! STE
! Don't let PEEPOP discriminate between memory
! references based on the Y field. EFIWs are
! pooled, and identical PBFSYMPTR's have
! identical I, X and Y fields.
%2351% PBOPWD[OBJADDR] = 0;
END ! LARGE
ELSE
BEGIN ! SMALL OR CHARACTER
PBOPWD[OBJADDR] = .PBOPWD[OBJADDR]+.EXPR[IDADDR];
PBOPWD[OBJIXF] = .PBOPWD[OBJIXF] OR .EXPR[TARGIXF];
IF .EXPR[OPERSP] EQL FORMLARRAY
%1265% AND .EXPR[VALTYPE] NEQ CHARACTER
AND .ARGFLAG
THEN PBOPWD[OTSIND] = 1;
IF .EXPR[OPERSP] EQL FORMLVAR
AND .EXPR[IDATTRIBUT(NOALLOC)]
THEN PSYMPTR = PBFNOSYM
ELSE PSYMPTR = .EXPR;
END; ! SMALL OR CHARACTER
END; ! DATAOPR
! RELATIONAL
%2462% DEFAULT = TRUE;
! FNCALL
%2462% DEFAULT = TRUE;
! ARTIHMETIC
%2462% DEFAULT = TRUE;
! TYPECNV
%2462% DEFAULT = TRUE;
BEGIN ! ARRAYREF
IF .EXPR[VALTYPE] NEQ CHARACTER
THEN
BEGIN ! NUMERIC
! For a small numeric ARRAYREF node, the
! TARGTMEM field specifies the I/X/Y fields
! for the instruction and ARG1PTR under the
! ARRAYREF points to the symbol table entry.
! For large numeric ARRAYREFs, the constant
! offset goes into the EFIW, and the EFIW is
! the symbolic reference. (The I/X/Y get
! filled in on the way out of the peephole
! buffer).
PSYMPTR = .EXPR[ARG1PTR]; ! Symbol table entry
! Extract constant offset in ARRAYREF
! differently based on OPERSP.
%2464% IF .EXPR[OPERSP] EQL ARREFSMALL ! Small ARRAYREF?
%2326% THEN CONST = EXTSIGN(.EXPR[TARGADDR]) ! Yes
%2464% ELSE ! No, big
%2464% BEGIN ! ARREFBIG
%2464% CONST = .EXPR[TARGADDR]; ! Get pointer
%2464% CONST = .CONST[CONST2]; ! Fetch constant
%2464% END; ! ARREFBIG
%2464% IF .PSYMPTR[IDPSECT] EQL PSLARGE ! Big array or
%2464% OR .EXPR[OPERSP] EQL ARREFBIG ! constant?
THEN ! Yes, make an EFIW
BEGIN ! BIG
%2464% PSYMPTR = MAKEFIW(.PBOPWD[OTSIND], ! I
.EXPR[TARGXF], ! X
%2351% EXTSIGN(.PBOPWD[OBJADDR]) ! Y
%2464% +.CONST,
.PSYMPTR); ! STE
PBOPWD[OTSIND] = .PSYMPTR[EFI];
PBOPWD[OTSINX] = .PSYMPTR[EFX];
! Don't let PEEPOP discriminate between memory
! references based on the Y field. EFIWs are
! pooled, and identical PBFSYMPTR's have
! identical I, X and Y fields.
%2351% PBOPWD[OBJADDR] = 0;
END ! BIG
ELSE ! Nope, no EFIW needed
BEGIN ! SMALL
PBOPWD[OBJADDR] =
%2464% .PBOPWD[OBJADDR]+.CONST;
PBOPWD[OBJIXF] =
.PBOPWD[OBJIXF] OR .EXPR[TARGIXF];
IF .PSYMPTR[FORMLFLG]
THEN PSYMPTR = PBFNOSYM;
END; ! SMALL
END ! NUMERIC
ELSE ! [1265] CHARACTER ARRAYREF
BEGIN ! CHARACTER
PSYMPTR = .EXPR[TARGADDR]; ! Symbol table entry
PBOPWD[OBJADDR] = ! Address of descriptor
.PBOPWD[OBJADDR]+.PSYMPTR[IDADDR];
END; ! CHARACTER
END; ! ARRAYREF
BEGIN ! CMNSUB
! Always use the right half of the target for a common
! subexpression node, even if INREGFLG is set. This
! is necessary for double precision operations on the
! KA10 where the second argument for the double
! precision routine must not be in a register.
IF .EXPR[TARGADDR] LEQ #17
THEN
BEGIN ! IN REGISTER
PSYMPTR = PBFNOSYM;
PBOPWD[OBJADDR] = .PBOPWD[OBJADDR]+.EXPR[TARGADDR];
END ! IN REGISTER
ELSE
BEGIN ! IN TEMPORARY
PSYMPTR = .EXPR[TARGADDR];
PBOPWD[OBJADDR] = .PBOPWD[OBJADDR]+.PSYMPTR[IDADDR];
END ! IN TEMPORARY
END; ! CMNSUB
! NEGNOT
%2462% DEFAULT = TRUE;
! SPECOP
%2462% DEFAULT = TRUE;
! FIELDREF
CGERR();
! STORECLS
%2462% DEFAULT = TRUE;
BEGIN ! REGCONTENTS
PBOPWD[OBJADDR] = .PBOPWD[OBJADDR]+.EXPR[TARGTAC];
PSYMPTR = PBFNOSYM;
END; ! REGCONTENTS
BEGIN ! LABOP
PBOPWD[OBJADDR] = .EXPR;
PSYMPTR = PBFLABREF;
END; ! LABOP
! STATEMENT
CGERR();
! IOLSCLS
CGERR();
! INLINFN
%2462% DEFAULT = TRUE;
! SUBSTRING
%2462% DEFAULT = TRUE;
! CONCATENATION
%2462% DEFAULT = TRUE;
! EFIWREF
CGERR();
TES; ! CASE OPRCLS
%2462% IF TRUTH(.DEFAULT) ! Was the OPRCLS special?
THEN ! No, generate address the normal way
BEGIN ! NORMAL OPRCLS
! For normal expression nodes (BOOLEAN, RELATIONAL,
! FNCALL, ARITHMETIC, TYPECNV, NEGNOT, SPECOP,
! STORECLS, INLINFN, SUBSTRING and CONCATENATION), the
! value may be in a temporary or variable. For all
! but the last two, it could also be in a register.
! If in a register, that register is the Y field
! and PSYMPTR is set up to prevent relocation of the
! AC. If in a temp or variable, the target field of
! the node points to the STE which contains its
! address. This pointer goes into PSYMPTR.
! Set I and X bits of the arg word from the expression
! target. Must use OR instead of + in case both I
! fields are set.
PBOPWD[OBJIXF] = .PBOPWD[OBJIXF] OR .EXPR[TARGIXF];
IF .EXPR[INREGFLG] ! Does the result end up in an AC ?
THEN ! Yes, there is no relocation
BEGIN ! REGISTER
PSYMPTR = PBFNOSYM;
PBOPWD[OBJADDR] = .PBOPWD[OBJADDR]+.EXPR[TARGTAC];
END ! REGISTER
ELSE ! The value is in a temp or variable
BEGIN ! NOT REGISTER
PSYMPTR = .EXPR[TARGADDR]; ! Point to STE
IF .PSYMPTR[IDPSECT] EQL PSLARGE
THEN
BEGIN ! PSLARGE
PSYMPTR = MAKEFIW(.PBOPWD[OTSIND],0, ! I, X
%2351% EXTSIGN(.PBOPWD[OBJADDR]) ! Y
+.PSYMPTR[IDADDR],
.PSYMPTR); ! STE
! Don't let PEEPOP discriminate between memory
! references based on the Y field. EFIWs are
! pooled, and identical PBFSYMPTR's have
! identical I, X and Y fields.
%2351% PBOPWD[OBJADDR] = 0;
END ! PSLARGE
ELSE PBOPWD[OBJADDR] =
.PBOPWD[OBJADDR]+.PSYMPTR[IDADDR];
END; ! NOT REGISTER
END; ! NORMAL OPRCLS
! Now that the complete word is built up in PBOPWD and
! PSYMPTR, place it in the peephole buffer. OBUFFA deposits
! the word in the buffer. OBUFF deposits into the buffer and
! also calls PEEPOP on the word to try and optimize it. They
! also list the buffer entries differently when they decide to
! empty the buffer.
IF .ARGFLAG ! Is this an argument list entry?
THEN OBUFFA() ! Yes, drop it off in the buffer
ELSE OBUFF(); ! No, buffer it and call PEEPOP
END; ! of GENREF
GLOBAL ROUTINE CGOPGEN=
%(**********************************************************************
THIS ROUTINE IS CALLED TO GENERATE THE CODE SPECIFIED BY
SOME SPECIFIED OPGENTABLE ENTRY FOR SOME SPECIFIED NODE
CALLED WITH THE GLOBALS
TREEPTR - PTR TO THE NODE FOR WHICH CODE IS BEING GENERATED
A1NODE - PTR TO THE 1ST ARG NODE UNDER THAT NODE
A2NODE - PTR TO THE 2ND ARG NODE UNDER THAT NODE
OPDSPIX - CONTAINS PTR INTO THE OPGENTABLE-DISPATCH-TABLE
FOR THE OPGENTABLE ENTRY TO BE USED IN INTERPRETING
THIS NODE
REGFORCOMP - BITS 9-12 OF THIS WD INDICATE REGISTER (OR REGISTER-PAIR) TO BE USED
IN THE COMPUTATION FOR WHICH CODE IS BEING GENERATED
**********************************************************************)%
BEGIN
MAP BASE PSYMPTR; !PTR TO SYMBOL TABLE ENTRY
REGISTER OPGENTRY OPGENPTR; !PTR TO WD IN OPGENTABLE BEING PROCESSES
[email protected]; !GET AOBJN PTR TO SET OF OPGENTABLE INSTRUCTIONS
%(****IF THIS PTR IS 0, NO INSTRUCTIONS NEED TO BE GENERATED***)%
IF .OPGENPTR EQL 0
THEN RETURN
%(***IF THIS PTR IS 1 - THEN HAVE AN ILLEGAL COMBINATION OF FLAGS***)%
ELSE
IF .OPGENPTR EQL 1
THEN
BEGIN
CGERR();
RETURN;
END;
%(*****REPEAT THE FOLLOWING BLOCK FOR ALL INSTRUCTIONS TO BE OUTPUT*******)%
%(********CT OF INSTRUCTIONS TO BE OUTPUT IS IN LEFT HALF OF THE
PTR OPGENPTR*********)%
DO
BEGIN
PBOPWD_.OPGENPTR[PATTERN];
%(***IF THE PATTERN WD DOES NOT SPECIFY THE REGISTER
FIELD TO BE USED, THEN THE GLOBAL "REGFORCOMP"
SPECIFIES A FIELD-VAL TO BE ADDED IN TO THAT SPECIFIED
BY THE PATTERN WD*****)%
IF .OPGENPTR[REGSPEC] NEQ FRPTN
THEN
PBOPWD_.PBOPWD+.REGFORCOMP;
%(***DETERMINE THE MEMREF FIELD (IE BITS 13-35) OF THE INSTRUCTION *****)%
CASE .OPGENPTR[MEMSPEC] OF SET
%(**0 MEANS USE FIELD IN WD 0 OF OPGENTABLE ENTRY***)%
PSYMPTR_PBFNOSYM;
%(***1 MEANS USE THE "REGFORCOMP" AS A MEMORY ADDRESS***)%
BEGIN
PBOPWD_.PBOPWD+(.REGFORCOMP^(-23));
PSYMPTR_PBFNOSYM;
END;
%(***2 MEANS USE THE IMPLICIT FN-NAME POINTED TO BY TREEPTR***)%
BEGIN
PSYMPTR_PBFIMFN;
PBOPWD_.PBOPWD+.TREEPTR;
END;
%(***3 MEANS USE THE IMPLICIT FN-NAME POINTED TO BY THE PATTERN WD***)%
%2444% % If /EXTEND:CODE, create an STE and EFIW and point to EFIW %
%2444% % otherwise move PBFIMFN into pointer %
%2444% BEGIN
%2444% IF EXTENDCODE
%2444% THEN
%2444% BEGIN ! Build STE and EFIW
%2444% ENTRY[0]=@(.PBOPWD<RIGHT>);
%2444% NAME=IDTAB;
%2444% PSYMPTR=TBLSEARCH();
%2444% PSYMPTR[OPERSP]=FNNAME;
%2444% PSYMPTR=MAKEFIW(0,0,0,.PSYMPTR);
%2444% PBOPWD<RIGHT>=0
%2444% END ! Build STE and EFIW
%2444% ELSE PSYMPTR=PBFIMFN
%2444% END;
%(***4 MEANS USE THE IMPLICIT FN NAME POINTED TO BY THE PATTERN WD INDEXED
BY THE "REGFORCOMP" - (E.G. THE LIBRARY ROUTINE TO BE USED FOR
A DOUBLE-PREC OP DEPENDS ON THE REG IN WHICH THE ARG WAS LEFT***)%
%2444% % If /EXTEND:CODE, create an STE and EFIW and point to EFIW %
%2444% % otherwise move PBFIMFN into pointer %
BEGIN
%2444% PBOPWD=.PBOPWD+.REGFORCOMP^(-23);
%2444% IF EXTENDCODE
%2444% THEN
%2444% BEGIN ! Build STE and EFIW
%2444% ENTRY[0]=@(.PBOPWD<RIGHT>);
%2444% NAME=IDTAB;
%2444% PSYMPTR=TBLSEARCH();
%2444% PSYMPTR[OPERSP]=FNNAME;
%2444% PSYMPTR=MAKEFIW(0,0,0,.PSYMPTR);
%2444% PBOPWD<RIGHT>=0
%2444% END ! Build STE and EFIW
%2444% ELSE
%2444% BEGIN
%2444% PSYMPTR=PBFIMFN
%2444% END
END;
%(***5 MEANS USE A1NODE IN IMMEDIATE MODE - EITHER AS AN IMMED CONSTANT OR
IF ITS A "REGCONTENTS", THEN AS 0(R)****)%
BEGIN
PSYMPTR_PBFNOSYM;
IF .A1NODE[OPR1] EQL CONSTFL
THEN
![1411] Delete conversion from GFLOATING
PBOPWD_.PBOPWD +
( IF .A1NODE[VALTP1] EQL INTEG1
THEN (.A1NODE[CONST2] AND #777777)
!REAL IMMEDIATE CONSTANT
%1411% ELSE .A1NODE[CONST1]^(-18) )
ELSE
IF .A1NODE[OPRCLS] EQL REGCONTENTS
THEN
PBOPWD_.PBOPWD+.A1NODE[TARGTAC]^18;
END;
%(***6 MEANS USE A2NODE IN IMMEDIATE MODE - EITHER AS AN IMMED CONSTANT OR
IF ITS A "REGCONTENTS", THEN AS 0(R)****)%
BEGIN
PSYMPTR_PBFNOSYM;
IF .A2NODE[OPR1] EQL CONSTFL
THEN
![1411] Delete conversion from GFLOATING
PBOPWD_.PBOPWD +
( IF .A2NODE[VALTP1] EQL INTEG1
THEN (.A2NODE[CONST2] AND #777777)
%1411% ELSE .A2NODE[CONST1]^(-18) )
ELSE
IF .A2NODE[OPRCLS] EQL REGCONTENTS
THEN
PBOPWD_.PBOPWD+.A2NODE[TARGTAC]^18;
END;
%(***7 MEANS USE THE NEG OF THE IMMED CNST A1NODE***)%
BEGIN
![1411] Delete conversion from GFLOATING
PBOPWD_.PBOPWD +
( IF .A1NODE[VALTP1] EQL INTEG1
THEN (-.A1NODE[CONST2]) AND #777777
%1411% ELSE (-.A1NODE[CONST1])^(-18) );
PSYMPTR_PBFNOSYM;
END;
%(***8 (#10) MEANS USE THE NEG OF THE IMMED CNST A2NODE***)%
BEGIN
![1411] Delete conversion from GFLOATING
PBOPWD_.PBOPWD +
( IF .A2NODE[VALTP1] EQL INTEG1
THEN (-.A2NODE[CONST2]) AND #777777
%1411% ELSE (-.A2NODE[CONST1])^(-18) );
PSYMPTR_PBFNOSYM;
END;
%(***9 (#11) MEANS USE THE "ARG2PTR" FIELD FROM THE PARENT***)%
BEGIN
PBOPWD_.PBOPWD+.TREEPTR[ARG2PTR];
PSYMPTR_PBFNOSYM;
END;
%(***10 (#12) MEANS USE THE NEG OF THE ARG2PTR FIELD OF THE PARENT***)%
BEGIN
PBOPWD_.PBOPWD+(-.TREEPTR[ARG2PTR] AND #777777);
PSYMPTR_PBFNOSYM;
END;
%(***11 (#13) MEANS USE 2**(VAL OF ARG2PTR) MINUS 1. (THIS IS USED
FOR P2DIV)****)%
BEGIN
PBOPWD_.PBOPWD+(( (1^.TREEPTR[ARG2PTR]) - 1) AND #777777);
PSYMPTR_PBFNOSYM;
END;
%(***12 (#14) MEANS USE THE LABEL SPECIFIED BY A1LABEL***)%
BEGIN
PBOPWD_.PBOPWD+.A1LABEL;
PSYMPTR_PBFLABREF;
END;
%(***13 (#15) MEANS USE THE LABEL SPECIFIED BY A2LABEL***)%
BEGIN
PBOPWD_.PBOPWD+.A2LABEL;
PSYMPTR_PBFLABREF;
END;
%(***14 (#16) MEANS USE THE LABEL SPECIFIED BY A3LABEL***)%
BEGIN
PBOPWD_.PBOPWD+.A3LABEL;
PSYMPTR_PBFLABREF;
END;
%(***15 (#17) MEANS USE THE VALUE IN THE GLOBAL C1H, NO SYMBOLIC REPRESENTATION***)%
BEGIN
PBOPWD_.PBOPWD+.C1H;
PSYMPTR_PBFNOSYM;
END;
%(***16 (#20) MEANS USE THE TEMPORARY POINTED TO BY THE TARGET WD OF THE PARENT -
IGNORE THE INDIRECT AND INDEX BITS IN THAT TARGET WD***)%
BEGIN
PSYMPTR_.TREEPTR[TARGADDR];
PBOPWD_.PBOPWD+.PSYMPTR[IDADDR];
END;
%(***17 (#21) MEANS USE MEMREF FIELD FROM A1NODE***)%
REFNODE_.A1NODE;
%(***18 (#22) MEANS USE MEMREF FIELD FROM A2NODE**)%
REFNODE_.A2NODE;
%(***19 (#23) MEANS USE MEMREF FIELD FROM PARENT NODE (IE NODE PTED TO BY TREEPTR)***)%
REFNODE_.TREEPTR
TES;
%(***IF THE MEMREF FIELD MUST BE RETRIEVED FROM THE NODE SPECIFIED BY
REFNODE, DO SO***)%
IF .OPGENPTR[MEMSPEC] GEQ FROMA1
THEN
BEGIN ! MEMREF
! If REFNODE is a type-conversion node that
! generates no code (is only to specify
! VALTYPE), move down to the arg under
! REFNODE. The redundant IF provides an
! illusion of speed. The gross amount of code
! generated by the NOCNV macro and generally
! losing Bliss-10 boolean expression
! evaluation make this desireable.
%2317% IF .REFNODE[OPRCLS] EQL TYPECNV
%2317% THEN WHILE .REFNODE[OPRCLS] EQL TYPECNV
%2317% AND NOCNV(REFNODE)
%2317% DO REFNODE = .REFNODE[ARG2PTR];
%2462% GENREF(.REFNODE,FALSE); ! Generate the memory reference
! and buffer the instruction
%2317% END ! MEMREF
%2317% ELSE OBUFF(); ! Output the instruction formed
! to the peephole buffer
%(***INCREMENT AOBJN PTR INTO THE OPGEN TABLE****)%
OPGENPTR_.OPGENPTR+1;
OPGENPTR_.OPGENPTR+AOBINCR; !ADD 1,,1
END
WHILE .OPGENPTR LSS 0;
END; ! of CGOPGEN
GLOBAL ROUTINE CGARGEVAL=
%(************************************************************
ROUTINE TO EVALUATE THE 2 ARGUMENT NODES OF SOME EXPRESSION
NODE AND PUT THE VAL OF THE 1ST INTO THE LOC SPECIFIED FOR THE
COMPUTATION
************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE; !PTR TO PARENT NODE
CNODE_.TREEPTR;
IF NOT .CNODE[RVRSFLG]
THEN
%(*****IF 1ST ARG SHOULD BE EVALUATED FIRST, EVALUATE IT******)%
BEGIN
IF NOT .CNODE[A1VALFLG]
THEN
%(****UNLESS THIS ARG IS ALREADY EVALUATED SOMEWHERE EVALUATE IT*****)%
BEGIN
TREEPTR_.CNODE[ARG1PTR];
CGETVAL();
END
END;
%(**************EVALUATE 2ND ARG********************)%
IF NOT .CNODE[A2VALFLG]
THEN
%(*****UNLESS ARG2 IS ALREADY EVALUATED SOMEWHERE OR IS
AN IMMED CONSTANT, EVALUATE IT**********)%
BEGIN
IF (TREEPTR_.CNODE[ARG2PTR]) NEQ 0 THEN
CGETVAL();
END;
IF .CNODE[RVRSFLG]
THEN
%(*****IF ARG1 SHOULD BE EVALUATED 2ND, EVALUATE IT******)%
BEGIN
IF NOT .CNODE[A1VALFLG]
THEN
%(****UNLESS THIS ARG IS ALREADY EVALUATED SOMEWHERE EVALUATE IT*****)%
BEGIN
TREEPTR_.CNODE[ARG1PTR];
CGETVAL();
END
END;
%(********SET UP GLOBALS FOR OPGENTABLE INTERPRETATION********)%
TREEPTR_.CNODE; !TREEPTR MAY HAVE BEEN DESTROYED BY CGETVAL
A1NODE_.CNODE[ARG1PTR];
A2NODE_.CNODE[ARG2PTR];
END; ! of CGARGEVAL
GLOBAL ROUTINE CGILF=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR IN-LINE FUNCTIONS.
CALLED WITH TREEPTR POINTING TO THE NODE FOR THE IN-LINE-FUNCTION-CALL
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE;
LOCAL PEXPRNODE ARG1NODE:ARG2NODE;
%(***EVALUATE ARGUMENTS***)%
CGARGEVAL();
%(***SET UP THE GLOBALS USED BY CGOPGEN (CODE TABLE DRIVER)***)%
CNODE_.TREEPTR;
A1NODE_.CNODE[ARG1PTR];
A2NODE_.CNODE[ARG2PTR];
REGFORCOMP_GETTAC(CNODE);
%(***COMPLETE CODE GENERATION FOR CMPLX***)%
IF .CNODE[OPERSP] EQL CMPLXFN THEN
BEGIN
OPDSPIX_GETA1OPIX(CNODE,A1NODE);
CGOPGEN();
REGFORCOMP_.REGFORCOMP+1^23;
SWAPARGS(CNODE);
A1NODE_.CNODE[ARG1PTR];
OPDSPIX_GETA1OPIX(CNODE,A1NODE);
RETURN CGOPGEN()
END;
%(***FOR ABS,IABS, AND SIGN - UNLESS A1SAMEFLG OR A1IMMEDFLG IS SET,
WILL PICK UP ARG1 BY A MOVM. HENCE DO NOT GET IT INTO A REG TO
START. OTHERWISE WILL GET ARG1 INTO REGFORCOMP***)%
IF ILFINRFC(.CNODE[OPERSP]) OR .CNODE[A1IMMEDFLG] OR .CNODE[A1SAMEFLG]
THEN
BEGIN
OPDSPIX_GETA1OPIX(CNODE,A1NODE);
CGOPGEN();
OPDSPIX_ILFIX(CNODE);
CGOPGEN();
END
ELSE
BEGIN
OPDSPIX_ILF1IX(CNODE); !FOR ABS,IABS,SIGN WHEN IMMEDFLG=0
CGOPGEN();
END;
END; ! of CGILF
GLOBAL ROUTINE CGSUBSTR= ![1431] New
BEGIN
REGISTER PEXPRNODE CNODE:ANODE;
CNODE = .TREEPTR; ! CNODE points to substring node
! Evaluate ARG1 (upper bound) and ARG2 (lower bound-1) nodes.
! Substring nodes always have RVRSFLG set, so the evaluation will be
! done in the order ARG2,ARG1. Also set up the globals A1NODE and
! A2NODE pointing to the subnodes.
CGARGEVAL();
! Generate MOVE TARGTAC, upper-bound-expression
REGFORCOMP = GETTAC(CNODE);
OPDSPIX = GETA1OPIX(CNODE,A1NODE);
CGOPGEN();
! Generate SUB TARGTAC, lower-bound-expression
OPDSPIX = SSSUBOPIX(CNODE);
CGOPGEN();
! Generate MOVEM TARGTAC, descriptor +1
OPDSPIX = OPGST1;
CGOPGEN();
! Different cases for subscripted and scalar variables
ANODE = .CNODE[ARG4PTR]; ! Get pointer to DATAOPR or ARRAYREF node
IF .ANODE[OPRCLS] EQL ARRAYREF
THEN
BEGIN ! arrayref node
! For arrayrefs, the byte pointer is calculated in the
! register specified by ANODE[TARGTAC]. Let RFC be this
! register.
! Evaluate subscript expression
TREEPTR = .ANODE[ARG2PTR];
CGETVAL();
! Generate MOVE RFC, subscript-expression
REGFORCOMP = GETTAC(ANODE);
A1NODE = .ANODE[ARG2PTR];
OPDSPIX = GETA2OPIX(ANODE,A1NODE);
CGOPGEN();
! Generate ADD RFC, lower-bound-expression
A2NODE = .CNODE[ARG2PTR];
OPDSPIX = SSADDOPIX(CNODE);
CGOPGEN();
ANODE = .ANODE[ARG1PTR]; ! Point ANODE to the ID table entry
! of the array name
END ! arrayref
ELSE
BEGIN ! dataopr
! For scalars, the byte pointer is calculated in the
! register specified by CNODE[TARGAUX]. Let RFC be this
! register.
! Generate MOVE RFC, lower-bound
REGFORCOMP = GETTAUX(CNODE);
A1NODE = .A2NODE;
OPDSPIX = GETA2OPIX(CNODE,A2NODE);
CGOPGEN();
ANODE = .CNODE[ARG4PTR]; ! Point ANODE at the ID table entry
! of the scalar
END; ! dataopr
! Generate ADJBP RFC, ANODE
! MOVEM RFC, descriptor
A1NODE = .ANODE;
TREEPTR = .CNODE;
OPDSPIX = OPSSEP;
CGOPGEN();
END; ! of CGSUBSTR
GLOBAL ROUTINE CGCONCAT=
BEGIN
!***************************************************************
! Generate code for a character concatenation expression. First
! evaluate all the arguments. For CONCTF nodes, generate a call
! to CONCF. For CONCTM nodes, move the .Dnnnn variable with the
! maximum length descriptor to the .Qnnnn variable for the
! actual result. Then call CONCM. For CONCTV nodes, generate a
! call to CONCD. to allocate run-time space for the result and
! to do the concatenation.
!***************************************************************
%1474% ! Written by TFV on 18-Feb-82
REGISTER
PEXPRNODE CNODE, ! Pointer to the concatenation
! node
BASE FNID; ! Pointer to the concatenation
! library routine
CNODE = .TREEPTR;
! Do the setup for the call to the concatenation routine. Then
! generate the call.
IF .CNODE[OPERSP] EQL CONCTF
THEN
BEGIN ! Fixed length result
ENTRY = SIXBIT 'CONCF.';
END ! Fixed length result
ELSE IF .CNODE[OPERSP] EQL CONCTM
THEN
BEGIN ! Known maximum length result
! Copy the .Dnnnn maximum length descriptor to the
! .Qnnnn variable for the actual descriptor
REGFORCOMP = 0;
! Generate DMOVE 0,.Dnnnn
A1NODE = .CNODE[ARG1PTR];
OPDSPIX = OPGLD2;
CGOPGEN();
! Generate DMOVEM 0,.Qnnnn
TREEPTR = .CNODE[TARGADDR];
OPDSPIX = OPGST2;
CGOPGEN();
ENTRY = SIXBIT 'CONCM.';
END ! Known maximum length result
ELSE IF .CNODE[OPERSP] EQL CONCTV
THEN
BEGIN ! Dynamic length result
%1533% ENTRY = SIXBIT 'CONCD.';
END; ! Dynamic length result
NAME = IDTAB; ! Get the symbol table entry for the
! routine to call
FNID = TBLSEARCH(); ! Lookup the entry
! If this was the first reference, set up the symbol table entry
! as a library function
IF NOT .FLAG
THEN
BEGIN
FNID[OPERSP] = FNNAME;
FNID[IDLIBFNFLG] = 1
END;
! Generate the code for the arguments and then generate the call
CGSBPRGM(.CNODE[ARG2PTR],.FNID);
END; ! of CGCONCAT
GLOBAL ROUTINE CGCHMRK(ARGL)=
BEGIN
!***************************************************************
! Perform code generation for a CHMRK. call. ARGL is a pointer
! to an argument list with a single argument which is the .Qnnnn
! variable which holds the mark in character dynamic space.
!***************************************************************
%1533% ! Written by TFV on 17-May-82
MAP ARGUMENTLIST ARGL; ! Argument list for the CHMRK. call
! If ARGLABEL is zero, thread the argument list onto the linked
! list. Otherwise, the argument list was already threaded by
! the last CHMRK. call.
IF .ARGL[ARGLABEL] EQL 0
THEN
BEGIN ! Thread argument list onto linked list
ARGL[ARGLINK] = .ARGLINKPT;
ARGLINKPT = .ARGL;
%1607% ARGL[ARGLABEL] = GENLAB(); ! Create ARGLABEL
END; ! Thread argument list onto linked list
! Generate:
! XMOVEI 16,A1LABEL
! PUSHJ 17,CHMRK.
%1607% A1LABEL = .ARGL[ARGLABEL];
OPDSPIX = OPGCHM;
CGOPGEN();
END; ! of CGCHMRK
GLOBAL ROUTINE CGCHUNW(ARGL)=
BEGIN
!***************************************************************
! Perform code generation for a CHUNW. call. ARGL is a pointer
! to an argument list with a single argument which is the .Qnnnn
! variable which holds the mark in character dynamic space.
!***************************************************************
%1533% ! Written by TFV on 17-May-82
MAP ARGUMENTLIST ARGL; ! Argument list for the CHUNW. call
A1LABEL = .ARGL[ARGLABEL]; ! For XMOVEI 16,A1LABEL
IF .A1LABEL EQL 0 THEN CGERR(); ! Error if CHMRK. was not called
! Generate:
! XMOVEI 16,A1LABEL
! PUSHJ 17,CHUNW.
OPDSPIX = OPGCHU;
CGOPGEN();
END; ! of CGCHUNW
GLOBAL ROUTINE CGVBOOL=
%(**********************************************************************
ROUTINE TO GENERATE CODE TO COMPUTE THE VALUE FOR AND,
OR, XOR, AND EQV NODES
USES THE GLOBAL
TREEPTR: POINTS TO THE NODE IN THE TREE BEING PROCESSED
************************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE; !PTR TO THE EXPRESSION NODE BEING PROCESSED
REGISTER PEXPRNODE ARG1NODE; !PTR TO 1ST ARG NODE
REGISTER PEXPRNODE ARG2NODE; !PTR TO 2ND ARG NODE
LOCAL NXLAB1,NXLAB2; !INDICATE LABELS TO BE GENERATED
!HEREIN (PTRS INTO LABEL TABLE)
MACRO
USEMSKLB=NXLAB1$,
USEBLLB=NXLAB2$;
LOCAL THENP,ELSEP; !INDICATE LOCS FOR "TRUE-TRANSFER"
!AND "FALSE-TRANSFER" FOR
!SUBNODES WHICH ARE ALSO BOOLEANS
LOCAL USEBLCND; !INDICATES WHICH VAL OF A CONTROL-TYPE SUBNODE (TRUE
! OR FALSE) SHOULD BECOME VAL OF PARENT
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
IF .CNODE[BOOLCLS] NEQ ANDORCLS OR
.ARG2NODE[VALTYPE] NEQ CONTROL !IF EITHER ARG IS OF TYPE CONTROL,
! ARG2 WILL BE (CMPLEX SWAPS THE
! ARGS IF ARG1 IS CONTROL, ARG2 NOT)
THEN
%(***FOR EQV AND XOR, AND FOR AND AND OR WHEN NEITHER ARG IS OF TYPE CONTROL***)%
%(*******USE OPGENTABLE TO GENERATE CODE TO COMPUTE THE VALUE OF THE PARENT FROM VALS OF ARGS***)%
BEGIN
CGARGEVAL();
%(***GET ARG1 INTO LOC FOR COMPUTATION***)%
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_GETA1OPIX(CNODE,ARG1NODE);
CGOPGEN();
OPDSPIX_BOOLOPIX(CNODE);
CGOPGEN();
RETURN
END;
IF .CNODE[VALTYPE] EQL CONTROL
THEN
%(*****FOR AND NODES AND OR NODES WHICH ONLY HAVE BOOLEAN-VALUED ARGS (NO MASKS),*******)%
%(*******INIT THE VALUE TO FALSE FOR AN AND NODE, TO TRUE FOR AN OR NODE, THEN CHANGE IT IF INCORRECT***)%
BEGIN
NXLAB1_GENLAB(); !GENERATE 2 NEW LABEL ENTRIES
NXLAB2_GENLAB();
IF .CNODE[BOPRFLG] EQL ANDOPF
THEN
%(****FOR AN AND NODE****)%
BEGIN
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_SETLOGIX(CNODE,FALSE);
CGOPGEN();
CGCBOOL(.NXLAB1, .NXLAB2); !GENERATE CODE TO TRANSFER TO
!NXLAB1 IF VAL IS TRUE, NXLAB2 IF FALSE
DEFLAB(.NXLAB1); !ASSOC THIS LOC WITH NXLAB1
TREEPTR_.CNODE;
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_SETLOGIX(CNODE,TRUE);
CGOPGEN();
END
ELSE
%(****FOR AN OR NODE****)%
BEGIN
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_SETLOGIX(CNODE,TRUE);
CGOPGEN();
CGCBOOL(.NXLAB2,.NXLAB1); !GENERATE CODE TO TRANSFER TO NXLAB2
! IF VALUE IS TRUE, NXLAB1 IF FALSE
DEFLAB(.NXLAB1); !ASSOC THIS LOC WITH NXLAB1
TREEPTR_.CNODE;
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_SETLOGIX(CNODE,FALSE);
CGOPGEN();
END;
DEFLAB(.NXLAB2); !ASSOC THIS LOC WITH NXLAB2
RETURN
END;
%(*****FOR AND AND OR NODES ON WHICH ARG2 IS OF TYPE CONTROL, ARG1 IS A MASK****)%
IF .CNODE[BOPRFLG] EQL ANDOPF
THEN
%(**********IF OPERATOR IS AND*********)%
BEGIN
USEBLCND_FALSE; !IF THE "CONTROL" TYPE ARG
! IS FALSE THAT IS THE VAL OF THE PARENT
! OTHERWISE THE PARENT HAS THE VAL OF
! THE ARG WHICH IS A MASK
THENP_USEMSKLB;
ELSEP_USEBLLB;
END
ELSE
%(**********IF OPERATOR IS OR*********)%
BEGIN
USEBLCND_TRUE; !IF THE "CONTROL" TYPE ARG
! IS TRUE THAT IS THE VAL OF THE PARENT
! OTHERWISE THE PARENT HAS THE VAL OF
! THE ARG WHICH IS A MASK
THENP_USEBLLB;
ELSEP_USEMSKLB;
END;
%(***GENERATE CODE TO SET VAL OF PARENT TO VAL OF 1ST ARG***)%
TREEPTR_.ARG1NODE;
CGETVAL();
TREEPTR_.CNODE;
A1NODE_.CNODE[ARG1PTR];
REGFORCOMP_GETTAC(CNODE);
%(***IF THE VAL IS BEING COMPUTED TO MEMORY AND THE ARG WAS IN A REG
CAN ALWAYS COUNT ON THAT REG BEING THE TARGTAC OF PARENT (EVEN
THO DO NOT SET "A1SAMEFLG" (BECAUSE ARG1 IS NOT IN THE TMP TO BE USED)***)%
IF .CNODE[INREGFLG] OR NOT .ARG1NODE[INREGFLG]
!IF THE A1NOTFLG IS SET, MUST GENERATE CODE TO COMPLEMENT
! THE VALUE OF A1NODE - THIS IS THE PLACE!
OR .CNODE[A1NOTFLG]
THEN
BEGIN
OPDSPIX_GETA1OPIX(CNODE,ARG1NODE);
CGOPGEN();
END;
%(***IF VAL IS COMPUTED TO MEMORY, STORE IT***)%
IF NOT .CNODE[INREGFLG]
AND NOT .CNODE[A1SAMEFLG] !IF ARG1 WAS NOT ALREADY IN THE TEMPORARY
THEN
BEGIN
OPDSPIX_STOROPIX(CNODE);
CGOPGEN();
END;
%(***GENERATE CODE FOR 2ND ARG - JUMP TO END IF VAL OF ARG2
IS TRUE FOR AND, FALSE FOR OR***)%
USEMSKLB_GENLAB();
TREEPTR_.ARG2NODE;
IF .ARG2NODE[OPRCLS] EQL RELATIONAL
THEN CGJMPC(NOT .USEBLCND,.USEMSKLB)
ELSE
BEGIN
IF .ARG2NODE[OPRCLS] EQL BOOLEAN
THEN
BEGIN
USEBLLB_GENLAB();
CGCBOOL(@@THENP,@@ELSEP);
DEFLAB(.USEBLLB);
END
ELSE CGERR(5); !ONLY RELATIONALS AND BOOLEANS CAN
! HAVE VALUE TYPE CONTROL
END;
%(***GENERATE CODE TO INIT VAL OF PARENT TO FALSE FOR AND, TRUE FOR OR**)%
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_SETLOGIX(CNODE,.USEBLCND);
TREEPTR_.CNODE;
CGOPGEN();
DEFLAB(.USEMSKLB);
END; ! of CGVBOOL
GLOBAL ROUTINE CGCBOOL(THENLAB,ELSELAB)=
%(******************************************************************************************
ROUTINE TO GENERATE CODE FOR BOOLEAN NODES WHICH ARE USED FOR CONTROL PURPOSES ONLY
CALLED WITH THE ARGUMENTS
THENLAB: INDICATES LABEL TO TRANSFER TO ON A TRUE VALUE
ELSELAB: INDICATES LABEL TO TRANSFER TO ON A FALSE VALUE
USES THE GLOBAL
TREEPTR: POINTS TO THE NODE IN THE TREE BEING PROCESSED
********************************************************************************************)%
BEGIN
REGISTER PEXPRNODE CNODE; !PTR TO THE EXPRESSION NODE BEING PROCESSED
REGISTER PEXPRNODE ARG1NODE; ! PTR TO 1ST ARG
REGISTER PEXPRNODE ARG2NODE; !PTR TO 2ND ARG NODE
REGISTER PEXPRNODE SUB2NODE; !PTR TO ARG2 UNDER THE FIRST ARG
LOCAL NXLAB1; !INDICATES LABEL TO BE GENERATED
!HEREIN (PTR INTO LABEL TABLE)
LOCAL THENP,ELSEP; !INDICATE LOCS FOR "TRUE-TRANSFER"
!AND "FALSE-TRANSFER" FOR
!SUBNODES WHICH ARE ALSO BOOLEANS
LOCAL FINJMP; !ADDR (THENLAB FOR AND, ELSELAB FOR OR) TO
! TRANSFER TO IF DO NOT EXIT AT ANY SUBNODE
LOCAL JMPCND; !INDICATES WHICH VALUE (TRUE OR FALSE)
!OF A SUBNODE WHICH IS A RELATIONAL
!OR A DATA ITEM SHOULD FORCE
!A TRANSFER
LOCAL JMADDR; !INDICATES WHERE TO TRANSFER TO
%(************************
DEFINE MACRO TO GENERATE CODE THAT WILL COMPUTE THE VALUE
OF THIS NODE AND THEN TEST IT.
**************************)%
MACRO EVALANDTST=
BEGIN
CGVBOOL();
TREEPTR_.CNODE;
REGFORCOMP_GETTAC(CNODE);
A1LABEL_.THENLAB;
A2LABEL_.ELSELAB;
OPDSPIX_ALTTRIX(CNODE);
CGOPGEN();
END$;
%(***DEFINE MACRO THAT TESTS WHETHER A NODE IS A BOOLEAN
IN WHICH ARG2 IS OF TYPE CONTROL (IF ONLY ONE ARG
IS OF TYPE CONTROL, THAT ARG WILL ALWAYS BE ARG2)**)%
MACRO CTLMBOOL(NODE)=
BEGIN
IF .NODE[OPRCLS] EQL BOOLEAN
THEN
BEGIN
SUB2NODE_.NODE[ARG2PTR];
IF .SUB2NODE[VALTYPE] EQL CONTROL
THEN TRUE
ELSE FALSE
END
ELSE FALSE
END$;
CNODE_.TREEPTR;
%(**********
FOR PURPOSES OF CODE GENERATION WE DIVIDE BOOLEANS INTO
TWO CLASSES-
FOR AND AND OR THE VALUES OF ALL SUBNODES DO NOT ALWAYS
HAVE TO BE COMPUTED; FOR XOR AND EQV THEY DO
**********)%
IF .CNODE[BOOLCLS] EQL ANDORCLS
THEN
%(**********FOR AN AND NODE OR AN OR NODE*********)%
BEGIN
%(*****DETERMINE WHAT THE VALUE OF EACH SUBNODE WILL IMPLY*****)%
IF .CNODE[BOPRFLG] EQL ANDOPF
THEN
%(*****IF PARENT NODE IS AND*****)%
BEGIN
JMPCND_FALSE; !IF SUBNODE IS FALSE
JMADDR_.ELSELAB; ! TRANSFER OUT TO ELSELAB
ELSEP_ELSELAB;
THENP_NXLAB1; !IF TRUE, GO ONTO NEXT
! SUBNODE
FINJMP_.THENLAB; !IF LAST SUBNODE IS TRUE,
! TRANSFER TO THENLAB
END
ELSE
%(*****IF PARENT NODE IS OR*****)%
BEGIN
JMPCND_TRUE; !IF SUBNODE IS TRUE
JMADDR_.THENLAB; ! TRANSFER OUT TO THENLAB
THENP_THENLAB;
ELSEP_NXLAB1; !IF FALSE, GO ONTO NEXT
! SUBNODE
FINJMP_.ELSELAB; !IF LAST SUBNODE IS FALSE,
! TRANSFER TO ELSELAB
END;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(***IF BOTH ARGS ARE MASKS - (IF ARG2 IS A MASK, CAN
ASSUME THAT ARG1 IS A MASK. THIS REORDERING
WAS DONE IN "CMPVBOOL" IN THE COMPLEXITY PASS) ***)%
IF .ARG2NODE[VALTYPE] NEQ CONTROL !IF BOTH ARGS ARE MASKS
THEN
(EVALANDTST; RETURN); !EVALUATE THE BOOLEAN, THEM TEST THE VALUE
%(***IF THE 2ND ARG IS OF TYPE CONTROL, BUT THE 1ST ARG IS A MASK***)%
IF .ARG1NODE[VALTYPE] NEQ CONTROL !IF ARG1 IS NOT A RELATIONAL
! NOR A BOOLEAN MADE UP OF RELATIONALS
AND NOT (CTLMBOOL(ARG1NODE)) ! NOR A BOOLEAN IN WHICH
! ONE OF THE ARGS IS A REL OR A
! BOOLEAN MADE UP OF RELS
THEN
BEGIN
OWN OJMPCND; !INDICATES WHETHER WISH TO JUMP ON
! VARIABLE TRUE OR ON FALSE
TREEPTR_.ARG1NODE;
CGETVAL();
OJMPCND_(IF .CNODE[A1NOTFLG] !IF WANT "NOT" OF THE VAR
THEN NOT .JMPCND ! THEN JUMP ON OPPOSITE CONDITION
! FROM THAT FOR THE WHOLE EXPRESSION
ELSE .JMPCND);
TREEPTR_.ARG1NODE;
REGFORCOMP_GETTAC(CNODE);
A1LABEL_.JMADDR;
OPDSPIX_TSTARGTRIX(CNODE,.OJMPCND);
CGOPGEN();
END
ELSE
%(****IF 1ST ARG IS OF TYPE CONTROL, CODE FOR THAT ARG
SHOULD BE GENERATED TO TRANSFER TO LOCS SPECIFIED
FOR PARENT************)%
BEGIN
TREEPTR_.ARG1NODE;
IF .ARG1NODE[OPRCLS] EQL BOOLEAN
THEN
%(**********IF THIS ARGUMENT IS A BOOLEAN OPERATION******)%
BEGIN
NXLAB1_GENLAB();
CGCBOOL(@@THENP,@@ELSEP);
DEFLAB(.NXLAB1); !ASSOCIATE THE CURRENT
!LOCATION WITH THE LABEL
!ENTRY .NXLAB1
END
ELSE
IF .ARG1NODE[OPRCLS] EQL RELATIONAL
THEN
%(**********IF THIS ARGUMENT IS A RELATIONAL*********)%
CGJMPC(.JMPCND,.JMADDR)
%(***IF ARG IS NOT A BOOLEAN OR RELATIONAL, COMPILER MADE AN ERROR***)%
ELSE CGERR();
END;
%(*****ONLY FALL THRU HERE IF ARG2NODE IS OF TYPE CONTROL****)%
%(****GENERATE CODE FOR 2ND ARG TO TRANSFER TO LOCS SPECIFIED BY PARENT****)%
TREEPTR_.ARG2NODE;
IF .ARG2NODE[OPRCLS] EQL BOOLEAN
THEN
%(****IF ARG2 IS A BOOLEAN OPERATION****)%
CGCBOOL(.THENLAB,.ELSELAB)
ELSE
IF .ARG2NODE[OPRCLS] EQL RELATIONAL
THEN
%(****IF ARG2 IS A RELATIONAL*****)%
BEGIN
CGJMPC(.JMPCND,.JMADDR);
JRSTGEN(.FINJMP);
END
ELSE CGERR();
END
ELSE
%(**********FOR AN XOR OR EQV NODE**********)%
%(***********EVALUATE THE BOOLEAN, THEN TEST IT*******)%
EVALANDTST;
END; ! of CGCBOOL
GLOBAL ROUTINE CGREL1(SKCND)=
%(**********************************************************************
ROUTINE TO GENERATE CODE FOR RELATIONALS
THIS ROUTINE IS CALLED WITH A SINGLE ARGUMENT "SKCND"
1. IF SKCND=TRUE:
THE CODE GENERATED SKIPS THE NEXT INSTRUCTION IF
THE RELATIONAL IS TRUE
2. IF SKCND=FALSE:
THE CODE GENERAPED SKIPS THE NEXT INSTRUCTION IFF THE
RELATIONAL IS FALSE
THE ROUTINE USES THE GLOBAL:
TREEPTR-POINTER TO THE NODE IN THE TREE CURRENTLY BEING
PROCESSED
THIS ROUTINE IS NEVER CALLED IF EITHER SUBNODE IS THE CONSTANT ZERO
**********************************************************************)%
BEGIN
LOCAL PEXPRNODE CNODE:ARG1NODE:ARG2NODE;
CNODE_.TREEPTR;
ARG1NODE_.CNODE[ARG1PTR];
ARG2NODE_.CNODE[ARG2PTR];
%(***CANNOT HANDLE NEGATE ON ARG2 OF A RELATIONAL. IF THERE
WAS AN A2NEGFLG, IT SHOULD HAVE BEEN REMOVED IN CMPLREL. IF THERE
IS ONE, HAVE AN INTERNAL COMPILER ERROR***)%
IF .CNODE[A2NEGFLG] THEN CGERR();
%(***GENERATE CODE TO EVALUATE THE 2 ARGS AND GET THE FIRST ARG
INTO POSITION TO APPLY THE COMPARISON*****)%
CGARGEVAL();
%(***GET ARG1 INTO LOC FOR COMPUTATION***)%
REGFORCOMP_GETTAUX(CNODE);
OPDSPIX_GETA1OPIX(CNODE,ARG1NODE);
CGOPGEN();
%(***WHEN COMPARING A DOUBLE-PREC TO 0, CAN USE THE SAME CODE
SEQUENCE AS IS USED FOR COMPARING A REAL TO 0 (SINCE CAN TELL BY
THE FIRST WORD WHETHER HAVE 0,POS OR NEG)***)%
IF .ARG2NODE[OPERATOR] EQL DOUBLCONST
THEN
BEGIN
IF .ARG2NODE[CONST1] EQL 0 AND .ARG2NODE[CONST2] EQL 0
THEN OPDSPIX_DPIMMRELOPIX(CNODE,.SKCND)
ELSE OPDSPIX_RELOPIX(CNODE,ARG1NODE,.SKCND)
END
ELSE OPDSPIX_RELOPIX(CNODE,ARG1NODE,.SKCND);
CGOPGEN();
END; ! of CGREL1
GLOBAL ROUTINE CGJMPC(JMCND,ADDR)=
%(**********************************************************************
ROUTINE TO GENERATE A CONDITIONAL JUMP ON A RELATIONAL TO A SPECIFIED LOCATION
CALLED WITH TWO ARGUMENTS:
1. JMCND:
IF JMCND=TRUE THE CODE GENERATED JUMPS IFF THE RELATIONAL
REPRESENTED BY THE NODE BEING PROCESSED IS TRUE.
IF JMCND=FALSE THE CODE GENERATED JUMPS IFF IT IS FALSE.
2. ADDR:
THE ADDRESS TO JUMP TO
THIS ROUTINE USES THE GLOBAL:
TREEPTR - PTR TO THE NODE IN THE TREE CURRENTLY BEING PROCESSED
(THIS NODE WILL ALWAYS BE A RELATIONAL)
**********************************************************************)%
BEGIN
CGREL1(NOT .JMCND); !GENERATE CODE TO SKIP IF CONDITION FOR JUMP DOES
! NOT HOLD
JRSTGEN(.ADDR); !GENERATE A "JRST .ADDR"
END; ! of CGJMPC
GLOBAL ROUTINE DEFLAB(LABPTR)=
%(*******************************************************************
ROUTINE TO IDENTIFY THE CURRENT LOCATION WITH THE LABEL ENTRY
SPECIFIED BY THE ARG LABPTR
***********************************************************************)%
BEGIN
MAP BASE LABPTR; !PTR TO THE LABEL ENTRY THAT
! WE WANT TO ASSOCIATE WITH
! THE CURRENT LOCATION
OWN BASE LAB1;
IF .PBFPTR[PBFLABEL] EQL NOLABEL
THEN
%(*****IF THIS IS THE 1ST LABEL TO BE ASSOCIATED WITH THIS LOC****)%
BEGIN
PBFPTR[PBFLABEL]_.LABPTR; !SET 1ST LABEL ASSOCIATED
! WITH THIS LOC TO THIS ONE
LABPTR[SNSTATUS]_INPBUFF; !FLAG IN LABEL ENTRY INDICATING
! THAT THE LOC ASSOCIATED WITH
! THIS LABEL IS CURRENTLY IN THE
! PEEPHOLE BUFFER
LABPTR[SN1STLAB]_.LABPTR; !FOR THIS LABEL, SET THE FIELD INDICATING
! "1ST LABEL ASSOC WITH SAME LOC"
! TO BE THIS LABEL ITSELF
%(***IF THERE ARE ANY LABELS CHAINED TO LABPTR (IE PEEPHOLER HAS
DETERMINED THEM TO BE EQUAL TO LABPTR EVEN THO UNRESOLVED)
SET THE "SNCADDRWD" (WORD INCLUDING STATUS AND PTR TO 1ST
LABEL WITH THE SAME ADDR) TO BE EQUAL TO THOSE OF LABPTR ***)%
LAB1_.LABPTR[SNNXTLAB];
UNTIL .LAB1 EQL LBTBENDMK
DO
BEGIN
LAB1[SNCADDRWD]_.LABPTR[SNCADDRWD];
LAB1_.LAB1[SNNXTLAB];
END;
END
%(***IF SOME OTHER LABEL(S) ARE ALREADY ASSOCIATED WITH THIS INSTR, ADD THIS
LABEL TO THE SET OF LABELS ASSOCIATED WITH THIS INSTR***)%
ELSE
ADDLAB(.LABPTR,.PBFPTR[PBFLABEL]);
END; ! of DEFLAB
! The below is for putting through RUNOFF to get a PLM file.
!++
!.END LITERAL
!--
END
ELUDOM