Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
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