Google
 

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