Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0001/postvl.for
There is 1 other file named postvl.for in the archive. Click here to see a list.
C
C
C
C            COPYRIGHT (c) 1977 BY
C    DIGITAL EQUIPMENT CORPORTATION, MAYNARD, MASS.
C   
C  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
C  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
C  INCLUSION OF THE  ABOVE COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY OTHER
C  COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE  MADE AVAILABLE TO ANY
C  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
C  TRANSFERRED.
C 
C  THE INFORMATION IN THIS  SOFTWARE IS SUBJECT TO CHANGE  WITHOUT NOTICE
C  AND  SHOULD  NOT  BE  CONSTRUED AS A COMMITMENT BY  DIGITAL  EQUIPMENT
C  CORPORATION.
C 
C  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
C  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
C 
C 
C 
C
C
C
C
C
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C   +                                                +
C   +            CALC    VERSION  X01-01             +
C   +                                                +
C   +  PETER BAUM  1-SEP-77                          +
C   +  DIGITAL EQUIPMENT CORPORATION                 +
C   +  146 MAIN STREET                               +
C   +  MAYNARD, MASSACHUSETTS  01754                 +
C   +                                                +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C
C
C
C **************************************************
C *                                                *
C *      SUBROUTINE  POSTVL (RETCD)                *
C *                                                *
C **************************************************
C
C
C  CONVERTS POSTFIX EXPRESSIONS IN STACK 1 TO A VALUE
C
C
C
C
C	RETCD	MEANING
C
C	1	O.K.
C	2	ERROR
C
C
C
C
C   MODIFY CLASSES: M3, M10
C
C
C
C
C
C POSTVL CALLS
C
C CALBIN    CALCULATES BINARY OPERATIONS
C CALUN     CALCULATES UNARY OPERATIONS
C ERRMSG    PRINTS OUT ERROR MESSAGES
C VAROUT    OUTPUTS THE VALUE OF A VARIABLE
C
C
C
C
C POSTVL IS CALLED BY CALC
C
C
C
C
C VARIABLE    USE
C _________ ___________________________
C
C    I,K     TEMPORARY VALUES
C
C    PT1     POINTS TO TOP ELEMENT IN STACK1
C
C    RETCD   RETURN CODE: 1=O.K., 2=ERROR
C
C    RETCD2  USED TO HOLD RETURN CODE WHEN CALLS TO
C            OTHER ROUTINES ARE MADE.
C
C    ST1PT   STACK 1 POINTER.
C
C    ST2PT   STACK 2 POINTER.
C
C    ST1TYP  VECTOR OF TYPES FOR EACH ELEMENT IN STACK 1
C 
C    ST2TYP  VECTOR OF TYPES FOR EACH ELEMENT IN STACK 2
C
C    STACK1  HOLDS ORIGINAL POSTFIX EXPRESSION.
C
C    STACK2  USED TO EVALUATE EXPRESSION IN STACK1.
C
C    TYPE(27) HOLDS THE DATA TYPE FOR EACH OF THE VARIABLES.
C
C    VBLS(100,27) HOLDS VALUES OF VARIABLES.
C
C    VIEWSW   VIEW SWITCH:
C                0 = OFF
C                1 = DISPLAY COMMANDS
C                2 = DISPLAY VALUE OF EXPRESSIONS
C                3 = DISPLAY ALL
C
C    
C
	SUBROUTINE POSTVL (RETCD)
C
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2 PT1
	INTEGER*2 VIEWSW,BASED
	INTEGER*2 RETCD,RETCD2,TYPE(27),VLEN(9)
	INTEGER*2 ST1TYP(40),ST2TYP(40)
	INTEGER*2 ST1LIM,ST2LIM,ST1PT,ST2PT
	INTEGER*2 I,K
C
	LOGICAL*1 LINE(80)
	LOGICAL*1 STACK1(100,40), STACK2(100,40),VBLS(100,27)
C
	COMMON /STACK/ STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;	       ST1LIM,ST2LIM
	COMMON /V/ TYPE,VBLS,VLEN
	COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
C
C
C
C
	RETCD=1
C
C
C IF THERE IS ONE ELEMENT IN STACK1 AND IT IS NOT
C A NUMBER, THE EXPRESSION IS ILLEGAL (GO TO 95).
	IF(ST1PT.EQ.2.AND.ST1TYP(1).GT.30)GO TO 95
C
C
10	IF (ST1PT.GT.2) GOTO 40
	IF (ST1PT.EQ.1) GOTO 95
