Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/cgstmn.bli
There are 12 other files named cgstmn.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/SJW/TFV/AHM/EGM
MODULE CGSTMN(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
GLOBAL BIND CGSTMV = 6^24 + 0^18 + 142; ! Version Date: 1-Oct-81
%(
***** Begin Revision History *****
105 ----- ----- ADD CODE GENERATION ROUTINES FOR E1LISTCALL AND
E2LISTCALL NODES
106 ----- ----- GENERATE ZERO INCREMENT FOR E1 OR E2 LISTCALL
NODES OUT OF LINE
107 ----- ----- GENERATE CODE FOR COMMON SUBS ON CALL STMNTS
108 ----- ----- FOR A REFERENCE TO A FORMAT STMNT, MAKE THE
PEEPHOLE BUFFER ENTRY POINT TO THE FORMAT STMNT RATHER
THAN SIMPLY CONTAINING THE RELATIVE ADDRESS OF THE STRING
109 ----- ----- FIX CAE1LIST AND CAE2LIST TO CALL IOPTR INSTEAD
OF ARGGEN
110 ----- ----- ADD CODE TO HANDLE ARBITRARY EXPRESSION AS THE VAL
OF AN ARG TO OPEN; ADD CODE TO HANDLE ARBITRARY EXPRESSION
AS A UNIT NUMBER
111 ----- ----- FIX BUG IN 110 (HAD LEFT OUT "FIND" AND "OPEN/CLOSE"
FOR EXPRESSIONS AS UNIT NOS)
112 ----- ----- COMMENT OUT THE ROUTINE "CGRELS" - WE CALL
"CGMTOP" FOR RELEASE STMNTS
113 ----- ----- FIX ERROR CALLS
114 ----- ----- FIX REFERENCES TO PROEPITYP AND PROGNAME
115 ----- ----- FIX CGDCALL TO SET INDIRECT BIT OVER FORMAL
ARRAYS UNDER DATACALL NODES
116 ----- ----- FIX CALLS TO IOPTR IN CAE1LIST AND CAE2LIST TO
CLEAR PBOPWD FIRST
117 ----- ----- CHANGE IOIMMED AS FOLLOWS:
FOROTS WILL NOW PERFORM THE INDIRECT
FOR ALL ARGUMENTS NOT IMMEDIATE MODE
CONSTANTS
DISTINGUISH IMMEDIATE MODE CONSTANTS FROM
IMMEDIATE MODE ARGUMENTS IN MEMORY
AS FOLLOWS:
CONSTANTS HAVE AN EMPTY LEFT HALF
OTHER VARIABLES HAVE TYPE FIELD SET
ONLY AN ARGUMENT PASSED IN THE FIRST
ELEMENT OF A FORMAL ARRAY
WILL HAVE THE INDIRECT BIT
SET
FOROTS WILL PERFORM AN EXTRA OPERATION
TO LOAD THE RIGHT HALF OF THE ARGUMENT
IN MEMORY
118 ----- ----- DO NOT CALL "IOENDERR" FOR FIND STMNTS,
SIMPLY PUT OUT 2 WDS OF 0 (THE STMNT NODE DOES NOT HAVE END/ERR FIELDS)
119 ----- ----- IN CGSTMN, IF THE FLAG "DBGTRAC" IS SET CALL
XCTFDDT TO GENERATE "XCT FDDT."
120 ----- ----- TAKE OUT CALLS TO FIN. FOR NAMELIST READ/WRITE
122 ----- ----- DONT CALL "XCTFDDT" FOR STMNT FNS AND ENTRIES
UNTIL AFTER THE LABELS ON THEM ARE DEFINED
123 ----- ----- FIX CODE GEN FOR "DIALOG" IN AN OPEN STMNT
124 306 16156 FIX OPEN/CLOSE TO GIVE FOROTS FORMAL ARRAYS RIGHT, (JNT)
125 367 18239 MAKE WRITE(3) GENERATE CORRECT CODE
126 376 18398 PREVENT CGRECNUM FROM CHANGING A1LABEL, (DCE)
***** Begin Version 5A *****
127 532 20323 SET INDIRECT BIT IN ARG BLOCK FOR ARRAY
REF AS ASSOCIATE VARIABLE, (DCE)
130 564 ----- MAKE CGREAD AND CGWRIT SYMMETRICAL:
MAKE CGREAD CHECK FOR NAMELIST ONLY IF IONAME
PTR NEQ 0;
MAKE CGWRIT GENERATE FIN CALL IF UNFORMATTED
131 607 22685 SET GLOBAL FLAG NEDZER IN CGEND, CGSTOP & CGPAUS
TO INDICATE ZERO-ARG-BLOCK NEEDED
***** Begin Version 5B *****
132 711 26754 PUT OUT FIN CALL WITH ENCODE/DECODE, (DCE)
***** Begin Version 6 *****
133 760 TFV 1-Oct-79 ------
Generate new argument blocks for I/O and OPEN/CLOSE statements
Arg blocks are now keyword based not positional
134 761 TFV 1-Mar-80 -----
Choose arg type based on /GFLOATING
135 1002 TFV 1-Jul-80 ------
MAP EVALU onto EVALTAB to get the argtype for argblock entries
136 1035 DCE 10-Dec-80 -----
For .IOLST calls, put out the correct argument count (add COUNTARGS).
138 1076 TFV 8-Jun-81
Allow list-directed I/O without an iolist.
140 1123 AHM 18-Sep-81 Q20-01650
Make CGIOENDERR and OPNFARGS work for IOSTAT=arrayref and IOSTAT=reg
142 1134 EGM 1-Oct-81 10-31654
For READ/WRITE/FIND, generate code for the record number, then the
unit number, since registers were allocated in that order. Also,
preserve the desired value of A1LABEL for FIND (more of edit 376).
***** End Revision History *****
)%
FORWARD
CGASMNT(0),CGAGO(0),CGCGO(0), CGLOGIF(0),CGARIF(0),CGASSI(0),CGCMNSUB(0),
CGPAUSE(0),CGSTOP(0),
CGIOLST(0),CGIOCALL(1),
CGIOLARGS(0),CGDCALL(0),CGSLIST(0),
CGE1LIST(1),CGE2LIST(1),
CAE1LIST(0),CAE2LIST(0),
BLDIOIMWD(1),
CGMTOP(0),CGREAD(0),CGWRIT(0),CGDECO(0),CGENCO(0),CGRERE(0),
CGUNIT(0),CGRECNUM(0),CGFIND(0),
CGCLOS(0),CGOPEN(0),CGEND(0),
IOPTR(1),
%[760]% CNTKEYS(0),
%1123% CGIOSTAT(0);
EXTERNAL CGERR,OUTMOD, PEEPOPTIMZ, CGFNCALL, CGARREF,
%[761]% OPCMGET,OPGETI,OPGARI,OPGSTI,
OPGPAU,OPGSTP,OPGEXI,OPGIOL,OPGREL,OPGBOOL,OPGCGO,OPGCGI,
OPGASR,OPGVTS,OPGAIF,ZERBLK,
NEDZER, ! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
OPGENDISP;
EXTERNAL
CGETVAL,CGOPGEN,
CGARGEVAL,TREEPTR,A1NODE,A2NODE,A1LABEL,C1H,OPDSPIX,REGFORCOMP,CSTMNT;
EXTERNAL
CGCBOOL,GENLAB,DEFLAB,CGREL1;
EXTERNAL CGDOLOOP,CGDOEND,CGPROEPI,CGSFN,CGSBPRGM,CGRETURN,CGARGS;
EXTERNAL
PBOPWD,PSYMPTR,OBUFF,OBUFFA;
%[761]% EXTERNAL OPGASI,OPASIN;
EXTERNAL OPGAI1,OPGAI2;
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
MAP PEXPRNODE TREEPTR:A1NODE:A2NODE;
MAP BASE CSTMNT;
OWN BASE TOPSTMNT; !WHEN HAVE A STATEMENT EMBEDDED INSIDE ANOTHER (EG IN
! LOGICAL IFS) THIS VAR PTS TO THE TOP LEVEL STMNT NODE
GLOBAL ROUTINE CGSTMNT=
%(***************************************************************************
ROUTINE TO PERFORM CODE GENERATION FOR A STATEMENT.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR WHICH CODE
IS TO BE GENERATED.
***************************************************************************)%
BEGIN
EXTERNAL XCTFDDT; !ROUTINE TO GENERATE "XCT FDDT."
EXTERNAL PBFPTR;
MAP PPEEPFRAME PBFPTR;
%(***IF THERE IS A LABEL ON THIS STATEMENT, ASSOCIATE THAT LABEL WITH THE
CURRENT LOCATION***)%
IF .CSTMNT[SRCLBL] NEQ 0
THEN DEFLAB(.CSTMNT[SRCLBL]);
%(***SET ISN FIELD FOR NEXT INSTR TO BE GENERATED TO ISN OF THIS STMNT***)%
PBFPTR[PBFISN]_.CSTMNT[SRCISN];
IF .FLGREG<DBGTRAC> !IF USER SPECIFIED /DEB:TRACE
THEN
( IF .CSTMNT[SRCID] NEQ ENTRID AND .CSTMNT[SRCID] NEQ SFNID
THEN XCTFDDT()); ! GENERATE "XCT FDDT."
%(***GENERATE CODE FOR THE STATEMENT************)%
CASE .CSTMNT[SRCID] OF SET
CGASMNT(); !FOR AN ASSIGNMENT
CGASSI(); ! ASSIGN
BEGIN ! CALL
IF .CSTMNT[SRCCOMNSUB] NEQ 0
THEN CGCMNSUB(); !IF HAVE ANY COMMON SUBS
! GENERATE CODE FOR THEM
CGSBPRGM(.CSTMNT[CALLIST],.CSTMNT[CALSYM]);
END;
BEGIN END; ! CONTINUE
CGDOLOOP(); ! DO
CGPROEPI(); ! ENTRY
CGASMNT(); ! COMMON SUBEXPR - SAME AS ASMNT
JRSTGEN(.CSTMNT[GOTOLBL]); !GOTO
CGAGO(); ! ASSIGNED GOTO
CGCGO(); ! COMPUTED GOTO
CGARIF(); !ARITHMETIC IF
CGLOGIF(); ! LOGICAL IF
CGRETURN(.CSTMNT[RETEXPR]); ! RETURN
CGSTOP(); ! STOP
CGREAD(); ! READ
CGWRIT(); ! WRITE
CGDECO(); ! DECODE
CGENCO(); ! ENCODE
CGRERE(); ! REREAD
CGFIND(); ! FIND
CGCLOS(); ! CLOSE
BEGIN END; ! INPUT (NOT IN RELEASE 1)
BEGIN END; ! OUTPUT (NOT IN RELEASE 1)
CGMTOP(); ! BACKSPACE
CGMTOP(); ! BACKFILE
CGMTOP(); ! REWIND
CGMTOP(); ! SKIP FILE
CGMTOP(); ! SKIP RECORD
CGMTOP(); ! UNLOAD
CGMTOP(); ! RELEASE
CGMTOP(); ! ENDFILE
CGEND(); ! END
CGPAUSE(); ! PAUSE
CGOPEN(); ! OPEN
CGSFN(); ! STATEMENT FN
BEGIN END; ! FORMAT - NO CODE GENERATED
BEGIN END; ! BLT (NOT IN RELEASE 1)
BEGIN END; ! OVERLAY ID
TES;
%(***IF THIS STMNT HAS A LABEL, CHECK FOR WHETHER IT ENDS A DO STMNT***)%
IF .CSTMNT[SRCLBL] NEQ 0
THEN CGDOEND(.CSTMNT[SRCLBL]);
END;
GLOBAL ROUTINE CGASMNT=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR ASSIGNMENT STATEMENTS.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
WHICH CODE IS TO BE GENERATED.
***************************************************************************)%
BEGIN
%(***COMPUTE THE VALUES OF ANY COMMON SUBEXPRS ASSOCIATED WITH THIS STATEMENT***)%
IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();
%(***GET THE VALUE OF THE LEFT HAND SIDE OF THE STATEMENT AND THE ADDRESS
OF THE RIGHT HAND SIDE WITHIN REACH OF ONE INSTRUCTION***)%
IF .CSTMNT[A1VALFLG]
OR (.CSTMNT[MEMCMPFLG] AND .CSTMNT[RVRSFLG]) !IF RHS IS COMPUTED DIRECTLY TO
! MEMORY LOC OF LHS AND VAL OF LHS NEEDNT BE PRELOADED
THEN
BEGIN
IF NOT .CSTMNT[A2VALFLG]
THEN
BEGIN
TREEPTR_.CSTMNT[RHEXP];
CGETVAL();
END;
END
ELSE
IF .CSTMNT[A2VALFLG]
THEN
BEGIN
TREEPTR_.CSTMNT[LHEXP];
CGETVAL();
END
ELSE
IF .CSTMNT[RVRSFLG]
THEN
%(***IF RIGHT-HAND SIDE SHOULD BE EVALUATED FIRST***)%
BEGIN
TREEPTR_.CSTMNT[RHEXP];
CGETVAL();
TREEPTR_.CSTMNT[LHEXP];
CGETVAL();
END
ELSE
%(***IF LEFT-HAND SIDE SHOULD BE EVALUATED FIRST***)%
BEGIN
TREEPTR_.CSTMNT[LHEXP];
CGETVAL();
TREEPTR_.CSTMNT[RHEXP];
CGETVAL();
END;
%(***IF THE RHS WAS NOT COMPUTED DIRECTLY INTO THE MEMORY LOC FOR THE LHS, PICK UP THE
RHS AND STORE IT INTO THE LHS*******)%
IF NOT .CSTMNT[MEMCMPFLG]
THEN
BEGIN
REGFORCOMP_GETASMNREG(CSTMNT);
%(***GET VAL OF RIGHT-HAND SIDE INTO REG FOR COMPUTATION OF THE STMNT***)%
A1NODE_.CSTMNT[RHEXP];
TREEPTR_.CSTMNT;
OPDSPIX_GETA2OPIX(CSTMNT,A1NODE);
CGOPGEN();
%(***STORE THE VALUE FROM REG-FOR-COMPUTATION INTO THE ADDRESS
SPECIFIED BY THE LEFT-HAND-SIDE***)%
IF NOT .CSTMNT[A1SAMEFLG]
THEN
BEGIN
TREEPTR_.CSTMNT[LHEXP];
OPDSPIX_ASNOPIX(CSTMNT,TREEPTR);
CGOPGEN();
END;
END;
END;
GLOBAL ROUTINE CGASSI=
%(***************************************************************************
GENERATE CODE FOR AN ASSIGN STATEMENT.
NOTE THAT THE VARIABLE WILL ALWAYS BE LOADED INTO REGISTER 1
***************************************************************************)%
BEGIN
%(***IF THE ASSIGNED VAR IS AN ARRAYREF, GENERATE CODE TO COMPUTE ITS ADDR***)%
TREEPTR_.CSTMNT[ASISYM];
IF .TREEPTR[OPRCLS] EQL ARRAYREF
THEN
CGETVAL();
%(***COMPUTE THE ASSIGN*******)%
A1NODE_.CSTMNT[ASISYM];
A1LABEL_.CSTMNT[ASILBL];
OPDSPIX_OPASIN;
CGOPGEN();
END;
GLOBAL ROUTINE CGAGO=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR ASSIGNED GOTO STATEMENT.
CALLED WITH "CSTMNT" POINTING TO THE STATEMENT TO BE PROCESSED.
IF A LIST OF LABELS WAS SPECIFIED FOR THIS STMNT,
CODE GENERATED IS:
MOVE 1,VAR
CAIN 1,LAB1
JRST LAB1
CAIN 1,LAB2
JRST LAB2
.
.
IF NOT, THE CODE GENERATED IS
SKIPE 1,VAR
JRST 0(1)
***************************************************************************)%
BEGIN
%(***OPCODES NEEDED FOR CODE FOR ASSIGNED GOTO***)%
BIND
HRRZOC=#550^27,
CAINOC=#306^27,
SKIPEOC=#332^27;
%(***ALWAYS USE REGISTER 1 TO HOLD THE ASSIGNED VAR***)%
BIND AGOREG=1^23;
BIND AGORGIX=1^18;
OWN AGOLSTPTR;
OWN PEXPRNODE AGOVAR;
%(***SET UP THE GLOBALS "PBOPWD" AND "PSYMPTR" USED BY THE OUTPUT ROUTINE
TO INDICATE AN ADDRESS REFERENCE TO THE ASSIGNED VARIABLE***)%
AGOVAR_.CSTMNT[AGOTOLBL];
%(***IF ASSIGNED VAR IS AN ARRAY REFERENCE*****)%
IF .AGOVAR[OPRCLS] EQL ARRAYREF
THEN
BEGIN
TREEPTR_.AGOVAR;
CGETVAL();
PSYMPTR_.AGOVAR[ARG1PTR]; !SYMBOL TABLE ENTRY FOR THE
! ARRAY
PBOPWD_.AGOVAR[TARGET]; !ADDRESS FIELD TO REF THE ARRAY
! ELEMENT DESIRED
END
%(***IF ASSIGNED VAR IS A SCALAR***)%
ELSE
BEGIN
PSYMPTR_.AGOVAR;
PBOPWD_.AGOVAR[IDADDR];
END;
%(****IF NO LIST OF LABELS WAS SPECIFIED******)%
IF .CSTMNT[GOTOLIST] EQL 0
THEN
BEGIN
%(***GENERATE "SKIPE 1,VAR" ***)%
PBOPWD_.PBOPWD OR SKIPEOC OR AGOREG;
OBUFF();
%(***GENERATE JRST 0(1)***)%
PSYMPTR_PBFNOSYM;
PBOPWD_JRSTOC OR AGORGIX;
OBUFF();
END
%(***IF A LIST OF LABELS WAS SPECIFIED***)%
ELSE
BEGIN
%(***GENERATE HRRZ 1,VAR****)%
PBOPWD_.PBOPWD OR HRRZOC OR AGOREG;
OBUFF();
%(***FOR EACH LABEL IN THE LIST, COMPARE REG 1 WITH THE LABEL AND
IF IT IS EQUAL, TRANSFER TO THE LABEL*****)%
AGOLSTPTR_.CSTMNT[GOTOLIST];
DECR CT FROM (.CSTMNT[GOTONUM]-1) TO 0
DO
BEGIN
PBOPWD_CAINOC OR AGOREG OR @.AGOLSTPTR;
PSYMPTR_PBFLABREF;
OBUFF();
JRSTGEN(@.AGOLSTPTR);
AGOLSTPTR_.AGOLSTPTR+1;
END;
END;
END;
GLOBAL ROUTINE CGCGO=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR COMPUTED GOTO.
CODE GENERATED IS:
SKIPLE 01,VAL
CAILE 01,CT
JRST Y
JRST @.(1)
ARG L1
ARG L2
.
.
Y: 1ST INSTR OF NEXT STMNT
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE COMPUTED GOTO STMNT
***************************************************************************)%
BEGIN
OWN BASE NXTSTMNT;
%(***DEFINE OPCODES USED FOR COMPUTED GOTO***)%
BIND SKIPLEOC=#333^27,
CAILEOC=#303^27,
SKIPAOC=#334^27,
ARGOC=JUMPOCD^27; !USE JUMP
%(***ALWAYS USE REGISTER 1 TO HOLD THE COMPUTED VAL***)%
BIND CGOREG=1^23,
CGORGIX=1^18;
OWN PEXPRNODE CGOEXP;
OWN CLOC;
OWN CGOLSTPTR;
%(***COMPUTE THE VALUES OF ANY COMMON SUBEXPRS ASSOCIATED WITH THIS STMNT***)%
IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();
CGOEXP_.CSTMNT[CGOTOLBL];
%(***IF THE EXPRESSION IS NOT A SCALAR OR A COMMON SUB, EVALUATE IT***)%
IF .CGOEXP[OPRCLS] NEQ DATAOPR AND .CGOEXP[OPRCLS] NEQ CMNSUB
THEN
BEGIN
TREEPTR_.CGOEXP;
CGETVAL();
END;
%(***GENERATE THE SKIPLE, CAILE, JRST SEQUENCE***)%
%(******DETERMINE WHAT THE LABEL ON THE NEXT STMNT IS, IF THERE IS NONE, GENERATE ONE***)%
%(*******(NOTE THAT IF THIS STMNT IS EMBEDDED INSIDE AN ARITH OR LOGICAL IF, MUST
LOOK AT THE "TOP-LEVEL" STMNT NODE TO GET A PTR TO THE NEXT STMNT)***)%
NXTSTMNT_(IF .CSTMNT[CLINK] NEQ 0 THEN .CSTMNT[CLINK] ELSE .TOPSTMNT[CLINK]);
A1LABEL_(IF .NXTSTMNT[SRCLBL] NEQ 0 THEN .NXTSTMNT[SRCLBL]
ELSE (NXTSTMNT[SRCLBL]_GENLAB() ) );
A1NODE_.CGOEXP;
C1H_.CSTMNT[GOTONUM];
%(***HAVE A SPECIAL CASE WHEN THE EXPRESSION IS THE LOOP INDEX OF A LOOP IN
WHICH THE INDEX IS STORED IN THE RIGHT HALF OF AN AC
(IN THIS CASE GENERATE:
MOVEI 1,0(LOOPAC)
JUMPLE 1,Y
CAILE 1,CT
JRST Y)
*********)%
IF .CSTMNT[A1IMMEDFLG] AND .CGOEXP[OPRCLS] EQL REGCONTENTS
THEN OPDSPIX_OPGCGI
ELSE OPDSPIX_OPGCGO;
CGOPGEN();
%(***ASSOCIATE A LABEL WITH THE CURRENT LOC***)%
CLOC_GENLAB();
DEFLAB(.CLOC);
%(***GENERATE JRST @CLOC(1)***)%
PBOPWD_JRSTOC OR INDBIT OR CGORGIX OR .CLOC;
PSYMPTR_PBFLABREF;
OBUFF();
%(***FOR EACH LABEL LISTED, GENERTAE "ARG LAB"***)%
PSYMPTR_PBFLABREF;
CGOLSTPTR_.CSTMNT[GOTOLIST];
DECR CT FROM (.CSTMNT[GOTONUM]-1) TO 0
DO
BEGIN
PBOPWD_ARGOC OR @.CGOLSTPTR;
OBUFF();
CGOLSTPTR_.CGOLSTPTR+1;
END;
END;
GLOBAL ROUTINE CGLOGIF=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR LOGICAL IF STATEMENTS.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
WHICH CODE IS TO BE GENERATED.
A LOGICAL IF STATEMENT NODE MAY HAVE THE FLAG "A1NOTFLG" SET, WHICH
MEANS TO TAKE THE "NOT" (COMPLEMENT) OF THE CONDITION SPECIFIED.
BECAUSE "NOT" PROPAGATES OVER BOTH BOOLEANS AND RELATIONALS, IT IS ASSUMED
THAT THIS FLAG WILL NEVER BE SET WHEN THE CONDITION IS A BOOLEAN OR RELATIONAL.
***************************************************************************)%
BEGIN
OWN THENLAB,ELSELAB; !NEW LABEL TABLE ENTRIES
!WHICH WILL BE CREATED TO PROCESS
! THIS STMNT
OWN BASE SUBSTATMNT; !STATEMENT TO BE EXECUTED IF CONDITION HOLDS
OWN BASE SAVSTMNT; !SAVE PTR TO THE LOG IF STATEMENT
OWN PEXPRNODE CONDEXPR; !CONDITIONAL EXPRESSION TO BE TESTED
%(***EVALUATE ANY COMMON SUBEXPRESSIONS UNDER THIS STATEMENT***)%
IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();
SUBSTATMNT_.CSTMNT[LIFSTATE];
CONDEXPR_.CSTMNT[LIFEXPR];
TREEPTR_.CSTMNT[LIFEXPR];
%(*****WHEN THE STATEMENT TO BE EXECUTED IF CONDITION IS TRUE IS A GOTO***)%
IF .SUBSTATMNT[SRCID] EQL GOTOID
THEN
BEGIN
%(****IF THE CONDITION TO BE TESTED IS A RELATIONAL***)%
IF .CONDEXPR[OPRCLS] EQL RELATIONAL
THEN
BEGIN
CGREL1(FALSE); !SKIP NEXT INSTR IF REL IS FALSE
%(***GENERATE A JRST TO THE GOTO-LABEL***)%
JRSTGEN(.SUBSTATMNT[GOTOLBL]);
END
%(***IF THE CONDITION TO BE TESTED IS A BOOLEAN***)%
ELSE
IF .CONDEXPR[OPRCLS] EQL BOOLEAN
THEN
BEGIN
ELSELAB_GENLAB(); !CREATE LABEL TABLE ENTRY FOR LABEL
! TO GO TO IF CONDITION IS FALSE
CGCBOOL(.SUBSTATMNT[GOTOLBL],.ELSELAB);
DEFLAB(.ELSELAB);
END
ELSE
%(***IF CONDITION IS NOT A RELATIONAL OR BOOLEAN, EVALUATE THE CONDEXPR AND
TEST WHETHER IS IS TRUE (SIGN BIT EQUAL 1) OR FALSE(SIGN=0) ***)%
BEGIN
CGETVAL();
%(***TEST VAL OF CONDEXPR,
IF "A1NOTFLG" IS SET, TRANSFER TO GOTO-LABEL IF ARG IS
FALSE, OTHERWISE TRANSFER TO GOTOLABEL IF ARG IS TRUE***)%
OPDSPIX_CNDVTRIX(CONDEXPR,(IF .CSTMNT[A1NOTFLG] THEN FALSE ELSE TRUE));
A1LABEL_.SUBSTATMNT[GOTOLBL];
TREEPTR_.CONDEXPR;
REGFORCOMP_GETTAC(TREEPTR);
CGOPGEN();
END;
END
%(****WHEN STATEMENT TO BE EXECUTED ON TRUE CONDITION IS NOT A GOTO***)%
ELSE
BEGIN
ELSELAB_GENLAB(); !CREATE LABEL TABLE ENTRY FOR LABEL
! TO GO TO WHEN CONDITION IS FALSE
%(***IF CONDITION TO BE TESTED IS A RELATIONAL***)%
IF .CONDEXPR[OPRCLS] EQL RELATIONAL
THEN
BEGIN
CGREL1(TRUE); !SKIP NEXT INSTR IF REL IS TRUE
%(***GENERTAE CODE TO GO TO THE LABEL ON THE CODE FOLLOWING THAT
FOR THE SUBSTATMNT OF THE IF STMNT***)%
JRSTGEN(.ELSELAB);
END
%(***IF THE CONDITION TO BE TESTED IS A BOOLEAN*****)%
ELSE
IF .CONDEXPR[OPRCLS] EQL BOOLEAN
THEN
BEGIN
THENLAB_GENLAB(); !CREATE LABEL TABLE ENTRY FOR LABEL TO
! GO TO WHEN CONDITION IS TRUE
CGCBOOL(.THENLAB,.ELSELAB);
DEFLAB(.THENLAB); !ASSOCIATE THIS LOC WITH THENLAB
END
%(***IF CONDITIONAL EXPRESSION IS NOT A REL OR BOOLEAN, EVALUATE IT AND
TEST WHETHER ITS VAL IS TRUE (SIGN=1) OR FALSE (SIGN=0)***)%
ELSE
BEGIN
CGETVAL();
%(***TEST VAL OF CONDEXPR,
IF "A1NOTFLG" IS SET, TRANSFER TO ELSELAB IF VAL IS TRUE
OTHERWISE TRANSFER TO ELSELAB IF VAL IS FALSE***)%
OPDSPIX_CNDVTRIX(CONDEXPR,(IF .CSTMNT[A1NOTFLG] THEN TRUE ELSE FALSE));
A1LABEL_.ELSELAB;
TREEPTR_.CONDEXPR;
REGFORCOMP_GETTAC(TREEPTR);
CGOPGEN();
END;
%(****GENERATE CODE FOR THE STATEMENT TO BE EXECUTED WHEN THE CONDITION IS TRUE***)%
TOPSTMNT_.CSTMNT; !SAVE A PTR TO THIS "TOP-LEVEL" STMNT
SAVSTMNT_.CSTMNT;
CSTMNT_.SUBSTATMNT;
CGSTMNT();
CSTMNT_.SAVSTMNT; !RESTORE THE GLOBAL CSTMNT
%(***ASSOCIATE THIS LOC WITH THE LABEL TRANSFERED TO WHEN THE CONDITION
IS FALSE****)%
DEFLAB(.ELSELAB);
END;
END;
GLOBAL ROUTINE CGEND=
%(*********************************************************
TO GENERATE CODE FOR AN END STATEMENT
**********************************************************)%
BEGIN
EXTERNAL CGEPILOGUE;
EXTERNAL NEDZER; ! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
EXTERNAL ZERBLK;
!AN END TRIGGERS A CALL TO EXIT ONLY IN A MAIN
!PROGRAM, NOT FOR A SUBPROGRAM
!IN A SUBPROGRAM THE END TRIGGERS A RETURN.
IF .FLGREG<PROGTYP> EQL MAPROG
THEN
BEGIN
NEDZER _ 1; ! FLAG ZERO-ARG-BLOCK NEEDED
A1LABEL_.ZERBLK; !ARGLIST FOR CALL TO EXIT IS ALWAYS
! 0 FOR THE END STMNT
OPDSPIX_OPGEXI;
CGOPGEN();
END
ELSE
!ALSO CHECK FOR A BLOCK DATA SUBPROGRAM
IF .FLGREG<PROGTYP> NEQ BKPROG
THEN
BEGIN
!IF THERE ARE MULTIPLE ENTRIES OR LABELS AS ARGS
IF .FLGREG<MULTENT> OR .FLGREG<LABLDUM>
! HAS MULTIPLE ENTRIES
THEN CGRETURN(0); ! GENERATE CODE TO "RETURN"
!FOR A SINGLE ENTRY SUBPROGRAM GENERATE THE
!EPILOGUE
IF NOT .FLGREG<MULTENT>
THEN
BEGIN
REGISTER BASE TSTMNT;
TSTMNT_.SORCPTR<LEFT>; !PTR TO 1ST STMNT IN PROG
WHILE .TSTMNT[SRCID] NEQ ENTRID
DO
BEGIN
TSTMNT_.TSTMNT[CLINK]; !(SKIP DUMMY CONTINUES)
IF .TSTMNT EQL 0 THEN CGERR() !IF NEVER FIND THE ENTRY
END;
CGEPILOGUE(.TSTMNT); !GENERATE THE EPILOGUE CORRESPONDING TO THIS ENTRY
END;
END
END;
GLOBAL ROUTINE CGSTOP=
%(***************************************************************************
TO GENERATE CODE FOR A STOP STMNT
***************************************************************************)%
BEGIN
EXTERNAL NEDZER; ! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
EXTERNAL ZERBLK;
%(***USE THE ZERO-ARG-BLOCK AS THE ARG BLOCK FOR THIS CALL TO FOROTS***)%
A1LABEL_(IF .CSTMNT[STOPIDENT] EQL 0 !IF DO NOT HAVE A CNST
! TO PRINT OUT, THEN ARGLIST
! FOR EXIT WILL BE 0
THEN (NEDZER _ 1; .ZERBLK) ! FLAG ZERO-ARG-BLOCK NEEDED
ELSE GENLAB() ); !IF HAVE AN ARG TO
! PASS TO EXIT, ASSOCIATE A LABEL
! WITH THE ARGLIST TO BE GENERATED
CSTMNT[STOPLBL]_.A1LABEL; !SAVE LABEL TO BE USED
OPDSPIX_OPGSTP;
CGOPGEN();
END;
GLOBAL ROUTINE CGPAUSE=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR PAUSE
***************************************************************************)%
BEGIN
EXTERNAL NEDZER; ! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
EXTERNAL ZERBLK;
A1LABEL_(IF .CSTMNT[PAUSIDENT] EQL 0 !IF DO NOT HAVE A CNST
! TO PRINT OUT, THEN ARGLIST
! FOR FOROTS "PAUSE" ROUTINE WILL BE 0
THEN (NEDZER _ 1; .ZERBLK) ! FLAG ZERO-ARG-BLOCK NEEDED
ELSE GENLAB() ); !IF HAVE AN ARG TO
! PASS TO FOROTS, ASSOCIATE A LABEL
! WITH THE ARGLIST TO BE GENERATED
CSTMNT[PAUSLBL]_.A1LABEL;
OPDSPIX_OPGPAU;
CGOPGEN();
END;
GLOBAL ROUTINE CGARIF=
%(***************************************************************************
ROUTINE TO GENERATE CODE FOR AN ARITHMETIC IF STATEMENT.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT
FOR WHICH CODE IS TO BE GENERATED.
***************************************************************************)%
BEGIN
EXTERNAL A1LABEL,A2LABEL,A3LABEL; !GLOBALS USED BY THE CODE-GENERATION
EXTERNAL REGFORCOMP,A1NODE,A2NODE; ! TABLE DRIVER
EXTERNAL TREEPTR;
MAP PEXPRNODE A1NODE:A2NODE:TREEPTR;
OWN BASE NXTSTMNT;
OWN PEXPRNODE CONDEXPR; !THE ARITHMETIC EXPRESSION UNDER THIS STMNT
%(***COMPUTE ANY COMMON SUBEXPRESSIONS UNDER THIS NODE***)%
IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();
%(***DETERMINE WHICH (IF ANY) OF THE 3 LABELS ASSOCIATED WITH
THIS NODE ARE EQUAL TO THE LABEL ON THE FOLLOWING STMNT***)%
NXTSTMNT_.CSTMNT[SRCLINK];
CSTMNT[AIFLBNXT]_
BEGIN
IF .CSTMNT[AIFLESS] EQL .NXTSTMNT[SRCLBL]
THEN LLBNXT
ELSE
IF .CSTMNT[AIFEQL] EQL .NXTSTMNT[SRCLBL]
THEN ELBNXT
ELSE
IF .CSTMNT[AIFGTR] EQL .NXTSTMNT[SRCLBL]
THEN GLBNXT
ELSE NOLBNXT
END;
%(***GET PTR TO THE CONDITIONAL EXPRESSION***)%
CONDEXPR_.CSTMNT[AIFEXPR];
TREEPTR_.CONDEXPR;
%(***COMPUTE THE VAL OF THE ARITH EXPR, THEN TEST IT****)%
%(***COMPUTE THE VAL OF THE ARITH EXPR***)%
IF NOT .CSTMNT[A1VALFLG]
THEN CGETVAL();
%(***IF THERE IS A NEG ON THE VALUE, EXCHANGE THE GTR AND LESS LABELS***)%
IF .CSTMNT[A1NEGFLG]
THEN
BEGIN
A1LABEL_.CSTMNT[AIFGTR];
A3LABEL_.CSTMNT[AIFLESS];
A2LABEL_.CSTMNT[AIFEQL];
%(***MODIFY THE "AIFLBNXT" FIELD WHICH INDICATED WHICH OF
THE 3 LABELS IS ON THE NEXT STMNT (CHANGE "GTR LABEL NEXT"
TO "LESS LABEL NEXT", "LESS LABEL NEXT" TO
"GTR LABEL NXT" LEAVE OTHERS UNCHANGED
MODIFY THE "AIFLBEQV" FIELD SO THAT "GTR LABEL SAME
AS EQL LABEL" BECOMES "LESS LABEL SAME AS EQL LABEL"
AND VICE-VERSA
****)%
SWPAIFFLGS(CSTMNT);
END
ELSE
BEGIN
A1LABEL_.CSTMNT[AIFLESS];
A3LABEL_.CSTMNT[AIFGTR];
A2LABEL_.CSTMNT[AIFEQL];
END;
%(***USE THE TABLE-DRIVER TO GENERATE CODE TO TEST THE VAL AND TRANSFER***)%
REGFORCOMP_GETAIFREG(CSTMNT);
OPDSPIX_AIFIX(CSTMNT,CONDEXPR);
A1NODE_.CONDEXPR;
CGOPGEN();
END;
GLOBAL ROUTINE CGCMNSUB=
%(***************************************************************************
GENERATE CODE TO EVLUATE ANY COMMON SUBEXPRESSIONS THAT OCCUR UNDER
THE STATEMENT NODE POINTED TO BY "CSTMNT"
***************************************************************************)%
BEGIN
OWN PEXPRNODE CCMNSUB;
%(***COMPUTE THE VALUES OF ANY COMMON SUBEXPRS ASSOCIATED WITH THIS STATEMENT***)%
CCMNSUB_.CSTMNT[SRCCOMNSUB];
UNTIL .CCMNSUB EQL 0
DO
BEGIN
IF NOT .CCMNSUB[A2VALFLG]
THEN
BEGIN
TREEPTR_.CCMNSUB[ARG2PTR];
CGETVAL();
END;
%(***IF THE COMMON SUBEXPR IS TO BE LEFT IN A DIFFERENT PLACE THAN
THAT INTO WHICH IT WAS COMPUTED, PUT IT THERE.
NOT THAT THIS CAN ONLY OCCUR WHEN THE PLACE IN WHICH
IT IS TO BE LEFT IS A REGISTER.
*******)%
IF NOT .CCMNSUB[A2SAMEFLG]
THEN
BEGIN
A1NODE_.CCMNSUB[ARG2PTR];
OPDSPIX_GETA2OPIX(CCMNSUB,A1NODE);
REGFORCOMP_GETTAC(CCMNSUB);
CGOPGEN();
END;
%(***IF THE VAL OF THIS COMMON SUB MUST BE STORED INTO A TMP, GENERATE
CODE TO DO SO***)%
IF .CCMNSUB[STOREFLG]
THEN
BEGIN
TREEPTR_.CCMNSUB;
REGFORCOMP_GETTAC(CCMNSUB);
OPDSPIX_STOROPIX(CCMNSUB);
CGOPGEN();
END;
CCMNSUB_.CCMNSUB[CLINK];
END;
END;
GLOBAL ROUTINE CGIOLST=
%(***************************************************************************
ROUTINE TO PERFORM CODE GENERATION FOR AN IOLIST.
CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR WHICH AN
IOLIST IS TO BE PROCESSED.
FOR EACH ELEMENT IN THE IOLIST:
1. IF THE ELEMENT IS A "STATEMENT" (EITHER A DO, OR A CONTINUE
WHICH TERMINATES A DO-LOOP, OR AN ASSIGNMENT), PERFORM
USUAL CODE GENERATION FOR THAT TYPE OF STATEMENT
2. IF THE ELEMENT IS AN "IOLSCLS" NODE (IE A DATACALL, SLISTCALL,
IOLSTCALL,E1LISTCALL,OR E2LISTCALL), PERFORM CODE
GENERATION FOR ALL ELEMENTS UNDER THE NODE AND
ALSO GENERATE:
MOVEI 16,ARGBLKP
PUSHJ 17,IOLST.
WHERE ARGBLKP IS A PTR TO THE ARGBLOCK FOR THIS ELEMENT
***************************************************************************)%
BEGIN
LOCAL SAVSTMNT;
LOCAL BASE IOLELEM;
EXTERNAL GENLAB;
EXTERNAL OPDSPIX,A1LABEL,CGOPGEN,OPGFIN;
%(***GET PTR TO 1ST ELEMENT ON THE IOLIST TO BE PROCESSED***)%
IOLELEM_.CSTMNT[IOLIST];
%(***SAVE PTR TO CURRENT STATEMENT (IF THERE ARE DO-STMNTS IN THE IOLIST,
WILL CLOBBER CSTMNT) *****)%
SAVSTMNT_.CSTMNT;
%(***WALK THUR THE IOLIST, PROCESSING ALL ELEMENTS***)%
UNTIL .IOLELEM EQL 0
DO
BEGIN
IF .IOLELEM[OPRCLS] EQL STATEMENT
THEN
BEGIN
CSTMNT_.IOLELEM;
CGSTMNT();
%(***IF THE LAST ELEMENT IN AN IO-LIST FOR A GIVEN STMNT IS
NOT OF IOLSCLS (IE DOES NOT GENERATE AN ARG-LIST)
THEN MUST GENERATE A "PUSHJ 17,FIN."
********)%
IF .IOLELEM[CLINK] EQL 0
THEN
BEGIN
OPDSPIX_OPGFIN;
CGOPGEN();
END;
END
ELSE
IF .IOLELEM[OPRCLS] EQL IOLSCLS
THEN
BEGIN
%(***GENERATE CODE TO EVALUATE ALL EXPRESSIONS UNDER THIS ELEMENT***)%
CASE .IOLELEM[OPERSP] OF SET
%(***FOR A DATACALL NODE - EVAL THE EXPR UNDER THE NODE ***)%
BEGIN
TREEPTR_.IOLELEM[DCALLELEM];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
CGETVAL();
END;
%(***FOR AN SLISTCALL NODE - EVAL THE EXPR FOR THE NUMBER OF ELEMS***)%
BEGIN
TREEPTR_.IOLELEM[SCALLCT];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN
CGETVAL();
END;
%(***FOR AN IOLSTCALL NODE - EVAL ALL EXPRS UNDER IT****)%
CGIOCALL(.IOLELEM);
%(***FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%
BEGIN
LOCAL BASE SAVCSTMNT;
SAVCSTMNT_.CSTMNT;
CSTMNT_.IOLELEM;
CGCMNSUB();
CSTMNT_.SAVCSTMNT;
CGE1LIST(.IOLELEM)
END;
%(**FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%
BEGIN
LOCAL BASE SAVCSTMNT;
SAVCSTMNT_.CSTMNT;
CSTMNT_.IOLELEM;
CGCMNSUB();
CSTMNT_.SAVCSTMNT;
CGE2LIST(.IOLELEM)
END
TES;
%(***CREATE A LABEL TABLE ENTRY FOR THE LABEL ASSOCIATED WITH
THE ARGBLOCK FOR THIS NODE***)%
A1LABEL_GENLAB();
IOLELEM[IOLSTLBL]_.A1LABEL;
%(***GENERATE CALL TO IOLST.***)%
OPDSPIX_OPGIOL;
CGOPGEN();
END
ELSE CGERR();
%(***GO ON TO NEXT ELEMENT***)%
IOLELEM_.IOLELEM[CLINK];
END;
CSTMNT_.SAVSTMNT;
END;
GLOBAL ROUTINE CGE1LIST(IOLELEM)=
%(**********************************************************************
ROUTINE TO GENERTE IN LINE CODE FOR
AN E1LISTCALL NODE
**********************************************************************)%
BEGIN
MAP BASE IOLELEM;
LOCAL BASE IOARRAY;
TREEPTR_.IOLELEM[ECNTPTR];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
TREEPTR_.IOLELEM[E1INCR];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
IOARRAY_.IOLELEM[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
TREEPTR_.IOARRAY[E2ARREFPTR];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
IOARRAY_.IOARRAY[CLINK]
END
END;
GLOBAL ROUTINE CGE2LIST(IOLELEM)=
%(**********************************************************************
ROUTINE TO GENERATE INLINE CODE FOR
AN E2LISTCALL NODE
**********************************************************************)%
BEGIN
MAP BASE IOLELEM;
LOCAL BASE IOARRAY;
TREEPTR_.IOLELEM[ECNTPTR];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
IOARRAY_.IOLELEM[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
TREEPTR_.IOARRAY[E2INCR];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
IOARRAY_.IOARRAY[CLINK]
END;
IOARRAY_.IOLELEM[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
TREEPTR_.IOARRAY[E2ARREFPTR];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
IOARRAY_.IOARRAY[CLINK]
END
END;
GLOBAL ROUTINE CGIOCALL(IOLSNODE)=
%(***************************************************************************
ROUTINE TO GENERATE THE CODE FOR AN IOLSTCALL NODE.
GENERATES CODE TO EVALUATE ALL EXPRESSIONS UNDER THE
IOLSTCALL.
***************************************************************************)%
BEGIN
MAP BASE IOLSNODE;
OWN BASE IOLELEM;
OWN SAVSTMNT;
%(***SAVE THE GLOBAL CSTMNT***)%
SAVSTMNT_.CSTMNT;
%(***GENERATE CODE FOR ANY COMMON SUBEXPRS UNDER THIS NODE***)%
CSTMNT_.IOLSNODE;
CGCMNSUB();
%(***WALK THRU THE ELEMS UNDER THIS IOLSTCALL***)%
IOLELEM_.IOLSNODE[IOLSTPTR];
UNTIL .IOLELEM EQL 0
DO
BEGIN
CASE .IOLELEM[OPERSP] OF SET
%(***FOR A DATACALL****)%
BEGIN
TREEPTR_.IOLELEM[DCALLELEM];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
END;
%(***FOR AN SLISTCALL (AN SLIST THAT HAS ONLY ONE ARRAYREF, AND
THAT ARRAYREF STARTS AT THE BASE OF THE ARRAY, AND THE
INCREMENT IS A CONSTANT) ***)%
BEGIN
TREEPTR_.IOLELEM[SCALLCT];
IF .TREEPTR[OPRCLS] NEQ DATAOPR
THEN CGETVAL();
END;
%(***AN IOLSTCALL NODE UNDER ANOTHER IOLSTCALL NODE IS ILLEGAL***)%
CGERR();
%(***FOR AN E1LISTCALL - OPTIMIZED CODE ONLY***)%
BEGIN
CGE1LIST(.IOLELEM)
END;
%(***FOR AN E2LISTCALL - OPTIMIZED CODE ONLY***)%
BEGIN
CGE2LIST(.IOLELEM)
END
TES;
IOLELEM_.IOLELEM[CLINK];
END;
%(***RESTORE CSTMNT***)%
CSTMNT_.SAVSTMNT;
END;
MAP PEXPRNODE TREEPTR;
%(*********DEFINE MACRO TO OUTPUT A WD OF 0 IN AN ARG-BLOCK***)%
MACRO ZIPOUT=
BEGIN
EXTERNAL PBOPWD,PSYMPTR,OBUFFA;
PBOPWD_0;
PSYMPTR_PBF2NOSYM;
OBUFFA()
END$;
GLOBAL ROUTINE COUNTARGS=
%(***************************************************************************
This routine walks an IOLSCLS node together with all its components
to count the number of words which are to be generated for the
corresponding argument list. It then puts out the -COUNT,,0 word
which precedes the arguments. This routine is necessary since
optimization may have performed transformations on the argument
list, thereby changing the resulting argument list(s), and there
are no fields to preserve the size of various IOLSCLS pieces.
This would also consume a fair amount of space. Hence this routine.
This entire routine is added by edit 1035.
***************************************************************************)%
BEGIN
LOCAL PEXPRNODE IOARRAY;
LOCAL SAVTREEPTR;
LOCAL ACNT; ! For counting the words in the argument list
ACNT_1; ! Initialize the count - block is always terminated
! by a zero word or a FIN call.
! The last shall be first...
CASE.TREEPTR[OPERSP] OF SET
%DATACALL%
ACNT_.ACNT+1; ! Only one item in a DATACALL node
%SLISTCALL%
ACNT_.ACNT+3; ! Count, increment, base address
%IOLSTCALL%
BEGIN
SAVTREEPTR_.TREEPTR;
TREEPTR_.TREEPTR[IOLSTPTR];
! Walk through the list, counting elements of each list item
UNTIL .TREEPTR EQL 0 DO
BEGIN
CASE .TREEPTR[OPERSP] OF SET
%DATACALL%
ACNT_.ACNT+1; ! Only one item in a DATACALL node
%SLISTCALL%
ACNT_.ACNT+3; ! Count, increment, base address
%IOLSTCALL%
CGERR(); ! IOLSTCALL under IOLSTCALL is illegal
%E1LISTCALL%
BEGIN
ACNT_.ACNT+2; ! Count, increment
IOARRAY_.TREEPTR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
ACNT_.ACNT+1; ! Add one for each array
IOARRAY_.IOARRAY[CLINK] ! Get next array
END
END;
%E2LISTCALL%
BEGIN
ACNT_.ACNT+1; ! ELIST,,count
IOARRAY_.TREEPTR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
ACNT_.ACNT+2; ! Increment and base address words
IOARRAY_.IOARRAY[CLINK]
END
END;
TES;
TREEPTR_.TREEPTR[CLINK]
END;
TREEPTR_.SAVTREEPTR;
END;
%E1LISTCALL%
BEGIN
ACNT_.ACNT+2; ! Count, increment
IOARRAY_.TREEPTR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
ACNT_.ACNT+1; ! Add one for each array
IOARRAY_.IOARRAY[CLINK] ! Get next array
END
END;
%E2LISTCALL%
BEGIN
ACNT_.ACNT+1; ! ELIST,,count
IOARRAY_.TREEPTR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
ACNT_.ACNT+2; ! Increment and base address words
IOARRAY_.IOARRAY[CLINK]
END
END;
TES;
! ACNT should now contain the count of argument words - put it out.
PBOPWD_ (-.ACNT)^18; ! Count to left half
PSYMPTR_PBF2NOSYM;
OBUFFA(); ! Put out -ACNT,,0
END; ! Of COUNTARGS
GLOBAL ROUTINE CGIOLARGS=
%(***************************************************************************
ROUTINE TO GENERATE THE ARG BLOCKS FOR AN IOLIST.
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE IOLIST.
***************************************************************************)%
BEGIN
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE PSYMPTR;
OWN SAVTREEPTR;
%(***WALK THRU ALL THE ELEMENTS ON THE IOLIST***)%
UNTIL .TREEPTR EQL 0
DO
BEGIN
%(**ONLY GENERATE ARG BLOCKS FOR NODES OF OPRCLS "IOLSCLS" (IGNORE
STATEMENT NODES) ***)%
IF .TREEPTR[OPRCLS] EQL IOLSCLS
THEN
BEGIN
![1035] Put out the -COUNT,,0 word for argument list
COUNTARGS(); ![1035]
%(***ASSOCIATE CURRENT LOC WITH THE LABEL ON THIS ARGBLOCK***)%
DEFLAB(.TREEPTR[IOLSTLBL]);
%(********GENERATE THE ARG BLOCK************************)%
CASE .TREEPTR[OPERSP] OF SET
%(***FOR DATACALL***)%
CGDCALL();
%(***FOR SLISTCALL***)%
CGSLIST();
%(***FOR IOLSTCALL***)%
BEGIN
%(***SAVE VAL OF TREEPTR***)%
SAVTREEPTR_.TREEPTR;
%(***WALK THRU THE ELEMENTS UNDER THIS NODE, GENERATING
ARG BLOCKS FOR THEM***)%
TREEPTR_.TREEPTR[IOLSTPTR];
UNTIL .TREEPTR EQL 0
DO
BEGIN
CASE .TREEPTR[OPERSP] OF SET
CGDCALL(); !FOR A DATACALL
CGSLIST(); !FOR AN SLIST
CGERR(); !IOLSTCALL IS ILLEGAL UNDER
! ANOTHER IOLSTCALL
CAE1LIST(); !E1LISTCALL NODE
CAE2LIST() !E2LISTCALL NODE
TES;
TREEPTR_.TREEPTR[CLINK];
END;
%(***RESTORE TREEPTR***)%
TREEPTR_.SAVTREEPTR;
END;
%(***FOR AN E1LISTCALL - OPTIMIZED CODE ONLY***)%
CAE1LIST();
%(***FOR AN E2LISTCALL - OPTIMIZED CODE ONLY***)%
CAE2LIST()
TES;
%(***IF THIS IS THE LAST ARG-BLOCK FOR THIS STMNT, GENERATE A FIN-BLOCK
AFTER IT; OTHERWISE GENERATE A ZERO-BLOCK AFTER IT***)%
PBOPWD_(IF .TREEPTR[CLINK] EQL 0 THEN OTSFINWD ELSE OTSZERWD);
PSYMPTR_PBF2NOSYM;
OBUFFA();
END;
%(***GO ON TO NEXT ELEMENT***)%
TREEPTR_.TREEPTR[CLINK];
END;
END;
GLOBAL ROUTINE CGDCALL=
%(***************************************************************************
ROUTINE TO GENERATE AN ARG BLOCK FOR A DATACALL ELEMENT IN AN IOLIST
CALLED WITH THE GLOBAL TREEPTR POINTING TO THE DATACALL NODE FOR
WHICH THE BLOCK IS TO BE GENERATED.
***************************************************************************)%
BEGIN
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE PSYMPTR;
OWN PEXPRNODE ARGNODE;
EXTERNAL EVALU;
%[1002]% MAP EVALTAB EVALU;
%(***GET PTR TO THE EXPRESSION-NODE WHOSE VAL IS TO BE AN ARG***)%
ARGNODE_.TREEPTR[DCALLELEM];
%(***INIT OUTPUT WD TO 0****)%
PBOPWD_0;
%(***SET ID FIELD OF OUTPUT WD TO INDICATE DATA***)%
PBOPWD[OTSIDN]_OTSDATA;
%(***SET TYPE FIELD OF ARG BLOCK TO THE EXTERNAL-TYPE CODE CORRESPONDING
TO THE VALTYPE INDICATED IN ARGNODE***)%
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.ARGNODE[VALTYPE]];
%(***IF THE EXPRESSION IS A SCALER VARIABLE***)%
IF .ARGNODE[OPRCLS] EQL DATAOPR
THEN
BEGIN
PBOPWD[OTSADDR]_.ARGNODE[IDADDR];
IF .ARGNODE[OPERSP] EQL FORMLARRAY THEN
PBOPWD[OTSIND]_1; !SET INDIRECT OVER FORMAL ARRAY
PSYMPTR_.ARGNODE; !PTR TO SYMBOL TABLE ENTRY
END
ELSE
%(***IF THE EXPRESSION IS AN ARRAYREF****)%
IF .ARGNODE[OPRCLS] EQL ARRAYREF
THEN
BEGIN
PBOPWD[OTSMEMRF]_.ARGNODE[TARGTMEM];
PSYMPTR_.ARGNODE[ARG1PTR];
%(***FOR A FORMAL ARRAY, WILL NOT WANT TO RELOCATE THE ADDRESS
FIELD OF THE ARGUMENT - SINCE WILL HAVE COMPUTED THE ARRAY BASE
ADDRESS INTO THE SUBSCRIPT***)%
IF .PSYMPTR[FORMLFLG] THEN PSYMPTR_PBF2NOSYM;
END
ELSE
%(***IF THE VAL OF THE EXPRESSION IS IN A REG***)%
IF .ARGNODE[INREGFLG]
THEN
BEGIN
PBOPWD[OTSADDR]_.ARGNODE[TARGADDR];
PSYMPTR_PBF2NOSYM;
END
ELSE
%(***IF THE VAL OF THE EXPRESSION IS IN A TEMP***)%
BEGIN
PSYMPTR_.ARGNODE[TARGADDR];
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
PBOPWD[OTSIND]_.ARGNODE[TARGIF];
END;
OBUFFA();
END;
GLOBAL ROUTINE CGSLIST=
%(***************************************************************************
ROUTINE TO GENERATE AN ARGUMENT BLOCK FOR AN SLIST CALL
IN AN IOLIST.
CALLED WITH THE GLOBAL POINTING TO THE SLISTCALL NODE.
THIS ROUTINE IS USED ONLY FOR THE SLISTS GENERATED BY
PHASE 1 FOR STMNTS OF THE FORM:
READ 11,A
WHERE A IS AN ARRAY.
IN A LATER RELEASE, PHASE 2 SKELETON WILL RECOGNIZE
IOLISTS THAT CAN BE TRANSFORMED INTO SLISTS AND WILL FORM
"S1LISTCALL" NODES FOR THESE SLISTS (WHICH MAY HAVE MORE THAN ONE ARRAY
AND INCREMENTS OTHER THAN 1).
***************************************************************************)%
BEGIN
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE PSYMPTR;
EXTERNAL EVALU;
%[1002]% MAP EVALTAB EVALU;
%(******OUTPUT FIRST WD OF ARGBLOCK (WD CONTAINING CODE FOR SLSIST AND COUNT)*****)%
%(***INIT OUTPUT WD TO 0***)%
PBOPWD_0;
%(***SET IDN FIELD TO CODE FOR SLSIST**)%
PBOPWD[OTSIDN]_OTSSLIST;
%(***BUILD THE WD THAT CONTAINS THE CT***)%
BLDIOIMWD(.TREEPTR[SCALLCT]);
OBUFFA();
%(****OUTPUT THE 2ND WD OF ARGBLOCK (WHICH CONTAINS THE INCREMENT 1)***)%
PBOPWD_1;
PSYMPTR_PBF2NOSYM;
OBUFFA();
%(***OUTPUT THE 3RD WD (WHICH CONTAINS A PTR TO THE ARRAY TO BE USED)*******)%
%(***GET PTR TO SYMBOL TABLE ENTRY FOR THE ARRAY***)%
PSYMPTR_.TREEPTR[SCALLELEM];
%(***ADDRESS FOR ARGBLOCK IS ADDRESS INDICATED BY THE SYMBOL TABLE ENTRY***)%
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.PSYMPTR[VALTYPE]];
%(***SET INDIRECT BIT FOR A FORMAL ARRAY***)%
IF .PSYMPTR[FORMLFLG]
THEN
PBOPWD[OTSIND]_1;
OBUFFA();
END;
GLOBAL ROUTINE CAE1LIST=
%(**********************************************************************
ROUTINE TO GENERATE CODE FOR AN ARGBLK FOR AN E1LISTCALL NODE
CALLED WITH GLOBAL POINTING TO E1LISTCALL NODE
**********************************************************************)%
BEGIN
LOCAL PEXPRNODE IOARRAY;
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE PSYMPTR;
%(***OUTPUT FIRST WORD - CONTAINS "SLIST" AND COUNT***)%
PBOPWD_0; !INITIALIZE WORD TO 0
PBOPWD[OTSIDN]_OTSSLIST; !SET ID FIELD TO SLIST
BLDIOIMWD(.TREEPTR[ECNTPTR]); !FILL IN THE COUNT
OBUFFA(); !OUTPUT THE WORD
%(***OUTPUT SECOND WORD - CONTAINS INCREMENT***)%
IOARRAY_.TREEPTR[E1INCR];
IF
BEGIN
IF .IOARRAY[OPR1] NEQ CONSTFL THEN 0 ELSE
IF .IOARRAY[CONST1] EQL 0 AND .IOARRAY[CONST2] EQL 0
THEN 1 ELSE 0
END
THEN
BEGIN
PSYMPTR_.IOARRAY; !MARK SYMBOL
PBOPWD<LEFT>_#100; !SET INTEGER
PBOPWD<RIGHT>_.IOARRAY[IDADDR]
END
ELSE
BEGIN
PBOPWD_0;
BLDIOIMWD(.TREEPTR[E1INCR]) !FILL IN THE INCREMENT
END;
OBUFFA(); !OUTPUT THE WORD
%(***OUTPUT ONE WORD FOR EACH ARRAYREF UNDER ELSTPTR***)%
IOARRAY_.TREEPTR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
PBOPWD_0; !CLEAR TARGET
IOPTR(.IOARRAY[E2ARREFPTR]); !GENERATE ARGUMENT
IOARRAY_.IOARRAY[CLINK]
END
END;
GLOBAL ROUTINE CAE2LIST=
%(**********************************************************************
ROUTINE TO GENERATE CODE FOR AN ARGBLK FOR AN E2LISTCALL NODE
CALLED WITH GLOBAL POINTING TO E2LISTCALL NODE
**********************************************************************)%
BEGIN
LOCAL PEXPRNODE IOARRAY;
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE PSYMPTR;
%(***OUTPUT FIRST WORD - CONTAINS "ELIST" AND COUNT***)%
PBOPWD_0; !INITIALIZE WORD TO 0
PBOPWD[OTSIDN]_OTSELIST; !SET ID FIELD TO ELIST
BLDIOIMWD(.TREEPTR[ECNTPTR]); !FILL IN THE COUNT
OBUFFA(); !OUTPUT THE WORD
%(***OUTPUT TWO WORD FOR EACH ARRAYREF UNDER ELSTPTR***)%
IOARRAY_.TREEPTR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
LOCAL PEXPRNODE E2ARG;
%(***OUTPUT INCREMENT***)%
E2ARG_.IOARRAY[E2INCR];
IF
BEGIN
IF .E2ARG[OPR1] NEQ CONSTFL THEN 0 ELSE
IF .E2ARG[CONST1] EQL 0 AND .E2ARG[CONST2] EQL 0
THEN 1 ELSE 0
END
THEN
BEGIN
PSYMPTR_.E2ARG;
PBOPWD<LEFT>_#100;
PBOPWD<RIGHT>_.E2ARG[IDADDR]
END
ELSE
BEGIN
PBOPWD_0;
BLDIOIMWD(.IOARRAY[E2INCR]) !FILL IN INCREMENT
END;
OBUFFA(); !OUTPUT INCREMENT
%(***OUTPUT ARRAY ADDRESS***)%
PBOPWD_0; !CLEAR TARGET
IOPTR(.IOARRAY[E2ARREFPTR]); !GENERATE ARGUMENT
IOARRAY_.IOARRAY[CLINK]
END
END;
GLOBAL ROUTINE BLDIOIMWD(ARGNODE)=
%(***************************************************************************
ROUTINE TO BUILD A WD OF AN ARGUMENT BLOCK FOR FOROTS WHEN
THAT WORD IS TO HAVE EITHER THE FORM:
1. INDIRECT BIT=0, IMMEDIATE CONSTANT IN RIGHT HALF
OR 2. INDIRECT BIT=1, PTR TO VAL IN RIGHT HALF
CALLED WITH THE ARG:
ARGNODE - PTR TO THE EXPRESSION NODE FOR THE VAL TO
BE REPRESENTED
CALLED WITH PBOPWD INITIALIZED SUCH THAT THE FIRST 9 BITS HAVE
THE VALUE DESIRED,AND THE RIGHT 27 BITS ARE 0.
***************************************************************************)%
BEGIN
EXTERNAL EVALU;
%[1002]% MAP EVALTAB EVALU;
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE PSYMPTR;
MAP PEXPRNODE ARGNODE;
%(***SET TYPE TO INDICATE IMMEDIATE ARG IN MEMORY***)%
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.ARGNODE[VALTYPE]];
%(***IF THE ARG IS A CONSTANT, USE THE IMMEDIATE FORM***)%
IF .ARGNODE[OPR1] EQL CONSTFL
THEN
BEGIN
PBOPWD[OTSTYPE]_IMMEDTYPE;
PBOPWD[OTSADDR]_.ARGNODE[CONST2];
PSYMPTR_PBF2NOSYM; !FLAG TO OUTMOD THAT NO SYMBOLIC
! REPRESENTATION CAN BE USED
END
ELSE
%(***IF ARG IS A VARIABLE, USE INDIRECT THRU ITS ADDR***)%
IF .ARGNODE[OPRCLS] EQL DATAOPR
THEN
BEGIN
IF .ARGNODE[OPERSP] EQL FORMLARRAY THEN PBOPWD[OTSIND]_1;
PBOPWD[OTSADDR]_.ARGNODE[IDADDR];
PSYMPTR_.ARGNODE; !PTR TO SYMBOL TABLE ENTRY
END
ELSE
%(***IF ARG IS AN EXPRESSION, USE THE TEMP IN WHICH THE VAL WAS STORED***)%
BEGIN
%(***IF VAL WAS LEFT IN AREG***)%
IF .ARGNODE[INREGFLG]
THEN
BEGIN
PBOPWD[OTSADDR]_.ARGNODE[TARGADDR];
PSYMPTR_PBF2NOSYM;
END
ELSE
%(***IF VAL WAS LEFT IN A TEMP***)%
BEGIN
%(***GET PTR TO TEMPORARY TABLE ENTRY***)%
PSYMPTR_.ARGNODE[TARGADDR];
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
END;
END;
END;
GLOBAL ROUTINE CGSTPAUARGS=
%(***************************************************************************
ROUTINE TO GENERATE THE ARG BLOCK FOR A STOP/PAUSE STMNT.
THIS BLOCK WILL HAVE THE FORM:
-------------------------------
! ARGCT ! 0 !
---------------------------------
LABEL: ! !TYPE ! ! ARGPTR !
----------------------------------
WHERE "LABEL" IS THE ARG-BLOCK LABEL, ARGCT IS NEG ARGCT AND WILL ALWAYS
BE -1 OR 0, TYPE IS THE VALUE TYPE OF THE ARG (LITERAL,OCTAL,INTEGER,REAL
DOUBLE PREC, OR COMPLEX) AND IS IN BITS 9-12, AND ARGPTR PTS TO THE ARG
THIS ROUTINE IS CALLED WITH THE GLOBAL "CSTMNT" POINTING TO THE STOP OR
PAUSE STMNT FOR WHICH AN ARG-BLOCK IS TO BE GENERATED.
***************************************************************************)%
BEGIN
EXTERNAL EVALU; !TABLE OF EXTERNAL VALUE-TYPE CODES
%[1002]% MAP EVALTAB EVALU;
MAP OBJECTCODE PBOPWD; !GLOBAL IN WHICH THE WD TO
! BE OUTPUT IS PASSED TO THE ROUTINE "OBUFFA"
MAP PEXPRNODE PSYMPTR; !WILL PT TO THE SYMBOL TABLE ENTRY (OR
! CONSTANT TABLE ENTRY) FOR THE ARG OF THE STOP/PAUSE
%(***IF THE STOP/PAUSE HAD NO ARG, WILL HAVE USED "ZERBLK" FOR THE
ARG-BLOCK. SO DONT HAVE TO GENERATE ANYTHING.***)%
IF .CSTMNT[PAUSIDENT] EQL 0
THEN RETURN;
%(***IF THIS STMNT WAS ELIMINATED (BY FOLDING A LOG IF), DO NOT WANT TO
GENERATE AN ARG LIST***)%
IF .CSTMNT[PAUSLBL] EQL 0 THEN RETURN;
%(***OUTPUT THE ARG-CT WD*****)%
PSYMPTR_PBF2NOSYM;
PBOPWD_(-1)^18;
OBUFFA();
%(***ASSOCIATE THE LABEL FOR THIS ARG-LIST WITH THE 2ND WD***)%
DEFLAB(.CSTMNT[PAUSLBL]);
%(***OUTPUT THE PTR WD***)%
PSYMPTR_.CSTMNT[PAUSIDENT];
PBOPWD_0; !INIT WD TO BE OUTPUT TO 0
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.PSYMPTR[VALTYPE]]; !SET TYPE FIELD OF WD TO BE OUTPUT
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR]; !ADDRESS OF VAR/CONSTANT/LITERAL
! TO BE OUTPUT
OBUFFA();
RETURN
END;
!AUTHOR: NORMA ABEL
!THIS FILE CONTAINS THE ROUTINES NECESSARY TO GENERATE CODE
!FOR THE I/O STATEMENTS THEMSELVES. WHERE APPROPRIATE THE ROUTINE
!CGIOLST IS CALLED TO GENERATE THE CALLS TO IOLST.
GLOBAL ROUTINE CGMTOP=
BEGIN
!CALLS TO MTOP FOR ALL STATEMENTS BACKID THRU ENDFID
EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
MAP BASE CSTMNT;
EXTERNAL OPGMTO;
CGUNIT(); !GENERATE CODE TO EVAL UNIT NUMBER (IF AN EXPRESSION)
%1123% CGIOSTAT(); ! Generate code for subscripted IOSTAT variables
!FILL IN IOARGLBL FIELD
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
OPDSPIX_OPGMTO;
CGOPGEN();
END;
GLOBAL ROUTINE CGENCO=
BEGIN
!CODE GENERATION FOR ENCODE
EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
MAP BASE CSTMNT;
%[711]% EXTERNAL CGIOLST,OPGENC,OPGFIN;
EXTERNAL TREEPTR,CGETVAL;
%(***IF THE COUNT FIELD IS AN EXPRESSION, EVALUATE IT***)%
TREEPTR_.CSTMNT[IOCNT];
CGETVAL();
%(***IF THE ENCODE VAR IS AN ARRAY-REF, GENERATE CODE FOR THE
SS CALCULATION***)%
TREEPTR_.CSTMNT[IOVAR];
CGETVAL();
%1123% CGIOSTAT(); ! Generate code for subscripted IOSTAT variables
!FILL IN IOARGLBL FIELD
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
OPDSPIX_OPGENC;
CGOPGEN();
![711] IF THE IOLIST IS NOT PRESENT, BE SURE TO PUT OUT A FIN CALL
![711] OTHERWISE ONE CAN END UP USING EXCESSIVE AMOUNTS OF CORE...
%[711]% IF .CSTMNT[IOLIST] EQL 0
%[711]% THEN (OPDSPIX_OPGFIN; CGOPGEN()) ! PUT OUT A FIN CALL
%[711]% ELSE CGIOLST();
END;
GLOBAL ROUTINE CGDECO=
BEGIN
!CODE GENERATION FOR DECODE
EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
MAP BASE CSTMNT;
%[711]% EXTERNAL OPGDEC,CGIOLST,OPGFIN;
%(***IF THE COUNT FIELD IS AN EXPRESSION, EVALUATE IT***)%
TREEPTR_.CSTMNT[IOCNT];
CGETVAL();
%(***IF THE DECODE ARRAY IS AN ARRAYREF - CALCULATE THE
OFFSET***)%
TREEPTR_.CSTMNT[IOVAR];
CGETVAL();
%1123% CGIOSTAT(); ! Generate code for subscripted IOSTAT variables
!FILL IN IOARGLBL FIELD
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
OPDSPIX_OPGDEC;
CGOPGEN();
![711] IF THE IOLIST IS EMPTY, BE SURE TO PUT OUT A FIN CALL
%[711]% IF .CSTMNT[IOLIST] EQL 0
%[711]% THEN (OPDSPIX_OPGFIN; CGOPGEN()) ! PUT OUT A FIN CALL
%[711]% ELSE CGIOLST();
END;
GLOBAL ROUTINE CGRERE=
BEGIN
!CODE GENERATION FOR REREAD
EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
EXTERNAL OPGFIN;
MAP BASE CSTMNT;
EXTERNAL CGIOLST,OPGIN;
CGUNIT(); !GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)
%1123% CGIOSTAT(); ! Generate code for subscripted IOSTAT variables
!FILL IN IOARGLBL FIELD
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
OPDSPIX_OPGIN;
CGOPGEN();
IF .CSTMNT[IOLIST]EQL 0
THEN
BEGIN
%(***IF HAVE NO IOLIST GENERATE A CALL TO FIN***)%
OPDSPIX_OPGFIN;
CGOPGEN();
END
ELSE
CGIOLST();
END;
GLOBAL ROUTINE CGUNIT=
%(***************************************************************************
GENERATE CODE TO EVALUATE THE UNIT NUMBER IN AN IO STMNT
CALLED WITH CSTMNT POINTING TO AN IO STMNT
***************************************************************************)%
BEGIN
TREEPTR_.CSTMNT[IOUNIT]; !PTR TO EXPRESSION NODE FOR UNIT
IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN CGETVAL()
END;
GLOBAL ROUTINE CGRECNUM=
%(***************************************************************************
TO GENERATE THE CODE TO COMPUTE THE RECORD NUMBER FOR AN IO STMNT
THAT HAS AN EXPRESSION FOR A RECORD NUMBER (UGH!!!)
***************************************************************************)%
BEGIN
EXTERNAL CSTMNT;
MAP PEXPRNODE CSTMNT;
OWN PEXPRNODE RECNUM;
IF (RECNUM_.CSTMNT[IORECORD]) NEQ 0
THEN
BEGIN
IF .RECNUM[OPRCLS] NEQ DATAOPR
THEN
BEGIN
TREEPTR_.RECNUM;
CGETVAL()
END
END
END;
GLOBAL ROUTINE CGIOSTAT= %1123%
BEGIN ! Generate code to compute subscripts for an I/O statement that has
! an array reference for an IOSTAT specifier
EXTERNAL PEXPRNODE CSTMNT;
REGISTER PEXPRNODE IOREF;
IOREF=.CSTMNT[IOIOSTAT];
IF .IOREF NEQ 0
THEN
BEGIN
TREEPTR_.IOREF;
CGETVAL()
END
END; %1123%
GLOBAL ROUTINE CGREAD=
BEGIN
!CODE GENERATION FOR ALL TYPES OF READ
EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
MAP BASE CSTMNT;
EXTERNAL CGIOLST,OPGNLI,OPGIN,OPGRTB,OPGFIN;
LOCAL BASE T1;
%(***IF THERE AN EXPRESSION TO BE EVALUATED FOR THE RECORD NUMBER (UGH!!!)
GENERATE CODE TO EVALUATE IT***)%
CGRECNUM();
%[1134]% CGUNIT(); !GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)
%1123% CGIOSTAT(); ! Generate code to evaluate ARRAYREF subscripts, etc
!FILL IN IOARGLBL FIELD
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
!MAKE CGREAD AND CGWRIT SYMMETRICAL: DON'T MAKE A NAMELIST
! CHECK WITHOUT CHECKING FOR IONAME PTR = 0
T1 _ .CSTMNT [IOFORM]; ! IOFORM == IONAME
IF .CSTMNT [IOLIST] EQL 0 ! NO IOLIST (BEWARE NAMELIST)
THEN
IF .T1 EQL 0 ! NO FORMAT
THEN BEGIN
OPDSPIX _ OPGRTB; ! UNFORMATTED READ
CGOPGEN ();
OPDSPIX _ OPGFIN; ! FIN CALL SINCE NO IOLIST
CGOPGEN ();
END
ELSE
IF .T1 [OPRCLS] NEQ STATEMENT AND ! CHECK FOR NAMELIST
.T1 [IDATTRIBUT (NAMNAM)]
THEN BEGIN
OPDSPIX _ OPGNLI; ! NAMELIST READ
CGOPGEN ();
END
ELSE BEGIN
OPDSPIX _ OPGIN; ! FORMATTED READ
CGOPGEN ();
OPDSPIX _ OPGFIN; ! FIN CALL SINCE NO IOLIST
CGOPGEN ();
END
ELSE BEGIN ! THERE IS AN IOLIST
IF .T1 EQL 0 ! CHECK FOR FORMAT
THEN OPDSPIX _ OPGRTB ! UNFORMATTED READ
ELSE OPDSPIX _ OPGIN; ! FORMATTED READ
CGOPGEN ();
CGIOLST (); ! PROCESS IOLIST
END;
END;
GLOBAL ROUTINE CGWRIT=
BEGIN
!CODE GENERATION FOR WRITE STATEMENTS OF ALL FORMS
EXTERNAL CGOPGEN,OPDSPIX,A1LABEL,OPGOUT,OPGNLO,OPGWTB,GENLAB,
CGIOLST,CSTMNT,OPGFIN;
MAP BASE CSTMNT;
LOCAL BASE T1;
%(***IF THERE AN EXPRESSION TO BE EVALUATED FOR THE RECORD NUMBER (UGH!!!)
GENERATE CODE TO EVALUATE IT***)%
CGRECNUM();
%[1134]% CGUNIT(); !GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)
!REORDER THINGS SO THAT THE CALL TO CGREGNUM DOES
! NOT OVERWRITE A1LABEL CAUSING BAD CODE
!FILL IN IOARGLBL FIELD
%1123% CGIOSTAT(); ! Generate code to evaluate ARRAYREF subscripts, etc
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
!MAKE CGREAD AND CGWRIT SYMMETRICAL: GENERATE A FIN CALL
! AFTER AN UNFORMATTED WRITE; REPLACE EDIT
T1 _ .CSTMNT [IOFORM]; ! IOFORM == IONAME
IF .CSTMNT [IOLIST] EQL 0 ! NO IOLIST (BEWARE NAMELIST)
THEN
IF .T1 EQL 0 ! NO FORMAT
THEN BEGIN
OPDSPIX _ OPGWTB; ! UNFORMATTED WRITE
CGOPGEN ();
OPDSPIX _ OPGFIN; ! FIN CALL SINCE NO IOLIST
CGOPGEN ();
END
ELSE
IF .T1 [OPRCLS] NEQ STATEMENT AND ! CHECK FOR NAMELIST
.T1 [IDATTRIBUT (NAMNAM)]
THEN BEGIN
OPDSPIX _ OPGNLO; ! NAMELIST WRITE
CGOPGEN ();
END
ELSE BEGIN
OPDSPIX _ OPGOUT; ! FORMATTED WRITE
CGOPGEN ();
OPDSPIX _ OPGFIN; ! FIN CALL SINCE NO IOLIST
CGOPGEN ();
END
ELSE BEGIN ! THERE IS AN IOLIST
IF .T1 EQL 0 ! CHECK FOR FORMAT
THEN OPDSPIX _ OPGWTB ! UNFORMATTED WRITE
ELSE OPDSPIX _ OPGOUT; ! FORMATTED WRITE
CGOPGEN ();
CGIOLST (); ! PROCESS IOLIST
END;
END;
GLOBAL ROUTINE CGOPLST=
%(***************************************************************************
ROUTINE TO GENERATE CODE TO EVALUATE ANY EXPRESSIONS THAT
OCCUR AS VALS OF ARGS UNDER AN OPEN/CLOSE STMNT
***************************************************************************)%
BEGIN
OWN OPENLIST ARVALLST; !LIST OF ARGS AND THEIR VALS UNDER THIS STMNT
CGUNIT(); !GENERATE CODE FOR UNIT NUMBER THAT IS AN EXPRESSION
%1123% CGIOSTAT(); ! Generate code for subscripted IOSTAT variables
ARVALLST_.CSTMNT[OPLST];
INCR I FROM 0 TO (.CSTMNT[OPSIZ]-1) !LOOK AT EACH ARG
DO
BEGIN
TREEPTR_.ARVALLST[.I,OPENLPTR]; !PTR TO THE EXPRESSION NODE FOR THE VAL OF THIS ARG
IF .TREEPTR EQL 0 !FOR "DIALOG", CAN HAVE NULL VAL
THEN BEGIN END
ELSE
IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN CGETVAL()
END
END; !END OF ROUTINE "CGOPLST"
GLOBAL ROUTINE CGOPEN=
BEGIN
!CODE GENERATION FOR THE CALL TO OPEN.
EXTERNAL CGOPGEN,OPDSPIX,A1LABEL,GENLAB,OPGOPE;
EXTERNAL CSTMNT; MAP BASE CSTMNT;
CGOPLST(); !GENERATE CODE TO EVAL ANY EXPRESSIONS THAT OCCUR AS VALS OF ARGS
!FILL IN IOARGLBL FIELD
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
OPDSPIX_OPGOPE;
CGOPGEN();
END;
!GLOBAL ROUTINE CGRELS=
!BEGIN
! !CODE GENERATION FOR RELAEASE STATEMENT
!
! EXTERNAL CSTMNT,CGOPGEN,OPDSPIX,A1LABEL,OPGREL,GENLAB;
! MAP BASE CSTMNT;
! !FILL IN IOARGLBL FIELD
!
! A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
! OPDSPIX_OPGREL;
! CGOPGEN();
!END;
!
GLOBAL ROUTINE CGFIND=
BEGIN
!CODE GENERATION FOR FIND
EXTERNAL CGOPGEN,CSTMNT,A1LABEL,GENLAB,OPDSPIX,OPGFND;
MAP BASE CSTMNT;
%(***IF THERE AN EXPRESSION TO BE EVALUATED FOR THE RECORD NUMBER (UGH!!!)
GENERATE CODE TO EVALUATE IT***)%
CGRECNUM();
%[1134]% CGUNIT(); !GENERATE CODE FOR UNIT NUMBER
%[1134]%
%1123% CGIOSTAT(); ! Generate code for subscripted IOSTAT variables
%[1134]% !FILL IN IOARGLBL FIELD
%[1134]% A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
OPDSPIX_OPGFND;
CGOPGEN();
END;
GLOBAL ROUTINE CGCLOS=
BEGIN
!CODE GENERATION FOR CLOSE STATEMENT
EXTERNAL CSTMNT,GENLAB,A1LABEL,OPDSPIX,CGOPGEN,OPGCLO;
MAP BASE CSTMNT;
CGOPLST(); !GENERATE CODE TO EVAL ANY EXPRESSIONS THAT OCCUR AS VALS OF ARGS
!FILL IN IOARGLBL FIELD
A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
OPDSPIX_OPGCLO;
CGOPGEN();
END;
MACRO
IOWHOLE=0,7,0,36$,
OPENFFIELD=0,33,3$,
OPENGFIELD=0,27,5$,
OPENCODE=0,0,18,18$,
OPENARG=0,0,0,18$,
UTILLOW=BACKID$,
UTILHI=ENDFID$;
GLOBAL ROUTINE CGDECARGS=
%(***************************************************************************
TO GENERATE THE ARG BLOCK FOR AN ENCODE OR DECODE STATEMENT
ARG BLOCK HAS THE FORM:
--------------------------------------------------
! -CT ! !
--------------------------------------------------
! 13 !TYPE !I! X ! CHAR CT (IMMED) !
--------------------------------------------------
LAB: ! 4 !TYPE !I! X ! END= !
--------------------------------------------------
! 5 !TYPE !I! X ! ERR= !
--------------------------------------------------
! 6 !TYPE !I! X ! IOSTAT= !
--------------------------------------------------
! 2 !TYPE !I! X ! FORMAT ADDR !
--------------------------------------------------
! 3 !TYPE !I! X ! FORMAT SIZE(IMMED) !
--------------------------------------------------
! 12 !TYPE !I! X ! VAR ARRAY ADDR !
--------------------------------------------------
WHERE THE ARGLIST PTR POINTS TO THE WORD CONTAINING THE CHAR CT
END/ERR/IOSTAT= are optional ( 4 <= CT <= 7 )
***************************************************************************)%
BEGIN
EXTERNAL IOIMMED,IOPTR;
EXTERNAL PBOPWD,CSTMNT,PSYMPTR,OBUFF;
EXTERNAL IOENDERR,IOFORMAT,EVALU;
%[1002]% MAP EVALTAB EVALU;
MAP PEXPRNODE CSTMNT; !ENCODE OR DECODE STMNT FOR WHICH ARG BLOCK
! IS TO BE GENERATED
MAP OBJECTCODE PBOPWD;
OWN PEXPRNODE ENCARRAY; !ARRAY TO BE INPUT OR OUTPUT
OWN PEXPRNODE CHARCT; !NUMBER OF CHARS TO BE PROCESSED
ENCARRAY_.CSTMNT[IOVAR];
CHARCT_.CSTMNT[IOCNT];
%(***OUTPUT WD CONTAINING THE CT OF WDS IN THE ARGLIST***)%
%[760]% PBOPWD_(-CNTKEYS())^18; ! CT in left half word
PSYMPTR_PBF2NOSYM;
OBUFFA();
%(***ASSOCIATE THE LABEL ON THE ARGLIST WITH THIS LOC***)%
DEFLAB(.CSTMNT[IOARGLBL]);
%(***SET UP THE COUNT OF CHARS TO BE PROCESSED IN THE 1ST WD OF THE ARG BLOCK***)%
![760] Set up keyword value
%[760]% PBOPWD_0; ! clear word
%[760]% PBOPWD[OTSKEY]_OTSKEDSIZ; ! output the char ct
IOIMMED(.CHARCT);
IOENDERR(); !OUTPUT THE END/ERR/IOSTAT WORDS OF THE ARG BLOCK
IOFORMAT(); !OUTPUT THE FORMAT WDS OF THE ARG BLOCK
%(***OUTPUT A PTR TO THE ARRAY***)%
![760] Set up keyword value
%[760]% PBOPWD_0; ! clear word
%[760]% PBOPWD[OTSKEY]_OTSKEDARR; ! output the array address
IOPTR(.ENCARRAY);
END;
ROUTINE IO1ARG(NUMB)=
%(*********************
ROUTINE TO OUTPUT 2 WDS OF THE FORM:
--------------------------------------------------
! -CT ! !
-------------------------------------------------
LAB: ! 1 ! TYPE !I! X ! UNIT !
---------------------------------------------------
WHERE "UNIT" IS IMMEDIATE
***********************)%
BEGIN
EXTERNAL IOIMMED;
EXTERNAL PBOPWD,PSYMPTR,OBUFF,CSTMNT;
MAP BASE CSTMNT;
MAP OBJECTCODE PBOPWD;
%(***OUTPUT MINUS THE CT OF WDS IN THE ARG BLOCK***)%
PBOPWD_(-.NUMB)^18; !CT IN LEFT HALF WD
PSYMPTR_PBF2NOSYM;
OBUFFA();
%(***ASSOCIATE THE LABEL ON THE ARG BLOCK WITH THIS LOC***)%
DEFLAB(.CSTMNT[IOARGLBL]);
%(***Output an "immediate" mode arg for the unit***)%
![760] Set up keyword value
%[760]% PBOPWD_0; ! clear word
%[760]% PBOPWD[OTSKEY]_OTSKUNIT; ! output the unit
IOIMMED(.CSTMNT[IOUNIT]);
PBOPWD_0;
END;
ROUTINE OPNFARGS=
%(*********************
routine to output first words of OPEN/CLOSE arg block
Note that ERR/IOSTAT are optional
-------------------------------------------------
! -CT ! !
-------------------------------------------------
LAB: ! 36 ! TYPE !I! X ! UNIT !
-------------------------------------------------
! 37 ! TYPE !I! X ! ERR !
-------------------------------------------------
! 21 ! TYPE !I! X ! IOSTAT !
-------------------------------------------------
WHERE "UNIT" IS IMMEDIATE
***********************)%
BEGIN
%[760]% EXTERNAL IOIMMED,EVALU;
%[760]% EXTERNAL PBOPWD,PSYMPTR,OBUFF,CSTMNT;
%[760]% MAP BASE CSTMNT;
%[760]% MAP OBJECTCODE PBOPWD;
%[760]% REGISTER CT,IOSVAL;
%[760]% MAP PEXPRNODE PSYMPTR;
%[760]% MAP PEXPRNODE IOSVAL;
%[1002]% MAP EVALTAB EVALU;
%(***Output minus the CT of words in the arg block***)%
%[760]% CT_.CSTMNT[OPSIZ]; ! number of args on stack
%[760]% IF .CSTMNT[IOUNIT] NEQ 0 THEN CT_.CT+1; ! add in UNIT=
%[760]% IF .CSTMNT[IOERR] NEQ 0 THEN CT_.CT+1; ! add in ERR=
%[760]% IF .CSTMNT[IOIOSTAT] NEQ 0 THEN CT_.CT+1; ! add in IOSTAT=
%[760]% PBOPWD_(-.CT)^18; ! CT in left half word
%[760]% PSYMPTR_PBF2NOSYM;
%[760]% OBUFFA();
%(***Associate the label on the arg block with this loc***)%
%[760]% DEFLAB(.CSTMNT[IOARGLBL]);
%[760]% %(***Output an "immediate" mode arg for the unit***)%
%[760]% PBOPWD_0; ! clear word
%[760]% PBOPWD[OTSKEY]_OPNCUNIT; ! output the unit
%[760]% IOIMMED(.CSTMNT[IOUNIT]);
%[760]% PBOPWD_0;
%(***Output the "ERROR" WD if non zero***)%
%[760]% PBOPWD_0; ! clear word
%[760]% IF .CSTMNT[IOERR] NEQ 0
%[760]% THEN
%[760]% BEGIN
%[760]% PBOPWD[OTSKEY]_OPNCERREQ; ! output the ERR= word
%[760]% PBOPWD[OTSTYPE]_ADDRTYPE; ! type is "address"
%[760]% PBOPWD[OTSADDR]_.CSTMNT[IOERR];
%[760]% PSYMPTR_PBFLABREF; ! it's a statement label
%[760]% OBUFFA();
%[760]% END;
%[760]% %(***Output the "IOSTAT" WD if non zero***)%
%[760]% PBOPWD_0; ! clear word
%[760]% IF .CSTMNT[IOIOSTAT] NEQ 0
%[760]% THEN
%[760]% BEGIN
%[760]% IOSVAL_.CSTMNT[IOIOSTAT];
%[760]% PBOPWD[OTSKEY]_OPNCIOSTAT; ! output the IOSTAT= word
%1123% IOPTR(.IOSVAL)
%[760]% END;
END;
GLOBAL ROUTINE CNTKEYS=
%(***********************
COUNT UP THE NUMBER OF WORDS IN ARG BLOCK TO USE FOR KEYWORDS.
NOTE THAT FMT= USES TWO WORDS (ADDRESS AND SIZE).
*************************)%
BEGIN
%[760]% EXTERNAL CSTMNT;
%[760]% MAP BASE CSTMNT;
%[760]% REGISTER COUNT;
%[760]%
%[760]% COUNT_0;
%[760]%
%[760]% IF .CSTMNT[IOUNIT] NEQ 0 THEN COUNT_.COUNT+1;
%[760]% IF .CSTMNT[IOFORM] NEQ 0 THEN COUNT_.COUNT+2; ! ADDRESS AND SIZE
%[760]% IF .CSTMNT[IOEND] NEQ 0 THEN COUNT_.COUNT+1;
%[760]% IF .CSTMNT[IOERR] NEQ 0 THEN COUNT_.COUNT+1;
%[760]% IF .CSTMNT[IOIOSTAT] NEQ 0 THEN COUNT_.COUNT+1;
%[760]% IF .CSTMNT[IORECORD] NEQ 0 THEN COUNT_.COUNT+1;
%[760]%
%[760]% RETURN .COUNT;
END;
GLOBAL ROUTINE IOENDERR=
%(***********************
OUTPUT THE END= AND/OR ERR= AND/OR IOSTAT= WORDS OF AN IO ARG BLOCK.
THESE WDS HAVE THE FORM:
---------------------------------------------------------
! 4 ! TYPE !I! X ! IOEND !
---------------------------------------------------------
! 5 ! TYPE !I! X ! IOERR !
---------------------------------------------------------
! 6 ! TYPE !I! X ! IOIOSTAT !
---------------------------------------------------------
Only output these words if nonzero.
**************************)%
BEGIN
EXTERNAL PBOPWD,OBUFFA,PSYMPTR,CSTMNT,EVALU;
%[1002]% MAP EVALTAB EVALU;
MAP BASE CSTMNT;
%[760]% MAP PEXPRNODE PSYMPTR;
MAP OBJECTCODE PBOPWD;
%[760]% LOCAL PEXPRNODE IOSVAL;
%(***OUTPUT THE "END" WD if non zero***)%
PBOPWD_0;
%[760]% IF .CSTMNT[IOEND] NEQ 0
%[760]% THEN
%[760]% BEGIN
%[760]% PBOPWD[OTSKEY]_OTSKEND;
%[760]% PBOPWD[OTSTYPE]_ADDRTYPE; !TYPE IS "ADDRESS"
%[760]% PBOPWD[OTSADDR]_.CSTMNT[IOEND];
%[760]% PSYMPTR_PBFLABREF;
%[760]% OBUFFA();
%[760]% END;
%(***OUTPUT THE "ERROR" WD if non zero***)%
PBOPWD_0;
%[760]% IF .CSTMNT[IOERR] NEQ 0
%[760]% THEN
%[760]% BEGIN
%[760]% PBOPWD[OTSKEY]_OTSKERR;
%[760]% PBOPWD[OTSTYPE]_ADDRTYPE; !TYPE IS "ADDRESS"
%[760]% PBOPWD[OTSADDR]_.CSTMNT[IOERR];
%[760]% PSYMPTR_PBFLABREF;
%[760]% OBUFFA();
%[760]% END;
%[760]% %(***OUTPUT THE "IOSTAT" WD if non zero***)%
%[760]% PBOPWD_0;
%[760]% IF .CSTMNT[IOIOSTAT] NEQ 0
%[760]% THEN
%[760]% BEGIN
%[760]% IOSVAL_.CSTMNT[IOIOSTAT];
%[760]% PBOPWD[OTSKEY]_OTSKIOS;
%1123% IOPTR(.IOSVAL)
%[760]% END;
PBOPWD_0;
END;
GLOBAL ROUTINE IOFORMAT=
%(********************
ROUTINE TO OUTPUT THE 2 FORMAT WDS OF AN IO ARG-BLOCK
THESE WDS HAVE THE FORM:
----------------------------------------------------------
! 2 ! TYPE !I! X ! FORMAT ADDR !
----------------------------------------------------------
! 3 ! TYPE !I! X! ! FORMAT SIZE !
----------------------------------------------------------
************************)%
BEGIN
EXTERNAL CSTMNT,PBOPWD,OBUFFA,PSYMPTR;
EXTERNAL ISN,FATLERR,E91;
EXTERNAL EVALU;
%[1002]% MAP EVALTAB EVALU;
MAP BASE CSTMNT;
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE PSYMPTR;
OWN BASE T:FORMATP;
FORMATP_.CSTMNT[IOFORM];
!IOSTATEMENT CONTAINS POINTER TO LABEL TABLES
!OR VARIABLE
PBOPWD_0;
![760] Only output words if FORMAT exists
%[760]% IF .FORMATP EQL 0 THEN RETURN; ! NOTHING TO DO
IF .FORMATP[OPRCLS] EQL LABOP
THEN
%(***IF FORMAT IS A STMNT- HAVE A PTR TO THE LABEL TABLE ENTRY FOR ITS LABEL***)%
BEGIN
FORMATP_.FORMATP[SNHDR];
%(***IF THE STMNT REFERENCED IS NOT A FORMAT STMNT, GIVE AN ERROR MESSAGE.***)%
IF .FORMATP[SRCID] NEQ FORMID
THEN
BEGIN
FATLERR(.FORMATP[SRCISN],E91<0,0>);
RETURN;
END;
%(***OUTPUT THE FORMAT ADDRESS WD***)%
![760] Set up keyword value
%[760]% PBOPWD[OTSKEY]_OTSKFMT;
PBOPWD[OTSADDR]_.FORMATP;
PBOPWD[OTSTYPE]_ADDRTYPE; !TYPE FIELD EQL TO "ADDRESS"
! INDICATES THAT FORMAT IS NOT
! AN ARRAY
PSYMPTR_PBFFORMAT;
OBUFFA();
%(***OUTPUT THE FORMAT SIZE WD***)%
PBOPWD_.FORMATP[FORSIZ];
![760] Set up keyword value
%[760]% PBOPWD[OTSKEY]_OTSKFSIZ;
PBOPWD[OTSTYPE]_IMMEDTYPE; !SIZE IS REFERENCED IMMED
PSYMPTR_PBF2NOSYM;
OBUFFA();
END
ELSE
%(***IF FORMAT IS AN ARRAY, HAVE A PTR TO THE SYMBOL TABLE ENTRY FOR THE ARRAY NAME***)%
BEGIN
%(***OUTPUT THE FORMAT ADDRESS WD - IF THE ARRAY IS A FORMAL SHOULD
SET THE INDIRECT BIT***)%
![760] Set up keyword value
%[760]% PBOPWD[OTSKEY]_OTSKFMT;
PBOPWD[OTSADDR]_.FORMATP[IDADDR]; !ADDRESS OF THE ARRAY
IF .FORMATP[FORMLFLG] THEN PBOPWD[OTSIND]_1;
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.FORMATP[VALTYPE]]; !TYPE OF THE ARRAY
PSYMPTR_.FORMATP; !PTR TO THE SYMBOL TABLE ENTRY
! FOR THE ARRAY
OBUFFA();
%(***OUTPUT THE FORMAT SIZE WORD. IT WILL BE REFERENCED IMMED, HENCE IF
THE ARRAY SIZE IS VARIABLE, SET THE INDIRECT BIT***)%
PBOPWD_0;
![760] Set up keyword value
%[760]% PBOPWD[OTSKEY]_OTSKFSIZ;
T_.FORMATP[IDDIM]; !GET PTR TO DIMENSION TABLE ENTRY
IF .T[ADJDIMFLG]
THEN
%(***IF THE ARRAY IS ADJUSTABLY DIMENSIONED***)%
BEGIN
PSYMPTR_.T[ARASIZ]; !PTR TO THE SYM TAB ENTRY FOR THE
! TMP THAT HOLDS THE ARRAY SIZE
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
PBOPWD[OTSIND]_1;
END
ELSE
BEGIN
PBOPWD[OTSADDR]_.T[ARASIZ]; !THE CONSTANT FOR ARRAY SIZE
PSYMPTR_PBF2NOSYM;
END;
PBOPWD[OTSTYPE]_IMMEDTYPE; !IMDICATING TO REFERENCE IMMED
OBUFFA();
END;
PBOPWD_0;
END;
GLOBAL ROUTINE IOPTR(EXPR)=
BEGIN
!OUTPUT A WORD OF THE FORM
!
!
!-----------------------------------------------!
! !TYPE !I! X ! ADDRESS !
!-----------------------------------------------!
!
!
EXTERNAL CSTMNT,PBOPWD,OBUFFA,PSYMPTR,EVALU;
%[1002]% MAP EVALTAB EVALU;
MAP PEXPRNODE PSYMPTR;
MAP BASE CSTMNT:EXPR;
MAP OBJECTCODE PBOPWD;
%(***FILL IN TYPE-CODE FIELD OF WD TO BE OUTPUT***)%
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.EXPR[VALTYPE]];
%(***FILL IN PTR TO THE VALUE TO BE OUTPUT. THIS PTR IS BUILT DIFFERENTLY
DEPENDING ON THE OPERATOR-CLASS OF THE EXPRESSION NODE***)%
SELECT .EXPR[OPRCLS] OF NSET
DATAOPR: BEGIN
PBOPWD[OTSADDR]_.EXPR[IDADDR];
IF .EXPR[OPERSP] EQL FORMLARRAY THEN
PBOPWD_.PBOPWD OR INDBIT;
PSYMPTR_.EXPR;
END;
ARRAYREF: BEGIN
OWN PEXPRNODE ARRSYMENTRY; !SYMBOL TABLE ENTRY FOR THE ARRAY NAME
PBOPWD[OTSMEMRF]_.EXPR[TARGTMEM]; !INDEX,ADDR AND INDIRECT FIELDS
ARRSYMENTRY_.EXPR[ARG1PTR];
PSYMPTR_(IF .ARRSYMENTRY[FORMLFLG] !IF ARRAY IS A FORMAL THEN
THEN PBF2NOSYM ! ADDR WILL NOT BE RELOCATED
ELSE .ARRSYMENTRY);
END;
OTHERWISE: BEGIN
%(***SET INDEX AND INDIRECT BITS OF THE OUTPUT WD FROM THE TARGET OF THE EXPR***)%
PBOPWD_.PBOPWD+GETTXFI(EXPR);
%(***IF THE TARGET-MEMREF IS USING AN AC AS A CORE LOCATION THEN
THERE IS NO SYMBOLIC REPRESENTATION***)%
IF .EXPR[INREGFLG]
THEN
BEGIN
PBOPWD[OTSADDR]_.EXPR[TARGTAC];
PSYMPTR_PBF2NOSYM
END
ELSE
%(***IF THE VAL HAS BEEN STORED IN A TEMPORARY***)%
BEGIN
PSYMPTR_.EXPR[TARGADDR];
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR]
END;
END;
TESN;
OBUFFA();
PBOPWD_0;
END;
GLOBAL ROUTINE IOIMMED(EXPR)=
%(***************************************************************************
OUTPUT AN IMMED-MODE FOROTS ARG FOR THE VAL OF "EXPR".
EXPR MAY BE ANY INTEGER EXPRESSION.
IF EXPR IS NOT A CONSTANT, THE INDIRECT BIT IN THE ARG WILL BE SET.
Note that PBOPWD must be cleared and then PBOPWD[OTSKEY] must be
set by the caller
***************************************************************************)%
BEGIN
EXTERNAL EVALU;
%[1002]% MAP EVALTAB EVALU;
EXTERNAL PBOPWD,OBUFFA,PSYMPTR;
MAP PEXPRNODE PSYMPTR;
MAP OBJECTCODE PBOPWD;
MAP PEXPRNODE EXPR;
%(***IF THE ARG IS NOT TYPE INTEGER OR IF THE ARG ALREADY MUST BE REFERENCED
INDIRECT, THEN HAVE AN INTERNAL COMPILER BUG***)%
IF .EXPR [VALTP1] NEQ INTEG1
THEN CGERR();
IF .EXPR[TARGIF] NEQ 0
THEN CGERR();
%(***SET TYPE CODE TO INDICATE THAT ARG IS IN MEMORY***)%
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.EXPR[VALTYPE]];
%(***HOW THE PTR IS TO BE BUILT DEPENDS ON THE OPERATOR OF THE EXPRESSION***)%
SELECT .EXPR[OPRCLS] OF NSET
DATAOPR: BEGIN
%(***IF THE EXPRESSION IS AN INTEGER CONSTANT, PUT THE CONSTANT
DIRECTLY IN THE ARG LIST***)%
IF .EXPR[OPR1] EQL CONSTFL
THEN
BEGIN
PBOPWD[OTSTYPE]_IMMEDTYPE; !INDICATE IMMEDIATE MODE CONSTANT
PBOPWD[OTSADDR]_.EXPR[CONST2];
PSYMPTR_PBF2NOSYM
END
%(***IF THE EXPRESSION IS A FORMAL ARRAY - SET INDIRECT BIT***)%
ELSE
IF .EXPR[OPERSP] EQL FORMLARRAY THEN
BEGIN
PBOPWD[OTSADDR]_.EXPR[IDADDR];
PBOPWD[OTSIND]_1;
PSYMPTR_.EXPR
END
%(***IF THE EXPRESSION IS AN VARIABLE - USE A PTR TO IT***)%
ELSE
BEGIN
PBOPWD[OTSADDR]_.EXPR[IDADDR];
PSYMPTR_.EXPR
END;
END;
ARRAYREF: BEGIN
OWN PEXPRNODE ARRSYMENTRY; !SYMBOL TABLE ENTRY FOR THE ARRAY NAME
PBOPWD[OTSMEMRF]_.EXPR[TARGTMEM]; !INDEX AND BASE ADDR FOR THE ARRAYREF
ARRSYMENTRY_.EXPR[ARG1PTR];
PSYMPTR_(IF .ARRSYMENTRY[FORMLFLG] !IF ARRAY IS A FORMAL THEN
THEN PBF2NOSYM ! ADDR WILL NOT BE RELOCATED
ELSE .ARRSYMENTRY);
END;
OTHERWISE: BEGIN
%(***SET INDEX FIELD FROM THE TARGET OF THE EXPR***)%
PBOPWD_.PBOPWD+GETTXFI(EXPR);
%(***IF THE TARGET MEMREF IS USING AN AC AS A CORE LOCATION THEN
THERE IS NO SYMBOLIC REPRESENTATION***)%
IF .EXPR[INREGFLG]
THEN
BEGIN
PBOPWD[OTSADDR]_.EXPR[TARGTAC];
PSYMPTR_PBF2NOSYM
END
ELSE
%(***IF THE VAL HAS BEEN STORED IN A TEMP***)%
BEGIN
PSYMPTR_.EXPR[TARGADDR];
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
END;
END;
TESN;
OBUFFA();
PBOPWD_0;
END;
ROUTINE CGOPARGS=
BEGIN
!GENERATE AN OPEN TYPE ARGUMENT
EXTERNAL EVALU;
%[1002]% MAP EVALTAB EVALU;
EXTERNAL OBUFF,PBOPWD,PSYMPTR,CSTMNT;
MAP BASE PSYMPTR;
MAP BASE CSTMNT;
MAP OBJECTCODE PBOPWD;
LOCAL OPENLIST ARVALLST; !LIST OF ARGS UNDER THIS OPEN STMNT
LOCAL PEXPRNODE ARGVAL; !PTR TO SYMBOL TABLE OR CONSTANT TABLE
! ENTRY FOR THE VALUE TO BE PASSED TO FOROTS
! FOR A GIVEN ARG
ARVALLST_.CSTMNT[OPLST];
%(***WALK THRU THE LIST OF ARGS GENERATING CODE FOR THEM***)%
INCR I FROM 0 TO (.CSTMNT[OPSIZ]-1) DO
BEGIN
PBOPWD_0;
PBOPWD[OPENGFIELD]_.ARVALLST[.I,OPENLCODE];
ARGVAL_.ARVALLST[.I,OPENLPTR]; !PTR TO EXPRESSION NODE FPR VAL OF THIS ARG
IF .ARGVAL EQL 0 !FOR "DIALOG", WHICH CAN HAVE A NULL VAL
THEN
BEGIN
PSYMPTR_PBFNOSYM;
PBOPWD[OTSADDR]_0
END
ELSE
BEGIN
![1002] Choose arg type based on /GFLOATING
%[1002]% PBOPWD[OTSTYPE]_.EVALU[.ARGVAL[VALTYPE]];
SELECT .ARGVAL[OPRCLS] OF NSET !HOW TO GET THE ADDR OF THE VAL OF EACH ARG DEPENDS
! ON THE OPERATOR-CLASS OF THE EXPRESSION
DATAOPR:
!FOR A VAR/CONST, GET THE ADDRESS FROM ITS SYM TABLE ENTRY
BEGIN
PBOPWD[OTSADDR]_.ARGVAL[IDADDR];
IF .ARGVAL[OPERSP] EQL FORMLARRAY !IF IT'S AN ARRAY FORMAL
THEN PBOPWD[OTSIND]_1; !SET INDIRECT BIT
PSYMPTR_.ARGVAL;
END;
ARRAYREF:
!AN ARRAYREF WILL ONLY OCCUR IN THIS CONTEXT
! IF THE ADDRESS IS ENTIRELY CONSTANT (IE NO INDEXING OR
! INDIRECTION NEED BE USED) - OTHERWISE A "STORECLS"
! NODE WILL HAVE BEEN INSERTED ABOVE THE ARRAYREF TO
! STORE THE VAL IN A TEMPORARY
BEGIN
PSYMPTR_.ARGVAL[ARG1PTR]; !PTR TO SYM TABLE ENTRY FOR THE ARRAY NAME
PBOPWD[OTSADDR]_.ARGVAL[TARGADDR]; !THE 18 BIT ADDRESS OF THIS ARRAY ELEM
END;
OTHERWISE:
!WE KNOW THAT ALL EXPRESSIONS IN THIS CONTEXT WILL BE EVALUATED
! INTO TEMPORARIES. GET THE ADDR OF THE TEMP FROM ITS SYMBOL TABLE ENTRY
BEGIN
PSYMPTR_.ARGVAL[TARGADDR]; !PTR TO SYM TABLE ENTRY FOR THE TEMP
PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
!SET INDIRECT BIT FOR ARRAY REF USED AS ASSOCIATE VARIABLE
!SET INDIRECT BIT FOR ARRAY REF USED AS ASSOCIATE VARIABLE
IF .PBOPWD[OPENGFIELD] EQL OPNCASSOCIATE
THEN PBOPWD[OTSIND]_1;
END;
TESN;
END;
OBUFFA();
END;
END;
FORWARD REDORWRIT;
GLOBAL ROUTINE CGIOARGS=
BEGIN
%(******************************
CODE GENERATION FOR ARGUMENT BLOCKS
FOR I/O STATEMENTS THEMSELVES.
IT IS ASSUMED THAT CSTMNT
POINTS TO THE STATEMENT. THIS IMPLIES
THAT THERE IS A DRIVER ROUTINE
THAT IS FOLLOWING THE LINK LIST OF I/O
STATEMENTS AND CALLING THIS ROUTINE
AND THEN CGIOLARGS TO GENERATE THE ARGUMENT
BLOCK FOR THE I/O LIST
******************************)%
MACRO IOSRCIDBAS=READID$;
!TO OUTPUT A WORD FOR ZEROS. THIS WORD DISTINGUISHES
!BINARY WRITES FROM LIST DIRECTED WRITES (READS TOO)
LOCAL T;
EXTERNAL DEFLAB,MTOPFUN,CGERR,TREEPTR;
EXTERNAL CSTMNT,PBOPWD,PSYMPTR,OBUFF;
MAP BASE CSTMNT;
MAP OBJECTCODE PBOPWD;
!INITIALIZE PBOPWD
PBOPWD_0;
!IF THIS STMNT WAS REMOVED FROM THE PROGRAM BY P2SKEL, THEN
!IOARGLBL FIELD WILL NEVER HAVE BEEN FILLED IN. DO NOT GENERATE
! AN ARGLIST IN THIS CASE
! *****WARNING**** WILL HAVE PROBLEMS IF "IOARGLBL" FIELD IS EVER USED
! FOR ANYTHING ELSE AND SO IS NON-ZERO
IF .CSTMNT[IOARGLBL] EQL 0 THEN RETURN;
IF .CSTMNT[SRCID] EQL OPENID THEN
BEGIN
![760] Output the first args for OPEN/CLOSE
%[760]% OPNFARGS();
CGOPARGS();
RETURN !DO NOT WANT TO LOOK AT THE IOLIST
END ELSE
IF .CSTMNT[SRCID] EQL CLOSID THEN
BEGIN
![760] Output the first args for OPEN/CLOSE
%[760]% OPNFARGS();
CGOPARGS();
RETURN !DO NOT WANT TO LOOK AT THE IOLIST
END ELSE
IF .CSTMNT[SRCID] EQL RELSID THEN
IO1ARG(1)
ELSE
!LOOK FOR CALLS TO MTOP.
IF .CSTMNT[SRCID] GEQ UTILLOW
AND .CSTMNT[SRCID] LEQ UTILHI THEN
BEGIN
![760] Adjust CNTKEYS result based on repeat
%[760]% IO1ARG(T_(IF .CSTMNT[IOREPT] NEQ 0 THEN CNTKEYS()+2 ELSE CNTKEYS()+1));
IOENDERR();
%(***OUTPUT A WD THAT CONTAINS A CODE INDICATING THE FUN TO BE PERFORMED***)%
PBOPWD_0;
![760] Set up keyword value
%[760]% PBOPWD[OTSKEY]_OTSKMTOP;
PBOPWD[OTSTYPE]_IMMEDTYPE;
PBOPWD[OTSADDR]_.MTOPFUN[.CSTMNT[SRCID]-UTILLOW];
PSYMPTR_PBF2NOSYM;
OBUFFA();
%(***OUTPUT THE REPEAT WD IF THERE IS A REPEAT CT***)%
IF .CSTMNT[IOREPT] NEQ 0 THEN
BEGIN
REGISTER BASE T1;
PBOPWD_0;
T1_.CSTMNT[IOREPT];
IF .T1[OPR1] EQL CONSTFL THEN
BEGIN
PBOPWD[OTSADDR]_.T1[CONST2];
PSYMPTR_PBF2NOSYM;
END ELSE
BEGIN
PSYMPTR_.T1;
PBOPWD[OTSADDR]_.T1[IDADDR];
PBOPWD[OTSIND]_1;
END;
PBOPWD[OTSTYPE]_IMMEDTYPE;
OBUFFA();
END;
END ELSE
BEGIN
CASE (.CSTMNT[SRCID]-IOSRCIDBAS) OF SET
! READID:
REDORWRIT();
! WRITID:
REDORWRIT();
! DECOID:
CGDECARGS();
! ENCOID:
CGDECARGS();
! REREDID:
BEGIN
![760] Output first words of arg block
%[760]% IO1ARG(CNTKEYS());
IOENDERR();
IOFORMAT();
END;
! FINDID:
BEGIN
![760] Output first words of arg block
![760] Set up keyword value
%[760]% IO1ARG(CNTKEYS());
%[760]% IOENDERR();
%[760]% PBOPWD[OTSKEY]_OTSKREC;
IOPTR(.CSTMNT[IORECORD]);
END;
! CLOSID:
BEGIN
![760] Output the first args for OPEN/CLOSE
%[760]% OPNFARGS();
CGOPARGS();
RETURN !DO NOT WANT TO LOOK AT THE IOLIST
END;
! INPUID: !NOT IN RELEASE 1
BEGIN
END;
! OUTPID: !NOT IN RELEASE 1
BEGIN
END;
TES;
END;
IF .CSTMNT[IOLIST] NEQ 0 THEN
BEGIN
TREEPTR_.CSTMNT[IOLIST];
CGIOLARGS();
END;
END;
GLOBAL ROUTINE REDORWRIT=
BEGIN
!CODE GENERATION FOR A READ OR WRITE STATEMENT
!INCLUDING ALL SIZES,SHAPES, VARIETIES AND COLORS
EXTERNAL CSTMNT,PBOPWD,OBUFFA,PSYMPTR,GENLAB;
MAP BASE CSTMNT;
MAP OBJECTCODE PBOPWD;
REGISTER BASE T1;
T1_(.CSTMNT[IORECORD] NEQ 0);
IF EXTSIGN(.CSTMNT[IOFORM]) EQL 0 THEN
BEGIN !BINARY IO
![760] Output first words of arg block
%[760]% IO1ARG(CNTKEYS());
IOENDERR();
%(***BINARY WRITE WITH NO IOLIST IS ILLEGAL***)%
!IF .CSTMNT[IOLIST] EQL 0 AND .CSTMNT[SRCID] EQL WRITID
!THEN ERROUT(97);
END ELSE
IF EXTSIGN(.CSTMNT[IOFORM]) EQL -1 THEN
BEGIN !LIST DIRECTED IO
![760] Output first words of arg block
%[760]% IO1ARG(CNTKEYS());
IOENDERR();
![760] Set up keyword value
%[760]% PBOPWD_0;
%[760]% PBOPWD[OTSKEY]_OTSKFMT;
%[760]% PSYMPTR_PBF2NOSYM;
%[760]% OBUFFA();
![760] Set up keyword value
%[760]% PBOPWD_0;
%[760]% PBOPWD[OTSKEY]_OTSKFSIZ;
%[760]% PSYMPTR_PBF2NOSYM;
%[760]% OBUFFA();
END ELSE
BEGIN
T1_.CSTMNT[IONAME];
IF .T1[OPRCLS] EQL DATAOPR AND .T1[IDATTRIBUT(NAMNAM)] THEN
BEGIN !NAME LIST READ
![760] Output first words of arg block
%[760]% IO1ARG(CNTKEYS()-1); ! NAMELIST NAME GETS COUNTED AS FORMAT (2 WDS)
IOENDERR();
!MAKE A LABEL FOR THE NAME LIST ARG BLK
!AND TUCK IT AWAY IN THE IDCOMMON FIELD
!OF THE SYMBOL TABLE
!MAKE IT ONLY IF THERE ISNT ALREADY ONE THERE
IF .T1[IDCOMMON] EQL 0 THEN
T1[IDCOMMON]_GENLAB();
PSYMPTR_PBFLABREF;
PBOPWD_ 0 OR .T1[IDCOMMON];
PBOPWD[OTSKEY]_OTSKNAME;
OBUFFA();
END ELSE
BEGIN !FORMATTER READ
![760] Output first words of arg block
%[760]% IO1ARG(CNTKEYS());
IOENDERR();
IOFORMAT();
END;
END;
IF .CSTMNT[IORECORD] NEQ 0 THEN
BEGIN
![760] Set up keyword value
%[760]% PBOPWD_0;
%[760]% PBOPWD[OTSKEY]_OTSKREC;
%[760]% IOPTR(.CSTMNT[IORECORD]);
END;
END;
GLOBAL ROUTINE NAMGEN=
BEGIN
!GENERATE NAMELIST BLOCKS FOR FORDTS
EXTERNAL OBUFFA, PSYMPTR, PBOPWD,NAMLPTR;
MAP OBJECTCODE PBOPWD;
OWN MRNAMPTR, !MASTER NAME LIST POINTER
NAMLENTRY, !POINTER TO EACH NAMELIST ENTRY
DMETRY; !POINTER TO DIMENSION TABLE ENTRY
LOCAL BASE PTR;
MAP BASE MRNAMPTR: NAMLENTRY: DMETRY;
MRNAMPTR_.NAMLPTR<LEFT>;
WHILE .MRNAMPTR NEQ 0 DO
BEGIN
!SIXBIT NAMELIST NAME
PSYMPTR _ PBF2NOSYM;
PTR_.MRNAMPTR[NAMLID];
%(***IF THIS NAMELIST IS NEVER REFERENCED IN THE PROGRAM, THEN
NO LABEL WILL HAVE BEEN ASSOCIATED WITH IT. IF SO DO NOT GENERATE
IT. (NOTE THAT THE "IDCOMMON" FIELD IS USED TO HOLD THE LABEL
OF A NAMELIST)*******)%
IF .PTR[IDCOMMON] NEQ 0
THEN
BEGIN
!DEFINE THE ARG BLOCK LABEL THAT
!WAS STORED IN THE IDCOMMON FIELD OF
!THE NAMELIST NAME BY REDORWRIT
DEFLAB(.PTR[IDCOMMON]);
PBOPWD _ 0 OR .PTR[IDSYMBOL];
OBUFFA();
PBOPWD_0;
!NOW EACH ENTRY IN THE NAMELIST
INCR I FROM 0 TO .MRNAMPTR[NAMCNT]-1 DO
BEGIN
NAMLENTRY _@(.MRNAMPTR[NAMLIST]+.I);
!OUTPUT SIXBIT NAME
PBOPWD_.NAMLENTRY[IDSYMBOL];
PSYMPTR_PBF2NOSYM;
OBUFFA();
PBOPWD_0;
IF .NAMLENTRY[OPERSP] EQL ARRAYNAME THEN
BEGIN !OUTPUT ARRAYNAME ENTRY
!------------------------------------------!
!#DIMS ! T !I! X ! BASE ADR !
!------------------------------------------!
DMETRY _.NAMLENTRY [IDDIM];
PBOPWD[OTSCNT]_.DMETRY[DIMNUM];
IOPTR (.NAMLENTRY);
!------------------------------------------!
! SIZE(ITEMS) ! POS OFFSET(WDS) !
!------------------------------------------!
%(***GET ARRAY SIZE IN ITEMS (ARASIZ FIELD IS IN WDS)***)%
PBOPWD[OTSFSIZ]_(IF .NAMLENTRY[DBLFLG]
THEN .DMETRY[ARASIZ]/2
ELSE .DMETRY[ARASIZ]);
PTR_.DMETRY[ARAOFFSET];
! (NOTE THAT ADJUSTABLY DIMENSIONED ARRAYS
! ARE ILLEGAL IN NAMELISTS)
%(***COMPILER ADDS THE OFFSET - FOROTS
SUBTRACTS IT. THEREFORE MUST PASS
FOROTS THE NEG OF THE OFFSET USED
BY THE COMPILER***)%
IF .PTR[OPR1] EQL CONSTFL THEN
PBOPWD[OTSADDR]_-.PTR[CONST2]
ELSE
CGERR(); !(ADJUSTABLY DIM ARRAY ILLEGAL)
PSYMPTR_PBF2NOSYM;
OBUFFA();
PBOPWD_0;
!FACTORS
!------------------------------------------!
! ! FACTOR (IN ITEMS)!
!------------------------------------------!
!FACTORS NECESSARY
INCR K FROM 1 TO .DMETRY[DIMNUM] DO
BEGIN
PTR_.DMETRY[DFACTOR ((.K-1))];
IF .PTR [OPR1] EQL CONSTFL THEN
BEGIN !A CONSTANT
PSYMPTR_PBF2NOSYM;
%(***GET FACTOR IN ITEMS (NOT WDS)**)%
PBOPWD_(IF .NAMLENTRY[DBLFLG]
THEN .PTR[CONST2]/2
ELSE .PTR[CONST2]);
OBUFFA();
END ELSE
CGERR();
END; !FACTOR OUTPUT
END ELSE !ARRAY OUTPUT
IOPTR(.NAMLENTRY);
END; !INCR LOOP ON ENTRIES IN NAMELIST
PBOPWD_OTSFINWD; !FIN. TERMINATING WD
PSYMPTR_PBF2NOSYM;
OBUFFA();
END;
MRNAMPTR_.MRNAMPTR[NAMLINK];
END; !WHILE LOOP;
END; !NAMGEN
END
ELUDOM