PDP-10 Archive: sources/algutl.mac from AP-5471B-BM (original) (raw)
Trailing-Edge-PDP-10 Archives-AP-5471B-BM- sources/algutl.mac
There are 8 other files named algutl.mac in the archive. Click here to see a list.
; ; ; ; ; ; ; COPYRIGHT (C) 1975,1976,1977,1978 ; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A ; SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY 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 EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO ; AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE ; SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT ; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ; EQUIPMENT CORPORATION. ; ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ;
;SUBTTL MODULE WITH GENERAL UTILITY ROUTINES
; COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
; WRITTEN BY T. TEITELBAUM, L. SNYDER, C.M.U. ; EDITED BY R. M. DE MORGAN.
HISEG
SEARCH ALGPRM,ALGMAC ; SEARCH PARAMETER FILESMODULE MUTL;
$PLEVEL=2; BEGIN EXPROC FAILED,EVAL,REOPEN,PLUNK,IPLUNK,CLOSE,UNSTACK,MOB,TOCT1,BEXIT; EXPROC XTNDLB,STADD,MABS,MREL,RAFIX,CGBINARY,SBHDR; EXPROC MABS,ADDFIX,PROGDEF,PROCDEF,ZZEND,SONOFF,COMPOSDEC; EXPROC SPRODEC,SBEGIN,SBRACK,SFPARN,EXPARN,DSEL,RUND,SCRUND,SEARCH,MABS,GETSPC; EXTERN .RINIT,.PINIT,COREB,CHKSUM,CCLSW;
SUBTTL INITIALIZATION FOR COMPILER AND TEST INTERN TEST OWN REALLOCATE; TEST: ;..PRIMARY INTERPRETATION LOOP; ;..SET SEQUENCE FOR NORMAL AND CCL ENTRY. TDZA A1,A1 ;NORMAL MOVEI A1,1 ;CCL MOVEM A1,CCLSW ZERO(COREB); ZERO(CHKSUM); WHILE TRUE NOOP FALSE;$ DO BEGIN ;CALL RINIT; JSP A1,.RINIT;$ SETF(REALLOCATE); ;..PROCESS ANY PSEUDO INSTRUCTIONS (LISTON,CHECKON,...) PSEUDO; IF NDEL = 'BEGIN' OR 'COLON' MOVE T,NDEL;$ CAMN T,ZBEGIN;$ GOTO TRUE;$ TEL(.COLON);$ THEN BEGIN ;..BLOCK OR LABELLED BLOCK; SETT(REALLOCATE); ;..WRITE LOADER BLOCK FOR PROGRAM; PROGDEF; ;..COMPILE PROGRAM; SPRODEC; ;..WRITE LOADER FIXUPS FOR ALL GLOBAL SYMBOLS AND CONSTANTS; ZZEND; ENDD;
ELSE IF NDEL = 'EOF' TEL(.EOF);$ THEN FAIL(89,HARD,DEL,EMPTY SOURCE FILE); FI; FI;
;..PROCESS INTERNAL PROCEDURES, ALLOW EXTRA SEMI-COLON BEFORE EOF; WHILE DEL NE 'EOF' AND (DEL NE SEMICOLON OR NDEL NE 'EOF') DELNEL(.EOF);$ TEST(N,DEL,.SC);$ GOTO TRUE;$ NDELNEL(.EOF);$ DO BEGIN ;..REALLOCATE FRESH TABLES AND STACK IF NECESSARY; IF REALLOCATE SKIPN REALLOCATE;$ GOTO FALSE;$ THEN ;CALL PINIT; JSP A1,.PINIT;$ FI; SETT(REALLOCATE); PSEUDO;
IF ERRL TGB(ERRL);$ THEN IF NDEL EQ 'BEGIN' MOVE T,NDEL;$ CAME T,ZBEGIN;$ GOTO FALSE;$ THEN SPRODEC; STRUE(ERRL); ELSE RUND FI ELSE IF NDEL ELEM DECSPEC MOVE T,NDEL;$ TEL(DECSPEC);$ THEN BEGIN RUND; COMPOSEDEC; NOOP .DECSEL; ;..COMPOSITE DELIMITER RETURN IN SYM; IF SYM = @PRODEC AND NOT ERRL HRRZI T,.SPRODEC;$ CAIN T,(SYM);$ TNGB(ERRL);$ THEN BEGIN ;..INTERNAL PROCEDURE;
;..WRITE LOADER BLOCK FOR INTERNAL PROCEDURE;
PROCDEF;
;..TURN ON DECLARATION MODE;
STRUE(DECLAR);
;FNLEVEL_1;
AOS FNLEVEL;$
BENTRY;
;..COMPILE PROCEDURE;
SPRODEC;
BEXIT;
SFALSE(DECLAR);
;..WRITE LOADER FIXUPS FOR GLOBAL SYMBOLS AND CONSTANTS;
ZZEND;
IF DEL NOT ELEM [SC EOF]
DELNEL(.SC!.EOF);$
THEN
FAIL(87,DEL,HARD,ILLEGAL TERM. OF PROC);
FI;
ENDD;
ELSE
IF NOT ERRL
TNGB(ERRL);$
THEN
FAIL(88,DEL,HARD,ILLEGAL FILE STRUCTURE);
FI;
FI;
ENDD;
ELSE
IF DEL = 'END'
DELEL(.END);$
THEN
FAIL(86,DEL,HARD,EXTRA END - INCORRECT BLOCK STRUCTURE);
ELSE
FAIL(85,DEL,HARD,INCORRECT BLOCK OR FILE STRUCTURE);
FI;
FI;FI; ENDD; OD; ;..FATAL COMPILER ERRORS REENTER HERE; INTERN HELL HELL: ENDD; OD;
SUBTTL ROUTINE LOOK. ;..ROUTINE FOR SYMBOL LOOK-AHEAD ON NSYM; ;.. USED WHEN RECOVERY FROM SYNTAX ERROR IS BEING ATTEMPTED; PROCEDURE LOOK; BEGIN OWN SYMSYM; ;..CALL SEARCH MAKING SURE THAT 1) NO ENTRY IS MADE ;.. AND 2)SEARCH IS NOT CALLED IF SYM IS PHI OR CONSTANT ;.. AND 3) SYM IS NOT DESTROYED.;
MOVEM SYM,SYMSYM;$
STRUE(NOENTRY);$
SKIPN T,NSYM;$
JRST .+3;$
TLNN T,$KIND;$
PUSHJ SP,.SEARCH;$
SFALSE(NOENTRY);$
MOVE SYM,SYMSYM;$ENDD;
SUBTTL ROUTINE TO RECOVER WINDOW AFTER MISSING SEMICOLON PROCEDURE SCINSERT; BEGIN FAIL(0,SOFT,NSYM,MISSING SEMICOLON); ;..FIXUP WINDOW; ;DEL_SEMICOLON; MOVE DEL,ZSC;$ ;SYM_SEARCH; SKIPN SYM,NSYM;$ JRST .+3;$ TLNN SYM,$KIND;$ PUSHJ SP,.SEARCH;$ ;..COMPUTE LEXEX AND COMPNAME; ;..LINE POINTER(SYM)_LINE POINTER(DEL)_LINE POINTER(NSYM); SCRUND; ZERO(NSYM); ENDD;
SUBTTL RUND2 ROUTINE. ;..ROUTINE TO RUND WINDOW WHEN A "BEGIN" OR ";" IS IN DEL; ;..RUND2 CHECKS FOR MISSING SEMICOLON AFTER PARAMETERLESS PROCEDURE; ;..FOR EXAMPLE: ;.. BEGIN P BEGIN END; P X_Y END; ;.. ^ ^ PROCEDURE RUND2; BEGIN IF NSYM NE PHI AND NDEL ELEMENT [KWSTST DECSPEC PHID] SKIPN NSYM;$ GOTO FALSE;$ MOVE T,NDEL;$ JUMPE T,TRUE;$ TEL(KWSTST!DECSPEC);$ THEN BEGIN ;..KILL POSSIBLE SEMERR LEXEME; ;SYM_0; SETZ SYM,0;$ ;T_LOOK; LOOK;$ IF T EQ PROCEDURE AND #PARAMETERS EQ 0 T.PRO(T);$ MOVE T1,1(T);$ TLNE T1,$AM-1;$ GOTO FALSE;$ THEN BEGIN ;..MISSING SEMI-COLON; IF NDEL = PHID SKIPE NDEL;$ GOTO FALSE;$ THEN BEGIN FAIL(0,SOFT,NDEL,MISSING SEMICOLON); RUND;
;DEL_SEMICOLON;
MOVE DEL,ZSC;$
ENDD
ELSE
SCINSERT;
FI
ENDD
ELSE
RUND;
FI;
ENDDELSE RUND; FI; ENDD;
SUBTTL RUND3 ROUTINE. ;..ROUTINE TO RUND WINDOW WHEN A ")" OR "]" IS IN DEL; ;..RUND3 CHECKS FOR MISSING SEMICOLON BEFORE STATEMENTS AND DECLARATIONS; ;.. AND VERIFIES THAT ")" OR "]" IS NOT IMMEDIATELY FOLLOWED BY ;.. A SYMBOL. ;..FOR EXAMPLE: ;.. BEGIN P(X,Y) BEGIN END; X_A[I] Y+Z+A[I] Y_0 END; ;.. ^ ^ ^ PROCEDURE RUND3; BEGIN IF NSYM = PHIS AND NDEL NOTELEM [KWSTST DECSPEC] SKIPE NSYM;$ GOTO FALSE;$ MOVE T,NDEL;$ TNEL(KWSTST!DECSPEC);$ THEN RUND ELSE ;..KILL POSSIBLE SEMERR LEXEME ;SYM_0; SETZ SYM,0;$ IF NOT TOPLEVEL TN.TOPLEV;$ THEN BEGIN IF NSYM NE PHIS OR NDEL EQ 'IF' SKIPE NSYM;$ GOTO TRUE;$ MOVE T,NDEL;$ CAME T,ZIF;$ GOTO FALSE;$ THEN FAIL(4,HARD,NSYM,MISSING OPERATOR); ;IN ALL OTHER CASES ERROR MUST BE GIVEN ON SELECTION; FI; RUND; ENDD
ELSE
IF NDEL ELEMENT [KWSTST DECSPEC]
MOVE T,NDEL;$
TEL(KWSTST!DECSPEC);$
THEN
BEGIN
IF NSYM NE PHIS
SKIPN NSYM;$
GOTO FALSE;$
THEN
BEGIN
FAIL(4,HARD,DEL,MISSING OPERATOR)
;SYM_NSYM_PHIS;
SETZB SYM,NSYM;$
ENDD
FI;
FAIL(0,SOFT,NSYM,MISSING SEMI);$
;DEL_SEMI;
MOVE DEL,ZSC;$
ENDD
ELSE
IF <NDEL ELEMENT [:_] OR (NDEL ELEMENT [;(] AND LOOK ELEMENT [NT PROC])>
TEST(E,T,.COLON);$
GOTO TRUE;$
CAMN T,ZASS;$
GOTO TRUE;$
TEST(E,T,.SC);$
GOTO .+3;$
CAME T,ZLPAR;$
GOTO FALSE;$
LOOK;$
T.PRO(T);$
T.N(T);$
THEN
BEGIN
FAIL(0,SOFT,DEL,MISSING SEMI);
;DEL_SEMI;
MOVE DEL,ZSC;$
ENDD
ELSE
BEGIN
FAIL(4,HARD,NSYM,MISSING OPERATOR);
RUND
ENDD
FI;
FI;
FI;FI; ENDD;
SUBTTL RUND5 ROUTINE. ;..ROUTINE TO RUND WINDOW WHEN EXPRESSION "ELSE" OR DECLARATION "," IN DEL; ;.. ALSO CERTAIN CASES IN PROCEDURE DECLARATION; ;..RUND5 CHECKS FOR MISSING SEMICOLON BEFORE A STATEMENT OR DECLARATION; ;..FOR EXAMPLE: ;.. BEGIN REAL X,Y BEGIN END; X_IF B THEN Y ELSE Z BEGIN END END; ;.. ^ ^ PROCEDURE RUND5; BEGIN IF NDEL NOT ELEMENT [KWSTST DECSPEC PHID] MOVE T,NDEL;$ JUMPE T,FALSE;$ TNEL(KWSTST!DECSPEC);$ THEN RUND ELSE ;..KILL POSSIBLE SEMERR LEXEME; ;SYM_0; SETZ SYM,0;$ IF NSYM EQ PHIS AND NDEL EQ 'IF' SKIPE NSYM;$ GOTO FALSE;$ CAME T,ZIF;$ GOTO FALSE;$ THEN RUND ELSE IF NDEL ELEMENT [KWSTST DECSPEC] TEL(KWSTST!DECSPEC);$ THEN ;..MISSING SEMICOLON; SCINSERT; ELSE BEGIN RUND;
IF <NOT ERRL AND (NDEL ELEMENT [: _] OR (NDEL ELEMENT [;(] AND LOOK EQ NONTYPE PROCEDURE))>
TNGB(ERRL);$
MOVE T,NDEL;$
TEST(E,T,.COLON);$
GOTO TRUE;$
CAMN T,ZASS;$
GOTO TRUE;$
TEST(E,T,.SC);$
GOTO .+3;$
CAME T,ZLPAR;$
GOTO FALSE;$
LOOK;$
T.PRO(T);$
T.N(T);$
THEN
BEGIN
FAIL(0,SOFT,DEL,MISSING SEMICOLON);
;DEL_SEMICOLON;
MOVE DEL,ZSC;$
ENDD;
FI;
ENDD;
FI;
FI;FI; ENDD;
SUBTTL ROUTINE PSEUDO. ;..ROUTINE PROCESSES PSEUDO-OPS IN ALL CASES EXCEPT WHERE SSEL SELECTS AUTOMATICALLY. ;..FOR EXAMPLE: BEFORE THE PROGRAM, BEFORE AND WITHIN DECLARATIONS, ;.. BUT NOT BETWEEN STATEMENTS. PROCEDURE PSEUDO; BEGIN WHILE NDEL = PSEUDO OP MOVE T,NDEL;$ TEST(E,T,KWSTST);$ TEST(N,T,DECSPEC);$ GOTO FALSE;$ DO BEGIN RUND2; SONOFF; ENDD; OD; ENDD;
SUBTTL ERREAD ROUTINE.
;..ENTRY TO ERREAD VIA .ERR WILL CAUSE A RETURN TO CALL SITE MINUS 3. ;..THIS ENTRY POINT IS USED IN ORDER TO OPTIMIZE THE SEL LOOPS. INTERN .ERR; .ERR: ;RETURN ADDRESS IN STACK_RETURN ADDRESS - 4; MOVNI T,4;$ ADDM T,(SP);$
;..ROUTINE TO RUND WINDOW WHILE IN A SYNTAX ERROR LEVEL.; ;..ERREAD WILL EITHER DESCEND ON A SUITABLE OPEN BRACKET OR RUND.; PROCEDURE ERREAD; BEGIN IF <DEL ELEMENT [BEGIN DO ( [ PROCEDURE]> DELEL(ERRST);$ [534] THEN DESCEND ELSE RUND FI; ERRLEX; ENDD;
SUBTTL GOBBLE ROUTINE. ;..ERROR READ ROUTINE FOR BRACKETS AND PARENS DURING DECLARATIONS. PROCEDURE GOBBLE; BEGIN ;..ARGUMENT IN T INDICATES PROPER STOPPER: ) OR ] BIT; LOCAL ST21; ;ST21_STOPS; SAVESTOPS(ST21);$ ;STOPS_[; END EOF ] UNION T; MOVE STOPS,T;$ ADDSTOPS(.SC!.END!.EOF);$ RUND; SFALSE(DECLAR); WHILE DEL NOT ELEMENT STOPS NOTSTOPS;$ DO ERREAD; OD; STRUE(DECLAR); ;STOPS_ST21; RESTOPS(ST21);$ ENDD;
SUBTTL DESCEND ROUTINE. ;..ROUTINE TO DESCEND DURING ERROR READING. ;..THE DELIMITERS ( [ BEGIN DO PROCEDURE ;..WILL CAUSE THE SYNTAX CHECKING TO RESUME DURING ERROR READING. PROCEDURE DESCEND; BEGIN LOCAL SVSTOPS,SVGB; ;SVSTOPS_STOPS; SAVESTOPS(SVSTOPS);$ ;SVGB_FL; MOVEM FL,SVGB;$ SFALSE(ERRL!DECLAR); SFALSE(NOENTRY); LET SEARCH MAKE ENTRIES. EDIT (604) ; FIX ERROR-RECOVERY FOR BEGIN INNTEGER I ETC; ;SYM0; TLZ SYM,$SERRL;$ IF DEL = LBRA CAME DEL,ZLBRA;$ GOTO FALSE;$ THEN BEGIN ZERO(SYM); ;SYM1; TLO SYM,$SERRL;$ IF SVGB MOVE T,SVGB;$ TEL(DECLAR);$ THEN BEGIN ;T ]-STOPPER; HRLZI T,.RBRA-22;$ GOBBLE; ENDD; ELSE SBRACK; NOOP .ERSEL; FI;
ENDDELSE IF DEL = LPAR CAME DEL,ZLPAR;$ GOTO FALSE;$ THEN BEGIN IF SVGB MOVE T,SVGB;$ TEL(DECLAR);$ THEN BEGIN ;T_ )-STOPPER; HRLZI T,.RPAR_-22;$ GOBBLE; ENDD; ELSE IF SYM ELEMENT [ARRAY PROC] OR SYM NEW ENTRY TLNE SYM,$ARR;$ GOTO TRUE;$ T.VIRGIN;$ THEN BEGIN ZERO(SYM); ;SYM_1; TLO SYM,$SERRL;$ SFPARN; NOOP .ERSEL ENDD ELSE BEGIN EXPARN; NOOP .ERSEL ENDD FI; FI; ENDD
ELSE
BEGIN
;STOPS_[SC END EOF ELSE];
HRLZI STOPS,<.SC!.END!.EOF!.ELSE>_-22;$
;SYM_PHIS;
SETZ SYM,;$
IF DEL = BEGIN
CAME DEL,ZBEGIN;$
GOTO FALSE;$
THEN
BEGIN
SBEGIN;
NOOP .ERSEL
ENDD
ELSE
IF DEL EQ PROCEDURE
CAME DEL,ZPROCEDURE;$
GOTO FALSE;$
THEN
BEGIN
IF <NDEL ELEMENT [ SEMICOLON ( ]>
MOVE T,NDEL;$
CAMN T,ZLPAR;$
GOTO TRUE;$
TEL(.SC);$
THEN
DSEL
ELSE
RUND
FI;
ENDD
ELSE
;DEL IS NECESSARILY A DO;
IF NDEL = KWSTST AND NSYM = PHIS
NDELEL(KWSTST);$
SKIPE NSYM;$
GOTO FALSE;$
THEN
BEGIN
RUND;
SSELECT(.ERSEL)
ENDD
ELSE
RUND;
FI;
FI;
FI;
ENDD;
FI;FI; ;STOPS_SVSTOPS; RESTOPS(SVSTOPS);$ ;FL_SVGB; SFALSE(ERRL!DECLAR!NOENTRY);$ MOVE T,SVGB;$ ANDI T,ERRL!DECLAR!NOENTRY;$ IOR FL,T;$ ENDD;
SUBTTL FAIL ROUTINE ;..ROUTINE TO EMIT FAIL MESSAGE. ;..FAIL MAY DECIDE TO SUPPRESS THE FAIL MESSAGE. PROCEDURE FAIL; BEGIN FORMAL FAILCODE; ;..FAILCODE ::= [XWD CODE, MSG] ;.. WHERE MSG IS THE MESSAGE NUMBER ;.. CODE IS A BIT ENCODING OF ;.. WINDOW POSITION (SYM,DEL,NSYM,NDEL) ;.. STRENGTH (HARD,SOFT,FRIED,FATAL,IUO).; ;T_FAILCODE; MOVE T,FAILCODE; TLNE T,..FVARY;$ HRR T,(T);$ ;T1_GLOBAL BOOLEAN REGISTER; MOVE T1,FL;$ ;IF FAILCODE ;THEN STRUE(ERRL); TLNE T,SUSPSYN;$ STRUE(ERRL);$ ;IF FAILCODE ;THEN STRUE(ERRF); TLNE T,SUSPCOD;$ STRUE(ERRF);$ ;TTY_FAIL MESSAGE; IF NOT T AND SYM AND (HARD IMPL ERRL) TLNE SYM,400000;$ TLNE T,..FATAL;$ GOTO FALSE;$ TLNN T,SUSPSYN;$ GOTO TRUE;$ TEST(N,T1,ERRL);$ GOTO FALSE;$ THEN ;..SUPRESS FAIL MSG; GOTO FOUT;$ FI; FAILED;
IF FAILCODE TLNN T,SUSPCOD;$ GOTO FALSE;$ THEN ERRLEX; FI;
FOUT: ;SKIP RETURN; AOS (SP);$ ENDD;
SUBTTL ERRLEX ROUTINE PROCEDURE ERRLEX; BEGIN ;..FORCE THE LEXEME OF SYM TO BE ALWAYS WRONG AND THEREBY ;..AUTOMATICALLY SKIP ALL EXPRESSION CODE GENERATION. THIS ;..LEXEME WILL BE PRESERVED BY ALL EXPRESSION ROUTINES. ;..THE LEXEME WILL EVENTUALLY DISAPPEAR WHEN A CORRECT LEXEME ;..NORMALLY WOULD. ;SYM_1; ;SYM_0; TLO SYM,$SERRL;$ TLZ SYM,$DECL;$ ENDD;
SUBTTL SEMANTICS ERROR RECOVERY
;..ROUTINE SEMERR DISTINGUISHES BETWEEN THREE CASES: ;.. 1/ SYM IS NULL, EG. ;IF THEN... ;.. 2/ SYM IS UNDECLARED VARIABLE, ;.. 3/ SYM IS WRONG IN THIS CONTEXT, EG. WRONG TYPE. ;..IN THE CASE OF AN UNDECLARED VARIABLE, THE MESSAGE GIVEN BIT IN ;.. THE SYMBOL TABLE IS TURNED ON AND IS USED TO SUPRESS DOUBLE MESSAGES. ;..IF THE CALL SITE HAS SPECIFIED A LIKELY LEXEME FOR THE UNDECLARED IDENTIFIER ;.. THEN IT IS GIVEN THAT DECLARATION. PROCEDURE SEMERR; BEGIN FORMAL SEMERLEX;
;..SEMERLEX ::= [XWD LEXEME,MSG] WHERE THE LEXEME IS
;..USED IN FIXING UP UNDECLARED IDENTIFIERS, IF ANY.
;..MSG INDICATES WHAT CONSTRUCT WAS BEING SOUGHT WHEN THE ERROR
;..WAS ENCOUNTERED FOR USE IN THE IUO FORM OF FAIL
IF NOT ERRL TNGB(ERRL);$ THEN BEGIN IF SYM = PHIS JUMPN SYM,FALSE;$ THEN BEGIN ;SYM_0; TLZ SYM,$SERRL;$ FAIL(5,FRIED,SYM,MISSING INDENTIFIER); ENDD;
ELSE IF SYM = VIRGIN ENTRY T.VIRGIN;$ THEN BEGIN IF NOT ST[SYM] HLL T,STW0;$ TLNE T,$MSG;$ GOTO FALSE;$ THEN BEGIN ;..ALWAYS PRINT MESSAGE(EVEN IF SEMANTIC ERROR LEVEL); ;SYM_0; TLZ SYM,$SERRL;$ FAIL(1,FRIED,SYM,UNDECLARED VARIABLE); ;ST[SYM]_TRUE; HRLZI T,$MSG;$ IORM T,STW0;$ ; TROUBLE LATER IF ITS REALLY A LABEL SO XTNDLB; ENDD; FI; ;ST[SYM]_SEMERLEX; HLL T,SEMERLEX;$ HLLM T,STW1;$ ;SYM_SEMERLEX; HLL SYM,T;$ ERRLEX; ENDD; ELSE ;FAIL(#,IUO,SYM,SEMERLEX[EXPECT]); MOVE T2,SEMERLEX;$ PUSHJ SP,.FAIL;$ XWD ..SYM!..IUO!..FVARY,T2;$ FI; FI; ENDD; FI; ;SKIP RETURN PAST ARG WORD; AOS (SP);$ ENDD;
SUBTTL ROUTINES FOR SELECTION ON BAD SYNTAX PROCEDURE F1; BEGIN STRUE(NOENTRY); FAIL(2,HARD,DEL,ILLEGAL STMT); ENDD;
PROCEDURE F2; BEGIN FAIL(96,HARD,DEL,DECLARATION FOLLOWS STATEMENT); ;..KILL "PROCEDURES DECLARED" FLAG; ZERO(PROSKIP); DSEL; WHILE DEL=SC AND NDEL IS DECSPEC TEST(N,DEL,.SC);$ GOTO FALSE;$ NDELEL(DECSPEC);$ DO BEGIN RUND2; DSEL; SFALSE(ERRL); ENDD; OD; STATEMENT; ENDD;
PROCEDURE F3; BEGIN FAIL(3,HARD,DEL,ILLEGAL EXPRESSION); ;STOPS_STOPS-[,: STEP UNTIL WHILE]; TLZ STOPS,EXPUNGE_-^D18;$ ENDD;
PROCEDURE F4; BEGIN FAIL(6,HARD,DEL,ILLEGAL DESIGNATION EXPRESSION); ;STOPS_STOPS-[,: STEP UNTIL WHILE]; TLZ STOPS,EXPUNGE_-^D18;$ ENDD;
PROCEDURE F5; BEGIN FAIL(7,HARD,DEL,ILLEGAL ASSINGMENT); STRUE(ERRL); ENDD;
SUBTTL BLOCK ENTRY ROUTINE. PROCEDURE BENTRY; BEGIN INCR(BLOCKLEVEL); ;GETSPC(1); MOVEI T4,1;$ GETSPC;$ ;SAVE STATE OF SYMBOL TABLE; MOVEI T4,1(T);$ EXCH T4,STBB;$ MOVEM T4,(T);$ IF NOT PRODUCTION SWITCH SET; TNGB(TRPOFF); THEN;..OUTPUT BLOCK-START ITEM FOR DEBUGGER SBHDR; FI; ENDD;
SUBTTL POST-MORTEM BLOCK GENERATION ROUTINES - PMBLNT PROCEDURE PMBLNT; BEGIN IF TRACING LABELS TNGB(TRLOFF);$ THEN ; LENGTH OF PMB _ SIXBITZ LENGTH OF NAME + 2 WORDS; BEGIN; MOVE T,2(SYM);$ ANDI T,77;$ TLNN SYM,$TYPE-$L ; TLNN SYM,$TYPE ; AOSA T ; ADDI T,2 ; IDIVI T,6;$ ADDI T,3;$ ENDD;$ ELSE; ; LENGTH _ 0 SETZ T,;$ FI; ENDD;
SUBTTL POST-MORTEM BLOCK GENERATION ROUTINES - PMBPLT PROCEDURE PMBPLT; BEGIN LOCAL OUTPTR; MOVEI T,0;$ MABS;$ MOVE T1,2(SYM);$ ANDI T1,77;$ AOS T1;$ HRRZI T,(T1);$ HRRZI T4,(T1);$ TLNN SYM,$TYPE-$L;$ TLNN SYM,$TYPE;$ JRST .+2;$ AOS T,T1 ; IDIVI T1,6;$ SKIPE T2;$ AOS T1;$ HRL T,T1;$ MOVEI T1,2(SYM);$ MOVE T2,2(SYM);$ LSH T2,-6;$ SETZB T3,T5;$
PMB2: JUMPN T2,PMB3;$ ADDI T1,1;$ MOVE T2,(T1);$
PMB3: SETZ T3,;$ LSHC T2,-6;$ JUMPE T3,PMB3;$ ROT T3,6;$ ADDI T3,40;$
PMB7: SOJG T5,PMB5;$ PUSH SP,T2;$ PUSH SP,T3;$ PUSH SP,T4;$ MABS; POP SP,T4;$ POP SP,T3;$ POP SP,T2;$ SETZ T,;$ SKIPA T5,.+1;$ POINT 6,T;$ MOVEM T5,OUTPTR;$ MOVEI T5,6;$
PMB5: IDPB T3,OUTPTR;$ SOJG T4,PMB2;$ MOVEI T3,':';$ TLNN SYM,$TYPE-$L;$ TLNN SYM,$TYPE;$ JRST .+2;$ JUMPE T4,PMB7;$ MABS; TRNN T,77;$ JRST PMB6;$ MOVEI T,0;$ MABS;$ PMB6: ENDD;
SUBTTL CODE GENERATION UTILITIES... PCALL, MJRST0. ;..ROUTINE TO EMIT CALL ON SYSTEM ROUTINE THROUGH %ALGDR TABLE. PROCEDURE PCALL; BEGIN FORMAL OFFSET; ;..THE ALGDR OFFSET IS PASSED AS A FORMAL.
;TOFFSET; HRR T,OFFSET;$ ;T'JSP AX,@'; HRLI T,<JSP AX,@.-.>_-22 MABS; ;T_RA-1; MOVE T,RA;$ SUBI T,1; FIXADD; KILLAX; ENDD;
;..ROUTINE TO EMIT INSTRUCTION "JRST 0" . PROCEDURE MJRST0; BEGIN ;T_'JRST .-.'; HRLZI T,<JRST .-.>_-22;$ MABS; ENDD
SUBTTL ROUTINE TOSTACK. PROCEDURE TOSTACK; BEGIN ;..THIS PROCEDURE GENERATES CODE TO PUSH SYM ONTO THE STACK; IF SYM = IMM T.IMM;$ THEN ;.. ADD TO CONSTANTS TABLE; ;T3_SYM; HRRZ T3,SYM;$ TOCT(1,SYM); FI; UNSTACK; REOPEN; ;T_'PUSH SP,.-.'; HRLZI T,<PUSH SP,0>_-22;$ PLUNKI(SYM); ;SYM_SP; TLZ SYM,$AM;$ TLO SYM,$SP;$ CLOSE; ENDD;
SUBTTL ROUTINE LABREF. ;..ROUTINE PROCESSES DESIGNATIONAL EXPRESSION. PROCEDURE LABREF; BEGIN IF SYM = ST SETCM T,SYM;$ TLNN SYM,30;$ TLNE T,7;$ GOTO FALSE;$ THEN BEGIN ;..SYM IS AN IDENTIFIER.; IF SYM = VIRGIN ID T.VIRGIN;$ THEN BEGIN XTNDLB; ;SYM_VAR,LABEL,SIM,UNDECL; ;ST[SYM]_VAR,LABEL,SIM,UNDECL; HRLI SYM,$VAR!$L!$SIM;$ HLLM SYM,STW1;$ TLO SYM,$ST;$ ENDD; ELSE IF ST[SYM] LT BLOCKLEVEL HLRZ T,STW0;$ ANDI T,$BL;$ LSH T,-6;$ CAML T,BLOCKLEVEL;$ GOTO FALSE;$ THEN BEGIN ;..IDENTIFIER IS DECLARED IN SOME OUTER BLOCK.; IF SYM NOT A FORMAL LABEL HLRZ T,SYM;$ ANDI T,$TYPE!$STATUS;$ CAIE T,$L!$FON;$ CAIN T,$L!$FOV;$ GOTO FALSE;$ THEN
;..MAKE NEW SYMBOL TABLE ENTRY FOR THIS IDENTIFIER
;.. AT CURRENT BLOCKLEVEL IN CASE
;.. IDENTIFIER IS REDECLARED IN THIS BLOCK.
;..(THE CASE OF THE FORMAL LABEL IS EXCLUDED BECAUSE
;.. WE REQUIRE A FORWARD DECLARATION IF A FORMAL
;.. LABEL IS TO BE REDECLARED. THIS IS NECESSARY
;.. BECAUSE THE DIFFERENCE BETWEEN THE CODE
;.. FOR GOTO LOCAL L AND