Google
 

Trailing-Edge - PDP-10 Archives - BB-4157D-BM - sources/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,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F.J. INFANTE, D. B. TOLMAN/DCE
MODULE EXPR(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN

GLOBAL BIND EXPRV = 5^24+1^18+32;		!VERSION DATE: 8-MAR-77

%(
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

)%

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
		)$;

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;
	LSP _ .SP;
	IF .LSAVE EQL 0
	THEN  (LSAVE_-1;LEXL _ LEXEMEGEN());
	IF .LEXL<LEFT> EQL LINEND THEN ERR0(.LEXNAM[IDENTIFIER]); !NO EXPRESSION FOUND
	RETURN  STK[SP_.LSP+1]_LOGEXPRESSION();
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;
		%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;
			     );
	!**;[542], LOGEXPRESSION @3494, DCE, 8-MAR-77
	!**;[542], NOT NODES SHOULD ALWAYS BE OF TYPE LOGICAL
	%[542]%	T1[VALTYPE] _ LOGICAL;
		T1[ARG1PTR] _ 0;
		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
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;
	LEXL _ LEXEMEGEN();
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;
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)] )
		   )
		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
					IF ( VREG_SRCHLIB( .IDPTR) )  NEQ  -1
					THEN
					BEGIN
						EXTERNAL NAME,ENTRY,DOTTEDNAMES,LIBFUNTAB,TBLSEARCH;
						NAME _ IDTAB;
						ENTRY[0] _ .DOTTEDNAMES[ .VREG - LIBFUNTAB<0,0> ];
						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
	EXTE