Google
 

Trailing-Edge - PDP-10 Archives - BB-D480C-SB_1981 - expres.bli
There are 12 other files named expres.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1973,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F.J. INFANTE, D. B. TOLMAN/DCE/JNG/TFV/EGM/EDS

MODULE EXPRES(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN

GLOBAL BIND EXPREV = 6^24 + 0^18 + 40;		! Version Date:	22-Sep-81

%(

***** Begin Revision History *****

24	-----	-----	CODE TO WORRY ABOUT STATEMENT FUNCTION DUMMIES
			HAS BEEN REMOVED SINCE THEY ARE NOW
			SPECIAL GENERATED SUBLOCAL VARIABLES

			CODE TO WORRY ABOUT VARIABLES THE SAME AS FUNCTION
			NAMES HAS BEEN REMOVED SINCE THE NAME OF THE FUNCTION
			CURRENTLY BEING COMPILED NO LONGER HAS FNNAME SET
			ON IT

25	-----	-----	DON'T LET DUMMY ARGUMENTS WHICH HAPPEN TO BE LIBRARY
			FUNCTION NAMES TURN INTO LIBRARY FUNCTION CALLS

26	_____	_____	PICK UP THE .ED NAMES FOR ACTUAL PARAMETER
			LIBRARY FUNCITONS
			THE ROUTINE LIBSRCH HAS BEEN CHANGED TO SRCHLIB
			WITH A SYMBOL TABLE POINTER AS PARAMETER

27	-----	-----	CLEAR THE ARG1PTR FOR NEGNOT NODES  IN MACRO
			BLDTREE

28	-----	-----	IMMEDIATELY NEGATE ALL CONSTANTS PRECEEDED BY 
			UNARY MINUS.  ROUTINE PRIMITIVE

29	-----	-----	DETECT A .NOT. B IN MACRO BLDTREE

30	-----	-----	REMOVE THE CONVERSION NODE INSERT CODE
			FOR UNARY NEGATION OF DOUBLE OCTAL AND LET
			NEGCNST DO IT NOW THAT CONSTANTS ARE IMMEDIATELY NEGATED

			ROUTINE PRIMITIVE

31	-----	-----	FIX PRIMITIVE SO THAT IT WILL NOT MAKE NAMSET
			CALLS  FOR LIBRARY ROUTINE ACTUAL PARAMETERS
32	542	22147	MAKE NOT NODES BE OF TYPE LOGICAL, (DCE)
33	626	23169	DON'T ALLOW FUNCTION OR ARRAY NAMES WITHOUT
			  PARENTHESIZED LISTS TO APPEAR IN EXPRESSIONS
			  IN ARGUMENT LISTS, E.G. CATCH FN(A+3), WHERE
			  FN IS A FUNCTION AND A IS AN ARRAY., (JNG)

***** Begin Version 6 *****

34	761	TFV	1-Mar-80	-----
	Choose either KLDP or GFLOATING dotted name for generic functions.
	Convert DP to SP based on /GFLOATING

35	1004	TFV	1-Jul-80	------
	Fix dottednames to lookup /GFLOATING routines only for doubleprecision.
	Replace VREG with temp.

36	1043	EGM	19-Jan-81	20-15466
	Generate warning for consecutive arithmetic operands.

37	1056	DCE	3-Mar-81	-----
	Put type conversion node beneath .NOT. node if necessary (for register
	allocation especially).

38      1072    CKS     22-May-81	Q20-1524
	Remove consecutive arithmetic operators illegal message until it can be
	put under flagger switch

40	1122	EDS	22-Sep-81	10-31589
	Fix PRIMITIVE to detect invalid complex expression.

***** End Revision History *****

)%

REQUIRE  LEXNAM.BLI;
REQUIRE ASHELP.BLI;


SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;


BIND PRECEDENCE =	!THE PRECEDENCE OF THE EXPRESSION OPERATORS
	PLIT(	%PRECEDENCE,,OPERATOR FLAG COMBINED IF NEGATIVE%
	PRCDNCE0,	!NULL FOR INDEXING
	PRCDNCE1,
	PRCDNCE2,
	PRCDNCE3,
	PRCDNCE4,
	PRCDNCE5,
	PRCDNCE6,
	PRCDNCE7,
	PRCDNCE8,
	PRCDNCE9,
	PRCDNCE10,
	PRCDNCE11,
	PRCDNCE12,
	PRCDNCE13,
	PRCDNCE14,
	PRCDNCE15,
	PRCDNCE16,
	PRCDNCE17,
	PRCDNCE18,
	PRCDNCE19,
	PRCDNCE20,
	PRCDNCE21,
	PRCDNCE22,
	);

MACRO	OPER(X)= (.PRECEDENCE[X] LSS 0)$;

MACRO ERR0(X)= RETURN FATLEX( X, .LEXNAME[.LEXL<LEFT>], E0<0,0> ) $;
MACRO MAKENEGAT = (LOCAL BASE NEGNOD;
			NAME _ EXPTAB;
			NEGNOD _ NEWENTRY();
			NEGNOD[OPRCLS]_ NEGNOT; NEGNOD[OPERSP]_NEGOP;
			.NEGNOD
		)$;

%[1043]% BIND ARITHOPFLAGS = ! A parallel table for PRECEDENCE
%[1043]%	     PLIT (  !  flagging arithmetic operators
%[1043]%	%[IDENTIFIER:LOGICAL MATCH]% 0,0,0,0,0,0,0,0,0,0,0,
%[1043]%	%[POWER]%                    1,
%[1043]%	%[ANDSGN:DOLLAR]%            0,0,0,0,0,0,
%[1043]%	%[MINUS:TIMES]%		     1,1,1,1,
%[1043]%	%[EQUAL]%		     0);
%[1043]% OWN CONSECOPS,		! Consecutive ops seen flag
%[1043]%     ARITHOPSEEN;	! Arithmetic operator seen flag
%[1043]% EXTERNAL E148;	! Consecutive arithmetic operators warning

EXTERNAL NEWENTRY,LEXEMEGEN,LEXL,LSAVE,STK,SP,LEXICAL,GSTLEXEME,FATLEX,LEXNAME;
GLOBAL ROUTINE EXPRESSION=
BEGIN
%
ROUTINE IS AN "ACTION" ROUTINE CALLED BY THE SYNTAX ANALYSER
TO PARSE A GENERAL FORTRAN EXPRESSION.
RETURNS A PTR TO AN EXPRESSION NODE IN STK[SP_.SP+1]
%
EXTERNAL SP,STK,LOGEXPRESSION;
LOCAL LSP;  !LOCAL STK PTR;
%[1043]% CONSECOPS _ 0;	! No consecutive operators seen
	LSP _ .SP;
	IF .LSAVE EQL 0
	THEN  (LSAVE_-1;LEXL _ LEXEMEGEN());
	IF .LEXL<LEFT> EQL LINEND THEN ERR0(.LEXNAM[IDENTIFIER]); !NO EXPRESSION FOUND
%[1043]% STK[SP_.LSP+1]_LOGEXPRESSION();
![1072] %[1043]% IF .CONSECOPS THEN WARNLEX( E148<0,0>); ! Issue consec ops warning
%[1043]% RETURN .STK[.SP]
END;
GLOBAL ROUTINE LOGEXPRESSION=
BEGIN
%
ROUTINE IS CALLED BY THE ACTION ROUTINE EXPRESSION
TO PARSE AN ARBITRARY FORTRAN EXPRESSION
THE ROUTINE IS AN OPERATOR PRECEDENCE  METHOD, THE PRECEDENCE OF THE
OPERATORS IS GIVEN IN THE TABLE PRECEDENCE IN THIS FILE

ROUTINE IS RECURSIVE
THE OPERATORS ** AND UNARY MINUS ARE HANDLED AS SPECIAL CASES IN THIS ROUTINE AND THE ROUTINES IT CALLS

%
MACRO BLDTREE(OPRATOR)=
BEGIN
LABEL BLDTR;
BLDTR: BEGIN
	LOCAL OPR;
	REGISTER BASE R2:T1:T2;
	OPR_.OPRATOR;
	NAME _ EXPTAB; !GENERATE AN EXPRESSION NODE
	T1 _ NEWENTRY();
	T1[ARG2PTR]_R2 _ .STAK[.STP]; STP _ .STP-1;
	IF .OPR<LEFT> EQL LOGICALNOT
	THEN
	   BEGIN
		EXTERNAL FATLEX,E132,TPCDMY; ![1056]
		%MAKE SURE THIS ISN'T A BINARY .NOT.%
		IF .STP  NEQ 0
		THEN
			IF .STAK[.STP-1]<LEFT> LEQ LASTLEX
			THEN
				IF NOT OPER( .STAK[.STP-1]<LEFT>)
				THEN	RETURN FATLEX(E132<0,0>);
		T1[OPRCLS] _ NEGNOT; T1[OPERSP]_ NOTOP;
		IF .R2[OPRCLS] EQL DATAOPR THEN T1[A2VALFLG] _1
			ELSE (R2[PARENT] _ .T1;
				IF .R2[FNCALLSFLG] THEN T1[FNCALLSFLG] _ 1;
			     );
		!NOT NODES SHOULD ALWAYS BE OF TYPE LOGICAL
		T1[VALTYPE] _ LOGICAL;
		T1[ARG1PTR] _ 0;
![1056] If a node of double size sits below a .NOT. node (shudder),
![1056] we need to insert an intervening type conversion node so that
![1056] register allocation does not use odd registers for dp and
![1056] complex numbers.
%[1056]%	IF .R2[DBLFLG] THEN T1[ARG2PTR]_TPCDMY(.T1,.R2);
		LEAVE BLDTR WITH .T1;
	    END;
	T1[ARG1PTR] _  .STAK[STP_.STP-1];
	CASE .OPR<LEFT>-6 OF SET
%RELATION%	(T1[OPRCLS]_RELATIONAL;T1[OPERSP]_.OPR<RIGHT>);
%NOT%		(T1[OPRCLS]_NEGNOT;T1[OPERSP]_NOTOP);
%AND%		(T1[OPRCLS]_BOOLEAN;T1[OPERSP]_ANDOP);
%OR%		(T1[OPRCLS]_BOOLEAN;T1[OPERSP]_OROP);
%MATCH%		(T1[OPRCLS]_BOOLEAN;T1[OPERSP]_ IF .OPR<RIGHT> EQL 1 THEN EQVOP ELSE XOROP);
%POWER%		(T1[OPRCLS]_ARITHMETIC;T1[OPERSP]_EXPONOP);
		0;
		0;
		0;
		0;
		0;
		0;
%MINUS%		(T1[OPRCLS]_ARITHMETIC;T1[OPERSP]_SUBOP);
%DIVIDE%	(T1[OPRCLS]_ARITHMETIC;T1[OPERSP]_DIVOP);
%PLUS%		(T1[OPRCLS]_ARITHMETIC;T1[OPERSP]_ADDOP);
%TIMES%		(T1[OPRCLS]_ARITHMETIC;T1[OPERSP]_MULOP)
		TES;
		R2 _ .T1;  EXPRTYPER(.T1); !SAVING EXPRESSION PTR
			!EXPRTYPER BUILDS A TYPE CONVERSION NODE IF NECESSARY
		T1_.R2;	!RESTORING PTR
		R2_.T1[ARG2PTR]; T2_.T1[ARG1PTR]; !RESTORING PTRS
		IF .R2[OPRCLS] EQL DATAOPR THEN T1[A2VALFLG]_1
			 ELSE (R2[PARENT]_.T1;IF .R2[FNCALLSFLG] THEN T1[FNCALLSFLG] _1;);

		  IF .T2[OPRCLS] EQL DATAOPR THEN T1[A1VALFLG]_1
			 ELSE (T2[PARENT]_.T1; IF .T2[FNCALLSFLG] THEN T1[FNCALLSFLG] _ 1;);

	.T1
   END
END$;	!OF MACRO BLDTREE
LOCAL STAK[14], STP; !STACK AND STACK PTR
REGISTER BASE R1;
EXTERNAL EXPRTYPER,PRIMITIVE,STK;
EXTERNAL POOL;
LABEL EXPR1,EXPR2;

!
!CHECK FOR STACK OVERFLOW
!
IF .SREG<RIGHT> GEQ (POOL<0,0>-50)<0,0> THEN RETURN FATLEX(E90<0,0>);
!
STP _ -1;	!INITIALIZE THE STACK PTR
%[1043]% ARITHOPSEEN _ 0;	! No arithmetic operators seen yet
WHILE 1 DO
BEGIN
EXPR1:
	IF .LEXL<LEFT> NEQ LOGICALNOT
	THEN
	   BEGIN
		IF (STAK[STP_.STP+1] _ PRIMITIVE()) LSS 0 THEN RETURN -1; !GET AN OPERAND OR OPERATOR
				!RETURN ON ERROR (-1)
	EXPR2:  WHILE 1 DO
		BEGIN
		   IF NOT OPER(.LEXL<LEFT>)
			THEN (IF .STP LEQ 0 THEN RETURN .STAK[.STP];)
			ELSE (
				IF .STP LEQ 0 THEN LEAVE EXPR2;
				IF .PRECEDENCE[.LEXL<LEFT>] GTR .PRECEDENCE[.STAK[.STP-1]<LEFT>]
				THEN LEAVE EXPR2; !LEAVE TO STACK THE OPERATOR
			     );
		!HERE IF NOT OPERATOR AND STACK PTR GTR 0
		!OR
		!IF OPERATOR PRECEDENCE LEQ PREVIOUS OPERATOR'S

		   STAK[.STP] _ BLDTREE(STAK[.STP-1]);	!BUILD A TREE NODE
		END; !OF WHILE 1 DO
	    END; !OF IF LEXL NEQ NOTOP
	!
	!HERE IF STACKING HIGER PRECEDENCE OPERATOR OR
	!NOT OP SEEN OR FIRST OPERATOR SEEN
	!
	STAK[STP_.STP+1] _ .LEXL;
%[1043]% ARITHOPSEEN _ .ARITHOPFLAGS[ .LEXL<LEFT>]; ! Indicate arith op seen
	LEXL _ LEXEMEGEN();
%[626]%	FLGREG<FELFLG> _ 0;	!ARRAYREFS OR FNS W/O ARG LISTS NO LONGER LEGAL
END;	!OF WHILE 1 DO
	!EXIT FROM THIS LOOP IS BY RETURN FROM INSIDE THE LOOP
END;	!OF LOGEXPRESSION
GLOBAL ROUTINE REFERENCE=
BEGIN
%
ROUTINE PARSES A VARIABLE OR FUNCTION REFERENCE
INCOMING LEXEME IS ALREADY AVAILABLE IN LEXL AND MUST BE AN IDENTIFIER
ROUTINE THEN PROCEEDS TO CHECK FOR ARRAY OR FUNCTION REFEERENCE
AND IF A LEFT PAREN IS SEEN THEN THE LST OF SUBSCRIPTS OR ARGUMENTS IS SCANNED
ROUTINE RETURNS A PTR TO A VARIABLE OR FUNCTION REFERENCE NODE
%
EXTERNAL NAMREF,NAMSET;
LOCAL BASE IDPTR;
EXTERNAL MAKLIBFUN;	!MAKES A LIBRARY FUNCTION CALL NODE
EXTERNAL ARRXPN,SRCHLIB,ASTATFUN,CORMAN,COPYLIST,SAVSPACE,PROGNAME,TBLSEARCH,CNVNODE;
%[1004]%	LOCAL VAL;
%[1004]%	EXTERNAL LIBFUNTAB,LIBATTRIBUTES;
%[1004]%	MAP LIBATTSTR LIBATTRIBUTES;
REGISTER BASE T1:T2;
MACRO ERR65(X)= RETURN  FATLEX ( X, E65<0,0> ) $;
MACRO ERR47(X)= RETURN FATLEX( X, E47<0,0> ) $;

IF .LEXL<LEFT> NEQ IDENTIFIER
THEN ERR0(.LEXNAM[IDENTIFIER]);
IDPTR _ .LEXL<RIGHT>; !PTR TO IDENTIFIER
LEXL _ LEXEMEGEN(); !NEXT LEXEME TO LOOK FOR "("
IF .LEXL<LEFT> EQL LPAREN
THEN
    BEGIN	!ARRAY REFERENCE OR FUNCTION REFERENCE
	LOCAL LSP; LSP _.SP;	!SAV THE STK PTR FO SYNTAX
	DO BEGIN	!WHILE REFERENCE FOLLOWED BY ","
		LEXL _ LEXEMEGEN();
		IF .IDPTR[OPRSP1] NEQ ARRAYNM1  !IF NOT ARRAY THEN FUNCTION CALL
		THEN FLGREG<FELFLG> _ 1; !SET FLG FOR CHECKING ARGS IN ARGLIST OF FUNCTION
		IF (.LEXL<LEFT> NEQ DOLLAR) AND (.LEXL<LEFT> NEQ ANDSGN)
		THEN (IF ( STK[SP _ .SP+1] _ LOGEXPRESSION()) LSS 0 THEN RETURN -1)
		ELSE
		   BEGIN
			!LABEL ARGS ARE ILLEGAL IN FUNCTION OR ARRAY REF'S
			RETURN FATLEX(E83<0,0>);
		   END;
	   END WHILE .LEXL<LEFT> EQL COMMA;
	IF .LEXL<LEFT> NEQ RPAREN THEN ERR0(.LEXNAM[RPAREN]);
	FLGREG<FELFLG> _ 0; !TURN OFF FELFLG FOR NEXT FUNCTION CALL
	COPYLIST(.LSP); !COPY LIST FROM STK TO FREE CORE
	INCR ARG FROM .STK[.SP] TO .STK[.SP]+.STK[.SP]<LEFT> DO
	BEGIN MAP BASE ARG;
		MACRO ARGPTR=0,0,FULL$, ARGFLG=0,0,LEFT$;
		LOCAL BASE R2;
		R2 _ .ARG[ARGPTR];
		IF .R2[OPRCLS] EQL DATAOPR
		THEN ARG[P1AVALFLG] _ 1
		ELSE ARG[P1AVALFLG] _ 0;
	END; !OF INCR ARG
!
!NOW SEE IF FUNCTION CALL OR ARRAY REF TO MAKE PROPER NODE TYPE
!
	LEXL _ LEXEMEGEN(); !FOR POSSIBLE RETURN TO CALLING ROUTINE
	IF .IDPTR[OPRSP1] NEQ ARRAYNM1
	THEN !IDENTIFIER IS FUNCTION NAME
	   BEGIN
		LABEL LIBCHK;
		LOCAL BASE ARGPT: FNEXPR;
		REGISTER R2;	!FOR PTR TO FUNTION ARG LIST
		FLGREG<BTTMSTFL> _ 0;  !TURN OFF BOTTOMOST ROUTINE FLAG
		!CHECK FOR RECURSIVE STATEMENT FUNCTION
		IF (.IDPTR EQL .ASTATFUN)  THEN ERR47(IDPTR[IDSYMBOL]);
		NAME<LEFT> _ .STK[.SP]<LEFT>+3;
		R2 _ CORMAN(); !CORE FOR FUNCTION ARGLIST
		!
		!NOW MOVE THE ARGLIST TO A BLOCK POINTED TO BY R2
		!BEGINNING AT WORD .R2+2 OF THE BLOCK
		!
		NAME _ EXPTAB; ENTRY[0] _ .IDPTR; ENTRY[1] _ .R2;
		FNEXPR_NEWENTRY();	!MAKE AN EXPREESION NODE FOR FNCALL
		FNEXPR[VALTYPE] _ .IDPTR[VALTYPE];  FNEXPR[OPRCLS] _ FNCALL;
		(.R2+1)<RIGHT> _ .STK[.SP]<LEFT>+1; !NUMBER OF ARGS
		!PREPARE TO MOVE ARGLIST TO NEW AREA
		T1 _ .STK[.SP];  T2 _ .R2+2;  !FROM T1 TO T2
		DECR I FROM .STK[.SP]<LEFT> TO 0 DO
		BEGIN
		  (.T2)[.I]  _ ARGPT _  @(.T1)[.I];
		  IF .ARGPT<LEFT> EQL 0  !IS ARG FUNCTION OR EXPRESION
			THEN ARGPT[PARENT] _ .FNEXPR;
		END;
!
!	NOW IF FUNCTION CALL IS TO LIBRARY CALL SPECIAL PROCESSING ROUTINE
!	IN MODULE GNRCFN
!
		LIBCHK:BEGIN
			IF  NOT .IDPTR[IDATTRIBUT(INEXTSGN)] AND NOT .IDPTR[IDATTRIBUT(DUMMY)]
			THEN (
				LOCAL LIBPTR;
				IF (LIBPTR_ SRCHLIB(.IDPTR)) NEQ -1
				THEN (
					MAKLIBFUN(.LIBPTR,.FNEXPR);	!MAKE THE LIB FUNCTION CALL NODE
					LEAVE LIBCHK;
					)
			     );
			FNEXPR[OPERSP] _ NONLIBARY;
			%NOTE POSSIBLE  "SET"  FOR NON-LIBRARY FUNCTIONS%
			DECR I FROM .STK[.SP]<LEFT> TO 0 DO
			BEGIN
			  ARGPT _  @(.T2)[.I];
			  IF .ARGPT[OPRCLS] EQL DATAOPR
			  THEN	( IF .ARGPT[OPRSP1] EQL ARRAYNM1  OR .ARGPT[OPRSP1] EQL VARIABL1
				THEN	NAMSET(VARYREF, .ARGPT) )
			  ELSE	IF .ARGPT[OPRCLS] EQL  ARRAYREF
				THEN	NAMSET( ARRAYNM1, .ARGPT[ARG1PTR]);
			END;
		END;	%LIBCHK%

!
		NAMREF(FNNAME1, .FNEXPR[ARG1PTR]) ;	!RECORD THE REFERENCE
		SAVSPACE(.STK[.SP]<LEFT>,.STK[.SP]); !SAVE THE ARGLIST SPACE
		IDPTR _  .FNEXPR;
	   END
	ELSE
	BEGIN
		% ARRAY NAME%
		NAMREF(ARRAYNM1, .IDPTR);	!RECORD THE REFERENCE
		IDPTR _  ARRXPN(.IDPTR,.STK[.SP]);
	END;
	SP _ .LSP;	!RESTORING STK PTR TO ORIGINAL TO AVOID RECURSION PROBLEMS
   END
ELSE
	!CHECK USE O NAME WITHOUT SUBSCRIPTS OR ARGS
   IF .IDPTR[PARENLSTFLG]
     THEN
	BEGIN !ARRAYNAME OR FUNCTION NAME W/O ARGS OR SUBSCRIPTS
		IF NOT .FLGREG<FELFLG>
		OR ( .IDPTR[OPRSP1] EQL  FNNAME1 
			AND NOT ( .IDPTR[IDATTRIBUT(INEXTERN)] OR .IDPTR[IDATTRIBUT(INEXTSGN)] )
		   )
%[626]%		OR OPER(.LEXL<LEFT>)	!CAN'T BE EMBEDDED IN AN EXPRESSION
		THEN !ERRONEOUS USE OF IDENTIFIER
		   BEGIN
			RETURN NAMREF(VARIABL1, .IDPTR)	! THIS WILL PRODUCE ERROR MESSAGE
		   END
		   ELSE	IF  .IDPTR[OPRSP1]  EQL  FNNAME1
			THEN	
			BEGIN
				% GET .ED NAME IF THIS IS A LIBRARY FUNCTION - NOT IN EXTERNAL WITH */&  %
				IF NOT .IDPTR[IDATTRIBUT(INEXTSGN)]
				THEN
%[1004]%					IF ( VAL_SRCHLIB( .IDPTR) )  NEQ  -1
					THEN
					BEGIN
%[761]%						EXTERNAL NAME,ENTRY,DOTTEDNAMES,GDOTTEDNAMES,LIBFUNTAB,TBLSEARCH;
						NAME _ IDTAB;

%[1004]%					VAL_.VAL - LIBFUNTAB<0,0>;	! Get offset into table
%[1004]%						IF .GFLOAT AND .LIBATTRIBUTES[.VAL,ATTRESTYPE] EQL DOUBLPREC
%[1004]%						THEN ENTRY[0] _ .GDOTTEDNAMES[ .VAL]
%[1004]%						ELSE ENTRY[0] _ .DOTTEDNAMES[ .VAL];
						IDPTR _ TBLSEARCH()
					END;

				NAMREF(FNNAME1, .IDPTR)
			END
			ELSE	NAMREF(ARRAYNM1, .IDPTR)
	  END
	  ELSE	NAMREF( VARIABL1, .IDPTR );	!RECORD REFERENCE

RETURN .IDPTR	!RETURN HERE ONLY
END;	!OF REFERENCE
GLOBAL ROUTINE PRIMITIVE=
BEGIN
%
PARSES A PRIMITIVE OF AN EXPRESSION
	THESE ARE:
	[$ OR * OR &]LABEL
	[+,-]CONSTANT OR LITERAL
	[+,-]REFERENCE (ARRAY OR FUNCTION)
	A**B
	(REAL,REAL) COMPLEX CONSTANT
	(EXPRESSION)
AND LEAVES NEXT LEXEME AVAILABLE WHEN FINISHED
%
LOCAL BASE NEGATNODE;
LOCAL BASE REALPART:IMAGPART;
MACRO MAKEREAL(X)=
BEGIN
![761] KTYPCG for /GFLOATING type conversions
%[761]%	EXTERNAL KTYPCB,KTYPCG,CNVNODE;
	C1H_0;
	C1L_X;
	COPRIX _ KKTPCNVIX(REAL2,FROMINT);
	CNSTCM();
END$;
MACRO DNEG(X)=
BEGIN
	C1H _ X[CONST1];	!HIGH ORDER
	C1L _ X[CONST2];	!LOW ORDER
%[761]%	COPRIX _ KDNEGB;
	CNSTCM();	!CONVERT TO NEG
	MAKECNST(REAL,.C2H,.C2L)
END$;
![761] KGFRL for converting GFLOATING DP to SP
%[761]% EXTERNAL CNSTCM,C1H,C1L,C2H,C2L,COPRIX,KDPRL,KGFRL,KDNEGB,CNVNODE;
EXTERNAL EXPRTYPER,TBLSEARCH;
LABEL PRIM1;
NEGATNODE _ 0;
WHILE 1 DO
BEGIN	!SCAN UNTIL NO LEADING + OR MINUS
	IF .LEXL<LEFT> EQL MINUS
	THEN( IF .NEGATNODE EQL 0 THEN NEGATNODE _ MAKENEGAT ELSE NEGATNODE _ 0;
		  LEXL _ LEXEMEGEN();
		)
	ELSE  IF .LEXL<LEFT> EQL PLUS
		THEN LEXL _ LEXEMEGEN()
		ELSE EXITLOOP;
%[626]%	FLGREG<FELFLG> _ 0;	!CALL FOO(+ARRAY) ISN'T LEGAL
![1043] Flag an error if 2nd arith op in a row, else mark operator seen
%[1043]% IF .ARITHOPSEEN NEQ 0 THEN CONSECOPS _ -1 ELSE ARITHOPSEEN _ -1;
END; !OF WHILE 1 DO
%[1043]% ARITHOPSEEN _ 0;	! Next token cannot be an arith operator

PRIM1:
	IF .LEXL<LEFT> EQL LPAREN
	THEN !PRENTHESIZED EXPRESSION OR COMPLEX CONSTANT
	   BEGIN
%[626]%		FLGREG<FELFLG> _ 0;	!CALL FOO((ARRAY)+1) ILLEGAL
		LEXL _ LEXEMEGEN();
		IF (REALPART _ LOGEXPRESSION()) LSS 0 THEN RETURN -1; !RECURSE RETURN IF ERROR
		IF .LEXL<LEFT> EQL COMMA
		THEN  !EXPECTING A COMPLEX CONSTANT
		   BEGIN
			EXTERNAL FATLEX,E127;
			LOCAL NEGSIGN;
			NEGSIGN _ 0;
%1122%			IF .REALPART[OPRCLS] EQL NEGNOT
			THEN !MUST BE A NEGATIVE CONSTANT
			  (
			   REALPART _ .REALPART[ARG2PTR];
			   IF .REALPART[OPERSP] NEQ CONSTANT THEN ERR0(.LEXNAM[RPAREN]);
			   NEGSIGN _ -1;
			  )
			ELSE IF .REALPART[OPERSP] NEQ CONSTANT
%1122%				OR .REALPART[OPRCLS] NEQ DATAOPR
				 THEN ERR0(.LEXNAM[RPAREN]);
			%DON'T ALLOW ELEMENTS OF COMPLEX CONSTANTS TO BE
			  COMPLEX CONSTANTS  %
			IF .REALPART[VALTYPE] EQL COMPLEX  THEN RETURN FATLEX(E127<0,0>);
			IF .REALPART[VALTYPE] EQL INTEGER THEN REALPART _ ( MAKEREAL(.REALPART[CONST2]);MAKECNST(REAL,.C2H,.C2L));
			IF .NEGSIGN NEQ 0 THEN REALPART _DNEG(.REALPART);
			!NOW CONVERT TO SINGLE PRECISION
			IF .REALPART[VALTYPE] NEQ OCTAL
			THEN
			BEGIN
			  C1H _ .REALPART[CONST1]; C1L _ .REALPART[CONST2];
![761] Convert DP to SP based on /GFLOATING
%[761]%			  IF .GFLOAT
%[761]%				THEN COPRIX_KGFRL
%[761]%				ELSE COPRIX_KDPRL;
			  CNSTCM();	!CONVERSION ROUTINE
			  REALPART _ .C2H;
			END
			  ELSE REALPART _ .REALPART[CONST2]; !GET THE OCTAL BITS
			NEGSIGN _ 0;
		 	LEXL _ LEXEMEGEN();
			IF .LEXL<LEFT> EQL PLUS
			THEN LEXL _ LEXEMEGEN()
			ELSE IF .LEXL<LEFT> EQL MINUS
				THEN( NEGSIGN _ -1; LEXL _ LEXEMEGEN());
			IF .LEXL<LEFT> NEQ CONSTLEX THEN ERR0(.LEXNAM[CONSTLEX]);
			IMAGPART _ .LEXL<RIGHT>;
			IF .IMAGPART[VALTYPE] EQL INTEGER THEN IMAGPART _ (MAKEREAL(.IMAGPART[CONST2]); MAKECNST(REAL,.C2H,.C2L));
			IF .NEGSIGN NEQ 0 THEN IMAGPART_ DNEG(.IMAGPART);
			!NOW CONVERT TO SINGLE PRECISION
			IF .IMAGPART[VALTYPE] NEQ OCTAL
			THEN
			BEGIN
			  C1H _ .IMAGPART[CONST1]; C1L _ .IMAGPART[CONST2];
![761] Convert DP to SP based on /GFLOATING
%[761]%			  IF .GFLOAT
%[761]%				THEN COPRIX_KGFRL
%[761]%				ELSE COPRIX_KDPRL;
			  CNSTCM();	!CONVERSION ROUTINE
			  IMAGPART _ .C2H;
			END
			  ELSE IMAGPART _ .IMAGPART[CONST2];  !GET THE OCTAL BITS
			REALPART _ MAKECNST(COMPLEX,.REALPART,.IMAGPART);
			LEXL _ LEXEMEGEN();

		   END !OF IF COMMA
		ELSE IF .REALPART[OPRCLS] NEQ DATAOPR THEN REALPART[PARENFLG] _ 1;
		IF .LEXL<LEFT> NEQ RPAREN THEN ERR0(.LEXNAM[RPAREN]);
		LEXL_ LEXEMEGEN(); !THIS IS TO LOOK AHEAD FOR EXPONENT OPERATOR
		LEAVE PRIM1;
	   END	!OF IF ... LPAREN
	ELSE	!NOT A PARENTHESIZED EXPRESSION
	   BEGIN
		IF .LEXL<LEFT>  EQL  CONSTLEX  OR  .LEXL<LEFT> EQL LITSTRING
		  THEN (REALPART _ .LEXL<RIGHT>; LEXL _ LEXEMEGEN())
		  ELSE
			IF ( REALPART _ REFERENCE()) LSS 0 THEN RETURN .VREG; !VARIABLE OR FUNCTION REFERENCE
		 !REFERENCE WILL RETURN WITH NEXT LEXEME IN LEXL
	   END;  !OF PRIM1:

!
!HERE NOW TO CHECK FOR ** OPERATOR AND SPECIAL PRIMITIVE
!REALPART CONTAINS EITHER
!	1. PTR TO CONSTANT NODE OR
!	2. PTR TO EXPRESSION NODE OR
!	3. PTR TO VARIABLE OR FUNCTION REFERENCE
!
	IF .LEXL<LEFT> EQL POWER
	THEN
	   BEGIN !MAKE AN EXPONENT NODE
		LOCAL BASE EXPON;REGISTER BASE T1;
%[1043]%	ARITHOPSEEN _ -1;	! Flag arith op seen

%[626]%		FLGREG<FELFLG> _ 0;	!CALL FOO(3**ARRAY) ILLEGAL
		NAME _ EXPTAB; EXPON_NEWENTRY();
		EXPON[OPRCLS]_ARITHMETIC; EXPON[OPERSP]_EXPONOP;
		EXPON[ARG1PTR] _ .REALPART; !BASE
		!NOW CHECK FOR SONS BEING DATAOPR OR NOT AND SET PARENT POINTERS APPROPRIATELY
		LEXL _ LEXEMEGEN();
		IF (REALPART  _ PRIMITIVE()) LSS 0 THEN RETURN -1; !RECURSE TO GET A**B**C = A**(B**C)
		EXPON[ARG2PTR]_.REALPART;
		EXPRTYPER(.EXPON);	!CHECK FOR TYPE CONVERSIONS
		REALPART _ .EXPON[ARG1PTR];	!CHECK SONS NOW
		IF .REALPART[OPRCLS] EQL DATAOPR
			THEN EXPON[A1VALFLG]_1
			ELSE ( REALPART[PARENT]_.EXPON;
				IF .REALPART[FNCALLSFLG] THEN EXPON[FNCALLSFLG]_1;
			     );
		REALPART _ .EXPON[ARG2PTR];	!CHECK SON AGAIN
		IF .REALPART[OPRCLS] EQL DATAOPR
			THEN EXPON[A2VALFLG]_1
			ELSE ( REALPART[PARENT]_.EXPON;
				IF .REALPART[FNCALLSFLG] THEN EXPON[FNCALLSFLG]_1;
			     );
		REALPART _ .EXPON;
	   END;
	IF .NEGATNODE NEQ 0
	  THEN(

		 NEGATNODE[ARG2PTR]_.REALPART;
		 NEGATNODE[ARG1PTR] _ 0;
		IF .REALPART[OPRCLS] EQL DATAOPR
			THEN
			BEGIN
				% NEGATE CONSTANTS NOW%
				IF .REALPART[OPERSP] EQL CONSTANT
				THEN  RETURN NEGCNST ( REALPART );
				NEGATNODE[A2VALFLG]_1
			END
			ELSE ( REALPART[PARENT]_.NEGATNODE;
				IF .REALPART[FNCALLSFLG] THEN NEGATNODE[FNCALLSFLG]_1;
			     );
		NEGATNODE[VALTYPE]_ (IF .REALPART[VALTYPE] EQL CONTROL THEN LOGICAL ELSE .REALPART[VALTYPE]);
		RETURN .NEGATNODE
		)
	   ELSE   RETURN .REALPART;
END; !0F ROUTINE PRIMITIVE
END
ELUDOM