Trailing-Edge
-
PDP-10 Archives
-
ALGOL-20_29Jan82
-
algol-sources/algexp.mac
There are 8 other files named algexp.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 MODULE FOR EXPRESSIONS
; WRITTEN BY T. TEITELBAUM, L. SNYDER, C.M.U.
; EDITED BY R. M. DE MORGAN.
HISEG
SEARCH ALGPRM,ALGMAC ; SEARCH PARAMETER FILES
MODULE MEXP;
$PLEVEL=2;
BEGIN
EXTERN STABLE,ETABLE,LTABLE,FTABLE,DCBYTE,PRIOBYTE,DESCBYTE;
EXPROC RUND,RUND2,RUND3,RUND5,FATRUND,FAIL,ERREAD,SCINSERT,LOOK,ERR;
EXPROC F1,F2,F3,F4,F5;
EXPROC CGDOT,CGFUN,ERRLEX,GCOND,GDOUBLE;
EXPROC CGELSE,LABREF,GBOOL,CGASS,COMBLEX,MERGEPORTIONS,TOSTACK,CGINT;
EXPROC CGUNARY,CGBINARY,MOB,FAIL,BENTRY,BEXIT,PCALL,MABS,MREL,SEMERR;
EXPROC CONVERT,RAFIX,EVAL,MJRST0,UNSTACK,REOPEN,CLOSE,LOAD;
EXTERN .IPLUNK;
FORWARD SDOT,SBRACK;
;..SIMULATE THE ENVIRONMENT OF PROCEDURE DECLARATION ROUTINR(SPRODEC).;
FAKE FORMCT,PNAME,FSDISP,MXDISP,ST11,RELBLOCK,PARAM1;
SUBTTL ROUTINE FOR STATEMENT AND EXPRESSION ASSIGNMENT
PROCEDURE SASS;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL ASSCONV;
FORMAL OLDEL;
CODE GASS1;
;----
IF SYM<KIND>=PROC
T.PRO(SYM);$
THEN
BEGIN
;..ASSIGNMENT TO PROCEDURE;
;
EDIT(010); CATCH USE OF RESERVED WORDS
;
Edit(162); Include all library procs in the test.
;
IF STANDARD PROCEDURE ; [E162]
HRRZ T2,SYM ; [E010] GET SYMBOL TABLE ENTRY ADDRESS
CAILE T2,B0END## ; [E010][E162] Library procedure ?
GOTO FALSE ; [E010] NO
THEN
FAIL(129,HARD,SYM,ATTEMPT TO ASSIGN TO STANDARD PROCEDURE)
FI
IF WRITE.INHIBIT = 1 AND SYM<TYPE> NE LABEL;
HRRZ T2,SYM;$
MOVE T,2(T2);$
ANDI T,77;$
ADDI T,1;$
IDIVI T,6;$
ADDI T2,3(T);$ POINT TO EXTENSION
SKIPL T,(T2);$ W.INH IS SIGN BIT
GOTO FALSE
TLNN SYM,$TYPE-$L;$
GOTO FALSE;$
THEN
FAIL(127,HARD,SYM,ASS TO PROC OUTSIDE ITS BODY)
FI;
;ASSIGNMENT.MADE _ 1;
TLO T,200000;$
MOVEM T,(T2);$
;SYM<KIND>_VAR;
;..SYM<AM>_PVAL;
TLZ SYM,$KIND!$AM;$
TLO SYM,$VAR!$PVAL;$
;LEXEX<BLOCKLEVEL>_V-TYPE;
HRLZI T,777000;$
XORM T,LEXEX;$
;COMPNAME_BIT PATTERN;
HRLZI T,400000;$
MOVEM T,COMPNAME;$
ENDD;
FI;
IF SYM<KIND>=VAR AND SYM<DECL> AND SYM<TYPE> NOT ELEM [LABEL NONTYPE]
TLNN SYM,$KIND-$VAR;$
TLNN SYM,$DECL;$
GOTO FALSE;$
TLNN SYM,$TYPE-$L;$
GOTO FALSE;$
TLNN SYM,$TYPE-$N;$
GOTO FALSE;$
THEN
EVAL;
ELSE
SEMERR(113,0,LEFT-HAND VALUE);
FI;
;LEFTOP_SYM;
SYMSAVE;$
;-------
ENDCODE;
SETT(ASSCONV);
IF NOT TOPLEV
TN.TOPLEV;$
THEN
RUND
ELSE
RUND5
FI;
SLHS;
IF DEL = '_'
CAME DEL,ZASS;$
GOTO FALSE;$
THEN
BEGIN
SASS;
NOOP .ESEL;
SETF(ASSCONV);
ENDD
ELSE
ESEL
FI;
CODE GASS2;
;----
EVAL;
IF SYM<KIND> NOT ELEM [VAR EXP] OR NOT SYM<DECL>
TLNE SYM,$KIND-$EXP;$
GOTO TRUE;$
TLNE SYM,$DECL;$
GOTO FALSE;$
THEN
SEMERR(114,0,ARITH OR LOGICAL EXPRESSION);
ELSE
IF NOT ASSCONV AND (SYM<TYPE> NE LOP<TYPE> AND NOT(LOP<BYTE SELECT> AND SYM<TYPE> = INTEGER))
SKIPE ASSCONV;$
GOTO FALSE;$
MOVE T,LOP;$
XOR T,SYM;$
TLNN T,$TYPE;$
GOTO FALSE;$
HLRZ T,LOP;$
CAIE T,$VAR!$S!$REG!$DECL!$PTR;$
GOTO TRUE;$
TLNN SYM,$TYPE-$I;$
GOTO FALSE;$
THEN
FAIL(49,SYM,FRIED,TYPE CONV. ILLEGAL);
ELSE
BEGIN
CGASS;
IF OLDEL ELEMENT SSEL
MOVE T,OLDEL;$
TEL(.SSEL);$
THEN
UNSTACK;
FI;
ENDD;
FI;
FI;
;SYM<STATUS>_'STMT';
TLO SYM,$STMT;$
;-------
ENDCODE;
ENDD;
SUBTTL ROUTINE FOR MONADIC AND DYADIC OPERATORS
PROCEDURE SOP;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL OPRIORITY,OPA;
IF SYM = PHI
JUMPN SYM,FALSE;$
THEN
BEGIN
IF DEL = '+'
CAME DEL,ZPLUS;$
GOTO FALSE;$
THEN
;DEL _ 'PLUSLEXEME';
MOVE DEL,ZUPLUS;$
ELSE
IF DEL = '-'
CAME DEL,ZMINUS;$
GOTO FALSE;$
THEN
;DEL_'NEGLEXEME'
MOVE DEL,ZUMINUS;$
ELSE
IF DEL NE 'NOT'
CAMN DEL,ZNOT;$
GOTO FALSE;$
THEN
FAIL(51,HARD,DEL,ILLEGAL UNARY OPERATOR)
FI;
FI;
FI;
ENDD
ELSE
IF DEL = 'NOT'
CAME DEL,ZNOT;$
GOTO FALSE;$
THEN
FAIL(52,HARD,DEL,ILLEGAL BINARY OPERATOR)
ELSE
CODE GOP1;
; ----
EVAL;
IF SYM<KIND> NOT ELEMENT [VAR EXP] OR NOT SYM<DECL>
TLNE SYM,$KIND-$EXP;$
GOTO TRUE;$
TLNE SYM,$DECL;$
GOTO FALSE;$
THEN
SEMERR(115,0,ARITHMETIC OR LOGICAL EXPRESSION);
FI;
; -------
ENDCODE;
FI;
FI;
;LEFTOP_SYM;
SYMSAVE;$
;OPA_DEL;
MOVEM DEL,OPA;$
;OPRIORITY_PRIORITY(DEL);
LDB T,PRIOBYTE;$
MOVEM T,OPRIORITY;$
;..THE FOLLOWING COMPOUND STATEMENT, KNOWN AS RUND4 DURING DEVELOPMENT,
;..SHIFTS THE WINDOW TWO FRAMES AND LOOKS OUT FOR MISSING SEMICOLONS;
BEGIN
IF NSYM NE PHI
SKIPN NSYM;$
GOTO FALSE;$
THEN
BEGIN
IF NDEL ELEMENT EXP.CONTINUATOR
NDELEL(EXPCONT);$
THEN
RUND
ELSE
IF NOT TOPLEVEL
TN.TOPLEV;$
THEN
BEGIN
IF NDEL EQ 'IF'
MOVE T,NDEL;$
CAME T,ZIF;$
GOTO FALSE;$
THEN
FAIL(50,HARD,NSYM,MISSING DELIMITER);
FI;
RUND;
ENDD
ELSE
IF NDEL ELEMENT [KWSTST DECSPEC]
NDELEL(KWSTST!DECSPEC);$
THEN
;..MISSING SEMI-COLON;
SCINSERT;
ELSE
BEGIN
RUND;
IF DEL EQ PHI AND NDEL ELEMENT [: _] OR LOOK EQ NONTYPE PROCEDURE
JUMPN DEL,FALSE;$
MOVE T,NDEL;$
TEST(E,T,.COLON);$
GOTO TRUE;$
CAMN T,ZASS;$
GOTO TRUE;$
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
ELSE
IF <NDEL ELEMENT [NOT (]>
MOVE T,NDEL;$
CAMN T,ZLPAR;$
GOTO TRUE;$
CAME T,ZNOT;$
GOTO FALSE;$
THEN
RUND
ELSE
IF NDEL EQ 'IF'
CAME T,ZIF;$
GOTO FALSE;$
THEN
BEGIN
FAIL(55,SOFT,NSYM,IF SHOULD HAVE BEEN PARENTHESIZED);
RUND;
;..FORCE IMMEDIATE PROCESSING OF IF EXPRESSION;
;DEL<PRIORITY>_HIGHEST;
TRO DEL,300;$
ENDD;
ELSE
IF NDEL ELEMENT EXP.CONTINUATORS
TEL(EXPCONT);$
THEN
BEGIN
IF NDEL ELEMENT [+ -]
MOVE T,NDEL;$
CAMN T,ZPLUS;$
GOTO TRUE;$
CAME T,ZMINUS;$
GOTO FALSE;$
THEN
BEGIN
IF DEL ELEMENT RELATIONALS
TRNE DEL,$OPPRI-$RELPRI;$
GOTO FALSE;$
THEN
RUND
ELSE
FAIL(56,HARD,DEL,RIGHT OPERAND NOT FACTOR OR PRIMARY);
FI;
ENDD
ELSE
FAIL(56,HARD,NSYM,MISSING OPERAND);
FI;
ENDD;
ELSE
;..NECESSARILY: NDEL ELEMENT KWSTST OR DECSPEC:
IF TOPLEVEL
T.TOPLEV;$
THEN
;..MISSING SEMI-COLON;
SCINSERT;
EDIT(003) ; TRAP ERROR AT ALL LEVELS
ELSE
FAIL(56,HARD,NDEL,MISSING OPERAND); [E003]
FI;
FI;
FI;
FI;
FI;
ENDD;
WHILE PRIORITY(OP) LT PRIORITY(DEL)
LDB T,PRIOBYTE;$
CAMG T,OPRIORITY;$
GOTO FALSE;$
DO
IF ERRL
TGB(ERRL);$
THEN
ERREAD
ELSE
ESELECT;
FI;
OD;
CODE GOP2;
;----
;OP_OPA;
MOVE T,OPA;$
MOVEM T,OP;$
EVAL;
IF SYM<KIND> NOT ELEMENT [VAR EXP] OR NOT SYM<DECL>
TLNE SYM,$KIND-$EXP;$
GOTO TRUE;$
TLNE SYM,$DECL;$
GOTO FALSE;$
THEN
SEMERR(116,0,ARITHMETIC OR LOGICAL EXPRESSION)
ELSE
IF LOP EQ PHIS
JUMPN LOP,FALSE;$
THEN
CGUNARY;
ELSE
CGBINARY;
FI;
FI;
;-------
ENDCODE;
ENDD
SUBTTL ROUTINE FOR ( <EXPRESSION> )
PROCEDURE EXPARN;
BEGIN
LOCAL ST5,PSYMSAVE,PLEXSAVE,PCOMPSAVE;
FORMAL OLDEL;
;ST5_STOPS;
;STOPS_STOPS OR ')';
SETSTOPS(ST5,.RPAR);$
RUND;
IF OLDEL ELEMENT OF DESIGNATIONALS
MOVE T,OLDEL;$
TEL(.LSEL);$
THEN
LSEL
ELSE
BEGIN
SLHS;
IF DEL = '_'
CAME DEL,ZASS;$
GOTO FALSE;$
THEN
BEGIN
SASS;
NOOP .ESEL;
ENDD
ELSE
ESEL
FI;
ENDD
FI;
;STOPS_ST5;
RESTOPS(ST5);$
CODE GPAREN;
;----
;T_OLDEL;
MOVE T,OLDEL;$
GCOND;
IF SYM<TYPE> NE LABEL AND SYM<AM> NE CONSTANT
TLNE SYM,$CONST;$
TN.L;$
THEN
LOAD(,ANYAC);
FI;
;SYM<KIND>_EXP;
TLZ SYM,$KIND;$
TLO SYM,$EXP;$
;-------
ENDCODE;
;TEMPLEX_SYM;
MOVEM SYM,PSYMSAVE;$
MOVE T,LEXEX;$
MOVEM T,PLEXSAVE;$
MOVE T,COMPNAME;$
MOVEM T,PCOMPSAVE;$
IF <DEL = ')'>
DELEL(.RPAR);$
THEN
BEGIN
SFALSE(ERRL);
RUND3;
;SYM_TEMPLEX;
MOVE SYM,PSYMSAVE;$
MOVE T,PLEXSAVE;$
MOVEM T,LEXEX;$
MOVE T,PCOMPSAVE;$
MOVEM T,COMPNAME;$
ENDD
ELSE
FAIL(60,HARD,DEL,MISSING RIGHT PAREN);$
FI;
ENDD
SUBTTL ROUTINE FOR <CONDITION EXPRESSION>.
PROCEDURE SEIF;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL ST3,BSYMSAVE,BLEXSAVE,BCOMPSAVE,CONDLAC;
FORMAL OLDEL;
IF SYM NE PHI
JUMPE SYM,FALSE;$
THEN
FAIL(8,SOFT,SYM,SYMBOL NOT PERMITTED HERE);
FI;
IF OLDEL = 'THEN'
MOVE T,OLDEL;$
TEL(OTHEN);$
THEN
FAIL(14,SOFT,DEL,"THEN-IF" NOT PERMITTED)
FI;
;ST3_STOPS;
;STOPS_STOPS OR 'THEN';
SETSTOPS(ST3,.THEN);$
RUND;
ESEL;
IF DEL = 'THEN'
DELEL(.THEN);$
THEN
BEGIN
CODE GEIF1;
; ----
GBOOL;
REOPEN;
;T_'TCTHEN';
HRLZI T,<TCTHEN 0,0>_-22;$
PLUNKI;
;T_'TCTO';
HRLZI T,<TCTO 0,0>_-22;$
PLUNKI;
CLOSE;
;SYM<AM>_SP;
TLZ SYM,$AM;$
TLO SYM,$SP;$
;BSYMSAVE_SYM;
MOVEM SYM,BSYMSAVE;$
MOVE T,LEXEX;$
MOVEM T,BLEXSAVE;$
MOVE T,COMPNAME;$
MOVEM T,BCOMPSAVE;$
LACSAVE(CONDLAC);
; -------
ENDCODE;
SFALSE(ERRL);
;STOPS_ST3 OR 'EELSE';
MOVE STOPS,ST3;$
ADDSTOPS(.ELSE);$
RUND;
IF OLDEL ELEMENTOF LSEL
MOVE T,OLDEL;$
TEL(.LSEL);$
THEN
LSEL(OTHEN)
ELSE
ESEL(OTHEN)
FI;
;STOPS_ST3;
RESTOPS(ST3);$
ENDD
ELSE
BEGIN
;STOPS_ST3;
RESTOPS(ST3);$
FAIL(53,HARD,DEL,THEN EXPRESSION NOT FOUND);
IF DEL NE 'ELSE'
DELNEL(.ELSE);$
THEN
GOTO RET2;
FI
ENDD
FI;
IF DEL = 'ELSE'
DELEL(.ELSE);$
THEN
BEGIN
CODE GEIF2;
; ----
;T_OLDEL;
MOVE T,OLDEL;$
GCOND;
;LEFTOP_SYM;
SYMSAVE;$
LACRESTORE(CONDLAC);
ENDCODE;
SFALSE(ERRL);
IF NOT TOPLEV
TN.TOPLEV;$
THEN
RUND
ELSE
RUND5
FI;
IF OLDEL ELEMENTOF LSEL
MOVE T,OLDEL;$
TEL(.LSEL);$
THEN
LSEL;
ELSE
ESEL;
FI;
CODE GEIF3;
; ----
;T_OLDEL;
MOVE T,OLDEL;$
GCOND;
CGELSE;
;LEFTOP_BSYMSAVE;
MOVE LOP,BSYMSAVE;$
MOVE T,BLEXSAVE;$
MOVEM T,LLEXEX;$
MOVE T,BCOMPSAVE;$
MOVEM T,LCOMPNAME;$
REVER;
MERGEPORTIONS;
COMBLEX;
CLOSE;
IF OLDEL EQ ACTUAL AND SYM<AM> EQ PTR AND SYM<TYPE> NE LABEL
MOVE T,OLDEL;$
TEL(OACTUAL);$
T.PTR;
TN.L;$
THEN
;..COERCE VALUE INTO REGISTER A0;
LOAD(,A0);
FI;
IF SYM<AM> EQ ACC ;
TLNE SYM,$AM-$ACC;$
JRST FALSE;$
THEN;..LAC_SYM<RHS>;
HRRZM SYM,LAC;$
FI;
; -------
ENDCODE;
SFALSE(ERRL)
ENDD
ELSE
FAIL(54,HARD,DEL,ELSE EXPRESSION NOT FOUND)
FI;
RET2:ENDD;
;
SUBTTL ROUTINE FOR <SUBSCRIPTED VARIABLE>.
PROCEDURE SARY;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL SSCT,ERRL2,ST2,TYPECT,ASYMSAVE,ALEXSAVE,ACOMPSAVE;
FORMAL OLDEL;
;ST2_STOPS;
;STOPS_STOPS OR ] OR , ;
SETSTOPS(ST2,.RBRA!.COM);$
CODE GSS1;
;----
IF SYM<KIND> = ARRAY
;..MUST BE DECLARED IF ARRAY;
T.ARR;$
THEN
BEGIN
;TYPECT_ST[SYM]<LEXEME>;
HLRZ T,STW1;$
MOVEM T,TYPECT;$
EVAL;
IF SUBSCRIPT CHECKING
TGB(ACOO);$
THEN
BEGIN
IF SYM<AM> = SINGLE
T.SINGLE;$
THEN
BEGIN
;T_'MOVEI A2,.-.';
HRLZI T,<MOVEI A2,>_-22;$
PLUNKI(SYM);
CLOSE;
ENDD;
FI;
;..SAVE ARRAY ID;
;ARYSAVE_SYM;
MOVEM SYM,ASYMSAVE;$
MOVE T,LEXEX;$
MOVEM T,ALEXSAVE;$
MOVE T,COMPNAME;$
MOVEM T,ACOMPSAVE;$
;..PLACE EMPTY PORTION IN SYM TO INITIALIZE FOR MERGE;
CLOSE;
;SYM<AM>_SP;
TLZ SYM,$AM;$
TLO SYM,$SP;$
ENDD;
ELSE
BEGIN
;ARYSAVE_SYM;
MOVEM SYM,ASYMSAVE;$
;..PREVENT TYPE CONVERSION WHILE COMPUTING
;..SUBSCRIPT SINCE ILIFFE VECTOR WILL BE
;..TREATED AS INTEGER;
;SYM<TYPE>_INTEGER;
TLZ SYM,$TYPE;$
TLO SYM,$I;$
ENDD;
FI;
ENDD;
ELSE
BEGIN
SEMERR(117,0,ARRAY IDENTIFIER);
;ARYSAVE_SYM;
MOVEM SYM,ASYMSAVE;$
ZERO(TYPECT);
ENDD;
FI;
;LEFTOP_SYM;
SYMSAVE;$
;-------
ENDCODE;
;SSCT_1;
MOVEI T,1;$
MOVEM T,SSCT;$
SETF(ERRL2);
LOOP
BEGIN
SFALSE(ERRL);
RUND;
ESEL;
INCR(SSCT);
CODE GSS2;
; ----
EVAL;
IF SYM IS ARITHMETIC EXPRESSION
T.AE;$
THEN
BEGIN
;..ROUND AND CONVERT TO INTEGER IF NECESSARY;
CGINT;
IF SUBSCRIPT CHECKING
TGB(ACOO);$
THEN
BEGIN
TOSTACK;
REVER;
MERGEPORTION;
COMBLEX;
CLOSE;
ENDD;
ELSE
BEGIN
IF DEL = RBRA AND DOUBLE-WORD VALUES
DELEL(.RBRA);$
HRLZ T,TYPECT;$
T.TWO(T);$
THEN
BEGIN
IF SYM ELEM [CT IMM]
T.CONST;$
THEN
;..COMBINE TWO CONSTANTS;
GDOUBLE;
ELSE
BEGIN
IF SYM<AM> = [PTR ST]
T.VAR;$
THEN
LOAD(,ANYAC);
FI;
REOPEN;
;T_'ADD SYM<RHS>,0';
HRLZ T,SYM;$
LSH T,5;$
TLO T,<ADD 0,0>_-22;$
PLUNKI(SYM);
CLOSE;
ENDD;
FI;
ENDD;
FI;
;..COMPUTE ADDRESS OF NEXT ILIFFE VECTOR CELL;
;OP_'BINARY-PLUS-LEXEME;
MOVE T,ZPLUS;$
MOVEM T,OP;$
CGBINARY;
;..MAKE RESULT LEXEME ADDRESS MODE POINTER;
;SYM<KIND>_'VAR';
;SYM<STATUS>_'SIM';
;SYM<AM>_'PTR';
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$VAR!$SIM!$PTR;$
ENDD;
FI;
ENDD;
ELSE
BEGIN
IF SYM EQ PHIS
JUMPN SYM,FALSE;$
THEN
;ERRL2_TRUE;
SETOM ERRL2;$
FI;
SEMERR(118,$VAR!$I!$SIM!$DECL,ARITHMETIC EXPRESSION);
ENDD;
FI;
;LEFTOP_SYM;
SYMSAVE;$
; -------
ENDCODE;
;ERRL2_ERRL2 OR ERRL;
IORM FL,ERRL2;$
ENDD
AS DEL = COMMA
DELEL(.COM);$
SA;
;STOPS_ST2;
RESTOPS(ST2);$
IF DEL = RIGHT BRA
DELEL(.RBRA);$
THEN
BEGIN
SFALSE(ERRL);
IF NOT ERRL2 AND TYPECT<CT> NE 0 AND TYPECT<CT> NE SSCT MOD 2^5
MOVE T,ERRL2;$
TNEL(ERRL);$
MOVE T,TYPECT;$
TRNN T,$AM;$
GOTO FALSE;$
XOR T,SSCT;$
TRNN T,$AM;$
GOTO FALSE;$
THEN
FAIL(57,DEL,FRIED,WRONG # DIMENSIONS);
FI;
RUND3;
CODE GSS3;
; ----
IF SUBSCRIPT CHECKING
TGB(ACOO);$
THEN
BEGIN
;..COERCING FORMAL RETURNS RESULT IN A2;
;SYM_ARYSAVE;
MOVE SYM,ASYMSAVE;$
MOVE T,ALEXSAVE;$
MOVEM T,LEXEX;$
MOVE T,ACOMPSAVE;$
MOVEM T,COMPNAME;$
REVER;
MERGEPORTIONS;
COMBLEX;
;..LOAD NUMBER OF DIMENSIONS INTO A1;
;T_'MOVEI A0,'.SSCT-1;
HRRZ T,SSCT;$
SUBI T,1;$
HRLI T,<MOVEI A0,>_-22!$IMM;$
PLUNKI;
;..PLACE CALL TO CHECK ARRAY ROUTINE;
;T_'TCADDFIX CHKARR';
MOVEI T,CHKARR;$
HRLI T,<TCADDFIX 0,0>_-22;$
PLUNKI;
;HANDLE<USED ACCS>_HANDLE<USED ACCS> OR [A0,A1,A2];
HRLZI T,7;$
IORM T,HANDLE;$
CLOSE;
;SYM<KIND>_VAR;
;SYM<STATUS>_SIM;
;SYM<AM>_PTR;
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$VAR!$SIM!$PTR;$
;SYM<RESULT>_A2;
HRRI SYM,A2;$
ENDD;
ELSE
BEGIN
;SYM_LEFTOP;
SYMRESTORE;$
;..RESTORE TYPE OF LEXEME TO ORIGINAL TYPE;
;SYM<TYPE>_TYPECT<TYPE>;
HRLZ T,TYPECT;$
TLZ SYM,$TYPE;$
TLZ T,700777;$
IOR SYM,T;$
ENDD;
FI;
IF ARRAY IDENTIFIER NOT IN ERROR BUT SOME SUBSCRIPT WAS
JUMPG SYM,FALSE;$
SKIPG SYM,ASYMSAVE;$
GOTO FALSE;$
THEN
BEGIN
;..MAKE LEXEME FOR THIS SUBSCRIPTED VARIABLE LOOK GOOD.;
;SYM_[VAR,ARYSAVE<TYPE>,SIMPLE,DECL,PTR];
AND SYM,[XWD $TYPE,0];$
TLO SYM,$VAR!$SIM!$DECL!$PTR;$
CLOSE;
ENDD;
FI;
; -------
ENDCODE;
ENDD
ELSE
FAIL(36,HARD,DEL,MISSING RIGHT BRA);$
FI
ENDD;
SUBTTL ROUTINE FOR <SWITCH DESIGNATOR>.
PROCEDURE SSW;
BEGIN
LOCAL ST4,SWSYMSAVE,SWLEXSAVE,SWCOMPSAVE;
CODE GSW1;
;----
IF SYM NE SWITCH
SETCM T,SYM;$
TLNN T,$PRO!$L;$
GOTO FALSE;$
THEN
SEMERR(119,$PRO!$L!$SIM!$DECL,SWITCH IDENTIFIER);
FI;
;SWSAVE_SYM;
MOVEM SYM,SWSYMSAVE;$
MOVE T,LEXEX;$
MOVEM T,SWLEXSAVE;$
MOVE T,COMPNAME;$
MOVEM T,SWCOMPSAVE;$
;-------
ENDCODE;
SFALSE(ERRL);
;ST4_STOPS;
;STOPS_STOPS OR ] ;
SETSTOPS(ST4,.RBRA);$
RUND;
ESEL;
;STOPS_ST4;
RESTOPS(ST4);$
CODE GSW2;
;----
EVAL;
IF SYM = ARITH EXPRESSION
T.AE;$
THEN
BEGIN
CGINT;
LOAD(,A2);
REOPEN;
;T<RHS>_SWSYMSAVE<RHS>;
MOVE T,SWSYMSAVE;$
IF SWSYMSAVE<STATUS> = FON
T.FORM(T);$
THEN
;T<LHS>_'XCT 0'.ST;
HRLI T,<XCT 0>_-22!$ST;$
ELSE
;T<LHS>_'PUSHJ SP'.ST;
HRLI T,<PUSHJ SP,0>_-22!$ST;$
FI;
PLUNKI;
;HANDLE<LHS>_ALL REGS USED;
HRROS HANDLE;$
CLOSE;
IF P-TYPE = (T_LEXEX)
SKIPL T,LEXEX;$
GOTO FALSE;$
THEN
BEGIN
;T<BL>_MIN(SWLEXSAVE<BL>,LEXEX<BL>);
CAML T,SWLEXSAVE;$
GOTO .+4;$
TLZ T,$BL;$
HLLZ T1,SWLEXSAVE;$
IOR T,T1;$
;SWCOMPSAVE_COMPNAME;
MOVE T1,COMPNAME;$
MOVEM T1,SWCOMPNAME;$
ENDD;
FI;
ENDD;
ELSE
SEMERR(122,$VAR!$I!$SIM!$DECL,ARITH EXPRESSION);
;..MAKE SURE THERE IS A PORTION FOR THIS DESIGNATOR.;
CLOSE;
;T_LEXEX;
MOVE T,LEXEX;$
FI;
;SWLEXSAVE_T;
MOVEM T,SWLEXSAVE;$
;-------
ENDCODE;
IF DEL = RIGHT BRA
DELEL(.RBRA);$
THEN
BEGIN
SFALSE(ERRL);
RUND3;
CODE GSW3;
; ----
;SYM_[EXP!L!SIM!DECL!PTR,A2];
HRLZI SYM,$EXP!$L!$SIM!$DECL!$PTR;$
HRRI SYM,A2;$
;LEXEX_SWLEXSAVE;
MOVE T,SWLEXSAVE;$
MOVEM T,LEXEX;$
;COMPNAME_SWCOMPSAVE;
MOVE T,SWCOMPSAVE;$
MOVEM T,COMPNAME;$
;..ONLY RETURN SEMANTICS ERROR LEXEME IF
;..THE SWITCH IDENTIFIER ITSELF WAS IN ERROR;
;IF SWSAVE<SERRL> THEN ERRLEX;
SKIPGE SWSYMSAVE;$
ERRLEX;$
; -------
ENDCODE;
ENDD
ELSE
FAIL(36,HARD,DEL,MISSING RIGHT BRA);
FI
ENDD;
SUBTTL ROUTINE FOR <BYTE SELECTION>
PROCEDURE SDOT;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL ST15,STRSAVE;
FORMAL OLDEL;
IF NDEL NE LBRA OR NSYM NE PHIS
MOVE T,NDEL;$
CAME T,ZLBRA;$
GOTO TRUE;$
SKIPN NSYM;$
GOTO FALSE;$
THEN
FAIL(97,HARD,DEL,ILLEGAL BYTE SELECTION);
ELSE
BEGIN
CODE GDOT1;
;----
IF SYM NE STRING VARIABLE AND NE STRING CONSTANT
TLNN SYM,$DECL;$
GOTO TRUE;$
TLNE SYM,$TYPE-$S;$
GOTO TRUE;$
TLNE SYM,$KIND;$
TLNN SYM,$CONST;$
GOTO FALSE;$
THEN
SEMERR(124,$VAR!$S!$SIM!$DECL,STRING VARIABLE);
ELSE
EVAL;
IF NOT CODE GENERATED
T.SINGLE;$
THEN
BEGIN
;T_'MOVEI A2,.-.';
HRLZI T,<MOVEI A2,0>_-22;$
PLUNKI(SYM);
;HANDLE<REG USED>_HANDLE<REG USED> OR A2 OR A3;
HRLZI T,14;$
IORM T,HANDLE;$
CLOSE;
;SYM<RESULT>_A2;
HRRI SYM,A2;$
;SYM<AM>_$PTR;
TLZ SYM,$AM;$
TLO SYM,$PTR;$
;IN A0, THEN A2 WILL CONTAIN THE BYTE POINTER, WHICH IS WHAT
;WE WANT - SO CHANGE SYM TO REFLECT THIS.
ENDD ;
ELSE ;
TDNN SYM,[XWD $AM-$ACC,-1];
IOR SYM,[XWD $PTR,A2];
;**** N.B. THIS ONLY WORKS BECAUSE $PTR INCLUDES ALL BITS OF $ACC ****
FI;
FI;
;LEFTOP_SYM;
SYMSAVE;$
;STRSAVE_SYM;
MOVEM SYM,STRSAVE;$
;-------
ENDCODE;
RUND;
;ST15_STOPS;
;STOPS_STOPS OR ] ;
SETSTOPS(ST15,.RBRA);$
RUND;
ESEL;
;STOPS_ST15;
RESTOPS(ST15);$
CODE GDOT2;
; ----
EVAL;
IF SYM ELEM ARITH. EXPRESS
T.AE;$
THEN
BEGIN
CGINT;
CGDOT;
ENDD;
ELSE
SEMERR(123,$VAR!$I!$SIM!$DECL,ARITH EXPRESS);
FI;
;LEFTOP_SYM;
SYMSAVE;$
; -------
ENDCODE;
IF DEL = RIGHT BRA
DELEL(.RBRA);$
THEN
BEGIN
SFALSE(ERRL);
RUND3;
CODE GDOT3;
; ----
;SYM_LEFTOP;
SYMRESTORE;$
IF STRING IDENTIFIER NOT IN ERROR BUT INDEX WAS
JUMPG SYM,FALSE;$
SKIPG STRSAVE;$
GOTO FALSE;$
THEN
BEGIN
;..MAKE LEXEME LOOK GOOD.;
;SYM_[VAR,INTEGER,SIMPLE,DECL,PTR];
HRLZI SYM,$VAR!$I!$SIM!$DECL!$PTR;$
CLOSE;
ENDD;
ELSE
BEGIN
REOPEN;
;HANDLE<REG USED>_HANDLE<REG USED> OR [A0,A1,A2];
HRLZI T,7;$
IORM T,HANDLE;$
;T_'TCADDFIX PBYTE';
HRLZI T,<TCADDFIX 0>_-22;$
HRRI T,PBYTE;$
PLUNKI;
IF <NOT(OLDEL=ACTUAL AND DEL ELEM [COMMA )]) AND DEL NE '_'>
CAMN DEL,ZASS;$
GOTO FALSE;$
TEST(N,DEL,.RPAR!.COM);$
GOTO TRUE;$
MOVE T,OLDEL;$
TNEL(OACTUAL);$
THEN
BEGIN
;T_'LDB A2,A2';
HRLZI T,<LDB A2,A2>_-22;$
HRRI T,A2;$
PLUNKI;
;SYM_[EXP INT SIMP DECL ACC,A2];
HRLZI SYM,$EXP!$I!$SIM!$DECL!$ACC;$
HRRI SYM,A2;$
ENDD;
FI;
CLOSE;
ENDD;
FI;
; -------
ENDCODE;
ENDD
ELSE
FAIL(36,HARD,DEL,MISSING RIGHT BRA);
FI
ENDD;
FI;
ENDD;
SUBTTL ROUTINE FOR <STANDARD FUNCTION DESIGNATORS>.
PROCEDURE STRIG;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL ST20,ARGCT,FNSAVE;
FORMAL OLDEL;
;ST20_STOPS;
;STOPS_STOPS OR ')' OR ',';
SETSTOPS(ST20,.RPAR!.COM);$
ZERO(ARGCT);
CODE GTRG1;
;----
;LEFTOP_SYM;
SYMSAVE;$
;FNSAVE_SYM;
MOVEM SYM,FNSAVE;$
;-------
ENDCODE;
LOOP
BEGIN
SFALSE(ERRL);
RUND;
ESEL;
INCR(ARGCT);
CODE GTRG2;
; ----
EVAL;
IF SYM = ARRAY ID OR NOT SYM<DECL> OR SYM NE ARITH OR BOOLEAN
TLNN SYM,$DECL;$
GOTO TRUE;$
TLNE SYM,$ARR;$
GOTO TRUE;$
TLNE SYM,$ARC;$
TLNN SYM,$TYPE-$B;$
GOTO FALSE;$
THEN
SEMERR(125,0,ARITH-BOOL EXPRESSION);
FI;
; -------
ENDCODE;
ENDD;
AS DEL = COMMA
DELEL(.COM);$
SA;
;STOPS_ST20;
RESTOPS(ST20);$
IF <DEL = ')'>
DELEL(.RPAR);$
THEN
BEGIN
SFALSE(ERRL);
CODE GTRG3;
; ----
IF ARGCT NE 1
SOS T,ARGCT;$
JUMPE T,FALSE;$
THEN
FAIL(58,DEL,FRIED,TOO MANY ARGS TO BUILT IN PROC);
ELSE
BEGIN
CGFUN;
IF OLDEL ELEMENT OF SSEL
MOVE T,OLDEL;$
TEL(.SSEL);$
THEN
UNSTACK;
FI;
ENDD;
FI
;LEFTOP_SYM;
SYMSAVE;$
; -------
ENDCODE;
RUND3;
;SYM_LEFTOP;
SYMRESTORE;$
IF ACTUAL PARAMETER WAS IN ERROR
JUMPG SYM,FALSE;$
THEN
BEGIN
;..MAKE LEXEME LOOK GOOD;
;SYM_[EXP,FNSAVE<TYPE>,SIMPLE,DECL,ACC];
HLLZ SYM,FNSAVE;$
TLZ SYM,-1-$TYPE;$
TLO SYM,$EXP!$SIM!$DECL!$ACC;$
CLOSE;
ENDD;
FI;
ENDD;
ELSE
FAIL(60,DEL,HARD,MISSING RIGHT PAREN);
FI;
ENDD;
SUBTTL ROUTINE FOR <FUNCTION DESIGNATOR WITH PARAMETERS>.
PROCEDURE SFPARN;
BEGIN
NEWLOP;
REGISTER LOP,DESCRIPTOR;
LOCAL PARMCT,ERRL1,ST1,SAVELAC,FPARMS;
;ST1_STOPS;
;STOPS_STOPS OR ) OR , ;
SETSTOPS(ST1,.RPAR!.COM);$
CODE GFUN1;
;----
IF SYM<KIND> = PROCEDURE AND SYM<TYPE> NE LABEL
;..MUST BE DECLARED IF PROCEDURE.
T.PRO;$
TN.L;$
THEN
BEGIN
;..SAVE NUMBER OF FORMALS FROM SYMBOL TABLE ENTRY;
;FPARMS_ST[SYM]<LEXEME>;
HLRZ T,STW1;$
TRZ T,777777-$AM;$
MOVEM T,FPARMS;$
EVAL;
ENDD;
ELSE
SEMERR(121,0,PROCEDURE IDENTIFIER);
ZERO(FPARMS);
FI;
;LEFTOP_SYM;
SYMSAVE;
;..PRESERVE ACCUMULATOR ALLOCATOR;
LACSAVE(SAVELAC);
;-------
ENDCODE;
;PARMCT_1;
MOVEI T,1;$
MOVEM T,PARMCT;$
SETF(ERRL1);
LOOP
BEGIN
SFALSE(ERRL);
RUND;
CODE GFUN2;
; ----
LACINIT;
; -------
ENDCODE;
ESEL(OACTUAL);
INCR(PARMCT);
CODE GFUN3;
; ----
IF CODE GENERATED
T.COGE;$
THEN
BEGIN
;..WE HAVE A THUNK;
IF THUNK = 0
SKIPE THUNK;$
GOTO FALSE;$
THEN
;..THIS IS THE FIRST THUNK OF THE EXPRESSION;
;..SO PLACE JRST AROUND THUNKS;
SPLIT(THUNK);
FI;
;..COMPOSE ARGUMENT DESCRIPTOR;
;DESCRIPTOR_[0,RA];
;DESCRIPTOR<KIND,TYPE,STATUS>_SYM<KIND,TYPE,STATUS>;
;DESCRIPTOR<DYNAMIC>_TRUE;
HRRZ DESCRIPTOR,RA;$
HLL DESCRIPTOR,SYM;$
TLO DESCRIPTOR,$DYN;$
IF SYM<TYPE> EQ 'NON-TYPE'
T.N;$
THEN
FAIL(59,SYM,FRIED,ILLEGAL USE OF NON-TYPE PROCEDURE)
ELSE
BEGIN
;..MOVE EXPRESSION VALUES TO A0, POINTER VALUES TO A2;
IF SYM<AM> = POINTER
T.PTR;$
THEN
BEGIN
;..PREVENT COERCING POINTER;
;SYM<AM>_'REG';
;SYM<TYPE>_ANY ONE WORD VALUE TYPE;
TLZ SYM,$TYPE!$AM;$
TLO SYM,$I!$ACC;$
LOAD(,A2);
ENDD;
ELSE
LOAD(,A0);
FI;
UNSTACK;
KILLAX;
MOB(THUNK);
MABSI(<POPJ SP,0>);
ENDD;
FI;
ENDD;
ELSE
IF SYM = PHIS OR SYM = VIRGIN
TLNE SYM,-1-$AM;$
GOTO FALSE;$
THEN
;..IF PARAMETER IS MISSING (IE. " ,, ")
;..THEN BOOK AS SYNTACTIC ERROR;
IF SYM EQ PHIS
JUMPN SYM,FALSE;$
THEN
;ERRL1_TRUE;
SETOM ERRL1;$
FI;
SEMERR(120,0,ACTUAL PARAMETER);
ELSE
BEGIN
EDIT(044); Dont force constants to D.P. unnecessarily
IF SYM = PSEUDO-LONG REAL CONSTANT ; [E044]
TLNN SYM,$TYPE-$LR ; [E044]
T.CONST (SYM) ; [E044]
TLNE SYM,$CT-$IMM ; [E044]
TLNN SYM,$DEC ; [E044]
GOTO FALSE ; [E044]
F.LOCN (T2,SYM) ; [E044]
ADD T2,CONTAB ; [E044]
SKIPL T4,3(T2) ; [E044]
GOTO FALSE ; [E044]
THEN;..CONVERT IT TO A REAL ; [E044]
MOVEI T,$R ; [E044]
CONVERT; ; [E044]
FI; ; [E044]
;DESCRIPTOR_SYM;
;DESCRIPTOR<DYNAMIC>_FALSE;
MOVE DESCRIPTOR,SYM;$
TLZ DESCRIPTOR,$DYN;$
ENDD;
FI;
FI;
;..ADD ACTUAL DESCRIPTOR TO LEFT PORTION;
REVER;
REOPEN(LOP);
;T_DESCRIPTOR;
MOVE T,DESCRIPTOR;$
PLUNKI;
CLOSE(LOP);
IF LEXEX = P-TYPE
SKIPL T,LEXEX;$
GOTO FALSE;$
THEN
BEGIN
;LCOMPNAME_LCOMPNAME OR COMPNAME;
MOVE T1,COMPNAME;$
IORM T1,LCOMPNAME;$
;LLEXEX<BL>_MIN(LLEXEX<BL>,LEXEX<BL>);
;..NOTE WE ASSUME SA IS ALWAYS 0;
CAMGE T,LLEXEX;$
HLLM T,LLEXEX;$
ENDD;
ELSE
IF SYM<KIND> ELEM [VAR ARRAY] AND NOT LABEL
TLNN SYM,$KIND-$ARR;$
TLNN SYM,$TYPE-$L;$
GOTO FALSE;$
THEN
;LCOMPNAME_LCOMPNAME OR COMPNAME;
MOVE T1,COMPNAME;$
IORM T1,LCOMPNAME;$
FI;
FI;
; -------
ENDCODE;
;ERRL1_ERRL1 OR ERRL;
IORM FL,ERRL1;$
ENDD
AS DEL = COMMA OR FATCOMMA
DELEL(.COM);$
SKIPE NSYM;$
FATRUND;$
SA;
;STOPS_ST1;
RESTOPS(ST1);$
IF DEL = RIGHT PAR
DELEL(.RPAR);$
THEN
BEGIN
SFALSE(ERRL);
;..VERIFY NUMBER OF ACTUALS CORRECT;
IF NOT ERRL1 AND FPARMS NE 0 AND (FPARMS NE PARMCT) MOD 2^5
MOVE T,ERRL1;$
TNEL(ERRL);$
SKIPN T,FPARMS;$
GOTO FALSE;$
XOR T,PARMCT;$
ANDI T,$AM;$
JUMPE T,FALSE;$
THEN
BEGIN
FAIL(61,DEL,FRIED,WRONG NUMBER OF ACTUALS);
RUND3;
ERRLEX;
ENDD
ELSE
RUND3;
FI;
CODE GFUN4;
; ----
;ARGUMENT WORD1<RHS>_PARMCT;
HRRZ T1,PARMCT;$
HRRZ T,LLEXEX;$
HRRZ T,(T);$
HRRM T1,2(T);$
;SYM_LEFTOP;
SYMRESTORE;$
;..RESTORE ACCUMULATOR ALLOCATOR COUNTER;
LACRESTORE(SAVELAC);
; -------
ENDCODE;
ENDD
ELSE
FAIL(60,HARD,DEL,MISSING RIGHT PAREN);
FI;
ENDD;
SUBTTL CODE TO SPLIT ON USE OF PARENS AND BRACKETS.
EXTERN PRLIB;
INTERN .SEPAREN,.SSPAREN,.SLPAREN,.SBRACK;
.SEPAREN:
JUMPE SYM,.EXPARN;$
MOVEI T,(SYM);$
SETCM T1,SYM;$
TLNN T1,$PRO;$ ; IF IT IS NOT A PROCEDURE
CAIL T,PRLIB;$ ; OR NOT A MATHS FUNCTION
GOTO .SFPARN ; GOTO SFPARN
GOTO .STRIG;$
.SSPAREN:
MOVEI T,(SYM);$
SUBI T,PRLIB;$
JUMPGE T,.SFPARN;$
JUMPN SYM,.STRIG;$
GOTO .F1;$
.SLPAREN:
JUMPE SYM,.EXPARN;$
GOTO .F4;$
.SBRACK:
TLNE SYM,200000;$
TLNN SYM,100000;$
GOTO .SARY;$
TLNE SYM,25000;$
GOTO .SARY;$
GOTO .SSW;$
ENDD; OF MODULE MEXP
LIT
END