SUBROUTINE INPOST (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  INPOST                  *
C *                                                *
C **************************************************
C
C
C  CONVERTS THE INPUT STRING (INFIX NOTATION) TO POSTFIX 
C  FOR LATER EVALUATION BY POSTVL
C
C
C
C  MODIFICATION CODES:  M3,M10
C
C
C MODIFIED 10-MAR-78 P.B. CHANGED STACK VALUE FOR FUNCTIONS FROM 15 TO 45
C   THIS CORRECTS IMPROPER EVALUATION OF SQRT(1.)-2.
C
C
C
C
C INPOST CALLS
C
C  ERRMSG   PRINTS ERROR MESSAGES
C  NEXTEL   GETS THE NEXT ELEMENT FROM LINE(80)
C
C
C
C INPOST IS CALLED BY CALC
C
C
C
C
C
C
C        THE VARIABLE AND FUNCTION CODES.
C TABLE ALSO GIVES COMPARE VALUES AND STACK VALUES OF
C FUNCTIONS THAT OCCUR WHEN EXPRESSIONS ARE EVALUATED.
C
C
C
C
C	STACK
C	ELEMENT				COMPARE	STACK
C	CODE	TYPE		BYTES	VALUE	VALUE
C
C	0	UNDEFINED	-	-	-
C	1	ASCII		1	-	-
C	2	DECIMAL		8	-	-
C	3	HEXADECIMAL	4	-	-
C	4	INTEGER		4	-	-
C	5	MULT.PREC.(10)	20	-	-
C	6	MULT.PREC.(8)	20	-	-
C	7	MULT.PREC.(16)	20	-	-
C	8	OCTAL		4	-
C	9	REAL		8	-	-
C	10-30	UNDEFINED	-	-	-
C
C	----------FUNCTIONS------------
C
C	31	ABS (=DABS)	-	70	45
C	32	IABS		-	70	45
C	33	FLOAT		-	70	45
C	34	IFIX		-	70	45
C	35	AINT		-	70	45
C	36	INT (=IDINT)	-	70	45
C	37	EXP (=DEXP)	-	70	45
C	38	ALOG (=DLOG)	-	70	45
C	39	ALOG10(=DLOG10)	-	70	45
C	40	SQRT (=DSQRT)	-	70	45
C	41	SIN (=DSIN)	-	70	45
C	42	COS (=DCOS)	-	70	45
C	43	TANH (=DTANH)	-	70	45
C	44	ATAN (=DATAN)	-	70	45
C	46-47   ASIN,ACOS,TAN   -       70      45
C       48-100  RESERVED        -       -       -
C
C       110     (               -       70      15
C       111     UNARY -         -       50      49
C       112     **              -       40      39
C       113     *               -       30      31
C       114     /               -       30      31
C       115     +               -       20      21
C       116     -               -       20      21
C       117     )               -       10      -
C
C       200     =               -       10      10
C
C
C
C
C
C
C    VARIABLE      USE
C
C    I,K          HOLDS TEMPORARY INTEGER*2 VALUES.
C    LASTOP       HOLDS THE TYPE OF LAST ELEMENT OBTAINED
C                 ON LINE(80). SET AT 0 AT BEGINNING OF EXPRESSION.
C                 USED BY NEXTEL TO IDENTIFY UNARY OPERATORS.
C    NONBLK       POINTER IN LINE(80). NEXTEL STARTS SCAN AT NONBLK+1.
C    OPVAL(200,2)   HOLDS THE COMPARE AND STACK VALUE OF EACH OPERATOR.
C    PARVAL       HOLDS 110 WHICH IS THE CODE FOR '(' IN STACK 2.
C    RETCD        RETURN CODE. 1=O.K.  2=ERROR.
C    RETCD2       RETURN CODE FOR CALL TO NEXTEL.
C    RETTYP       HOLDS TYPE OF NEXT ELEMENT IN LINE, EITHER A FUNCTION
C                 CODE OR A DATA TYPE CODE.
C    RETVAL(100)  HOLDS VALUE OF NEXT ELEMENT IN LINE(80).
C    ST1LIM       HOLDS LIMIT OF STACK 1.
C    ST2LIM       HOLDS LIMIT OF STACK 2.
C    ST1PT        STACK 1 POINTER.
C    ST2PT        STACK 2 POINTER.
C    ST1TYP       TYPE OF EACH ELEMENT IN STACK 1
C    ST2TYP       TYPE OF EACH ELEMENT IN STACK 2
C    VLEN         HOLDS THE NUMBER OF BYTES USED BY EACH DATA TYPE.
C
C
C
C
C	SUBROUTINE INPOST (RETCD)
C
C
C	
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2 LASTOP
	INTEGER*2 VIEWSW,BASED
	INTEGER*2 OPVAL(200,2),PARVAL
	INTEGER*2 RETCD,RETCD2,RETTYP
	INTEGER*2 TYPE(RRWP,RCLP)
	INTEGER*2 ST1TYP(40),ST2TYP(40),ST1PT,ST2PT
	INTEGER*2 ST1LIM,ST2LIM
	INTEGER*2 VLEN(9)
	INTEGER*2 I,K
C
	LOGICAL*1 LINE(80)
	LOGICAL*1 AVBLS(20,27),RETVAL(20)
	LOGICAL*1 VBLS(8,RRWP,RCLP)
	LOGICAL*1 STACK1(20,40),STACK2(20,40)
C
C
	COMMON /STACK/STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     1  ST1LIM,ST2LIM
	COMMON /V/TYPE,AVBLS,VBLS,VLEN
	COMMON /ERROR/ LASTOP
	COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
C
C
	DATA OPVAL/30*-1,17*70,62*-1,70,50,40,30,30,20,20,10,82*-1,10,
     1             30*-1,17*45,62*-1,15,49,39,31,31,21,21,-1,82*-1,10/
	DATA PARVAL/110/
C
C
C
C
C
C  INITIALIZE STACKS, RETURN CODE DEFAULT, AND LASTOP
	RETCD=1
	ST1PT=1
	ST2PT=1
	LASTOP=0
C
C SET UP FOR NEXTEL CALL
	NONBLK=NONBLK-1
C
C
C
C
C **************************************************
C ***** GET NEXT ELEMENT OF EXPRESSION *************
C **************************************************
C
C
C
C  NEXTEL RETURNS
C	1	IF OPERAND
C	2	IF OPERATOR (VALUE IN RETTYP)
C	3	IF NO MORE ELEMENTS
C	4	IF ERROR
C
C
50	CALL NEXTEL (RETVAL,RETTYP,RETCD2)
	GOTO (100,200,300,999),RETCD2
	STOP 50
C
C
C
C
C
C **************************************************
C ********  OPERAND FOUND, PUT ON STACK 1  *********
C **************************************************
C
C STACK 1 OVERFLOW CHECK
100	IF (ST1PT.GT.ST1LIM) GOTO 990
C
C
C
C
C
109	CONTINUE
C
C  SUBROUTINE ERRCX HAS ALREADY ASSURED THAT
C  IF AN OPERAND IS FOLLOWED BY AN = SIGN, THAT VARIABLE
C  IS NOT PART OF AN EXPRESSION.
C
C  VARIABLE INDEX IS TO BE PLACED IN STACK1 (1,ST1PT)
C  SO IF YOU WANTED TO SPEED THE OPERATION AT THE EXPENSE
C  OF SPACE, YOU WOULD ONLY COPY RETVAL(1) IF RETTYP < 0
	K=VLEN(IABS(RETTYP))
	DO 110 I=1,K
110	STACK1(I,ST1PT)=RETVAL(I)
	ST1TYP(ST1PT)=RETTYP
	ST1PT=ST1PT+1
	GOTO 50
C
C
C
C
C
C
C
C
C **************************************************
C *****************  OPERATOR  *********************
C **************************************************
C
200	CONTINUE
C
C IF NO OTHER OPERATOR ON STACK 2, PLACE ON STACK 2
	IF (ST2PT.EQ.1) GOTO 222
C
C
C COMPARE VALUE WITH OPERATOR IN STACK2, IF GREATER OR EQUAL THEN
C PLACE IN STACK 2 BECAUSE IT HAS HIGHER PRECEDENCE AND IS ASSOCIATED
C WITH PREVIOUSLY ENCOUNTERED OPERAND, IS A UNARY OPERATOR ASSOCIATED
C WITH THE FOLLOWING ELEMENT, OR IS A '(' WHICH IS SAVED UNTIL A ')'
C IS FOUND.
C
	K=ST2TYP(ST2PT-1)
	IF (OPVAL(RETTYP,1).GE.OPVAL(K,2)) GOTO 220
C
C
C IF POPPING OFF ELEMENTS FROM STACK2 BECAUSE ')' WAS FOUND THEN WHEN
C ')' IS FOUND WE GO TO 230 TO REMOVE THE OPERATOR '(' FROM STACK 2.
C
	IF (PARVAL.EQ.K) GOTO 230
	IF (ST1PT.GT.ST1LIM) GOTO 990
C
C
C
C OPERATOR ON STACK 2 GOES ONTO STACK 1.
C
	ST1TYP(ST1PT)=K
	ST1PT=ST1PT+1
	ST2PT=ST2PT-1
	GOTO 200
C
C
C  PUT OPERATOR ON STACK 2
220	IF (ST2PT.GT.ST2LIM) GOTO 992
222	ST2TYP(ST2PT)=RETTYP
	ST2PT=ST2PT+1
	GOTO 50
C
C
C REMOVE '(' FROM STACK 2
230	ST2PT=ST2PT-1
	GOTO 50
C
C
C
C
C
C **************************************************
C ******* NO MORE ELEMENTS IN LINE *****************
C **************************************************
C
C CLEAN OFF STACK 2
300	IF (ST2PT.EQ.1) GOTO 1000
C
C IF A '(' GO TO 350 TO THROW IT AWAY.
	IF (ST2TYP(ST2PT-1).EQ.PARVAL) GOTO 350
	IF (ST1PT.GT.ST1LIM) GOTO 990
C
C
C
C PLACE ELEMENT ON STACK 2 ONTO STACK 1.
C
	ST1TYP(ST1PT)=ST2TYP(ST2PT-1)
	ST1PT=ST1PT+1
C
C THROW AWAY '(' FROM STACK 2.
350	ST2PT=ST2PT-1
	GOTO 300
C
C
C
C
C *** ERROR HANDLING ***
C
C STACK 1 OVERFLOW
990	I=7
	GO TO 998
C
C STACK 2 OVERFLOW
992	I=9
C
C
998	CALL ERRMSG(I)
999	RETCD=2
1000	RETURN
C
	END