Trailing-Edge
-
PDP-10 Archives
-
BB-D608D-SB_1982
-
algdec.mac
There are 8 other files named algdec.mac in the archive. Click here to see a list.
;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;
;SUBTTL DECLARATION MODULE
; WRITTEN BY T. TEITELBAUM, L. SNYDER, C.M.U.
; EDITED BY R. M. DE MORGAN.
HISEG
SEARCH ALGPRM,ALGMAC ; SEARCH PARAMETER FILES
MODULE MDEC;
BEGIN
$PLEVEL=0;
EXTERN STABLE,ETABLE,LTABLE,FTABLE,DCBYTE,PRIOBYTE,DESCBYTE;
EXPROC RUND,RUND2,RUND3,RUND5,FATRUND,FAIL,ERREAD,ERR;
EXPROC BENTRY,BEXIT,SONOFF,MABS,SBEGIN,PCALL,PRSYM;
EXPROC MREL,MREL0,ABSFIX,GCOND,REOPEN,UNSTACK,CLOSE;
EXPROC IPLUNK,RAFIX,SEMERR,XTNDLB,SCOL;
EXPROC GSTAT,EVAL,CGINT,TOSTACK,MOB,MPS,MJRST0,PMBPLT;
EXPROC SNBLK,MRK.0,MRK.8,MRK.9;
SUBTTL FRONT END OF DECLARATION OF PROCEDURE SPRODEC.
PROCEDURE SPRODEC;
;WARNING!! DONT DECLARE ANY REGISTERS WITHOUT CHANGING ALL MODULE INITIALIZATIONS.
BEGIN
REGISTER FORMCHAIN;
LOCAL FORMCT,PNAME,FSDISP,MXDISP,ST11,RELBLOCK,PARAM1,PARAM2;
;..JUMP AROUND ALL OTHER PROCEDURES BEING DECLARED WITHIN THIS ONE;
GOTO SPRO1;
;..PUT THE FOLLOWING ROUTINES AT THE INNERMOST PROCEDURE LEVEL.
;.. THIS WAY, THEY WILL NOT USE THE DISPLAY REGISTER FOR THEIR LOCALS.
$PLEVEL=$PLEVEL+1;
SUBTTL ROUTINE COMPOSEDEC TO GATHER MULTIPLE WORD DECLARATIONS.
PROCEDURE COMPOSEDEC;
BEGIN
REGISTER STATE,KTS,XDEL;
FORMAL REQUEST;
IF SYM NE PHI
JUMPE SYM,FALSE;$
THEN
FAIL(8,SOFT,SYM,ILLEGAL SYMBOL);
FI;
;STATE_KTS_0;
SETZB STATE,KTS;$
NXTDEL:
;XDEL_DEL<DISCRIM>;
LDB XDEL,DESCBYTE;$
;KTS_KTS OR COMBTABLE[XDEL];
IOR KTS,COMBTABLE(XDEL);$
;XDEL_DEL<TRANSCLASS>;
LDB XDEL,[POINT 4,DEL,22];$
;STATE_TRANSMATRIX[STATE,XDEL];
LDB STATE,TRANSITION(XDEL);$
IF NDEL = DECSPEC AND NDEL NE KWSTST
MOVE T,NDEL;$
TEST(E,T,DECSPEC);$
TEST(E,T,KWSTST);$
GOTO FALSE;$
THEN
BEGIN
IF NSYM NE PHI
SKIPN NSYM;$
GOTO FALSE;$
THEN
BEGIN
IF STATE ELEMENT FINAL
CAIGE STATE,10;$
GOTO FALSE;$
THEN
GOTO L;
ELSE
FAIL(8,SOFT,NSYM,ILLEGAL SYMBOL);
FI;
ENDD;
FI;
RUND;
GOTO NXTDEL;
ENDD;
FI;
IF STATE ELEMENT FINAL
CAIGE STATE,10;$
GOTO FALSE;$
THEN
L: BEGIN
IF KTS<TYPE> = COMPLEX
TLNE KTS,$TYPE;$
T.C(KTS);$
THEN
BEGIN
FAIL(21,FRIED,DEL,COMPLEX NOT IMPLEMENTED);
;KTS<TYPE>_'REAL';
TLZ KTS,$TYPE;$
TLO KTS,$R;$
ENDD;
FI;
IF KTS<LONG BIT>
TLZN KTS,$LONGBIT;$
GOTO FALSE;$
THEN
BEGIN
;KTS<LONG BIT>_FALSE;
IF KTS<TYPE> = REAL
TLNE KTS,$TYPE;$
T.R(KTS);$
THEN
ELSE
FAIL(22,SOFT,DEL,LONG MUST BE FOLLOWED BY REAL);
FI;
;KTS<TYPE>_'LONG REAL';
TLZ KTS,$TYPE;$
TLO KTS,$LR;$
ENDD;
FI;
;T_REQUEST;
MOVE T,REQUEST;$
;SELECT[STATE-10];
PUSHJ SP,@XANAL-10(STATE);$
ENDD;
ELSE
BEGIN
FAIL(25,HARD,DEL,ILLEGAL DECLARATION-SPECIFICATION);
IF KTS<KIND> = PROC
T.PRO(KTS);$
THEN
;DEL_PROCEDURE;
MOVE DEL,ZPROCEDURE;$
SFALSE(ERRL);
;KTS_.SPRODEC;
MOVEI KTS,.SPRODEC;$
FI;
ENDD;
FI;
;SYM_KTS;
MOVE SYM,KTS;$
;RETURN LEXEME AND PROCESSING ROUTINE ADDR. IN SYM
ENDD
PROCEDURE SPCHECK;
BEGIN
IF SPECIFICATION AND KTS<STATUS> ELEMENT [OWN EXTERNAL FORWARD]
TRNN T,.SPSEL;$
GOTO FALSE;$
HLRZ T,KTS;$
ANDI T,$STATUS;$
CAIL T,$OWN;$
CAILE T,$FOW;$
GOTO FALSE;$
THEN
BEGIN
FAIL(24,FRIED,DEL,ILLEGAL SPECIFICATION);
;KTS<STATUS>_'SIMPLE';
TLZ KTS,$STATUS;$
ENDD;
FI;
ENDD;
;..FORWARD;
PROCEDURE XANL0;
BEGIN
SPCHECK;
;KTS<DECL>_FALSE;
TLZ KTS,$DECL;$
;KTS<TYPE>_'LABEL';
TLO KTS,$L;$
ENDD;
;..OWN VARIABLES (NOT INCLUDING ARRAYS).
PROCEDURE XANL1;
BEGIN
SPCHECK;
;KTS<ROUTINE>_@SIMP;
HRRI KTS,.SIMP;$
ENDD;
;..SIMPLE VARIABLES.
PROCEDURE XANL2;
BEGIN
;KTS<ROUTINE>_@SIMP;
HRRI KTS,.SIMP;$
ENDD;
;..VALUE AND LABEL.
PROCEDURE XANL3;
BEGIN
IF DECLARATION
TRNN T,.DECSEL;$
GOTO FALSE;$
THEN
FAIL(23,HARD,DEL,LABEL-VALUE NOT DECLARATION);
FI;
ENDD;
;..SIMPLE AND OWN ARRAYS.
PROCEDURE XANL4;
BEGIN
SPCHECK;
IF KTS<TYPE> = 0
T.PHI(KTS);$
THEN
;KTS<TYPE>_'REAL';
TLO KTS,$R;$
FI;
ENDD;
;..SIMPLE,FORWARD, AND EXTERNAL PROCEDURES.
PROCEDURE XANL5;
BEGIN
SPCHECK;
IF KTS<TYPE> = 0
T.PHI(KTS);$
THEN
;KTS<TYPE>_'NON TYPE';
TLO KTS,$N;$
FI;
IF KTS<STATUS> = SIMPLE
T.SIM(KTS);$
THEN
;KTS<ROUTINE>_@SPRODEC;
HRRI KTS,.SPRODEC;$
FI;
ENDD;
;..SIMPLE AND FORWARD SWITCHES.
PROCEDURE XANL6;
BEGIN
SPCHECK;
IF KTS<STATUS> = SIMPLE
T.SIM(KTS);$
THEN
;KTS<ROUTINE>_@SWDEC;
HRRI KTS,.SSWDEC;$
FI;
ENDD;
;..FORWARD LABEL;
PROCEDURE XANL7;
BEGIN
SPCHECK;
IF DEL EQ 'LABEL'
CAME DEL,ZLABEL;$
GOTO FALSE;$
THEN
;KTS<DECL>_FALSE;
TLZ KTS,$DECL;$
ELSE
;..ERROR IS "FORWARD VALUE";
FAIL(25,DEL,HARD,ILLEGAL DECLARATION-SPECIFICATION);
FI;
ENDD;
TRANSMATRIX:
; 0 1 2 3 4 5 6 7 10
; V
; A
; L P
; E U R
; X F E O
; T O ' C S
; E R L A E W
; R W A R D I L T
; N O A B R U T O Y
; A W R E A R C N P
; L N D L Y E H G E
; WHERE TYPE ::=
; <INTEGER REAL BOOLEAN STRING COMPLEX>.
BYTE(4) 01,05,10,13,14,15,16,07,12; 0
BYTE(4) 06,06,06,06,06,15,06,02,04; 1
BYTE(4) 06,06,06,06,06,15,06,06,04; 2
BYTE(4) 06,06,06,06,14,06,06,06,11; 3
BYTE(4) 06,06,06,06,06,15,06,06,06; 4
BYTE(4) 06,06,06,06,14,06,06,03,11; 5
BYTE(4) 06,06,06,06,06,06,06,06,06; 6
BYTE(4) 06,06,06,06,14,15,06,06,12; 7
BYTE(4) 06,06,06,17,06,15,16,02,04; 10 FINAL
BYTE(4) 06,06,06,06,14,06,06,06,06; 11 FINAL
BYTE(4) 06,06,06,06,14,15,06,06,06; 12 FINAL
BYTE(4) 06,06,06,06,06,06,06,06,06; 13 FINAL
BYTE(4) 06,06,06,06,06,06,06,06,06; 14 FINAL
BYTE(4) 06,06,06,06,06,06,06,06,06; 15 FINAL
BYTE(4) 06,06,06,06,06,06,06,06,06; 16 FINAL
BYTE(4) 06,06,06,06,06,06,06,06,06; 17 FINAL
COMBTABLE:
XWD $DECL!$EXT,.SIMP;
XWD $DECL!$OWN,0;
XWD $DECL!$FOW,.SIMP;
XWD $DECL!$L,.SIMP;
XWD $DECL!$FOV,.SIMP;
XWD $DECL!$ARR,.SARYDEC;
XWD $DECL!$PRO,0;
XWD $DECL!$PRO!$L,0;
XWD $DECL!$LONGBIT,0;
XWD $DECL!$R,0;
XWD $DECL!$I,0;
XWD $DECL!$B,0;
XWD $DECL!$S,0;
XWD $DECL!$C,0;
TRANSITION:
REPEAT 11,<POINT 4,TRANSMATRIX(STATE),<.-TRANSITION>*4+3>;
XANAL:
XANL0;
XANL1;
XANL2;
XANL3;
XANL4;
XANL5;
XANL6;
XANL7;
SUBTTL ROUTINE TO SELECT DECLARATIONS
PROCEDURE DSEL;
BEGIN
SFALSE(ERRL);
IF DEL EQ PSEUDO-STATEMENT
DELEL(KWSTST);$
THEN
SONOFF
ELSE
BEGIN
;COMPOSE MULTIPLE KEYWORD DECLARATION
;CALL COMPOSEDEC;
COMPOSEDEC;
NOOP .DECSEL;
;THE COMPOSED DELIMITER IS RETURNED IN SYM: (LEXEME,ROUTINE)
WHILE DEL NOT AN ELEMENT OF STOPPERS
NOTSTOP;$
DO
IF ERRL
TGB(ERRL);$
THEN
RUND5
ELSE
BEGIN
STRUE(DECLAR);
;CALL @SYM;
PUSHJ SP,(SYM);$
NOOP .DECSEL;$
SFALSE(DECLAR);
IF DEL#SC
CAMN DEL,ZSC;$
GOTO FALSE;$
THEN
FAIL(16,HARD,DEL,DECLARATION MUST BE FOLLOWED BY SC)
FI;
ENDD;
FI;
OD;
ENDD;
FI;
ENDD;
SUBTTL ROUTINE TO SELECT SPECIFIERS
DEFINE SPSEL
<
BEGIN
IF DEL EQ PSEUDO-STATEMENT
DELEL(KWSTST);$
THEN
SONOFF
ELSE
BEGIN
;CALL COMPOSEDEC;
COMPOSEDEC;$
NOOP .SPSEL;$
WHILE DEL NOT ELEMENT OF STOPS
NOTSTOPS;$
DO
IF ERRL
TGB(ERRL);$
THEN
RUND5
ELSE
BEGIN
;CALL SIMP;
SIMP;$
NOOP .SPSEL;$
ENDD;
FI;
OD;
ENDD;
FI;
ENDD;
>
SUBTTL ROUTINE DUBDEC ... FOR DOUBLE DECLARATION OF VARIABLES.
PROCEDURE DUBDEC;
BEGIN
SEMERR(106,0,UNDECLARED (UNSPECIFIED) IDENTIFIER);
IF SYM NE PHI
JUMPE SYM,FALSE;$
THEN
BEGIN
EDIT(137) ; Don't try to mark constants as undeclared.
IF SYM EQ CONSTANT ; [E137]
T.CONST(SYM) ; [E137]
THEN ; [E137]
BEGIN ; [E137]
TLZ SYM,$SERRL ; [E137]
TLO SYM,$DECL ; [E137]
ENDD ; [E137]
ELSE ; [E137]
BEGIN ; [E137]
;ST[SYM]<SERRL>_TRUE;
;ST[SYM]<DECL>_FALSE;
TLO SYM,$SERRL;$
TLZ SYM,$DECL;$
HLLZM SYM,STW1;$
ENDD ; [E137]
FI ; [E137]
ENDD;
FI;
ENDD;
SUBTTL ROUTINE TO DECLARE/SPECIFY LIST OF VARIABLES.
PROCEDURE SIMP;
BEGIN
REGISTER LEXVAL,SIMPSIZE,ST12;
FORMAL OLDEL;
CODE GSMP1;
;----
;LEXVAL<LEX>_SYM<LEX>;
;LEXVAL<RHS>_0;
HLLZM SYM,LEXVAL;$
;..GIVE WARNING IF THIS DECLARATION IS FOLLOWING A PROCEDURE
;..OR SWITCH DECLARATION;
IF NOT SPECIFICATION AND PROSKIP NE 0
MOVE T,OLDEL;$
TEST(N,T,.SPSEL);$
SKIPN T,PROSKIP;$
GOTO FALSE;$
THEN
BEGIN
JOIN;..(PROSKIP);
FAIL(26,DEL,SOFT,WARNING: VARIABLES DECLARED AFTER PROCEDURES OR SWITCHES);
ZERO(PROSKIP);
ENDD;
FI;
;SIMPSIZE_1;
MOVEI SIMPSIZE,1;$
IF LEXVAL<TYPE> ELEM [LONGREAL STRING COMPLEX]
T.TWO(LEXVAL);$
THEN
;SIMPSIZE_SIMPSIZE+1;
ADDI SIMPSIZE,1;$
FI;
;-------
ENDCODE;
;ST12_STOPS;
;STOPS_STOPS OR COMMA;
SETSTOPS(ST12,.COM);$
LOOP
BEGIN
RUND5;
WHILE DEL NOT ELEMENT OF STOPS
NOTSTOP;$
DO
IF ERRL
TGB(ERRL);$
THEN
ERREAD
ELSE
IF DEL = LBRA
CAME DEL,ZLBRA;$
GOTO FALSE;$
THEN
FAIL(27,HARD,DEL,IMPROPER ARRAY DECLARATION -SPECIFICATION);
ELSE
IF SYM=PHIS AND NSYM=PHIS
SKIPN NSYM;$
JUMPE SYM,TRUE;$
GOTO FALSE;$
THEN
FAIL(28,HARD,DEL,CANNOT DECLARE OR SPECIFY A DELIMITER);
ELSE
FAIL(30,HARD,DEL,IMPROPER DECLARATION);
FI;
FI;
FI;
OD;
IF SYM EQ PHI
JUMPN SYM,FALSE;$
THEN
FAIL(29,SOFT,SYM,MISSING LIST ELEMENT);
ELSE
IF NOT ERRL
TNGB(ERRL);$
THEN
IF OLDEL ELEMENT SPEC.SEL
MOVE T,OLDEL;$
TEL(.SPSEL);$
THEN
CODE GSPEC1;
; ----
IF SYM<STATUS> ELEM [FOV FON] AND FNLEVEL EQ ST[SYM]<PL>
T.FORM;$
HLRZ T,STW0;$
XOR T,FNLEVEL;$
TRNE T,$PL;$
GOTO FALSE;$
THEN
BEGIN
;SYM<AM>_0;
TLZ SYM,$AM;$
IF LEXVAL<STATUS> = FOV
T.FOV(LEXVAL);$
THEN
BEGIN
;..VALUE SPECIFICATION;
IF SYM<STATUS> = FON
T.FON;$
THEN
;SYM<STATUS>_ST[SYM]<STATUS>_FORMAL-BY-VALUE;
TLZ SYM,$STATUS;$
TLO SYM,$FOV;$
HLLM SYM,STW1;$
ELSE
FAIL(31,SOFT,SYM,ALREADY SPECIFIED VALUE);
FI;
ENDD;
ELSE
;..TYPE SPECIFICATION;
IF SYM<KIND!TYPE> EQ 0
TLNE SYM,$KIND!$TYPE;$
GOTO FALSE;$
THEN
;SYM<KIND!TYPE>_ST[SYM]<KIND!TYPE>_LEXVAL<KIND!TYPE>;
HLLZ T,LEXVAL;$
TLZ T,400777;$
IORM T,STW1;$
IOR SYM,T;$
ELSE
DUBDEC;
FI;
FI;
IF SYM EQ VALUE PROCEDURE OR SWITCH
HLRZ T,SYM;$
ANDI T,$KIND!$STATUS;$
XORI T,$PRO!$FOV;$
JUMPN T,FALSE;$
THEN
BEGIN
FAIL(32,SYM,SOFT,PROCEDURES AND SWITCHES CANNOT BE VALUE);
;ST[SYM]<STATUS>_FORMAL-BY-NAME;
TLZ SYM,$STATUS;$
TLO SYM,$FON;$
HLLM SYM,STW1;$
ENDD;
FI;
ENDD
ELSE
BEGIN
IF FORMCT NE -1
SKIPGE FORMCT;$
GOTO FALSE;$
THEN
BEGIN
FAIL(33,FRIED,SYM,ATTEMPT TO SPECIFY NON-FORMAL(S));
;FORMCT_-1;
SETOM FORMCT;$
ENDD;
FI;
IF LEXVAL<KIND>!<TYPE> NE 0
TLNN LEXVAL,$KIND!$TYPE;$
GOTO FALSE;$
THEN
;ST[SYM]<LEX>_LEXVAL<KIND>!<TYPE>!<DECL>;
HLLZ T,LEXVAL;$
TLZ T,-1-$KIND-$TYPE-$DECL;$
IORM T,STW1;$
FI;
ENDD;
FI;
; -------
ENDCODE;
ELSE
CODE GSMP2;
; ----
;..SIMPLE VARIABLES (INTEGER, REAL, BOOLEAN, STRING, LONG REAL,
;..COMPLEX, LONG COMPLEX) ARE DEFINED AND STORAGE IS ALLOCATTD.
IF SYM NOT A VIRGIN ENTRY
TN.VIRGIN;$
THEN
DUBDEC;
ELSE
BEGIN
IF LEXVAL<KIND> = VARIABLE AND LEXVAL<TYPE> NE LABEL
T.VAR(LEXVAL);$
TN.L(LEXVAL);$
THEN
BEGIN
IF LEXVAL<STATUS> = SIMPLE AND FNLEVEL GT 1
MOVE T,FNLEVEL;$
CAILE T,1;$
T.SIM(LEXVAL);$
THEN
BEGIN
;..VARIABLE ALLOCATED IN FIXED STACK;
;LEXVAL<VALUE>_FSDISP;
HRR LEXVAL,FSDISP;$
;FSDISP_FSDISP+SIMPSIZE;
ADDM SIMPSIZE,FSDISP;$
IF LEXVAL<TYPE> = STRING
T.S (LEXVAL);$
THEN
BEGIN;..PLANT CALL TO OTS ROUTINE
;..PLANT MOVEI 1,<LEXVAL>(15);
HRLZI T,<MOVEI 1,0(15)>_-22;$
HRR T,LEXVAL;$
MABS;
MCALL(STRDEC);
SETT(ARDEC);
ENDD;
FI;
ENDD;
ELSE
BEGIN
;..VARIABLE ALLOCATED IN OWN AREA;
;LEXVAL<VALUE>_0;
HRRI LEXVAL,0;$
IF LEXVAL ELEM [LONGREAL COMPLEX STRING]
T.TWO(LEXVAL);$
THEN
XTNDLB
FI;
ENDD;
FI;
ENDD;
ELSE
BEGIN
;..EXTERNAL OR FORWARD DECLARATION;
;LEXVAL<VALUE>_0;
HRRI LEXVAL,0;$
XTNDLB;
IF LEXVAL<TYPE> EQ PROC ;
T.PRO(LEXVAL);$
THEN
BEGIN
;..WRITE.INHIBIT _ 1;
MOVE T,2(SYM);$
ANDI T,77;$
ADDI T,1;$
IDIVI T,6;$
ADDI T,3(SYM);$
MOVE T1,(T);$ FIRST EXTENSION WORD
TLO T1,400000;$
MOVEM T1,(T);$
ENDD; ;
FI;
ENDD;
FI;
;..STORE LEXEME AND VALUE FIELD IN SYMBOL TABLE ENTRY;
;ST[SYM]<1>_LEXVAL;
MOVEM LEXVAL,STW1;$
ENDD;
FI;
; -------
ENDCODE;
FI;
FI;
FI;
SFALSE(ERRL);
ENDD;
AS DEL = COMMA
DELEL(.COM);$
SA;
;STOPS_ST12;
RESTOPS(ST12);$
ENDD;
SUBTTL ROUTINE TO DECLARE ARRAY VARIABLES.
PROCEDURE SARYDEC;
BEGIN
REGISTER ARYCHAIN,LEXVAL;
LOCAL ST13,ARYCT,BPCT,LOWER,ST10,ERRL3;
;ST13_STOPS;
;STOPS_STOPS OR COMMA;
SETSTOPS(ST13,.COM);$
CODE GARY1;
;----
;COMPOSED DECLARATOR LEXEME PASSED BY COMPOSEDEC IN SYM.
;LEXVAL<LEX>_SYM<LEX>;
;LEXVAL<RHS>_0;
HLLZM SYM,LEXVAL;$
;..GIVE WARNING IF THIS DECLARATION IS FOLLOWING A PROCEDURE
;..OR SWITCH DECLARATION;
IF PROSKIP NE 0
SKIPN T,PROSKIP;$
GOTO FALSE;$
THEN
BEGIN
JOIN;..(PROSKIP);
FAIL(26,DEL,SOFT,WARNING: VARIABLES DECLARED AFTER PROCEDURES OR SWITCHES);
ZERO(PROSKIP);
ENDD;
FI;
;..NOOP BLOCK EXIT OPTIMIZATION DUE TO ARRAY DECLARATION;
SETT(ARDEC);
;-------
ENDCODE;
LOOP
BEGIN
SFALSE(ERRL);
CODE GARY2;
; ----
ZERO(ARYCT);
;ARYCHAIN<FIRST>_0;
;ARYCHAIN<OLD>_@ARYCHAIN-1;
HRLZI ARYCHAIN,-1+ARYCHAIN;$
; -------
ENDCODE;
LOOP
BEGIN
RUND5;
CODE GARY3;
; ----
IF SYM NE VIRGIN
TN.VIRGIN;$
THEN
DUBDEC;
ELSE
BEGIN
;ST[SYM]<LEX>_LEXVAL<LEX>;
HLLM LEXVAL,STW1;$
;ST[ARYCHAIN<OLD>]<VALUE>_SYM<ASTE>;
HLRZ T,ARYCHAIN;$
HRRM SYM,1(T);$
;ARYCHAIN<OLD>_SYM<ASTE>;
HRLM SYM,ARYCHAIN;$
INCR(ARYCT);
ENDD;
FI;
; -------
ENDCODE;
ENDD
AS DEL EQ COMMA
DELEL(.COM);$
SA;
IF DEL NE LEFT BRACKET
CAMN DEL,ZLBRA;$
GOTO FALSE;$
THEN
BEGIN
FAIL(34,HARD,DEL,BOUND PAIR NOT FOUND);
WHILE DEL NOT ELEMENT STOPS
NOTSTOP;$
DO
ERREAD;
OD;
ENDD
ELSE
BEGIN
;..THIS COMPOUND STATEMENT PROCESSES THE BOUND PAIR;
;ST10_STOP;
;STOPS_STOPS OR [RIGHT-BRACKET , : ];
SETSTOPS(ST10,.RBRA!.COM!.COLON);$
SETT(LOWER);
STRUE(BPAIR);
ZERO(BPCT);
SFALSE(DECLAR);
SETF(ERRL3);
LOOP
BEGIN
SFALSE(ERRL);
RUND;
ESEL;
IF DEL EQ COLON XOR LOWER
MOVE T,LOWER;$
XOR T,DEL;$
TEST(N,T,.COLON);$
GOTO FALSE;$
THEN
BEGIN
IF NOT ERRL
TNGB(ERRL);$
THEN
FAIL(35,HARD,DEL,BAD PUNCTUATION IN BOUND PAIR)
FI;
ENDD
ELSE
BEGIN
;LOWER_ NOT LOWER;
SETCMM LOWER;$
INCR(BPCT);
CODE GBP1;
; ----
EVAL;
IF SYM ELEM [ARITH EXP]
T.AE;$
THEN
BEGIN
;..FORCE TO INTEGER;
CGINT;
TOSTACK;
MOB;
ENDD;
ELSE
SEMERR(107,$VAR!$I!$SIM!$DECL,ARITH EXPRESSION);
FI;
; -------
ENDCODE;
ENDD;
FI;
;ERRL3_ERRL OR ERRL3;
IORM FL,ERRL3;$
ENDD
AS DEL IS AN ELEMENT OF [COMMA :]
DELEL(.COM!.COLON);$
SA;
;STOPS_ST10;
RESTOPS(ST10);$
IF DEL EQ RIGHT BRACKET
DELEL(.RBRA);$
THEN
BEGIN
SFALSE(ERRL);
RUND3;
ENDD
ELSE
IF NOT ERRL
TNGB(ERRL);$
THEN
FAIL(36,HARD,DEL,MISSING RIGHT BRACKET);
FI;
FI;
SFALSE(BPAIR);
STRUE(DECLAR);
CODE GARY4;
; ----
;..ALLOCATE LOCAL USE OF TEMPORARY REGISTERS;
DIM=T2;
;..INITIALIZE SYM FOR PASSING THRU LINKED SYMBOL TABLE ENTRIES;
;SYM<LHS>_0;
;SYM<ASTE>_ARYCHAIN<FIRST>;
HRRZ SYM,ARYCHAIN;$
;..TREAT NUMBER OF DIMENSIONS ;
;BPCT_BPCT/2;
;DIM<LHS>_(BPCT+1) MOD 2^5;
MOVE DIM,BPCT;$
LSH DIM,-1;$
MOVEM DIM,BPCT;$
ADDI DIM,1;$
ANDI DIM,$AM;$
HRLZI DIM,(DIM);$
;..TREAT GLOBALS AND OWNS DIFFERENTLY FROM VARIABLES IN THE STACK;
IF LEXVAL<STATUS> EQ SIMPLE AND FNLEVEL NE 1
MOVE T,FNLEVEL;$
CAILE T,1;$
T.SIM(LEXVAL);$
THEN
;..VARIABLE IN STACK;
WHILE SYM<ASTE> NE 0
TRNN SYM,777777;$
GOTO FALSE;$
DO
BEGIN
;T_ST[SYM]<VALUE>;
HRR T,STW1;$
;ST[SYM]<VALUE>_FSDISP;
MOVE T1,FSDISP;$
HRRM T1,STW1;$
;FSDISP_FSDISP+2;
ADDI T1,2;$
MOVEM T1,FSDISP;$
;ST[SYM]<AM>_DIM;
IORM DIM,STW1;$
;SYM<ASTE>_T;
HRR SYM,T;$
ENDD;
OD;
ELSE
;..VARIABLE IN STORAGE;
WHILE SYM<ASTE> NE 0
TRNN SYM,777777;$
GOTO FALSE;$
DO
BEGIN
;T_ST[SYM];
MOVE T,STW1;$
;ST[SYM]<AM>_DIM;
IOR T,DIM;$
;ST[SYM]<VALUE>_0;
HLLZM T,STW1;$
;SYM<ASTE>_T;
HRR SYM,T;$
ENDD;
OD;
FI;
;..CODE CALL SEQUENCE FOR ARRAY ALLOCATION;
;..REG A1: LEXEME OF ARRAY;
;T_'MOVEI A1,'.LEXVAL<LEXEME>;
;BUT MAKE IT OWN IFI FXED ARRAY;
HLRZ T,LEXVAL;$
ANDI T,$KIND!$TYPE!$STATUS;$
MOVE T1,FNLEVEL;$
CAIG T1,1;$
IORI T,$OWN;$
HRLI T,<MOVEI A1,0>_-22;$
MABS;
;..REG A2: ADDRESS OF FIRST ARRAY VARIABLE IN LIST;
;T_'MOVEI A2,'.$ST.ARYCHAIN<FIRST>;
HRRZ T,ARYCHAIN;$
HRLI T,<MOVEI A2,>_-22!$ST;$
MPS;
;..REG A3: -# OF ARRAYS;
;T_'MOVNI A3'.ARYCT;
MOVE T,ARYCT;$
HRLI T,<MOVNI A3,>_-22;$
MABS;
;..REG A4: -# OF DIMENSIONS;
;T_'MOVNI A4,'.BPCT;
HRLZI T,<MOVNI A4,0>_-22;$
HRR T,BPCT;$
MABS;
;..CALL ALLOCATOR IN ALGOTS;
IF LEXVAL<STATUS> = OWN
T.OWN(LEXVAL);$
THEN
MCALL(OARRAY);
ELSE
MCALL(ARRAY);
FI;
; -------
ENDCODE;
ENDD;
FI;
ENDD
AS DEL EQ COMMA
DELEL(.COM);$
SA;
;STOPS_ST13;
RESTOPS(ST13);$
ENDD;
SUBTTL ROUTINE FOR <SWITCH DECLARATION>.
PROCEDURE SSWDEC;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL ST9,LISTCT,SWFIX;
;ST9_STOPS;
;STOPS_STOPS OR COMMA;
SETSTOPS(ST9,.COM);$
RUND5;
CODE GSW1DEC;
;----
;..PLACE JRST AROUND SWITCH BODY IF THIS IS FIRST PROCEDURE IN THIS BLOCK;
IF PROSKIP EQ 0
SKIPE PROSKIP;$
GOTO FALSE;$
THEN
SPLIT(PROSKIP);
FI;
IF SYM<STATUS> EQ 'FORWARD'
T.FOW;$
THEN
BEGIN
IF SYM NE SWITCH
SETCM T,SYM;$
TLNN T,$PRO!$L;$
GOTO FALSE;$
THEN
FAIL(37,FRIED,SYM,TYPE DISAGREES WITH FORWARD DECLARATION);
;..SYM<STATUS>_SIMPLE
TLZ SYM,$STATUS
FI;
;..RESOLVE BACKCHAIN OF REFERENCES;
FIXREL(STW1);
;..FORCE SYM TO LOOK LIKE A VIRGIN IDENTIFIER;
;SYM<LHS>_0;
HRRZI SYM,(SYM);$
ENDD;
FI;
IF SYM NE VIRGIN IDENTIFIER
TN.VIRGIN;$
THEN
DUBDEC;
ELSE
BEGIN
;ST[SYM]<LEXEME>_[PRO LABEL SIMPLE DECL];
;ST[SYM]<VALUE> _RA;
MOVE T,RA;$
HRLI T,$PRO!$L!$SIM!$DECL;$
MOVEM T,STW1;$
ENDD;
FI;
ZERO(LISTCT);
MABSI(<CAILE A2,0>);
;SWFIX_RA;
MOVE T,RA;$
MOVEM T,SWFIX;$
MABSI(<CAILE A2,.-.>);
MABSI(<SETZ A2,0>);
MABSI(<XCT .-.(A2)>);
MABSI(<POPJ SP,0>);
;T_'POPJ SP,0';
HRLZI T,<POPJ SP,0>_-22;$
PLUNKI;
REVER;
CLOSE(LOP);
BENTRY;
;-------
ENDCODE;
SFALSE(DECLAR);
IF DEL NE _
CAMN DEL,ZASS;$
GOTO FALSE;$
THEN
FAIL(38,HARD,DEL,COLON-EQUAL MISSING IN SWITCH DECL.);
FI;
LOOP
BEGIN
SFALSE(ERRL);
RUND5;
LSEL;
CODE GSW2DEC;
; ----
REVER;
IF SYM<AM> EQ CODE GENERATED
T.COGE;$
THEN
BEGIN
UNSTACK;
REOPEN;
;T_'POPJ SP,0';
HRLZI T,<POPJ SP,0>_-22;$
PLUNKI;
CLOSE;
;SWFIX<LHS>_RA;
MOVE T,RA;$
HRLM T,SWFIX;$
MOB;
REOPEN(LOP);
;T_'JRST'.SWFIX<LHS>;
HRLZI T,<JRST 0>_-22!$REL;$
HLR T,SWFIX;$
PLUNKI;
CLOSE(LOP);
ENDD;
ELSE
BEGIN
REOPEN(LOP);
;LEXEX_LLEXEX;
MOVE T,LLEXEX;$
MOVEM T,LEXEX;$
;T_'.LSEL';
MOVEI T,.LSEL;$
GCOND;
;LLEXEX_LEXEX;
MOVE T,LEXEX;$
MOVEM T,LLEXEX;$
ENDD;
FI;
INCR(LISTCT);
; -------
ENDCODE;
ENDD
AS DEL EQ COMMA
DELEL(.COM);$
SA;
;STOPS_ST9;
RESTOPS(ST9);$
CODE GSW3DEC;
;----
FIXABS(SWFIX,LISTCT);
;T_SWFIX+2;
HRRZ T,SWFIX;$
ADDI T,2;$
FIXREL;
;SYM_LEFTOP;
;SYM<LEXEME>_[EXP LABEL SIMPLE DECL SP];
MOVE T,LLEXEX;$
MOVEM T,LEXEX;$
HRLZI SYM,$EXP!$L!$SIM!$DECL!$SP;$
MOB;
BEXIT;
;-------
ENDCODE;
SFALSE(ERRL);
ENDD;
;..RETURN TO THE PROCEDURE LEVEL OF THE BODY OF SPRODEC.
$PLEVEL=$PLEVEL-1;
SUBTTL BODY OF PROCEDURE SPRODEC.
SPRO1:
IF FNLEVEL = 0
SKIPE FNLEVEL;$
GOTO FALSE;$
THEN
BEGIN
;..THE PROGRAM BLOCK;
MCALL(PARAM);
MOVEI T,0;$
MABS;$
;PARAM1_RA;
MOVE T,RA;$
MOVEM T,PARAM1;$
;T_0,.-.;
SETZ T,0;$
MABS;
MABSI(<XWD $PRO!$N,1>);
;FSDISP_MXDISP_2;
MOVEI T,2;$
MOVEM T,FSDISP;$
MOVEM T,MXDISP;$
INCR(FNLEVEL);
ZERO(PNAME);
ZERO(RELBLOCK);
BENTRY;
RUND;
PUSH SP,RA
MOVE T,PARAM1
SUBI T,2
MOVEM T,RA
TRNN FL,TRPOFF
PUSHJ SP,.ESBLK##
POP SP,RA
IF DEL EQ 'COLON'
DELEL(.COLON);$
THEN
SCOL
FI;
IF DEL EQ 'BEGIN'
CAME DEL,ZBEGIN;$
GOTO FALSE;$
THEN
SBEGIN
ELSE
FAIL(88,HARD,DEL,PROGRAM NOT FOUND AFTER LABEL)
FI;
TRNN FL,TRPOFF
PUSHJ SP,.ESBLK##
MABSI(<JRST 1(DL)>);
FIXABS(PARAM1,MXDISP);
BEXIT;
ENDD;
ELSE
BEGIN
CODE GPRO1;
;----
; THIS ROUTINE SAVES THE TYPE OF THE PROCEDURE IN THE LEFT HALF OF
; PNAME. THE TYPE COMES FROM SYM, WHERE IS WAS LEFT BY COMPOSEDEC.
;PNAME<LEX>_SYM<LEX>;
HLLZM SYM,PNAME;$
;..IF THIS IS THE FIRST PROCEDURE DECLARATION THIS BLOCK
;..THEN PLACE A JRST INSTRUCTION AROUND PROCEDURE CODE;
IF PROSKIP EQ 0
SKIPE PROSKIP;$
GOTO FALSE;$
THEN
SNBLK;
MRK.8;
MRK.9;
SPLIT(PROSKIP);
FI;
;-------
ENDCODE;
RUND5;
; Edit (1004) Fix compiler looping on bad procedure name.
IF SYM = PHI OR SYM = CONST; [E1004]
JUMPE SYM,TRUE; [E1004]
T.CONST(SYM); [E1004]
THEN; [E1004]
BEGIN; [E1004]
SEMERR (106,0, UNDECLARED(UNSPECIFIED) IDENTIFIER );[E1004]
; [E1004] ENTER AN ERROR SYMBOL TABLE ENTRY
PUSH SP,NSYM; [E1004]
PUSH SP,FL; [E1004]
;
Edit(170); Turn off CREF switch correctly.
;
TRZ FL,CREF; [E1004][E170]
MOVEI T,[
EXP 0
XWD 1,0]; [E1004]
AOJ T,; [E1004]
MOVEM T,NSYM; [E1004]
PUSHJ SP,.SEARCH##; [E1004]
POP SP,FL; [E1004]
POP SP,NSYM; [E1004]
; [E1004] MAKE IT A VIRGIN IDENTIFIER
; [E1004] SYM<LHS>_0
TLZ SYM,777777; [E1004]
ENDD; [E1004]
ELSE; [E1004]
IF TRACING
TRNE FL,TRLOFF;$
GOTO FALSE;$
THEN
BEGIN ; PLANT TRACE INFORMATION BLOCK BEFORE PROC HEADING
; PARAM1_RA;
HRR T,RA;$
MOVEM T,PARAM1;$
PMBPLT;
ENDD;
ELSE
; NO TRACING;
; PARAM1_0;
SETZM PARAM1;$
FI;
FI; [E1004]
CODE GPRO2;
;----
;..THE PROCEDURE IDENTIFIER IS DECLARED, THE JUMP AROUND PROCEDURE
;..DECLARATIONS IS PLACED, THE FICTIOUS BLOCK IS SETUP AND THE
;..FORMAL CHAIN IS INITIALIZED (SEE GPRO3, GPRO5).
IF SYM<STATUS> = FORWARD
T.FOW;$
THEN
BEGIN
IF SYM<TYPE> NE PNAME<TYPE>
HLL T,SYM;$
XOR T,PNAME;$
TLNN T,$TYPE;$
GOTO FALSE;$
THEN
FAIL(37,FRIED,SYM,TYPE DISAGREES WITH FORWARD DECLARATION);
FI;
;..RESOLVE BACKCHAIN OF REFERENCES TO THIS PROCEDURE;
FIXREL(STW1);
;..MAKE SYM LOOK LIKE A VIRGIN IDENTIFIER;
;SYM<LHS>_0;
TLZ SYM,777777;$
;.. WRITE.INHIBIT _ 0; ;
MOVE T,2(SYM);$
ANDI T,77;$
ADDI T,1;$
IDIVI T,6;$
ADDI T,3(SYM);$
SETZM (T);$ W.INH IS SIGN BIT;
ENDD;
ELSE;
IF SYM<STATUS> NE EXTERNAL
TLNN SYM,700;$
GOTO TRUE;$
TLC SYM,300;$
TLCN SYM,300;$
GOTO FALSE;$
THEN;
XTNDLB;
FI; ;
FI;
IF NOT VIRGIN IDENTIFIER
TN.VIRGIN;$
THEN
BEGIN; [E1004]
DUBDEC; [E1004]
; [E1004] PNAME<SERRL>_TRUE
MOVE T,PNAME; [E1004]
TLO T,$SERRL; [E1004]
MOVEM T,PNAME; [E1004]
ENDD; [E1004]
ELSE
BEGIN
; SYM<LEX>_ST[SYM]<LEXEME>_PNAME<LEX>;
HLL T,PNAME;$
HLL SYM,T;$
; ST[SYM]<VALUE>_RA
HRR T,RA;$
MOVEM T,STW1;$
;PNAME<AM>_ST;
;PNAME<ASTE>_SYM<ASTE>;
TLO SYM,$ST;$
MOVEM SYM,PNAME;$
ENDD;
FI;
;T_FNLEVEL_FNLEVEL+1;
AOS T,FNLEVEL;$
IF FNLEVEL GT 63
CAIGE T,100;$
GOTO FALSE;$
THEN
FAIL(39,FATAL,DEL,TOO MANY PROCEDURE LEVELS);
FI;
;..SET FSDISP TO POINT TO FIRST FORMAL LOCATION;
IF SYM<TYPE> ELEM [LONGREAL STRING COMPLEX]
T.TWO;$
THEN
;FSDISP_3;
MOVEI T,3;$
ELSE
IF SYM<TYPE> = NONTYPE
T.N;$
THEN
BEGIN; ;
;..ASSIGNMENT.DONE _ 1; TO AVOID WARNING AT END;
MOVE T,2(SYM);$
ANDI T,77;$
ADDI T,1;$
IDIVI T,6;$
ADDI T,3(SYM);$
MOVE T1,(T);$
TLO T1,200000;$
MOVEM T1,(T);$
;FSDISP_1;
MOVEI T,1;$
ENDD; ;
ELSE
;FSDISP_2;
MOVEI T,2;$
FI;
FI;
;MXDISP_FSDISP_FSDISP+FNLEVEL;
ADD T,FNLEVEL;$
MOVEM T,FSDISP;$
MOVEM T,MXDISP;$
BENTRY;
ZERO(RELBLOCK);
;FORMCT_1;
MOVEI T,1;$
MOVEM T,FORMCT;$
;..INITIALIZE THE FORMCHAIN WORD ::= <OLD,FIRST> APPROPRIATELY TO SAVE
;..THE FIRST FORMAL SYMBOL TABLE ADDRESS.
;FORMCHAIN<OLD>_@FORMCHAIN-1;
;FORMCHAIN<FIRST>_0;
HRLZI FORMCHAIN,-1+FORMCHAIN;$
;-------
ENDCODE;
IF DEL = LPAR
CAME DEL,ZLPAR;$
GOTO FALSE;$
THEN
BEGIN
;ST11_STOPS;
;STOPS_STOPS OR RPAR COM;
SETSTOPS(ST11,.RPAR!.COM);$
LOOP
BEGIN
RUND;
WHILE DEL NOT ELEMENT OF STOPS
NOTSTOP;$
DO
IF ERRL
TGB(ERRL);$
THEN
RUND5
ELSE
FAIL(40,DEL,HARD,NOT SIMPLE ID IN FORMAL LIST);
FI;
OD;
CODE GPRO3;
; ----
;..THIS ROUTINE PROCESSES A FORMAL PARAMETER AND CHAINS THE SYMBOL TABLE
;..ENTRIES FOR THESE PARAMETERS IN THE VALUE FIELD OF THE ST ENTRY
;..FOR CONVENIENT REFERENCE IN GPRO5.
IF SYM NE VIRGIN
TN.VIRGIN;$
THEN
SEMERR(108,0,VIRGIN IDENTIFIER);
ELSE
BEGIN
;ST[SYM]<LEX>_[0,0,FON,DECL];
MOVEI T,$FON!$DECL;$
HRLM T,STW1;$
;ST[FORMCHAIN<0LD>]<VALUE>_SYM<ASTE>;
HLRZ T,FORMCHAIN;$
HRRM SYM,1(T);$
;FORMCHAIN<OLD>_SYM<ASTE>;
HRLM SYM,FORMCHAIN;$
INCR(FORMCT);
ENDD;
FI;
; -------
ENDCODE;
SFALSE(ERRL);
ENDD
AS DEL = COMMA OR FATCOMMA
DELEL(.COM);$
SKIPE NSYM;$
FATRUND;$
SA;
;STOPS_ST11;
RESTOPS(ST11);$
IF DEL NE RPAR
DELNEL(.RPAR);$
THEN
FAIL(41,DEL,SOFT,FORMAL LIST NOT CLOSED);
ELSE
RUND5
FI;
ENDD
ELSE
IF DEL = PHID
JUMPN DEL,FALSE;$
THEN
BEGIN
FAIL(42,DEL,SOFT,MISSING SEMI IN PROC HEAD);
;DEL_SEMI;
MOVE DEL,ZSC;$
ENDD
FI;
;POSSIBLE FIXUP FOR: P A,B);;
FI;
WHILE DEL NOTELEMENT STOPS
NOTSTOP;$
DO
IF ERRL
TGB(ERRL);$
THEN
RUND5
ELSE
FAIL(44,DEL,HARD,ILLEGAL PUNCTUATION IN FORMAL LIST);
FI
OD;
IF DEL NE SEMI
DELNEL(.SC);$
THEN
FAIL(0,DEL,HARD,MISSING SEMICOLON);
ELSE
BEGIN
CODE GPRO4;
; ----
;..THE ROUTINE GENERATES THE CALL TO PARAM FOR PROCEDURE
;..INITIALIZATION.
TRNN FL,TRPOFF
PUSHJ SP,.ESBLK##
MCALL(PARAM);
; PLANT POINTER TO POST-MORTEM BLOCK
HRRZ T,PARAM1;$
IF NOT TRACING
TRNN FL,TRLOFF
GOTO FALSE
THEN;
MABS;
ELSE;
MREL0;
FI;
;..GENERATE ARGUMENT WORD 1, [FUNCTION LEVEL OF PROCEDURE NAME, MAX FIXED STACK SIZE];
;PARAM1_RA;
MOVE T,RA;$
MOVEM T,PARAM1;$
;T<LHS>_FNLEVEL-1;
;T<RHS>_.-.;
HRLZ T,FNLEVEL;$
SUB T,[XWD 1,0];$
MABS;
;..GENERATE ARGUMENT WORD 2, [PROCEDURE LEXEME,# OF FORMALS +1];
;T<LHS>_PNAME<LEX>;
HLL T,PNAME;$
TLZ T,000077;$
;T<RHS>_FORMCT;
HRR T,FORMCT;$
MABS;
;ST[PNAME]<ADRESS MODE FIELD>_FORMCT MOD 2^5;
MOVE T1,PNAME;$
MOVE T,FORMCT;$
DPB T,[POINT 5,1(T1),17];$
; -------
ENDCODE;
SFALSE(ERRL);
IF NDEL ELEMENT DECSPEC
NDELEL(DECSPEC);$
THEN
BEGIN
LOOP
BEGIN
RUND2;
SPSEL;
SFALSE(ERRL);
ENDD;
AS DEL = SEMI AND NDEL ELEMENT DECSPEC
TEST(N,DEL,.SC);$
GOTO FALSE;$
NDELEL(DECSPEC);$
SA;
ENDD;
FI;
IF DEL NE SEMI
DELNEL(.SC);$
THEN
FAIL(0,DEL,HARD,MISSING SEMICOLON);
FI;
CODE GPRO5;
; ----
;..THIS ROUTINE PASSES THRU THE LIST OF FORMALS
; 1) VERIFY THAT EACH HAS BEEN SPECIFIED
; 2) OUTPUT FORMAL DESCRIPTOR WORD FOR PARAM CALL
;SYM<LHS>_0;
;SYM<ASTE>_FORMCHAIN<FIRST>;
HRRZ SYM,FORMCHAIN;$
ZERO(FORMCT);
; WARNING !!!!!!!
; TERMINATION OF THE FOLLOWING LOOP RELIES ON THE FACTS
; 1) FORMCHAIN<OLD> IS INITIALLY ZERO
; 2) THE LAST FORMAL ON THE CHAIN HAS <VALUE> = 0
WHILE SYM<ASTE> NE 0
TRNN SYM,777777;$
GOTO FALSE;$
DO
BEGIN
;T1_FSDISP;
MOVE T1,FSDISP;$
;T_ST[SYM]<WORD1>;
MOVE T,STW1;$
IF T<TYPE> = 0
T.PHI(T);$
THEN
BEGIN
;ST[SYM]<LEX>_VIRGIN;
HRRZS STW1;$
;ST[SYM]<MSGIVEN>_TRUE;
HRLZI T2,$MSG;$
IORM T2,STW0;$
INCR(FORMCT)
ENDD;
FI;
;ST[SYM]<VALUE>_T1;
HRRM T1,STW1;$
;SYM<ASTE>_T<RHS>;
HRR SYM,T;$
;T<RHS>_T1;
HRR T,T1;$
IF T<KIND> = ARRAY
HLRZ T2,T;$
ANDI T2,$KIND;$
CAIE T2,$ARR;$
GOTO FALSE;$
THEN
;T1_T1+2;
ADDI T1,2;$
ELSE
IF T<STATUS> = FORMAL BY NAME OR T<TYPE> = LABEL
HLRZ T2,T;$
ANDI T2,$TYPE;$
CAIN T2,$L;$
GOTO TRUE;$
T.FON(T);$
THEN
;T1_T1+3;
ADDI T1,3;$
ELSE
IF T<TYPE> ELEM [LONGREAL STRING COMPLEX]
T.TWO(T);$
THEN
;T1_T1+2;
ADDI T1,2;$
ELSE
;T1_T1+1;
ADDI T1,1;$
FI;
FI;
FI;
;FSDISP_T1;
MOVEM T1,FSDISP;$
MABS;
ENDD;
OD;
IF FORMCT NE 0
SKIPN FORMCT;$
GOTO FALSE;$
THEN
FAIL(43,FRIED,DEL,N UNSPECIFIED FORMALS);
FI;
;..FICTITIOUS BLOCK AROUND BODY;
BENTRY;
; -------
ENDCODE;
SFALSE(DECLAR)
RUND2;
SFALSE(ERRL);
SSEL;
CODE GPRO6;
; ----
;..GENERATOR FOR PROCEDURE EXIT.
;..COMPLETE THE PROCEDURE BODY;
GSTAT;
;T1_MAX(MXDISP,FSDISP);
MOVE T1,FSDISP;$
CAMGE T1,MXDISP;$
MOVE T1,MXDISP;$
;..RESOLVE THE MAXIMUM FIXED STACK SIZE
;.. PARAMETER IN THE CALL TO PARAM.
FIXABS(PARAM1);
;..LABEL THE FINAL END WITH A STATEMENT NUMBER
TRNN FL,TRPOFF
PUSHJ SP,.ESBLK##
;..PROCEDURE EXIT THROUGH INSTRUCTION LOADED
;.. BY PARAM IN THE RESULT SPECIFIER LOCATION.
;T_'JRST FNLEVEL(DL)';
MRK.0; ;PLACE MARKER
HRLZI T,<JRST 0(DL)>_-22;$
ADD T,FNLEVEL;$
MABS;
BEXIT;
BEXIT;
IF TRACING AND TYPED PROCEDURE
MOVE T,PNAME;
;
Edit(167); Test for /PRODUCTION switch correctly.
;
TLNE T,$TYPE-$N
TRNE FL,TRPOFF; [E167]
GOTO FALSE;
THEN; Place Symbol Table Entry for Procedure Result
PRSYM;
FI;
DECR(FNLEVEL);
IF NOT PNAME<SERRL>; [E1004]
MOVE T,PNAME; [E1004]
TLNE T,$SERRL; [E1004]
GOTO FALSE; [E1004]
THEN; [E1004]
;..WRITE.INHIBIT _ 1; ;
HRRZ T,PNAME;$
MOVE T1,2(T);$
ANDI T1,77;$
ADDI T1,1;$
IDIVI T1,6;$
ADDI T,3(T1) ; POINT TO EXTN
MOVE T1,(T); 1ST EXTENSION WORD
IF NO.ASSIGNMENT.MADE;
TLOE T1,600000; ALSO SET W.INH
GOTO FALSE;
THEN
BEGIN
MOVEM T1,(T);$
FAIL(126,SOFT,DEL,NO ASSIGN TO TYPED PROCEDURE IN ITS BODY);
ENDD;
ELSE
MOVEM T1,(T);$
FI;
FI; [E1004]
; -------
ENDCODE;
SFALSE(ERRL);
ENDD;
FI;
ENDD;
FI;
ENDD; OF PROCEDURE SPRODEC.
ENDD; OF MODULE MDEC
LIT
END