Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/cgexpr.bli
There are 26 other files named cgexpr.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY/HPW/DCE/TFV/EDS
MODULE CGEXPR(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
GLOBAL BIND CGEXPV = 6^24 + 0^18 + 76; ! Version Date: 23-Jul-81
%(
***** 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.
***** End Revision History *****
)%
![761] OPGARG, OPGSPG, OPGTCG for /GFLOATING code generation
EXTERNAL CGERR,OUTMOD, PEEPOPTIMZ, CGSBPRGM, CGARREF,
%[761]% OPCMGET,OPGETI,OPGARI,OPGARG,OPGSTI,OPGN1I,OPGN2I,
OPGDBF,OPGDB1, !FOR DABSIN LINE
%[761]% OPGSPG,OPGSPI,OPGSPM,OPP21I,OPCUBI,OPGILF,OPGILI,OPGIL1,OPGSTC,
OPGBOO,OPGSET,OPGVTS,OPGALT,OPGREL,OPGTCG,OPGTCI,
OPGENDISP;
FORWARD CGEXCIOP(0);
FORWARD CGETVAL(0), CGOPGEN(0), CGARGEVAL(0),CGILF(0), CGVBOOL(0),
CGCBOOL(2), CGREL1(1), CGJMPC(2), DEFLAB(0);
EXTERNAL PROPNEG; !ROUTINE TO PROPAGATE A NEG OVER ARITH AND TYPECNV NODES,
! FOUND IN MODULE UTIL
EXTERNAL GENLAB;
EXTERNAL TREEPTR,CSTMNT,A1NODE,A2NODE,A1LABEL,A2LABEL,A3LABEL,C1H,
OPDSPIX,REGFORCOMP,PC,PBOPWD,
PSYMPTR,GBYSREGS,RESNAME;
EXTERNAL NEWENTRY;
EXTERNAL PBUFF,PBFPTR,PEEPPTR;
EXTERNAL ADDLAB;
EXTERNAL OPGSTD;
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
%(***MAP STRUCTURES ONTO THE GLOBAL PTRS USED TO LOOK AT THE CURRENT NODE
IN THE TREE AND ITS 2 SUBNODES***)%
MAP PEXPRNODE TREEPTR:A1NODE:A2NODE;
MAP BASE CSTMNT;
%(*********SET UP PEEPHOLE BUFFER********************)%
MAP VECTOR PBUFF;
BIND PBFEND=PBUFF+PBFENTSIZE*PBFENTCT; !PTR TO THE WD AFTER THE END OF THE LAST
! ENTRY IN THE PEEPHOLE BUFFER
MAP PPEEPFRAME PBFPTR; !PTR TO NEXT AVAILABLE WD IN PEEPHOLE BUFFER
! (WHEN THE BUFFER IS FULL, THIS WILL ALWAYS PT TO AN EXTRA
! WD AFTER THE END OF THE BUFFER
! THIS WD WILL OFTEN CONTAIN A LABEL CORRESPONDING
! TO THE NEXT INSTR TO BE GENERATED
MAP PEEPFRAME PBUFF;
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
PEEPOPTIMZ();
END;
END;
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
EXTERNAL OUTMDA;
%(***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;
GLOBAL ROUTINE CGEXCIOP=
%(**********************************************************************
ROUTINE TO GENERATE CODE FOR SPECOP EXCIOP
CALLED WITH TREEPTR, A1NODE, A2NODE, REGFORCOMP
SET UP
**********************************************************************)%
BEGIN
EXTERNAL OPGEX,OPGEXM,OPGEXS,OPGXPI; !GENERATORS
![761] Indices for /GFLOATING code generation
%[761]% EXTERNAL OPGXG,OPGXGM,OPGXGS;
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;
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
%(***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
REGFORCOMP_GETTXF(CNODE);
A1NODE_.CNODE[ARG2PTR];
TREEPTR_.CNODE;
OPDSPIX_GETA2OPIX(CNODE,A1NODE);
CGOPGEN();
END;
END;
%(***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;
%(***FOR STORECLS - THESE ARE NODES TO CAUSE A PTR
TO AN ARRAY ELEMENT OR THE CONTENTS OF AN ARRAY ELEMENT
TO BE STORED IN A TEMPORARY
*********)%
BEGIN
%(***EVALUATE THE EXPRESSION TO BE STORED***)%
TREEPTR_.CNODE[ARG2PTR];
CGETVAL();
TREEPTR_.CNODE;
A2NODE_.CNODE[ARG2PTR];
REGFORCOMP_GETTAC(CNODE);
OPDSPIX_STCLSOPIX(CNODE);
CGOPGEN();
END;
%(***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();
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;
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 IDICATE 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
OWN PEXPRNODE REFNODE; !INDICATES WHICH EXPRESSION NODE
! SPECIFIES THE MEMREF FIELD TO BE USED
! (MAY BE ARG1, ARG2, OR PARENT)
%[1006]% EXTERNAL KISNGL;
%(****DEFINE ROUTINES TO SET UP THE MEMREF FIELD CORRESPONDING TO A
NODE*******)%
%(***FOR A DATA NODE, TARGET FIELD SPECIFIES MEMREF FOR INSTRUCTION,
PTR TO THE "NODE" ITSELF IS THE SYMBOL-TABLE PTR TO OUTPUT***)%
ROUTINE MRFDATA=
BEGIN
PBOPWD_.PBOPWD+.REFNODE[IDTARGET];
IF .REFNODE[OPERSP] EQL FORMLVAR !FOR A FORMAL PARAM
AND .REFNODE[IDATTRIBUT(NOALLOC)] ! THAT IS NOT EVER COPIED TO A LOCAL
THEN PSYMPTR_ PBFNOSYM
ELSE
PSYMPTR_.REFNODE;
![761] Don't fold GFLOATING to KLDP more than once
%[761]% IF .GFLOAT AND NOT .FLGREG<OBJECT>
AND .REFNODE[OPERATOR] EQL REALCONST
THEN
BEGIN
REFNODE[CONST1]_KISNGL(.REFNODE[CONST1],.REFNODE[CONST2]);
REFNODE[CONST2]_0;
END;
END;
%(***FOR AN ARRAYREF NODE, TARGET FIELD SPECIFIES MEMREF FIELD FOR
INSTRUCTION, "ARG1PTR" UNDER THE NODE PTS TO THE SYMBOL-TABLE ENTRY***)%
ROUTINE MRFARREF=
BEGIN
MAP OBJECTCODE PBOPWD;
OWN PEXPRNODE ARRSYMENTRY; !SYMBOL TABLE ENTRY FOR THE ARRAY NAME
ARRSYMENTRY_.REFNODE[ARG1PTR];
PBOPWD[OBJADDR]_.PBOPWD[OBJADDR]+.REFNODE[TARGADDR]; !ADD THE ADDRESS+OFFSET
! FROM THE NODE TO THOSE
!FROM THE TABLE (SUPPRESS OVFL INTO
!THE INDEX FIELD)
PBOPWD[OBJIXF]_.PBOPWD[OBJIXF]+.REFNODE[TARGIXF]; !ADD THE INDEX AND INDIRECT
! FIELDS FROM THE NODE TO THOSE FROM
! THE TABLE
%(***IF THE ARRAY IS A FORMAL, ADDRESS FIELD OF INSTR WILL NOT BE RELOCATED***)%
IF .ARRSYMENTRY[FORMLFLG]
THEN PSYMPTR_PBFNOSYM
%(***OTHERWISE, WILL REFER TO THE SYMBOL TABLES ENTRY FOR THE ARRAY NAME***)%
ELSE
PSYMPTR_.ARRSYMENTRY;
END;
%(***FOR BOOLEAN,RELATIONAL,ARITHMETIC,FN CALL, TYPECNV, NEG/NOT, AND SPECIAL-CASE
NODES - THE VALUE MAY BE EITHER IN A REG OR A TEMPORARY.
IF IN A REG, THAT REG IS MEMREF FIELD AND PSYMPTR FIELD IS "1".
IF IN A TEMPORARY, THE TARGET FIELD OF THE NODE PTS TO THE TEMPORARY
TABLE ENTRY FROM WHICH THE ADDR MUST BE RETRIEVED
THE PTR TO THE TEMPORARY TABLE ENTRY BECOMES THE PSYMPTR
*********)%
ROUTINE MRFEXPR=
BEGIN
%(***SET INDEX AND INDIRECT FIELDS OF INSTRUCTION FROM THOSE OF TARGET***)%
PBOPWD_.PBOPWD+GETTXFI(REFNODE);
%(***IF THE TARGET-MEMREF IS USING AN AC AS A CORE-LOC***)%
%(*****THEN THERE IS NO SYMBOLIC REPRESENTATION *****)%
IF .REFNODE[INREGFLG]
THEN
BEGIN
PBOPWD_.PBOPWD+.REFNODE[TARGTAC];
PSYMPTR_PBFNOSYM;
END
ELSE
BEGIN
PSYMPTR_.REFNODE[TARGADDR];
PBOPWD_.PBOPWD + .PSYMPTR[IDADDR];
END;
END;
%(***FOR A COMMON SUBEXPR NODE - ALWAYS USE THE RIGHT HALF OF THE TARGET
(EVEN IF INREGFLG IS SET - THIS IS NECESSARY FOR DOUBLE-PREC OPS ON KA10
WHERE THE 2ND ARG FOR THE DOUBLE-PREC ROUTINE MUST NOT BE IN A REG)
*******)%
ROUTINE MRFCSB=
BEGIN
IF .REFNODE[TARGADDR] LEQ #17
THEN
BEGIN
%(***IF RH OF TARGET INDICATES THAT CSB IS ONLY IN A REG***)%
PBOPWD_.PBOPWD+.REFNODE[TARGADDR];
PSYMPTR_PBFNOSYM;
END
ELSE
BEGIN
%(***IF THE CSB HAS BEEN STORED IN A TMP***)%
PSYMPTR_.REFNODE[TARGADDR];
PBOPWD_.PBOPWD+.PSYMPTR[IDADDR];
END
END;
[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***)%
PSYMPTR_PBFIMFN;
%(***4 MEANS USE THE IMPLICIT FN NAME POINTED TO BY THE PATTERN WD INDEXED
BY THE "REGFORCOMP" - (E.G. A DIFFERENT LIBRARY ROUTINE IS USED
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***)%
BEGIN
PBOPWD_.PBOPWD+.REGFORCOMP^(-23);
PSYMPTR_PBFIMFN;
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
PBOPWD_.PBOPWD +
(IF .A1NODE[VALTP1] EQL INTEG1
THEN (.A1NODE[CONST2] AND #777777)
!ROUND UP REAL IMMEDIATE CONSTANT BEFORE LISTING IT
ELSE
![761] Don't round /GFLOATING to KLDP more than once
%[761]% IF .FLGREG<OBJECT>
%[761]% THEN .A1NODE[CONST1]^(-18)
%[761]% ELSE (KISNGL(.A1NODE[CONST1],.A1NODE[CONST2])^(-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
PBOPWD_.PBOPWD +
(IF .A2NODE[VALTP1] EQL INTEG1
THEN (.A2NODE[CONST2] AND #777777)
ELSE
![1006] Don't round /GFLOATING to KLDP more than once
%[1006]% IF .FLGREG<OBJECT>
%[1006]% THEN .A2NODE[CONST1]^(-18)
%[1006]% ELSE (KISNGL(.A2NODE[CONST1],.A2NODE[CONST2])^(-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
PBOPWD_.PBOPWD +
(IF .A1NODE[VALTP1] EQL INTEG1
THEN (-.A1NODE[CONST2]) AND #777777
ELSE
![1006] Don't round /GFLOATING to KLDP more than once
%[1006]% IF .FLGREG<OBJECT>
%[1006]% THEN (-.A1NODE[CONST1])^(-18)
%[1006]% ELSE (-KISNGL(.A1NODE[CONST1],.A1NODE[CONST2])^(-18)));
PSYMPTR_PBFNOSYM;
END;
%(***8 (#10) MEANS USE THE NEG OF THE IMMED CNST A2NODE***)%
BEGIN
PBOPWD_.PBOPWD +
(IF .A2NODE[VALTP1] EQL INTEG1
THEN (-.A2NODE[CONST2]) AND #777777
ELSE
![1006] Don't round /GFLOATING to KLDP more than once
%[1006]% IF .FLGREG<OBJECT>
%[1006]% THEN (-.A2NODE[CONST1])^(-18)
%[1006]% ELSE (-KISNGL(.A2NODE[CONST1],.A2NODE[CONST2])^(-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
%(***IF REFNODE IS A TYPE-CONVERSION NODE THAT GENERATES NO CODE (IS ONLY
TO SPECIFY VALTYPE), MOVE DOWN TO THE ARG UNDER REFNODE***)%
IF .REFNODE[OPRCLS] EQL TYPECNV
THEN
BEGIN
IF NOCNV(REFNODE)
THEN
BEGIN
REFNODE_.REFNODE[ARG2PTR];
WHILE .REFNODE[OPRCLS] EQL TYPECNV AND NOCNV(REFNODE)
DO REFNODE_.REFNODE[ARG2PTR];
END;
END;
CASE .REFNODE[OPRCLS] OF SET
MRFEXPR(); !GET MEMREF FROM A BOOLEAN NODE
MRFDATA(); ! FROM A SYMBOL TABLES ENTRY
MRFEXPR(); ! FROM A RELATIONAL
MRFEXPR(); ! FROM A FN CAL
MRFEXPR(); ! FROM AN ARITH NODE
MRFEXPR(); ! FROM A TYPECNV NODE
MRFARREF(); ! FROM AN ARRAYREF NODE
MRFCSB(); ! FROM A COMMON SUB NODE
MRFEXPR(); ! FROM A NEG/NOT NODE
MRFEXPR(); ! FROM A SPECIAL-CASE NODE
BEGIN END; ! FROM A FIELD-REF NODE (NOT IMPLEMENTED
! IN RELEASE 1)
MRFEXPR(); ! FROM A STORECLS NODE
( PBOPWD_.PBOPWD+.REFNODE[TARGTAC];
PSYMPTR_PBFNOSYM); !FROM A REGCONTENTS NODE
CGERR(); !REFNODE SHOULD NEVER BE A LABEL
CGERR(); !REFNODE SHOULD NEVER BE A STMNT
CGERR(); !REFNODE SHOULD NEVER BE AN IOLIST ELEM
MRFEXPR(); !FOR AN IN-LINE-FN
TES;
END;
%(****OUTPUT THE INSTR FORMED TO THE PEEPHOLE BUFFER***)%
OBUFF();
%(***INCREMENT AOBJN PTR INTO THE OPGEN TABLE****)%
OPGENPTR_.OPGENPTR+1;
OPGENPTR_.OPGENPTR+AOBINCR; !ADD 1,,1
END
WHILE .OPGENPTR LSS 0;
END;
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;
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];
TREEPTR_.CNODE;
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;
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;
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;
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;
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;
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;
END
ELUDOM