Trailing-Edge
-
PDP-10 Archives
-
ap-5069c-sb
-
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 FILES
MODULE 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<RHS> = @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<KIND> 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;
ENDD
ELSE
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.
;SYM<SERRL>_0;
TLZ SYM,$SERRL;$
IF DEL = LBRA
CAME DEL,ZLBRA;$
GOTO FALSE;$
THEN
BEGIN
ZERO(SYM);
;SYM<SERRL>_1;
TLO SYM,$SERRL;$
IF SVGB<DECLAR>
MOVE T,SVGB;$
TEL(DECLAR);$
THEN
BEGIN
;T_ ]-STOPPER;
HRLZI T,.RBRA_-22;$
GOBBLE;
ENDD;
ELSE
SBRACK;
NOOP .ERSEL;
FI;
ENDD
ELSE
IF DEL = LPAR
CAME DEL,ZLPAR;$
GOTO FALSE;$
THEN
BEGIN
IF SVGB<DECLAR>
MOVE T,SVGB;$
TEL(DECLAR);$
THEN
BEGIN
;T_ )-STOPPER;
HRLZI T,.RPAR_-22;$
GOBBLE;
ENDD;
ELSE
IF SYM<KIND> ELEMENT [ARRAY PROC] OR SYM NEW ENTRY
TLNE SYM,$ARR;$
GOTO TRUE;$
T.VIRGIN;$
THEN
BEGIN
ZERO(SYM);
;SYM<SERRL>_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<SUSPEND SYNTAX SCAN>
;THEN STRUE(ERRL);
TLNE T,SUSPSYN;$
STRUE(ERRL);$
;IF FAILCODE<SUSPEND OBJECT FILE>
;THEN STRUE(ERRF);
TLNE T,SUSPCOD;$
STRUE(ERRF);$
;TTY_FAIL MESSAGE;
IF NOT T<FATAL> AND SYM<SERRL> 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<SUSPEND CODE GENERATION>
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<SERRL>_1;
;SYM<DECLAR>_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<SERRL>_0;
TLZ SYM,$SERRL;$
FAIL(5,FRIED,SYM,MISSING INDENTIFIER);
ENDD;
ELSE
IF SYM = VIRGIN ENTRY
T.VIRGIN;$
THEN
BEGIN
IF NOT ST[SYM]<MESSAGE GIVEN>
HLL T,STW0;$
TLNE T,$MSG;$
GOTO FALSE;$
THEN
BEGIN
;..ALWAYS PRINT MESSAGE(EVEN IF SEMANTIC ERROR LEVEL);
;SYM<SERRL>_0;
TLZ SYM,$SERRL;$
FAIL(1,FRIED,SYM,UNDECLARED VARIABLE);
;ST[SYM]<MSG>_TRUE;
HRLZI T,$MSG;$
IORM T,STW0;$
; TROUBLE LATER IF ITS REALLY A LABEL SO
XTNDLB;
ENDD;
FI;
;ST[SYM]<LEX>_SEMERLEX;
HLL T,SEMERLEX;$
HLLM T,STW1;$
;SYM<LEX>_SEMERLEX<LEX>;
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.
;T<RHS>_OFFSET;
HRR T,OFFSET;$
;T<LHS>_'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<AM> = IMM
T.IMM;$
THEN
;.. ADD TO CONSTANTS TABLE;
;T3_SYM<RHS>;
HRRZ T3,SYM;$
TOCT(1,SYM);
FI;
UNSTACK;
REOPEN;
;T_'PUSH SP,.-.';
HRLZI T,<PUSH SP,0>_-22;$
PLUNKI(SYM);
;SYM<AM>_SP;
TLZ SYM,$AM;$
TLO SYM,$SP;$
CLOSE;
ENDD;
SUBTTL ROUTINE LABREF.
;..ROUTINE PROCESSES DESIGNATIONAL EXPRESSION.
PROCEDURE LABREF;
BEGIN
IF SYM<AM> = 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]<LEXEME>_VAR,LABEL,SIM,UNDECL;
HRLI SYM,$VAR!$L!$SIM;$
HLLM SYM,STW1;$
TLO SYM,$ST;$
ENDD;
ELSE
IF ST[SYM]<BL> 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 GOTO FORMAL L COULD
;.. NOT BE RESOLVED BY THE LOADER).;
STADD;
;SYM_VAR,LABEL,SIM,UNDECL;
;ST[SYM]<LEXEME>_VAR,LABEL,SIM,UNDECL;
HRLI SYM,$VAR!$L!$SIM;$
HLLM SYM,STW1;$
TLO SYM,$ST;$
FI;
ENDD;
ELSE
;..IDENTIFIER IS ALREADY AT CURRENT BLOCKLEVEL AND SO
;.. IT MUST BE A LABEL OR BE IN ERROR.;
IF SYM NE (VAR LABEL)
TLNN SYM,$TYPE;$
GOTO TRUE;$
TLNN SYM,<$KIND-$VAR>!<$TYPE-$L>;$
GOTO FALSE;$
THEN
SEMERR(104,0,LABEL IDENTIFIER);
FI;
FI;
FI;
ENDD;
ELSE
;..SYM IS NOT AN IDENTIFIER AND SO MUST BE A DESIGNATIONAL
;.. EXPRESSION OR BE IN ERROR.;
IF SYM NE (EXP LABEL SIM)
HLRZ T,SYM;$
ANDI T,$KIND!$TYPE!$STATUS;$
XORI T,$EXP!$L!$SIM;$
JUMPE T,FALSE;$
THEN
SEMERR(103,0,DESIGNATIONAL EXPRESSION);
FI;
FI;
ENDD;
SUBTTL ROUTINE FATRUND.
;..ROUTINE TO CHECK FOR USE OF FAT COMMA.
;..FATRUND IS USED IN SPRODEC AND SFPARN AS FOLLOWS:
;.. LOOP
;.. ...
;.. AS DEL EQ COMMA OR FATCOMMA
;.. DELEL(.COM)
;.. SKIPE NSYM
;.. FATRUND
;.. SA;
;..IF NO FAT COMMA , RETURN FALLS THROUGH.
;..IF FAT COMMA, RETURN IS TO TRUE (MADE VIA THE GOTO TRUE IN DELEL(.COM)).
PROCEDURE FATRUND;
BEGIN
REGISTER NUMERIC;
IF DEL= RPAR AND NDEL = COL
DELEL(.RPAR);$
NDELEL(.COLON);
THEN
BEGIN
;T1_NSYM;
MOVE T1,NSYM;$
IF NSYM=CONSTANT
TLNN T1,$EXP;$
GOTO FALSE;$
THEN
;NUMERIC_40;
MOVEI NUMERIC,40;
ELSE
BEGIN
;..AN EXPLANATION OF WHAT THIS COMPOUND STATEMENT DOES
;..IS LEFT AS AN EXERCISE TO THE READER;
;T5_LENGTH IN WORDS OF ID;
MOVE T5,-1(T1);$
;NUMERIC_FIRST FIVE CHARACTERS;
MOVE NUMERIC,(T1);$
;NUMERIC<30-35>_0;
TRZ NUMERIC,77;$
WHILE T5 NE 0
JUMPE T5,FALSE;$
DO
BEGIN
;NUMERIC_NUMERIC OR @NSYM;
IOR NUMERIC,@NSYM;$
DECR(T5);
ENDD;
OD;
ENDD;
FI;
ZERO(NSYM);
RUND;
IF NSYM = PHI AND NDEL = LPAR
MOVE T,NDEL;$
CAMN T,ZLPAR;$
SKIPE NSYM;$
GOTO FALSE;$
THEN
BEGIN
;..FAT COMMA;
IF NUMERIC AND 404040404040 NE 0
TDNN NUMERIC,[404040404040];$
GOTO FALSE;$
THEN
FAIL(11,SOFT,SYM,ONLY LETTER STRING ALLOWED);
FI;
RUND;
;RETURN TO TRUE;
MOVE T,-1(SP);$
SUBI T,3;$
MOVEM T,-1(SP);$
ENDD;
ELSE
FAIL(9,HARD,DEL,AMBIGUOUS USE OF COLON);
FI;
ENDD;
FI;
ENDD;
SUBTTL ROUTINE GCOND.
;..ROUTINE TO PROCESS EXPRESSION THAT MAY BE
;..BOOLEAN, ARITHMETIC OR DESIGNATIONAL. IT IS CALLED FROM
;..BOTH CLAUSES OF CONDITIONAL EXPRESSION , EXPRESSION PARENTHESIS,
;.. AND SWITCH DECLARATION.;
PROCEDURE GCOND;
BEGIN
;..THE FORMAL FROM THE CALLING ROUTINE IS PASSED IN T;
IF OLDEL = DESIGNATIONALS
TEL(.LSEL);$
THEN
LABREF;
FI;
EVAL;
IF SYM<TYPE> = LABEL
TLNE SYM,$TYPE;$
T.L;$
THEN
BEGIN
IF SYM<AM> = ST
TLNE SYM,$AM-$ST;$
GOTO FALSE;$
THEN
BEGIN
;T_'MOVEI A2,.-.';
HRLZI T,<MOVEI A2,0>_-22;$
PLUNKI(SYM);
;SYM<STATUS>_SIMPLE;
;SYM<AM>_PTR;
TLZ SYM,$AM!$STATUS;$
TLO SYM,$PTR;$
;SYM<RESULT>_A2;
HRRI SYM,A2;$
CLOSE;
ENDD;
FI;
ENDD;
ELSE
IF SYM<KIND>=ARRAY OR SYM<TYPE> = N.T. OR NOT SYM<DECL>
TLNE SYM,$ARR;$
GOTO TRUE;$
TLNN SYM,$DECL;$
GOTO TRUE;$
T.N;$
THEN
SEMERR(100,0,EXPRESSION);
FI;
FI;
ENDD;
SUBTTL ROUTINE GDOUBLE.
;..ROUTINE TO DOUBLE A CONSTANT AT COMPILE TIME;
;..USED FOR LAST DIMENSION OF LONG REAL AND STRING ARRAY SUBSCRIPTING.;
PROCEDURE GDOUBLE;
BEGIN
NEWLOP;
REGISTER LOP;
;LEFTOP_SYM;
SYMSAVE;$
;OP_'PLUS LEXEME';
MOVE T,ZPLUS;$
MOVEM T,OP;$
CGBINARY;
ENDD;
SUBTTL ROUTINE GSTAT.
;..ROUTINE TO COMPLETE THE CODE FOR A STATEMENT AND OUTPUT TO REL FILE.
PROCEDURE GSTAT;
BEGIN
IF NOT SYM<STMT>
SETCM T,SYM;$
TLNN T,$STMT;$
GOTO FALSE;$
THEN
BEGIN
IF SYM<KIND> = PROC AND SYM<TYPE> NE LABEL
T.PRO;$
TN.L;$
THEN
TRNN FL,TRPOFF
PUSHJ SP,.SNBLK##
EVAL
ELSE
BEGIN
IF SYM NE PHIS AND NOT ERRL
JUMPE SYM,FALSE;$
TNGB(ERRL);$
THEN
SEMERR(101,$PRO!$I!$DECL,STATEMENT);$
FI;
STATEMENT;
;* WARNING, ERRL IS BEING TURNED OFF!!;
SFALSE(ERRL);
ENDD;
FI;
ENDD;
FI;
IF CODE GENERATED
T.COGE;$
THEN
MOB;
FI;
;..RESTORE TEMPCODE BUFFER TO EMPTY;
;INDEX_TCBASE;
;HANDLE_770000,TCBASE;
MOVE T,TCBASE;$
MOVEM T,INDEX;$
HRLI T,770000;$
MOVEM T,HANDLE;$
ENDD;
SUBTTL ROUTINE GBOOL.
;..ROUTINE TO PROCESS BOOLEAN EXPRESSION USED IN CONDITIONAL TEST.
;..GBOOL IS CALL FOR CONDITIONAL STATEMENT,CONDITIONAL EXPRESS,
;.. WHILE STATEMENT, AND WHILE-FOR-LIST-ELEMENT.
PROCEDURE GBOOL;
BEGIN
EVAL;
UNSTACK;
REOPEN;
IF SYM<KIND> EQ ARRAY OR SYM<TYPE> NE BOOLEAN OR NOT SYM<DECL>
TLNN SYM,$DECL;$
GOTO TRUE;$
TLNN SYM,$TYPE;$
GOTO TRUE;$
TLNN SYM,$ARR!<$TYPE-$B>;$
GOTO FALSE;
THEN
SEMERR(102,$VAR!$B!$SIM!$DECL,BOOLEAN EXPRESSION)
ELSE
IF SYM<ADDRESS MODE> EQ ACCUMULATOR
TLNE SYM,$AM-$ACC;$
GOTO FALSE;$
THEN
BEGIN
;..BOOLEAN VALUE IS IN A REGISTER.;
IF LAST OPERATION WAS RELATION
MOVE T,INDEX;$
HLRZ T1,-2(T);$
ANDI T1,777000;$
CAIE T1,<TDZA 0,0>_-22;$
GOTO FALSE;$
HLRZ T1,-1(T);$
ANDI T1,777000;$
CAIE T1,<SETO 0>_-22;$
GOTO FALSE;$
THEN
BEGIN
;..STRIP OFF CODE TO CREATE TRUE OR FALSE;
;TC[INDEX-2]_'JRST 0';
HRLZI T1,<JRST 0>_-22;$
MOVEM T1,-2(T);$
DECR(INDEX);
ENDD;
ELSE
BEGIN
;T_'JUMPE .-.';
HRLZI T,<JUMPE .-.>_-22;$
;T1_SYM<RESULT>;
HRRZ T1,SYM;$
PLUNK;
ENDD
FI;
ENDD;
ELSE
;..BOOLEAN VALUE IS NOT IN A REGISTER.;
IF SYM<ADDRESS MODE> ELEMENT OF [CT IMM]
T.CONST;$
THEN
BEGIN
;..BOOLEAN VALUE IS A CONSTANT.;
IF SYM<ADDRESS MODE> EQ IMM AND SYM<RHS>EQ FALSE
TRNN SYM,777777;$
T.IMM;$
THEN
;..CONSTANT IS FALSE SO ALWAYS JUMP TO ELSE-PART.;
;T_'JRST .-.';
HRLZI T,<JRST .-.>_-22;$
ELSE
;..CONSTANT IS NOT FALSE (NE 0) SO NEVER JUMP.
;.. IE. ALWAYS FALL THROUGH TO THEN -PART.;
;T_'NOOP .-.';
HRLZI T,<NOOP .-.>_-22;$
FI;
PLUNKI;
ENDD
ELSE
BEGIN
;..BOOLEAN VALUE IS IN STORAGE AND IS NOT A CONSTANT.;
;T_'SKIPN 0';
HRLZI T,<SKIPN 0>_-22;$
PLUNKI(SYM);
;T_'JRST .-.';
HRLZI T,<JRST .-.>_-22;$
PLUNKI;
ENDD;
FI;
FI;
FI;
CLOSE;
;SYM<KIND>_EXP;
TLZ SYM,$KIND;$
TLO SYM,$EXP;$
ENDD;
SUBTTL DISPATCH TABLES FOR SYNTAX ROUTINES
INTERNAL STABLE; ;STATEMENTS
INTERNAL ETABLE; ;EXPRESSIONS(ARITHMETIC & BOOLEAN)
INTERNAL LTABLE; ;EXPRESSIONS(DESIGNATIONAL)
INTERNAL FTABLE; ;FOR LIST ELEMENTS
;MACRO TO DEFINE DISPATCH TABLES
DEFINE DT(LIST)
<IRP LIST,<IFNDEF .'LIST,<EXTERN .'LIST>
XWD 0,.'LIST
>>
STABLE: DT(<F1,SARY,SSPAREN,SSIF,F1,F1,F1,SWHILE,SASS,SDOT,SBEGIN,SFOR,SGOTO,SCOL,SONOFF,F2>);
ETABLE: DT(<F3,SBRACK,SEPAREN,SEIF,SOP,F3,F3,F3,F5,SDOT,F3,F3,F3,F3,F3,F3>);
LTABLE: DT(<F4,SSW,SLPAREN,SEIF,F4,F4,F4,F4,F4,F4,F4,F4,F4,F4,F4,F4>);
FTABLE=.-5
DT(<SSTEP,SUNTIL,SFWHILE>);
SUBTTL GLOBAL CONSTANTS
INTERN DCBYTE,PRIOBYTE,DESCBYTE
DCBYTE: POINT 4,DEL,35
PRIOBYTE: POINT 4,DEL,31
DESCBYTE: POINT 5,DEL,27
ENDD; OF MODULE ALGUTL
LIT
END TEST