Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/cgdo.bli
There are 12 other files named cgdo.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 NORMA ABEL/HPW/MD/DCE/SJW/RDH/TFV
MODULE CGDO(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
GLOBAL BIND CGDOV = 6^24 + 0^18 + 145; ! Version Date: 23-Jul-81
%(
***** Begin Revision History *****
119 ----- ----- MAKE ARGGEN A GLOBAL ROUTINE
120 ----- ----- IN "CGRETURN", WHEN LOOK FOR NEXT STMNT AFTER
THE RETURN EQUAL TO END, SKIP OVER AN INTERVENING CONTINUE
121 ----- ----- IN "CGRETURN", WHEN CHECKING THE SRCID OF NXTSTMNT,
MUST FIRST CHECK THE NXTSTMNT NEQ 0
122 ----- ----- IN "CGRETURN", GENERATE A RETURN WHEN THERE
ARE LABEL ARGUMENTS IN ALL CASES
123 ----- ----- FIX ARGGEN TO PERMIT MULTIPLE LEVEL PASSING
OF SUBPROGRAM NAMES
124 ----- ----- FIX 123 (I HOPE)
125 ----- ----- CHANGE REFERENCES TO PROEPITYP
126 ----- ----- PUT OUT TYPE CODE WITH LABEL ARGUMENTS
127 ----- ----- GIVE ERROR MESSAGES FOR MULTIPLE RETURN
WHEN THERE WERE NO LABEL PARAMS; AND
FOR VALUE OF A FN NEVER DEFINED
128 ----- ----- MESSAGE FOR VAL OF FN UNDEFINED SHOULD NOT
BE GIVEN FOR A STMNT FN
129 ----- ----- MACRO SET1ZGEN MISSPELLED IN CGRETURN
130 ----- ----- FIX CALLS TO FATLERR TO INCLUDE .ISN
131 ----- ----- WHEN /DEB:TRACE WAS SPECIFIED, FOR STMNT FNS
AND ENTRIES THE XCT FDDT. MUST BE GENERATED AFTER
THE ENTRY NAME IS DEFINED.
132 ----- ----- IN "CGPROEPI", SHOULD CLEAR PBFISN FIELD
BEFORE OUTPUT SIXBIT FOR ENTRY NAME; SET
IT TO THE STMNT ISN BEFORE THE 1ST INSTRUCTION
133 ----- ----- GENERATE COMMON SUBS ON DO STMNTS
134 256 15493 DO NOT LOOK FOR LABEL DUMMIES IN STATEMENT FUNCTIONS,
(JNT)
135 323 16729 USE .A00NN FOR NAME OF TEMPORARY USED TO SAVE
REGISTERS IN PROLOGUE OF A FUNCTION, (MD)
136 360 18243 FIX RETURN BEFORE CONTINUE, END STMNTS, (DCE)
***** Begin Version 5A *****
137 607 22685 SET GLOBAL FLAG NEDZER IN CGSBPRGM TO INDICATE
ZERO-ARG-BLOCK NEEDED
140 613 QA2114 IGNORE INDIRECT BIT IN FORMAL FUNCTION TARGET
ON ENTRY PROLOGUE, (SJW)
***** Begin Version 5B *****
141 674 11803 TEST FOR DOSTAK OVERFLOW AND GIVE ERROR MSG, (DCE)
142 677 25573 GENERATE CODE TO CHECK FOR CORRECT
NUMBER OF PARAMETERS IF DEBUG:PARAM SET, (DCE)
***** Begin Version 6 *****
143 750 TFV 1-Jan-80 ------
remove Debug:parameters (edit 677)
144 761 TFV 1-Mar-80 -----
Remove KA10FLG and add in /GFLOATING
145 1002 TFV 1-Jul-80 ------
MAP EVALU onto EVALTAB to get the argtype for argblock entries
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
%*****
CODE GENERATOR DRIVERS FOR DO LOOPS
*****%
GLOBAL ROUTINE CGDOLOOP=
BEGIN
EXTERNAL CGCMNSUB; !GEN CODE FOR COMMON SUBS
EXTERNAL TREEPTR,A1NODE,A2NODE,OPDSPIX,REGFORCOMP,CGOPGEN,CSTMNT,DEFLAB,GENLAB;
EXTERNAL CGERR,DOSTI;
%[761]% EXTERNAL CGETVAL,OPGETI,DOSP,OPGSTI,DOSTC;
MAP BASE DOSP:A1NODE:CSTMNT:TREEPTR;
EXTERNAL E144,FATLERR,DOSTAK; ![674] ERROR MESSAGE DECLARATIONS
OWN PEXPRNODE DOCEXPR; !PTR TO EXPRESSION FOR CONTROL WD
LOCAL CTLREG, !CONTROL WORD REGISTER
IVALREG; !INITIAL VALUE REGISTER
IF .CSTMNT[SRCCOMNSUB] NEQ 0 !IF HAVE ANY COMMON SUBS
THEN CGCMNSUB(); ! GEN CODE FOR THEM
!SET UP LOCAL VALUES
CTLREG_.CSTMNT[DOCREG]^23;
IVALREG_.CSTMNT[DOIREG]^23;
%(***GET THE VAL OF THE CONTROL EXPRESSION INTO THE LOOP CTL REG***)%
DOCEXPR_.CSTMNT[DOLPCTL];
A1NODE_.DOCEXPR;
%(***IF THE CTL EXPR NEEDS TO BE EVALUATED AT RUN TIME, GENERATE
CODE TO EVALUATE IT***)%
IF .DOCEXPR[OPRCLS] NEQ DATAOPR
THEN
BEGIN
TREEPTR_.DOCEXPR;
CGETVAL();
END;
%(***GET THE VALUE OF THE CTL EXPRESSION INTO THE LOOP CTL REG***)%
IF NOT .CSTMNT[CTLSAMEFLG]
THEN
BEGIN
REGFORCOMP_.CTLREG;
A1NODE_.DOCEXPR;
IF .CSTMNT[FLCWD] THEN !IF THE CTL IS IN AN AOBJN WD
%[761]% OPDSPIX_OPGETI
ELSE
OPDSPIX_DOGETAOPIX(.CSTMNT[CTLIMMED],
.A1NODE[VALTP1],.CSTMNT[CTLNEG]);
CGOPGEN();
END;
!CONTROL WORD IS NOW IN A REGISTER
!GET THE INTIALIAL VALUE IN ONE IF NECESSARY
IF NOT .CSTMNT[FLCWD] THEN
BEGIN
REGFORCOMP_.IVALREG;
A1NODE_.CSTMNT[DOM1]; !INITIAL VALUE
%(***IF THE INITIAL VAL IS NOT IN THE REG FOR THE DO INDEX, PUT IT THERE**)%
IF .A1NODE[OPRCLS] EQL REGCONTENTS
AND .A1NODE[TARGTAC] EQL .CSTMNT[DOIREG]
THEN
BEGIN END
ELSE
BEGIN
IF .CSTMNT[INITLIMMED] THEN
OPDSPIX_DOGETAOPIX(1,.A1NODE[VALTP1],.CSTMNT[INITLNEG])
ELSE
OPDSPIX_DOGETAOPIX(0,.A1NODE[VALTP1],.CSTMNT[INITLNEG]);
CGOPGEN();
END
END;
%(***IF THIS LOOP MUST HAVE ITS COUNT-CTL VAR MATERIALIZED, GENERATE CODE TO
STORE THE COUNT ***)%
IF .CSTMNT[NEDSMATRLZ] OR .CSTMNT[MATRLZCTLONLY]
THEN
BEGIN
%(***GENERATE CODE TO STORE THE COUNT***)%
A1NODE_.CSTMNT[DOCTLVAR];
REGFORCOMP_.CTLREG;
OPDSPIX_DOSTC + .CSTMNT[FLCWD];
CGOPGEN();
END;
%(***IF THIS LOOP MUST HAVE ITS INDEX MATERIALIZED, GENERATE CODE
TO STORE THE INDEX***)%
IF .CSTMNT[NEDSMATRLZ] OR .CSTMNT[MATRLZIXONLY]
THEN
BEGIN
%(***GENERATE THE MATERIALIZATION LABEL***)%
DOSP[LEFTP]_GENLAB();
DEFLAB(.DOSP[LEFTP]);
!NOW STORE INITIAL VALUE
!USING OPGNTA TABLES TO GET DOUBLE PRECISION UNLESS ITS AN HRRM
IF .CSTMNT[FLCWD] THEN
BEGIN
A1NODE_.CSTMNT[DOSYM]; !INDUCTION VARIABLE
REGFORCOMP_.CTLREG;
OPDSPIX_DOSTI;
CGOPGEN();
END ELSE
BEGIN
REGFORCOMP_.IVALREG;
TREEPTR_.CSTMNT[DOSYM];
OPDSPIX_STOROPIX(TREEPTR);
CGOPGEN();
END;
END;
!NOW GENERATE NON-MATERIALIZATION LABELS
DOSP[RIGHTP]_GENLAB();
DEFLAB(.DOSP[RIGHTP]);
DOSP_.DOSP+1;
![674] TEST FOR STACK OVERFLOW, AND ISSUE MESSAGE IF NECESSARY
%[674]% IF (.DOSP-DOSTAK) GTR TDOSTSIZ THEN FATLERR(.ISN,E144<0,0>);
END;
GLOBAL ROUTINE CGDOEND(TLAB)=
BEGIN
LABEL DODOER;
EXTERNAL CGERR;
![761] OPGARG for /GFLOATING code generation
EXTERNAL CGOPGEN,OPDSPIX,REGFORCOMP,TREEPTR,A1LABEL,A2LABEL,
%[761]% A1NODE,A2NODE,DOSP,DOEND,OPGARG,OPGARI,OPGDOE;
%[761]% EXTERNAL OPGETI,OPGDOS;
MAP BASE TLAB;
MAP BASE A1NODE:DOSP:A2NODE:TREEPTR;
!TLAB POINTS TO LABEL TABLE ENTRY FOT LABEL TERMINATING THE SCOPE OF
!ONE OR MORE DO STATEMENTS.
!SNDOLNK POINTS TO A LINKED LIST OF THE DO STATEMENTS TERMINATING
!HERE
LOCAL CURDO, !THE CURRENT DO LOOP
NXTWD, !WORD CONTAINING LINK AND DO POINTER
NXTLNK, !WORD CONTAINING LINK TO NEXT WORD
TMP1;
MAP BASE CURDO:TMP1:NXTWD:NXTLNK;
IF .TLAB[SNDOLVL] EQL 0 THEN RETURN; !NO DO'S END HERE
NXTWD_.TLAB[SNDOLNK]; !POINT AT FIRST OF LIST
DODOER:
WHILE 1 DO
BEGIN
CURDO_.NXTWD[LEFTP];
!IF THE LOOP IS STILL THERE
IF NOT .CURDO[DOREMOVED] THEN
BEGIN
DOSP_.DOSP-1;
!LOOK AT THE CORRECT STACK ENTRY
!DETERMINE WHICH LABEL TO TRANSFER TO AT LOOP ENDING
! IF THE INDEX IS MATERIALIZED, TRANSFER TO MATERIALIZ LABEL
IF .CURDO[NEDSMATRLZ] OR .CURDO[MATRLZIXONLY] THEN
A1LABEL_.DOSP[LEFTP]
ELSE
A1LABEL_.DOSP[RIGHTP];
IF .A1LABEL EQL 0 THEN CGERR();
%(***FOR THE AOBJN CASE - THE CONTROL WD AND THE LOOP INDEX ARE INCREMENTED
TOGETHER***)%
IF .CURDO[FLCWD] AND NOT .CURDO[NEDSMATRLZ]
THEN
BEGIN
A1NODE_.CURDO[DOCTLVAR]; !TEMP FOR CONTOL WORD
REGFORCOMP_.CURDO[DOCREG]^23;
OPDSPIX_OPGDOE;
!GENERATE AOBJN CREG,A1LABEL
END ELSE
%(***FOR CASES OTHER THAN AOBJN - MUST GENERATE CODE TO INCREMENT
THE LOOP INDEX AND CODE TO INCREMENT AND TEST THE CONTROL-WORD***)%
BEGIN
%(***GENERATE CODE TO ADD THE STEP SIZE TO THE LOOP INDEX***)%
REGFORCOMP_.CURDO[DOIREG]^23;
!IF THE LOOP INDEX IS NOT MATERIALIZED, WILL SIMPLY GENERATE
! AN ADD OF THE INCR TO THE REG HOLDING THE INDEX
IF NOT .CURDO[NEDSMATRLZ] AND NOT .CURDO[MATRLZIXONLY]
THEN
BEGIN
A2NODE_.CURDO[DOSSIZE]; !PTR TO INCR
OPDSPIX_(IF (.CURDO[SSIZONE] OR .CURDO[SSIZIMMED])
AND .A2NODE[VALTYPE] NEQ DOUBLPREC
THEN DOARITHOPIX(.A2NODE[VALTP1],0,1,.CURDO[SSIZNEGFLG])
ELSE DOARITHOPIX(.A2NODE[VALTP1],0,0,.CURDO[SSIZNEGFLG]) );
CGOPGEN();
END
!IF THE LOOP INDEX IS MATERIALIZED AND THE INCREMENT IS
! 1, GENERATE AOS
ELSE
IF (.CURDO[SSIZONE] AND NOT .CURDO[REALARITH])
OR .CURDO[FLCWD]
THEN
BEGIN
A1LABEL_.DOSP[RIGHTP];
!NON-MATRLIZE LABEL
OPDSPIX_OPGDOS;
A1NODE_.CURDO[DOSYM];
CGOPGEN();
END
!IF THE LOOP INDEX NEEDS TO BE MATERIALIZED, PICK UP THE
! INCREMENT AND THEM ADD IT TO MEMORY IF VALTYPE IS NOT DOUBLE-PREC
ELSE
BEGIN
!TO LOAD THE INCREMENT
A1NODE_.CURDO[DOSSIZE];
OPDSPIX_(IF (.CURDO[SSIZONE] OR .CURDO[SSIZIMMED])
AND .A1NODE[VALTYPE] NEQ DOUBLPREC
THEN DOGETAOPIX(1,.A1NODE[VALTP1],.CURDO[SSIZNEGFLG])
ELSE DOGETAOPIX(0,.A1NODE[VALTP1],.CURDO[SSIZNEGFLG]) );
CGOPGEN();
!UNLESS THE INDEX IS DOUBLE-PREC WILL ADD THE
! INCREMENT TO IT IN BOTH THE REG USED AND MEMORY,
! AND TRANSFER AT LOOP
! END WILL BE TO THE CODE AFTER THE MATERIALIZATION CODE
A2NODE_.CURDO[DOSYM];
IF .A2NODE[DBLFLG]
THEN OPDSPIX_DOARITHOPIX(.A2NODE[VALTP1],0,0,0)
ELSE
BEGIN
A1LABEL_.DOSP[RIGHTP];
OPDSPIX_DOARBOTHOPIX(.A2NODE[VALTP1]); !INDEX TO GENERATE
!ADD TO BOTH FOR REAL OR INTEGER
END;
CGOPGEN();
END;
!GENERATE CODE TO INCREMENT AND TEST THE CONTROL WORD
!AOJL
!OR
!AOSGE
!JRST
!THE CONTROL REGISTER IS USED
REGFORCOMP_.CURDO[DOCREG]^23;
!CODE TO BE GENERATED DEPENDS ON WHETHER THE CTL-COUNT WD
! IS MATERIALIZED
OPDSPIX_OPGDOE+2+(.CURDO[NEDSMATRLZ] OR .CURDO[MATRLZCTLONLY]);
A1NODE_.CURDO[DOCTLVAR];
END;
CGOPGEN();
END; !DO LOOP REALLY THERE TEST
NXTLNK_.NXTWD[RIGHTP];
IF .NXTLNK EQL 0 THEN LEAVE DODOER
ELSE
NXTWD_.NXTLNK;
END; !WHILE 1 LOOP
END; !CGDOEND;
!MACRO CREATES 3 SIXBIT CHARACTERS OF SUBROUTINE NAME TO
!BE USED IN FORMING TEMPORARY NAMES. THE NAMES ARE PREFIXED WITH
!A . AND SUFFIXED WITH THE NUMBERS 2-17.
!2-16 ARE FOR REGISTER SAVES.
!17 IS FOR THE EPILOGUE ADDRESS IF THERE ARE MULTIPLE ENTRIES
!MACRO GETXXX=
! (.PROGNAME<30,6>^24
! +(IF .PROGNAME<24,6> EQL 0 THEN 16
! ELSE .PROGNAME<24,6>)^18
! +(IF .PROGNAME<18,6> EQL 0 THEN 16
! ELSE .PROGNAME<18,6>)^12)$;
!ADD THE DOT AND NUMBER WITH THE MACRO TNAME
!MACRO TNAME DEFINES .A00NN TEMP NAMES TO SAVE THE REGISTERS
!USED IN THE FUNCTION. THE USE OF .XXXNN WHERE XXX IS THE
!FIRST THREE CHARS OF THE FUNCTION NAME IS DELETED
!BECAUSE IT HAD CONFLICTS WITH FUNCTIONS NAMED F OR Q
!OR ANY OTHER TEMP NAMES USED BY THE COMPILER.
MACRO TNAME(INDX)=
!MAKE IT .A00NN WHERE NN IS THE REGISTER NUMBER
(SIXBIT '.A00'
+((INDX AND #70)^(-3)+16)^6
+((INDX AND #7)+16))$;
!GENERATE A MOVE 1,SRCE
MACRO MOV1GEN(SRCE)=
BEGIN
EXTERNAL C1H;
OPDSPIX_MOVRET;
C1H_SRCE;
CGOPGEN();
END$;
!GENERATE THE VALUE TO ADD TO THE VALUE OF THE PARAMETER LIST
!BASE FOR A RETURN I
MACRO DATAGEN(NUMB)=
BEGIN
PSYMPTR_PBF2NOSYM;
!THE WORD WILL HAVE 16 IN THE REGISTER FIELD
PBOPWD_#16^18 OR NUMB;
OBUFFA();
END$;
MACRO ENTLST=ENTLIST$; !TO CORRECT TYPING ERROR
!OWN VARIABLE
OWN EPILAB,JUMPABOUT,JMPVECT,LABARGCT,JMPSFN;
EXTERNAL LASTONE;
GLOBAL ROUTINE CGPROEPI =
BEGIN
OWN PEXPRNODE ENTNAME;
%(*********************************
SUBROUTINE PROLOGUE
AND EPILOGUE
*********************************)%
!TEMPORARY NAMES ARE OF THE FORM
!.XXXNN, WHERE:
! 1. XXX IS THE FIRST 3 LETTERS OF THE SUBROUTINE NAME
! 2. NN IS 2-16 (DECIMAL)
LABEL FNLOK;
LOCAL ARGLSTPT,NEDTOSAV;
EXTERNAL OPGADJ,A2LABEL;
EXTERNAL OPGMVL;
%[761]% EXTERNAL A1LABEL,OPGPHR,OPGPPR,DVALU,OPINSI,CLOBBREGS;
EXTERNAL OUTMOD,PBFPTR,PBUFF,PBOPWD,OBUFF,OBUFFA,PSYMPTR,C1H;
EXTERNAL CSTMNT,NAME,TBLSEARCH,ENTRY,GENLAB,DEFLAB,POPRET,CRETN,PROGNAME;
%[761]% EXTERNAL CGOPGEN,OPDSPIX,REGFORCOMP,TREEPTR, A1NODE, OPINDI,OPGETI,OPGSTI;
EXTERNAL XCTFDDT;
MAP PPEEPFRAME PBFPTR;
EXTERNAL ARGLINKPT;
MAP PEXPRNODE CSTMNT:A1NODE;
MAP ARGUMENTLIST ARGLSTPT;
MAP PEEPFRAME PBUFF;
EXTERNAL OUTMDA,OPGIIN;
EXTERNAL CGEPILOGUE; !ROUTINE TO GENERATE EPILOGUE CODE
PBFPTR[PBFISN]_NOISN; !REMOVE THE SEQ NUMBER FROM THE NEXT INSTR (INSTEAD IT
! WILL GO ON THE 1ST INSTR AFTER THE ENTRY PT)
JUMPABOUT_0;
!IF AN ENTRY THEN JRST AROUND PROLOGUE
!AND EPILOQUE
IF .CSTMNT[SRCID] EQL SFNID THEN
BEGIN
JMPSFN_GENLAB();
JRSTGEN(.JMPSFN);
!USE A1NODE AS A TEMP
!TO MAKE AND SAVE THE LABEL FOR THE SFN THAT
!WILL BE USED IN THE PUSHJ AT REFERENCE TIME
A1NODE_.CSTMNT[SFNNAME];
A1NODE[IDSFNLAB]_GENLAB();
END;
IF .CSTMNT[ENTNUM] NEQ 0 AND .CSTMNT[SRCID] NEQ SFNID THEN
BEGIN
JUMPABOUT_GENLAB();
JRSTGEN(.JUMPABOUT);
END;
%(***OUTPUT ANY INSTRS REMAINING IN THE PEEPHOLE BUFFER (AND INITIALIZE
THE PTR TO NEX AVAILABLE WD IN BUFFER TO THE 1ST WD OF BUFFER)***)%
IF .PBFPTR NEQ PBUFF
THEN
BEGIN
OUTMOD(PBUFF,(.PBFPTR-PBUFF)/PBFENTSIZE);
PBUFF[PBFLABEL]_NOLABEL; !INIT LABEL FIELD OF 1ST INSTR
PBFPTR_PBUFF;
END;
%(***CLEAR "ISN" FIELD IN PEEPHOLE BUFFER - WANT THE ISN ON
THE 1ST INSTR, NOT ON THE SIXBIT***)%
PBFPTR[PBFISN]_NOISN;
%(***OUTPUT SIXBIT FOR THE ENTRY NAME. USE THE OUTPUT ROUTINE "OBUFFA" TO
BYPASS THE PEEPHOLE OPTIMIZER***)%
ENTNAME_.CSTMNT[ENTSYM];
PBOPWD_.ENTNAME[IDSYMBOL];
PSYMPTR_PBF2NOSYM;
OBUFFA();
%(***MUST NOW CLEAR THE PEEPHOLE BUFFER AGAIN BEFORE START PEEPHOLING***)%
IF .PBFPTR NEQ PBUFF
THEN
BEGIN
OUTMDA(PBUFF,(.PBFPTR-PBUFF)/PBFENTSIZE);
PBFPTR_PBUFF;
PBUFF[PBFLABEL]_NOLABEL;
END;
!THERE SHOULD BE ONLY ONE SUBROUTINE OR FUNCTION PER
!COMPILATION UNIT
!SAVE THE EPILOGUE ADDRESS IF NECESSARY
!MAKE THE ENTRY NAME A GLOBAL FOR THE LOADER
IF .CSTMNT[SRCID] NEQ SFNID THEN
BEGIN
PBOPWD_.CSTMNT[ENTSYM];
PSYMPTR_PBFENTRY;
OBUFF();
END
ELSE
BEGIN
A1NODE_.CSTMNT[SFNNAME];
DEFLAB(.A1NODE[IDSFNLAB]);
END;
PBFPTR[PBFISN]_.CSTMNT[SRCISN]; !INTERNAL SEQ NUMBER OF
! THE ENTRY STMNT GOES ON THE 1ST INSTRUCTION
! OF THE ENTRY SEQUENCE
!IF THE USER SPECIFIED /DEB:TRACE, GENERATE "XCT FDDT."
IF .FLGREG<DBGTRAC> THEN XCTFDDT();
!DEFINE THE EPILOGUE LABEL
EPILAB_GENLAB();
!IF MULTIPLE ENTRIES
IF .FLGREG<MULTENT> THEN
BEGIN
REGFORCOMP_1^23; !HOPE TO GENERATE
A1LABEL_.EPILAB; !MOVEM 1, XXX17
OPDSPIX_OPGMVL;
NAME_IDTAB;
ENTRY_TNAME(#17);
A1NODE_TBLSEARCH();
CGOPGEN();
END;
!REGISTER SAVE
!SAVE REGISTER 16 EXCEPT IF ITS A STATEMENT FUNCTION
! OR A FUNCTION THAT DOES NOT CALL FOROTS OR ANY OTHER FUNCTIONS
!USE PUSHES FOR SFN,S MOVEMS OTHERWISE
IF .CSTMNT[SRCID] EQL SFNID THEN
OPDSPIX_OPGPHR !STORE THE OTHER REGS USING "PUSH"
ELSE
IF NOT (.BTTMSTFNFLG AND .IOFIRST EQL 0 AND NOT .LIBARITHFLG)
THEN
BEGIN
%[761]% OPDSPIX_OPGSTI;
NAME_IDTAB;
ENTRY_TNAME(#16);
TREEPTR_TBLSEARCH();
REGFORCOMP_#16^23;
CGOPGEN();
END
%[761]% ELSE OPDSPIX_OPGSTI; !WILL STORE ANY OTHER REGS USING "MOVEM"
!NOW IF IT IS A FUNCTION
FNLOK:
IF .FLGREG<PROGTYP> EQL FNPROG THEN
BEGIN
NEDTOSAV_LASTONE(.CLOBBREGS);
IF .NEDTOSAV LSS 0 THEN LEAVE FNLOK;
DECR I FROM .NEDTOSAV TO 2 DO
BEGIN
IF .CSTMNT[SRCID] EQL ENTRID THEN
BEGIN
NAME_IDTAB;
ENTRY_TNAME(.I);
TREEPTR_TBLSEARCH();
END;
REGFORCOMP_.I^23;
CGOPGEN();
END;
END;
!MOVE ARGS TO TEMPS
!ADDRESS OF TEMP IS IN SYMBOL TABLE FOR ARGUMENT
REGFORCOMP_0;
IF .CSTMNT[ENTLST] NEQ 0 THEN
BEGIN
ARGLSTPT_.CSTMNT[ENTLST];
INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
BEGIN
TREEPTR_
A1NODE_.ARGLSTPT[.I,ARGNPTR];
IF .A1NODE EQL 0 THEN !ZERO MEANS LABEL
ELSE
IF .ARGLSTPT[.I,ENTNOCOPYFLG] !IF NO LOCAL COPY IS TO BE MADE OF THIS PARAM
THEN BEGIN END ! DO NOTHING
ELSE
BEGIN
IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR) THEN
!MOVE VALUE OF SCALAR TO REGISTER
BEGIN
%[761]% OPDSPIX_.A1NODE[VALTP1]+OPINDI;
%[761]% C1H _ INDBIT OR (.I-1);
END ELSE
BEGIN
OPDSPIX_OPGIIN;
C1H_INDBIT OR (.I-1);
END;
!PICK UP REGISTER FROM ENTAC FIELD
REGFORCOMP_.ARGLSTPT[.I,ENTAC]^23;
CGOPGEN(); !VALUE NOW IN A REGISTER
!NOW STORE VALUE OR POINTER IN TEMP
IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR) THEN
%[761]% OPDSPIX_.A1NODE[DBLFLG]+OPGSTI
ELSE
%[761]% OPDSPIX_OPGSTI;
!ONLY DO STORE IF NOT GLOBALLY ALLOCATED
IF NOT .ARGLSTPT [.I, ENTGALLOCFLG]
THEN BEGIN
NEDTOSAV _ .A1NODE [IDTARGET] AND INDBIT; ! SAVE CURRENT INDIRECT FLAG OF FORMAL
A1NODE [IDTARGET] _ .A1NODE [IDTARGET] AND (NOT INDBIT); ! TURN OFF INDIRECT FLAG
CGOPGEN (); ! GENERATE STORE CODE
A1NODE [IDTARGET] _ .A1NODE [IDTARGET] OR .NEDTOSAV; ! RESTORE INDIRECT FLAG
END;
END;
END;
END;
!NOW GENERATE JRST TO FIRST EXECUTABLE STATEMENT
!*************************************************
!*************************************************
!THIS JRST IS SPECIAL
!IF WE ARE GOING TO CREATE A JUMP VECTOR FOR MULTIPLE
!RETURNS, WE MUST OUTPUT THE PEEPHOLE BUFFER BEFORE
!GENERATING THE JRST. ELSE, IT WOULD BE A LABELED
!JRST AND RECEIVE CROSS-JUMPING OPTIMIZATION. SINCE
!THE PEEPHOLE OPTIMIZER ALWAYS LOOKS AT THE THIRD FROM LAST
!INSTRUCTION, MAKING IT THE FIRST INSTRUCTION WILL
!INHIBIT THE PEEPHOLE.
!****************************************************
!*********************************************************
IF .JUMPABOUT EQL 0 THEN !ALREADY HAVE LABEL IF
!JUMPABOUT IS SET
JUMPABOUT_GENLAB();
!IF THERE WERE LABEL DUMMY ARGS
IF .FLGREG<LABLDUM> THEN
!MAKE THIS JRST THE BASE OF THE JUMP VECTOR
BEGIN !SO WE DONT WASTE A SPACE
!*************************
!HERE IS THE SPECIAL OUTPUT OF THE BUFFER
!****************************
OUTMOD(PBUFF,(.PBFPTR-PBUFF)/PBFENTSIZE);
PBFPTR_PBUFF;
PBUFF[PBFLABEL]_NOLABEL;
JMPVECT_GENLAB();
DEFLAB(.JMPVECT);
END;
!NOW JRST TO FIRST EXECUTABLE
!IF THERE ARE LABEL ARGS AND HENCE A JUMP VECTOR
IF .FLGREG<LABLDUM>
OR .FLGREG<MULTENT> !OR MULTIPLE ENTRIES
! THIS ENTRY FOLLOWS THE PROLOGUE)
THEN
JRSTGEN(.JUMPABOUT); ! GENERATE A "JRST" TO THE 1ST EXECUTABLE INSTR
!NOW THE REST OF THE JUMP VECTOR IF NEEDED
IF .CSTMNT[SRCID] NEQ SFNID !DON'T NEED IT IF
THEN !IT'S AN ARITHMETIC STATEMENT FUNCTION
BEGIN
LABARGCT_0;
IF .FLGREG<LABLDUM> THEN
BEGIN
!FIRST OUTPUT THE JRST, IT MUST GO THRU
!OUTMOD.
OUTMOD(PBUFF,1);
PBFPTR_PBUFF;
PBUFF[PBFLABEL]_NOLABEL;
IF .CSTMNT[ENTLST] NEQ 0 THEN
BEGIN
ARGLSTPT_.CSTMNT[ENTLST];
INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
BEGIN
IF .ARGLSTPT[.I,ARGNPTR] EQL 0 THEN !ITS A LABEL
BEGIN
LABARGCT_.LABARGCT+1;
DATAGEN(.I-1);
END;
END;
END;
!NOW OUTPUT THE JUMP VECTOR THROUGH OUTMDA
OUTMDA(PBUFF,.LABARGCT);
PBFPTR_PBUFF;
END;
END; !END OF IF STATEMENT FUNCTION
%(**FOR MULTIPLE ENTRY SUBROUTINES, GENERATE THE EPILOGUE RIGHT AFTER
THE PROLOGUE FOR EACH ENTRY**)%
IF .FLGREG<MULTENT>
THEN CGEPILOGUE(.CSTMNT);
!DEFINE FIRST EXECUTABLE
DEFLAB(.JUMPABOUT); !DEFINE LABEL OF FIRST EXECUTABLE
!IF THERE ARE MULTIPLE ENTRIES (THE RETURN WILL BE AN
!INDIRECT JRST) THEN MAKE EPILAB POINT TO THE TEMP
!IN WHICH THE EPILOGUE ADDRESS IS STORED
IF .FLGREG<MULTENT> THEN
BEGIN
NAME_IDTAB;
ENTRY_TNAME(#17);
EPILAB_TBLSEARCH();
END;
END; !END OF ROUTINE "CGPROEPI"
GLOBAL ROUTINE CGEPILOGUE(ENTSTMN)=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR FUNCTION/SUBROUTINE EPILOGUE.
"ENTSTMN" POINTS TO THE ENTRY STATEMENT TO WHICH
THIS EPILOGUE CORRESPONDS
***************************************************************************)%
BEGIN
EXTERNAL FATLERR,E131;
EXTERNAL A1NODE,A1LABEL,A2LABEL,C1H,
OPDSPIX,REGFORCOMP,CGOPGEN; !BASIC CODE GEN ROUTINE AND THE GLOBALS IN WHICH IT
! TAKES ITS PARAMETERS
EXTERNAL PROGNAME;
MAP PEXPRNODE A1NODE;
%[761]% EXTERNAL OPGETI,POPRET,CRETN,
%[761]% OPINSI,OPGPPR; !INDICES INTO THE CODE GENERATION TABLE
EXTERNAL GENLAB,DEFLAB,CLOBBREGS,TBLSEARCH;
EXTERNAL NAME;
MAP BASE ENTSTMN;
REGISTER ARGUMENTLIST ARGLSTPT;
!DEFINE THE EPILOGUE LABEL DEFINED BY THE GLOBAL "EPILAB"
DEFLAB(.EPILAB);
!RESTORE REGISTER 16
!STATEMENT FUNCTIONS AND BOTTOMMOST FUNCTIONS WONT RESTORE 16
IF .ENTSTMN[SRCID] EQL SFNID OR
(.BTTMSTFNFLG AND .IOFIRST EQL 0 AND NOT .LIBARITHFLG)
THEN
ELSE
BEGIN
NAME_IDTAB;
ENTRY_TNAME(#16);
A1NODE_TBLSEARCH();
%[761]% OPDSPIX_OPGETI;
REGFORCOMP_#16^23;
CGOPGEN();
END;
!FOR LABELS AS PARAMETERS GENERATE THE COMPLEX RETURN
IF .FLGREG<LABLDUM> THEN
BEGIN
A2LABEL_.JMPVECT;
A1LABEL_GENLAB(); !LABEL FOR OUT OF BOUNDS
C1H_.LABARGCT;
OPDSPIX_CRETN;
CGOPGEN();
DEFLAB(.A1LABEL);
END;
!NOW MOVE SCALARS BACK
!NOT NECESSARY FOR STATEMENT FUNCTIONS
IF .ENTSTMN[ENTLST] NEQ 0 AND .ENTSTMN[SRCID] NEQ SFNID THEN
BEGIN
REGFORCOMP_0;
ARGLSTPT_.ENTSTMN[ENTLST];
INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
BEGIN
A1NODE_.ARGLSTPT[.I,ARGNPTR];
IF .A1NODE EQL 0 THEN
ELSE IF .ARGLSTPT[.I,ENTNOCOPYFLG] !IF NO LOCAL COPY WAS MADE
! OF THIS ARG
THEN BEGIN END
ELSE
!ONLY MOVE THEM BACK IF THEY WERE
!STORED INTO, ELSE WE ARE IN TROUBLE
!WITH GENERATING HISEG STORES
IF .A1NODE[IDATTRIBUT(STORD)] THEN
IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR) THEN
BEGIN
!THINGS ARE DIFFERENT IF GLOBAL
!ALLOCATION OF AN ARGIMENT HAS
!OCCURRED
IF NOT .ARGLSTPT[.I,ENTGALLOCFLG] THEN
BEGIN
!LOCAL CASE
!SET REGFORCOMP
REGFORCOMP_(IF .ENTSTMN[VALINR0] THEN
1^23 ELSE 0);
C1H_INDBIT OR (.I-1);
%[761]% OPDSPIX_.A1NODE[VALTP1]+OPGETI;
CGOPGEN();
%[761]% OPDSPIX_.A1NODE[DBLFLG]+OPINSI;
CGOPGEN();
END ELSE
BEGIN
!GLOBALLY ALLOCATED
REGFORCOMP_.ARGLSTPT[.I,ENTAC]^23;
C1H_INDBIT OR (.I-1);
%[761]% OPDSPIX_.A1NODE[DBLFLG]+OPINSI;
CGOPGEN();
END;
END;
END;
END;
!RESTORE REGISTERS IF NEED BE
IF .ENTSTMN[SRCID] EQL SFNID THEN
OPDSPIX_OPGPPR
ELSE
%[761]% OPDSPIX_OPGETI;
NAME_IDTAB;
IF .FLGREG<PROGTYP> EQL FNPROG THEN
BEGIN
!***********************************
!NOTE:
!SINCE STATEMENT FUNCTIONS PUSH AND POP
!FOR REGISTER SVAE RESTORE THESE MUST
!BE SYMETRICALLY REVERSE TO THE SAVE
!CODE IN THE PROLOGUE
!************************************
INCR I FROM 2 TO LASTONE(.CLOBBREGS) DO
BEGIN
IF .ENTSTMN[SRCID] EQL ENTRID THEN
BEGIN
ENTRY_TNAME(.I);
A1NODE_TBLSEARCH();
END;
REGFORCOMP_.I^23;
CGOPGEN();
END;
A1NODE_.ENTSTMN[ENTSYM]; !NAME OF FN
IF NOT .A1NODE[IDATTRIBUT(STORD)] !IF THE FN VALUE IS NEVER STORED
AND NOT .ENTSTMN[SRCID] EQL SFNID
THEN FATLERR(.ISN,E131<0,0>);
!PICK UP RETURN FUNCTION VALUE
!IF NOT ALREADY PUT THERE BY GLOBAL ALLOCATOR
IF NOT .ENTSTMN[VALINR0] THEN
BEGIN
REGFORCOMP_0;
%[761]% OPDSPIX_.A1NODE[VALTP1]+ OPGETI;
CGOPGEN();
END;
END;
OPDSPIX_POPRET;
CGOPGEN();
END; !END OF ROUTINE "CGEPILOGUE"
!MACRO TO GENERATE AN INDIRECT JRST THROUGH A VRIABLE
!DIFFERS FROM JRSTIGEN IN THE SETTING OF PSYMPTR
MACRO JRSTIVAR(ADDR)=
BEGIN
PBOPWD_JRSTOC OR INDBIT OR ADDR[IDADDR];
PSYMPTR_ADDR;
OBUFF();
END$;
GLOBAL ROUTINE CGRETURN(EXPR)=
BEGIN
%(******************************************
RETURN STATEMENT
EXPR POINTS TO THE RETURN EXPRESSION
******************************************)%
!GENERATE SETZ 1 FOR PLAIN RETURN WHEN THERE ARE LABELS AS PARAMETERS
MACRO SET1ZGEN=
BEGIN
REGFORCOMP_1^23;
OPDSPIX_OPGSET+1;
CGOPGEN();
END$;
EXTERNAL FATLERR,E130;
EXTERNAL MOVRET,CGETVAL;
EXTERNAL PBOPWD,OPDSPIX,PSYMPTR,OBUFF,OPGSET,CGOPGEN,REGFORCOMP;
%[761]% EXTERNAL TREEPTR,A1NODE,CSTMNT,OPGETI,PROGNAME,CGEND;
REGISTER BASE NXTSTMNT; !PTR TO NEXT STMNT
MAP PEXPRNODE TREEPTR:A1NODE:CSTMNT;
MAP BASE EPILAB;
MAP PEXPRNODE EXPR;
%(***IF THIS IS A MULTIPLE RETURN AND THERE WERE NO LABEL ARGS,
GIVE AN ERROR MESSAGE**)%
IF .EXPR NEQ 0 AND NOT .FLGREG<LABLDUM> THEN FATLERR(.ISN,E130<0,0>);
IF (NXTSTMNT_.CSTMNT[CLINK]) NEQ 0 !STMNT FOLLOWING THE RETURN
THEN ! (IF THE RETURN WAS NOT THE BRANCH OF A LOG IF)
BEGIN
IF .NXTSTMNT[SRCID] EQL CONTID !SKIP THE "CONTINUE" INSERTED
! BY THE OPTIMIZER
!MAKE SURE IT IS A DUMMY CONTINUE STATEMENT BY
! CHECKING FOR ZERO SOURCE STATEMENT NUMBER
THEN IF .NXTSTMNT[SRCISN] EQL 0
THEN NXTSTMNT_.NXTSTMNT[CLINK];
!IF THERE ARE NOT LABEL ARGUMENTS AND THE NEXT STATEMENT
!IS IS THE END STATEMENT THEN DO NOT GENERATE
!THE RETURN. IT WILL BE PART OF THE END CODE
IF NOT .FLGREG<LABLDUM> THEN
IF .NXTSTMNT[SRCID] EQL ENDID
THEN RETURN;
END;
!A RETURN THAT APPEARS IN A MAIN PROGRAM SHOULD BE
!TREATED LIKE A CALL EXIT. THIS IS ACCOMPLISHED BY CALLING CGEND
IF .FLGREG<PROGTYP> EQL MAPROG THEN
(CGEND(); RETURN);
!SINGLE ENTRY
IF NOT .FLGREG<MULTENT> THEN
BEGIN
!LABELS OR NOT
IF NOT .FLGREG<LABLDUM> THEN
JRSTGEN(.EPILAB)
ELSE
!LABELS ARE ARGS
BEGIN
IF .EXPR EQL 0 THEN !PLAIN VANILLA RETURN
BEGIN !RETURN THRU A LABEL
SET1ZGEN;
END ELSE
BEGIN
TREEPTR_.EXPR;
IF .TREEPTR[OPRCLS] EQL DATAOPR THEN !EXPRESSION IS DATAITEM
BEGIN
REGFORCOMP_1^23;
A1NODE_.TREEPTR;
%[761]% OPDSPIX_.A1NODE[VALTP1] + OPGETI;
CGOPGEN();
END ELSE
BEGIN
CGETVAL();
!IF THE REGISTER ALLOCATOR DIDNT PUT IT IN 1
!WHICH IT NEVER WILL DO. THEN MOVE IT TO 1
IF .EXPR[TARGTAC] NEQ 1 THEN MOV1GEN(.EXPR[TARGTAC]);
END;
END;
JRSTGEN(.EPILAB);
END;
END ELSE
!MULTIPLE ENTRIES
BEGIN
!LABELS OR NOT
IF NOT .FLGREG<LABLDUM> THEN
JRSTIVAR(.EPILAB)
ELSE
!LABELS AS ARGS WITH MULTIPLE ENTRIES
BEGIN
IF .EXPR EQL 0 THEN !PLAIN VANILLA RETURN
BEGIN
SET1ZGEN;
END ELSE
BEGIN !RETURN THRU A LABEL
TREEPTR_.EXPR;
IF .TREEPTR[OPRCLS] EQL DATAOPR THEN !EXPRESSION IS DATAITEM
BEGIN
REGFORCOMP_1^23;
A1NODE_.TREEPTR;
%[761]% OPDSPIX_.A1NODE[VALTP1] + OPGETI;
CGOPGEN();
END ELSE
BEGIN
CGETVAL();
!IF IT SI NOT ALREADY IN AC1 MOVE IT THERE
IF .EXPR[TARGTAC] NEQ 1 THEN MOV1GEN(.EXPR[TARGTAC]);
END;
END;
JRSTIVAR(.EPILAB);
END;
END;
END;
GLOBAL ROUTINE CGSFN=
BEGIN
!CODE GENERATION FOR STATEMENT FUNCTION
OWN OCSTMNT,OCLOBB,OPRGM,OPE,SFNSYM,OEPILB;
EXTERNAL CSTMNT,CLOBBREGS,PROGNAME,CGASMNT;
MAP BASE CSTMNT:SFNSYM;
EXTERNAL CGPROEPI,CGRETURN,DEFLAB;
!SAVE AWAY PERTINENT GLOBALS
OCLOBB_.CLOBBREGS;
OPRGM_.PROGNAME;
OPE_.FLGREG<0,36>;
OCSTMNT_.CSTMNT;
OEPILB_.EPILAB;
!ADJUST FLGREG
FLGREG<PROGTYP>_FNPROG;
FLGREG<MULTENT>_0;
FLGREG<LABLDUM>_0;
CLOBBREGS<LEFT>_.CSTMNT[SFNCLBREG];
SFNSYM_.CSTMNT[SFNNAME];
PROGNAME_.SFNSYM[IDSYMBOL];
CGPROEPI(); !GENERATE PROLOGUE & EPILOGUE
CSTMNT_.CSTMNT[SFNEXPR];
CGASMNT(); !GENERATE CODE FOR STATEMENT
CGEPILOGUE(.OCSTMNT); !GENERATE THE EPILOGUE CODE
!PUT SAVED VALUES BACK
CLOBBREGS_.OCLOBB;
PROGNAME_.OPRGM;
FLGREG<0,36>_.OPE;
CSTMNT_.OCSTMNT;
EPILAB_.OEPILB;
DEFLAB(.JMPSFN);
END;
GLOBAL ROUTINE CGSBPRGM(ARLISTT,NAMEP)=
BEGIN
%(******************************
PERFORM VITAL CODE GENERATION
FOR CALLS, FUNCTION REFERENCES
AND STATEMENT FUNCTION REFERENCES
AND LIBRARY FUNCTION REFERENCES
******************************)%
EXTERNAL ARGLINKPT,GENLAB,CGOPGEN,OPDSPIX,A1LABEL,A2LABEL;
EXTERNAL TREEPTR,CGETVAL,OPGSFN,ZERBLK;
EXTERNAL NEDZER; ! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
%[761]% EXTERNAL A1NODE,CALLER,TBLSEARCH,REGFORCOMP,OPGSTI;
MAP BASE NAMEP;
MAP ARGUMENTLIST ARLISTT;
!ARLISTT IS A POINTER TO THE ARGUMENT LIST.
!NAMEP IS A POINTER TO THE SYMBOL TABLE
! ENTRY FOR THE ROUTINE NAME.
!LINK INTO ARGLIST
!FIRST CHECK FOR THE PRESENCE OF ARGUMENTS
IF .ARLISTT NEQ 0 THEN
BEGIN
IF .ARGLINKPT NEQ 0 THEN ARLISTT[ARGLINK]_.ARGLINKPT;
ARGLINKPT_.ARLISTT;
!GENERATE CODE TO EVALUATE ARGUMENTS, IF NEEDED
INCR I FROM 1 TO .ARLISTT[ARGCOUNT] DO
BEGIN
REGISTER BASE T;
T_.ARLISTT[.I,ARGNPTR]; !PICK UP ARG PTR
IF NOT .ARLISTT[.I,AVALFLG]
THEN
BEGIN
TREEPTR_.T;
CGETVAL();
END ELSE
BEGIN
!IF ITS A REGISTER AND A LIBRARY FUNCTION
!STASH IT AWAY IN MEMORY. IF ITS A REGISTER
!AND NOT A LIBRARY FUNCTION THEN YOU LOSE
IF .T[OPRCLS] EQL REGCONTENTS THEN
BEGIN
MAP PEXPRNODE TREEPTR;
TREEPTR_.T[ARG2PTR];
REGFORCOMP_.T[TARGTAC]^23;
OPDSPIX_STOROPIX(TREEPTR);
CGOPGEN();
!TAKE THE REGCONTENTS NODE OUT
!SO THE ARG LIST WILL BE RIGHT
ARLISTT[.I,ARGNPTR]_.T[ARG2PTR];
END;
END;
END;
!SHOULD TEST FOR THIS BEING A LIBRARY FUNCTION
!TO GENERATE A DIFFERENT NAME. NOT IN RELEASE 1.
!**********************************
A1LABEL_ARLISTT[ARGLABEL]_GENLAB();
END ELSE !FOR ARGUMENTS ONLY
!IN THE CASE OF NO ARGS REFERENCE A 2 WORD, DEFINED ONLY ONCE
!ZERO ARG BLOCK
(NEDZER _ 1; A1LABEL_.ZERBLK;); ! FLAG ZERO-ARG-BLOCK NEEDED
!FOR A FORMAL FUNCTION SET THE INDIRECT BIT IN TH SYMBOL TABLE
IF .NAMEP[IDATTRIBUT(DUMMY)] THEN
NAMEP[TARGET]_.NAMEP[TARGET] OR INDBIT;
IF .NAMEP[IDATTRIBUT(SFN)] THEN
BEGIN
A2LABEL_.NAMEP[IDSFNLAB];
OPDSPIX_OPGSFN;
END ELSE
BEGIN
A1NODE_.NAMEP;
OPDSPIX_CALLER;
END;
CGOPGEN();
END;
GLOBAL ROUTINE ARGGEN(PTR)=
BEGIN
MAP PEXPRNODE PTR;
EXTERNAL EVALU,OBUFFA,PSYMPTR,PBOPWD,CGERR;
%[1002]% MAP EVALTAB EVALU;
MAP OBJECTCODE PBOPWD;
!FOR A FORMAL ARRAY TURN ON THE INDIRECT BIT
IF .PTR[OPR1] EQL OPR1C(DATAOPR,FORMLARRAY) THEN
BEGIN
PSYMPTR_.PTR;
![1002] fold in /GFLOATING to get arg type
%[1002]% PBOPWD_.EVALU[.PTR[VALTYPE]]^23+.PTR[IDADDR]+INDBIT;
END ELSE
IF .PTR[OPRCLS] EQL DATAOPR THEN
BEGIN
!IF IT IS A FORMAL AND ALSO DECLARED EXTERNAL WE WANT
!TO SET THE INDIRECT BIT ON THE ARGLIST. IT MAY ALREADY
!HAVE BEEN SET IF IT WAS PREVIOUSLY REFERENCED AS A
!FORMAL FUNCTION. THAT IS WAY THERE IS AN OR INSTEAD
!OF A +.
IF .PTR[FORMLFLG] AND .PTR[IDATTRIBUT(INEXTERN)] THEN
BEGIN
![1002] fold in /GFLOATING to get arg type
%[1002]% PBOPWD_.EVALU[.PTR[VALTYPE]]^23 + .PTR[TARGTMEM]
OR INDBIT;
PSYMPTR_.PTR;
END ELSE
BEGIN
![1002] fold in /GFLOATING to get arg type
%[1002]% PBOPWD_.EVALU[.PTR[VALTYPE]]^23 + .PTR[TARGTMEM];
PSYMPTR_.PTR;
END;
END ELSE
IF .PTR[OPRCLS] EQL LABOP THEN
BEGIN
PBOPWD_ADDRTYPE^23+.PTR;
PSYMPTR_PBFLABREF;
END ELSE
IF .PTR[OPRCLS] EQL ARRAYREF
THEN
BEGIN
%(***FOR AN ARRAYREF, THE TARGET FIELD OF THE EXPRESSION NODE CONTAINS
THE RELATIVE ADDRESS. ARG1PTR POINTS TO THE SYMBOL
TABLE ENTRY***)%
![1002] fold in /GFLOATING to get arg type
%[1002]% PBOPWD_.EVALU[.PTR[VALTYPE]]^23 + .PTR[TARGADDR];
PSYMPTR_.PTR[ARG1PTR];
%(***AN ARRAYREF-NODE IS FOUND DIRECTLY UNDER AN EXPRESSION NODE
ONLY IF THE ADDRESS CALCULATION IS ENTIRELY CONSTANT.
(IF THERE IS A VARIABLE PART, WILL HAVE INSERTED A NODE
TO STORE A PTR TO THE ELEMENT INTO A TEMPORARY)***)%
IF .PTR[ARG2PTR] NEQ 0 THEN CGERR();
END
ELSE
BEGIN
REGISTER BASE T; !A TEMP
!PICK UP THE TEMP IN WHICH THE RESULT VALUE WILL
!WILL BE STORED. THIS IS THE *REAL* ARG
T_.PTR[TARGADDR];
PSYMPTR_.T;
![1002] fold in /GFLOATING to get arg type
%[1002]% PBOPWD_.EVALU[.PTR[VALTYPE]]^23+.T[IDADDR];
PBOPWD[OTSIND]_.PTR[TARGIF];
END;
OBUFFA();
END;
GLOBAL ROUTINE CGARGS=
BEGIN
%(******************************
AT THE END OF A BLOCK
GENERATE ARGUMENT LISTS AND
CONSTANTS NOT ALREADY GENERATED
******************************)%
EXTERNAL CGOPGEN,DVALU,OPDSPIX,C1H;
LABEL ARGBLK;
EXTERNAL ARGLINKPT,DEFLAB,PBOPWD;
LOCAL ARGLSTPT,ARGCT,ARGS;
MAP BASE ARGLINKPT:ARGS;
EXTERNAL PSYMPTR,OBUFFA;
MAP ARGUMENTLIST ARGLSTPT;
!INSERT TEST FOR REALLY END OF
!PROGRAM AND OTHERWISE GENERATE A
!JRST AROUND
WHILE .ARGLINKPT NEQ 0 DO
ARGBLK:
BEGIN
ARGLSTPT_.ARGLINKPT;
!WATCH OUT FOR STATEMENTS THAT MAY HAVE
!BEEN DELETED BY FOLDING. ARGLABEL IS 0 FOR
!THESE STATEMENTS.
IF .ARGLSTPT[ARGLABEL] NEQ 0 THEN
BEGIN
ARGCT_.ARGLSTPT[ARGCOUNT];
PBOPWD_-.ARGCT^18;
PSYMPTR_PBF2NOSYM;
OBUFFA();
PBOPWD_0;
DEFLAB(.ARGLSTPT[ARGLABEL]);
INCR I FROM 1 TO .ARGCT DO
BEGIN
ARGS_.ARGLSTPT[.I,ARGNPTR];
ARGGEN(.ARGS);
PBOPWD_0;
END;
END;
ARGLINKPT_.ARGLINKPT[CLINK]; !WHEN DONE THIS WILL BE
!REINITIALIZED TO 0
END;
END;
END
ELUDOM