; ; ;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=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 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_VAR; ;..SYM_PVAL; TLZ SYM,$KIND!$AM;$ TLO SYM,$VAR!$PVAL;$ ;LEXEX_V-TYPE; HRLZI T,777000;$ XORM T,LEXEX;$ ;COMPNAME_BIT PATTERN; HRLZI T,400000;$ MOVEM T,COMPNAME;$ ENDD; FI; IF SYM=VAR AND SYM AND SYM 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 NOT ELEM [VAR EXP] OR NOT SYM 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 NE LOP AND NOT(LOP AND SYM = 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_'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 NOT ELEMENT [VAR EXP] OR NOT SYM 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 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_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 NOT ELEMENT [VAR EXP] OR NOT SYM 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 ( ) 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 NE LABEL AND SYM NE CONSTANT TLNE SYM,$CONST;$ TN.L;$ THEN LOAD(,ANYAC); FI; ;SYM_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 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 . 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,_-22;$ PLUNKI; ;T_'TCTO'; HRLZI T,_-22;$ PLUNKI; CLOSE; ;SYM_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 EQ PTR AND SYM NE LABEL MOVE T,OLDEL;$ TEL(OACTUAL);$ T.PTR; TN.L;$ THEN ;..COERCE VALUE INTO REGISTER A0; LOAD(,A0); FI; IF SYM EQ ACC ; TLNE SYM,$AM-$ACC;$ JRST FALSE;$ THEN;..LAC_SYM; HRRZM SYM,LAC;$ FI; ; ------- ENDCODE; SFALSE(ERRL) ENDD ELSE FAIL(54,HARD,DEL,ELSE EXPRESSION NOT FOUND) FI; RET2:ENDD; ; SUBTTL ROUTINE FOR . 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 = ARRAY ;..MUST BE DECLARED IF ARRAY; T.ARR;$ THEN BEGIN ;TYPECT_ST[SYM]; HLRZ T,STW1;$ MOVEM T,TYPECT;$ EVAL; IF SUBSCRIPT CHECKING TGB(ACOO);$ THEN BEGIN IF SYM = SINGLE T.SINGLE;$ THEN BEGIN ;T_'MOVEI A2,.-.'; HRLZI T,_-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_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_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 = [PTR ST] T.VAR;$ THEN LOAD(,ANYAC); FI; REOPEN; ;T_'ADD SYM,0'; HRLZ T,SYM;$ LSH T,5;$ TLO T,_-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_'VAR'; ;SYM_'SIM'; ;SYM_'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 NE 0 AND TYPECT 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,_-22!$IMM;$ PLUNKI; ;..PLACE CALL TO CHECK ARRAY ROUTINE; ;T_'TCADDFIX CHKARR'; MOVEI T,CHKARR;$ HRLI T,_-22;$ PLUNKI; ;HANDLE_HANDLE OR [A0,A1,A2]; HRLZI T,7;$ IORM T,HANDLE;$ CLOSE; ;SYM_VAR; ;SYM_SIM; ;SYM_PTR; TLZ SYM,$KIND!$STATUS!$AM;$ TLO SYM,$VAR!$SIM!$PTR;$ ;SYM_A2; HRRI SYM,A2;$ ENDD; ELSE BEGIN ;SYM_LEFTOP; SYMRESTORE;$ ;..RESTORE TYPE OF LEXEME TO ORIGINAL TYPE; ;SYM_TYPECT; 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,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 . 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_SWSYMSAVE; MOVE T,SWSYMSAVE;$ IF SWSYMSAVE = FON T.FORM(T);$ THEN ;T_'XCT 0'.ST; HRLI T,_-22!$ST;$ ELSE ;T_'PUSHJ SP'.ST; HRLI T,_-22!$ST;$ FI; PLUNKI; ;HANDLE_ALL REGS USED; HRROS HANDLE;$ CLOSE; IF P-TYPE = (T_LEXEX) SKIPL T,LEXEX;$ GOTO FALSE;$ THEN BEGIN ;T_MIN(SWLEXSAVE,LEXEX); 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 THEN ERRLEX; SKIPGE SWSYMSAVE;$ ERRLEX;$ ; ------- ENDCODE; ENDD ELSE FAIL(36,HARD,DEL,MISSING RIGHT BRA); FI ENDD; SUBTTL ROUTINE FOR 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,_-22;$ PLUNKI(SYM); ;HANDLE_HANDLE OR A2 OR A3; HRLZI T,14;$ IORM T,HANDLE;$ CLOSE; ;SYM_A2; HRRI SYM,A2;$ ;SYM_$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_HANDLE OR [A0,A1,A2]; HRLZI T,7;$ IORM T,HANDLE;$ ;T_'TCADDFIX PBYTE'; HRLZI T,_-22;$ HRRI T,PBYTE;$ PLUNKI; IF 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,_-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 . 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 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 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,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 . 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 = PROCEDURE AND SYM NE LABEL ;..MUST BE DECLARED IF PROCEDURE. T.PRO;$ TN.L;$ THEN BEGIN ;..SAVE NUMBER OF FORMALS FROM SYMBOL TABLE ENTRY; ;FPARMS_ST[SYM]; 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_SYM; ;DESCRIPTOR_TRUE; HRRZ DESCRIPTOR,RA;$ HLL DESCRIPTOR,SYM;$ TLO DESCRIPTOR,$DYN;$ IF SYM 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 = POINTER T.PTR;$ THEN BEGIN ;..PREVENT COERCING POINTER; ;SYM_'REG'; ;SYM_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(); 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_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_MIN(LLEXEX,LEXEX); ;..NOTE WE ASSUME SA IS ALWAYS 0; CAMGE T,LLEXEX;$ HLLM T,LLEXEX;$ ENDD; ELSE IF SYM 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_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