Trailing-Edge
-
PDP-10 Archives
-
AP-5471B-BM
-
sources/algexp.mac
There are 8 other files named algexp.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 FOR EXPRESSIONS
; COPYRIGHT 1971,1972,1973,1974 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 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
IF STANDARD FUNCTION
HRRZ T2,SYM ; [E010] GET SYMBOL TABLE ENTRY ADDRESS
CAILE T2,PRASE## ; [E010] STANDARD FUNCTION ?
GOTO FALSE ; [E010] NO
THEN
FAIL(129,HARD,SYM,ATTEMPT TO ASSIGN TO STANDARD FUNCTION)
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