C
C
C ***************************************
C ****** ONLY 1 ELEMENT ON STACK 1 ******
C ***************************************
	K=VLEN(ST1TYP(ST1PT-1))
C
C
C COPY INTO VARIABLE %
	DO 20 I=1,K
20	VBLS(I,27)=STACK1(I,1)
	TYPE(27)=ST1TYP(1)
C
C
C OUTPUT VALUE OF %
	IF (VIEWSW.GT.1) CALL VAROUT(27)
	RETURN
C
C
C  MORE THAN ONE ELEMENT ON STACK1
40	CONTINUE
	IF (ST1TYP(ST1PT-1).LE.30) GOTO 90
	IF (ST2PT.LE.ST2LIM) GOTO 45
C
C
C *** ERROR *** STACK 2 OVERFLOW
	CALL ERRMSG(9)
43	RETCD=2
	RETURN
C
C
C
C
C ****************************************
C ****** OPERATOR SO PUT ON STACK 2 ******
C ****************************************
45	ST2TYP(ST2PT)=ST1TYP(ST1PT-1)
	ST2PT=ST2PT+1
	ST1PT=ST1PT-1
	IF(ST1PT.EQ.1)GO TO 95
	GOTO 40
C
C
C
C
C
C *********************
C ****** OPERAND ******
C *********************
C
C FIRST BE SURE THAT THERE IS AN OPERATOR INVOLVED ON STACK 2
C (IF ONLY ONE ELEMENT IN STACK 1 YOU SHOULD NOT BE HERE).
90	IF(ST2PT.NE.1)GO TO 110
C
C
C *** ERROR *** ILLLEGAL EXPRESSION
95	CALL ERRMSG(8)
	GO TO 43
C
C
C
C
C ENTER HERE AFTER APPLYING AN OPERATOR TO A NUMBER
100	IF (ST2PT.EQ.1) GOTO 10
110	K=ST2TYP(ST2PT-1)
C
C IF A UNARY OPERATOR, GO TO 190
	IF ((K.GT.30.AND.K.LE.44).OR.K.EQ.111) GOTO 190
C
C
C IF A BINARY OPERATOR, GO TO 170
	IF (K.GE.110.AND.K.LE.117) GOTO 170
	IF(K.EQ.200)GO TO 170
C 
C IF ELEMENT ON STACK2 AT ST2PT-1 IS AN OPERAND, APPLY CALBIN AGAIN
	IF(K.LE.30) GO TO 180
	STOP 110
C
C
C
C
C ***************************************************************
C ****** CALBIN CALCULATES THE BINARY VALUE OF AN OPERATOR ******
C ***************************************************************
C  UPON ENTRANCE:
C	OPERAND 1 IS IN STACK 1
C	OPERAND 2 IS IN STACK 2
C	OPERATOR IS BELOW OPERAND 2
C  UPON EXIT RESULT IS ON STACK 1
C
C	RETURN CODE	MEANING
C
C	1		O.K.
C	2		OPERATION COMPLETE (RESULT HAS BEEN OUTPUT)
C	3		ERROR ENCOUNTERED
C
C
170	CONTINUE
C
C
C FIRST PUT OPERAND 2 ONTO STACK 2
	PT1=ST1PT-1
	ST2TYP(ST2PT)=ST1TYP(PT1)
	K=VLEN(ST2TYP(ST2PT))
	DO 175 I=1,K
175	STACK2(I,ST2PT)=STACK1(I,PT1)
	ST1PT=ST1PT-1
	IF(ST1PT.EQ.1)GO TO 95
	ST2PT=ST2PT+1
C
C
C IF OPERAND 1 IS AN OPERATOR, PUT IT ON STACK 2 (GO TO 45)
	IF(ST1TYP(ST1PT-1).GT.30) GO TO 45
180	CALL CALBIN (RETCD2)
	GOTO (100,1000,43), RETCD2
	STOP '180'
C
C
C
C
C
C ********************************************************************
C ****** CALL CALUN TO CALCULATE THE VALUE OF A UNARY OPERATION ******
C ********************************************************************
C	OPERATOR IS IN STACK 2   
C	OPERAND IS IN STACK 1
C	UPON EXIT, OPERATOR IS POPPED OFF STACK 2
C
C	RETURN CODE	MEANING
C
C	1		O.K.
C	2		OPERATION COMPLETE (RESULT HAS BEEN OUTPUT)
C	3		ERROR ENCOUNTERED
C
C
190	CALL CALUN (RETCD2)
	GOTO(100,43),RETCD2
	STOP '190'
C
C
1000	RETURN
	END