Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
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) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: S. MURPHY/HPW/DCE/TFV/EDS/RVM/AHM/CDM
MODULE CGEXPR(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
GLOBAL BIND CGEXPV = 7^24 + 0^18 + #1607; ! Version Date: 4-Aug-82
%(
***** 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.
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
FORWARD
OBUFF,
OBUFFA,
CGEXCIOP,
CGETVAL,
MRFDATA,
MRFARREF,
MRFEXPR,
MRFCSB,
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,
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,
%761% OPP21I,
%1251% OPSSEP,
OUTMDA,
OUTMOD,
PBFPTR,
PBOPWD,
PBUFF,
PC,
PEEPOPTIMZ,
PEEPPTR,
PROPNEG, ! Routine to propagate a neg over arithmetic and
! typecnv nodes
PSYMPTR,
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
PEEPOPTIMZ();
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
%(***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;
%(***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();
%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
ROUTINE MRFDATA=
BEGIN
!***************************************************************
! For a data node, target field specifies memref for
! instruction, pointer to the node is the symbol table pointer
! to output
!***************************************************************
PBOPWD = .PBOPWD + .REFNODE[IDTARGET];
! Test for a formal parameter that is never copied to a local
IF .REFNODE[OPERSP] EQL FORMLVAR AND .REFNODE[IDATTRIBUT(NOALLOC)]
THEN PSYMPTR = PBFNOSYM
ELSE PSYMPTR = .REFNODE;
END; ! of MRFDATA
ROUTINE MRFARREF=
BEGIN
!***************************************************************
! For a numeric ARRAYREF node, target field specifies MEMREF
! field for instruction, ARG1PTR under the node points to the
! symbol table entry
!
! For a character array ref, use the .Dnnn descriptor pointing
! to the result of the reference.
!***************************************************************
MAP OBJECTCODE PBOPWD;
MAP BASE PSYMPTR; ! Ptr to symbol table entry
REGISTER PEXPRNODE ARRSYMENTRY; ! Array name symbol table entry
%1567% IF .REFNODE[VALTYPE] EQL CHARACTER
%1567% THEN
%1567% BEGIN ! Character array
%1567%
%1567% PSYMPTR = .REFNODE[TARGADDR]; ! .Dnnn for result
%1567% PBOPWD = .PBOPWD + .PSYMPTR[IDADDR]; ! of array ref
%1567%
%1567% END ! Character array
%1567% ELSE
%1567% BEGIN ! Numeric array
ARRSYMENTRY = .REFNODE[ARG1PTR];
! Add the address and offset from the node to those from
! the table. Suppress overflow into the index field
PBOPWD[OBJADDR] = .PBOPWD[OBJADDR]+.REFNODE[TARGADDR];
! Add the index and indirect fields from the
! node to those from the table
PBOPWD[OBJIXF] = .PBOPWD[OBJIXF] + .REFNODE[TARGIXF];
! If the array is a formal, address field of instruction
! will not be relocated. Otherwise, use the symbol
! table entry for the ARRAYNAME
IF .ARRSYMENTRY[FORMLFLG]
THEN PSYMPTR = PBFNOSYM
ELSE PSYMPTR = .ARRSYMENTRY;
%1567% END; ! Numeric array
END; ! of MRFARREF
ROUTINE MRFEXPR=
BEGIN
!**************************************************************
! For BOOLEAN, RELATIONAL, ARITHMETIC, FNCALL, TYPECNV, NEG/NOT,
! and special-case nodes, the value may be either in a register
! or a temporary. If in a register, that register is the memref
! field and PSYMPTR field is 1. If in a temporary, the target
! field of the node points to the temporary table entry from
! which the address must be retrieved. The pointer to the
! temporary table entry becomes the PSYMPTR.
!**************************************************************
MAP BASE PSYMPTR; ! Pointer to symbol table entry
! Set index and indirect fields of instruction from those of target
PBOPWD = .PBOPWD + GETTXFI(REFNODE);
! If the target memref field is using an ac as a memory
! location, 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; ! of MRFEXPR
ROUTINE MRFCSB=
BEGIN
!***************************************************************
! For a common subexpression node - always use the right half of
! the target (even if INREGFLG is set - this is necessary for
! double precision operations on KA10 where the second argument
! for the double precision routine must not be in a register)
!***************************************************************
MAP BASE PSYMPTR; ! Pointer to symbol table entry
IF .REFNODE[TARGADDR] LEQ #17
THEN
BEGIN ! Common sub is in a register
PBOPWD = .PBOPWD + .REFNODE[TARGADDR];
PSYMPTR = PBFNOSYM;
END ! Common sub is in a register
ELSE
BEGIN ! Common sub is in a temporary
PSYMPTR = .REFNODE[TARGADDR];
PBOPWD = .PBOPWD + .PSYMPTR[IDADDR];
END ! Common sub is in a temporary
END; ! of MRFCSB
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
[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
![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
%(***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
%1431% MRFEXPR(); !SUBSTRING
%1474% MRFEXPR(); !CONCATENATION
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; ! 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
END
ELUDOM