SUBROUTINE POSTVL (RETCD)
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
	INCLUDE 'VKLUGPRM.FTN'
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32
C RRW=MAX REAL ROWS
C RCL=MAX REAL COLS
C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS
C VBLS AND TYPE DIMENSIONED RRW,RCL
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    AVBLS(100,27) HOLDS VALUES OF VARIABLES.
C    VBLS(8,RRW,RCL) HOLDS VALUE OF COMPLEXLY-NAMED VARIABLES. 1ST 27 ELEMENTS
C	ARE PLACE HOLDERS FOR AVBLS; ROUTINES THAT GENERATE DIMENSIONS ID1,ID2
C	FOR VBLS RETURN DIMENSIONS 1-27,1 FOR A-Z,%. THESE RESULT IN AVBLS
C	ARRAY BEING USED. VBLS ARRAY (MAX LENGTH 8 BYTES/VARIABLE) IS USED
C	FOR OTHER VARIABLES WHOSE NAMES ARE <ALPHA>[<ALPHA>]<NUM>[<NUM>]
C	(WITH OPTION FOR ANY REASONABLE # OF ALPHAS AND NUMERICS BUT CLAMPED
C	AT RRW,RCL VALUES TO WORK CORRECTLY.)
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
C	SUBROUTINE POSTVL (RETCD)
C
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2 PT1
	INTEGER*2 VIEWSW,BASED
	INTEGER*2 RETCD,RETCD2,VLEN(9)
	INTEGER*2 TYPE(RRWP,RCLP)
	INTEGER*2 ST1TYP(40),ST2TYP(40)
	INTEGER*2 ST1LIM,ST2LIM,ST1PT,ST2PT
	INTEGER*2 I,K
C
	LOGICAL*1 LINE(80)
	LOGICAL*1 STACK1(20,40), STACK2(20,40),AVBLS(20,27)
	LOGICAL*1 VBLS(8,RRWP,RCLP)
C
	COMMON /STACK/ STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;	       ST1LIM,ST2LIM
	COMMON /V/ TYPE,AVBLS,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	AVBLS(I,27)=STACK1(I,1)
	CALL TYPSET(27,1,ST1TYP(1))
C	TYPE(27,1)=ST1TYP(1)
C
C
C OUTPUT VALUE OF %
	IF (VIEWSW.GT.1) CALL VAROUT(27,1)
	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.47).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