	PROGRAM CALC
*******************************************************************************
* 
*    UNIT NAME:  CALC
* 
*    PURPOSE:  MAIN PROGRAM FOR CALCULATOR
* 
*    INVOCATION METHOD:
* 	RUN CALC
* 
*    LOCAL VARIABLES:
*      NAME      	  TYPE         FULL NAME:DESCRIPTION
*    -------------------- ----         ---------------------
*    INLINE		   C		COMMAND LINE BUFFER
* 
*    MODULES CALLED:
*      NAME           PURPOSE
*    -------------    --------------------------------------
*    CALC_IND		ACCEPT INPUT FROM A FILE
*    LIB$GET_INPUT      GET INPUT FROM TERMINAL
*    STR$UPCASE		CONVERT INPUT TO UPPER CASE
*    CALC_CLI           PARSE COMMAND STRING
*    CLI$DISPATCH       CALL COMMAND PROCESSOR
*    CALC_CHKCLI        FIXUP COMMANDS WITH ARBITRARY PARAMETERS
*    EXPRESS            EVALUATE AN EXPRESSION
*    PRINT_DEC          PRINT SYMBOL TABLE ENTRY IN DECIMAL 
*                        (PASSED TO EXPRESS)
*    CALC_HANDLER       CONDITION HANDLER
*                        (PASSED TO EXPRESS)
* 
*    DEVELOPMENT HISTORY:
*      AUTHOR	            DATE          COMMENT
*    D. FITZGERALD         4/14/83
* 
*******************************************************************************
*
*		SPECIFICATIONS
*
	EXTERNAL PRINT_DEC, CALC_HANDLER, CALC_SET_SYM
	INTEGER CALC_CLI
	CHARACTER*132 INLINE
	INCLUDE '($RMSDEF)'
*
*		CODE SECTION
*
	INQUIRE (FILE='CALCINI', EXIST=ISTAT)
	IF (ISTAT) CALL CALC_IND('CALCINI',.FALSE.,.FALSE.,'.DAT')
*
*		CHECK FOR INPUT ON COMMAND LINE
*
	INLINE=' '
	ISTAT = LIB$GET_FOREIGN(INLINE,,INLEN)
D	PRINT 1000, ISTAT,ISTAT,INLEN,INLINE	
*
	IF (INLEN.GT.0) THEN
	    CALL STR$UPCASE(INLINE(1:INLEN),INLINE(1:INLEN))
	    CALL EXPRESS(INLINE(1:INLEN),CALC_SET_SYM,CALC_HANDLER)
	ELSE
	    DO WHILE (.TRUE.)
	        ISTAT = LIB$GET_INPUT(INLINE,'CALC>',INLEN)
	        IF (ISTAT) THEN
		    IF (INLEN .GT. 0) THEN
		        call str$upcase(inline(1:inlen),inline(1:inlen))
		        IF (INLINE(1:1) .EQ. '/') THEN
			    ISTAT2 = CALC_CLI(INLINE(2:INLEN))
			    IF (ISTAT2) THEN
			        CALL CLI$DISPATCH
			    ELSE
D			        PRINT *,'CLI RETURNS',ISTAT2
			        CALL CALC_CHKCLI(ISTAT2,INLINE(2:INLEN))
			    ENDIF
		        ELSEIF (INLINE(1:1) .EQ. '@') THEN
			    CALL CALC_IND(INLINE(2:INLEN), .FALSE.,
     +                        .TRUE., '.COM' )
		        ELSE
			    CALL EXPRESS(INLINE, PRINT_DEC, 
     +                       CALC_HANDLER)
		        ENDIF
		    ENDIF
	        ELSEIF (ISTAT .NE. RMS$_EOF) THEN
		    CALL EXIT (ISTAT)
	        ELSE
		    CALL EXIT
	        ENDIF
	    ENDDO
	ENDIF
*
*		FORMAT STATEMENTS
*
D1000	FORMAT(' **GET_FOREIGN CALLED**  ISTAT = ',Z8.8,I12/
D    +         '     INLEN = ',I5/
D    +         '     INLINE = ',A)
	END
	SUBROUTINE PRINT_DEC(syment)
*******************************************************************************
* 
*    UNIT NAME:  PRINT_DEC
* 
*    PURPOSE:  PRINT A SYMBOL TABLE ENTRY VALUE IN DECIMAL
* 
*    INVOCATION METHOD:
* 	CALL PRINT_DEC(SYMENT)
* 
*    ARGUMENT LIST:
*      NAME               TYPE  USE    FULL NAME:DESCRIPTION
*    -------------------- ----  ---    ---------------------
*    SYMENT		   *     I     SYMBOL TABLE ENTRY
* 
*    LOCAL VARIABLES:
*      NAME      	  TYPE         FULL NAME:DESCRIPTION
*    -------------------- ----         ---------------------
*    OUTSTR               C*32         OUTPUT STRING
*    ITYPE                I*2          TYPE OF SYMBOL TABLE VALUE
*    IVALUE/RVALUE      I*4/R*4        VALUE FROM SYMBOL TABLE
* 
*    MODULES CALLED:
*      NAME           PURPOSE
*    -------------    --------------------------------------
*    CALC_DECODE      GET TYPE AND VALUE FROM SYMBOL TABLE
*    LIB$PUT_OUTPUT   WRITE OUTPUT STRING TO TERMINAL
* 
*    DEVELOPMENT HISTORY:
*      AUTHOR	            DATE  	COMMENTS
*    D. FITZGERALD         4/14/83        
* 
*******************************************************************************
*
*		SPECIFICATIONS
*
	LOGICAL*2 SYMENT(12)
	CHARACTER*32 OUTSTR
	INTEGER*2 ITYPE
	REAL*4 RVALUE
	INTEGER*4 IVALUE
	EQUIVALENCE (RVALUE,IVALUE)
*
*		CODE SECTION
*
	CALL CALC_DECODE(SYMENT, ITYPE,, IVALUE)
	IF (ITYPE.EQ.2) THEN
	    WRITE (OUTSTR,1000) IVALUE
	ELSE
	    WRITE (OUTSTR,1001) RVALUE
	ENDIF
	CALL LIB$PUT_OUTPUT(OUTSTR)
	RETURN
*
*		FORMAT STATEMENTS
*
1000	FORMAT('          = ',I20)
1001	FORMAT('          = ',G20.7)
	END
	INTEGER FUNCTION CALC_CLI(LINE)
*******************************************************************************
* 
*    UNIT NAME:  CALC_CLI
* 
*    PURPOSE:  TO PARSE A CALCULATOR COMMAND LINE
* 
*    INVOCATION METHOD:
* 	ISTAT = CALC_CLI(LINE)
* 
*    ARGUMENT LIST:
*      NAME               TYPE  USE    FULL NAME:DESCRIPTION
*    -------------------- ----  ---    ---------------------
*    ISTAT                 I*4   O     STATUS RETURNED FROM CLI$DCL_PARSE
*    LINE                 C*(*)  I     COMMAND LINE (WITHOUT "/")
* 
*    MODULES CALLED:
*      NAME           PURPOSE
*    -------------    --------------------------------------
*    LIB$ESTABLISH    ESTABLISH A CONDITION HANDLER
*    LIB$SIG_TO_RET   TO CONVERT SIGNAL FORM CLI$DCL_PARSE TO A RETURN CODE
*    CLI$DCL_PARSE    PARSE THE COMMAND LINE
*    CALC_TAB         COMMAND TABLES FOR CLI$DCL_PARSE
* 
*    DEVELOPMENT HISTORY:
*      AUTHOR	            DATE  	COMMENTS
*    D. FITZGERALD         4/14/83        
* 
*******************************************************************************
*
*		SPECIFICATIONS
*
	EXTERNAL LIB$SIG_TO_RET, CALC_TAB
	CHARACTER*(*) LINE
	INTEGER CLI$DCL_PARSE
*
*		CODE SECTION
*
	CALL LIB$ESTABLISH(LIB$SIG_TO_RET)
	CALC_CLI = CLI$DCL_PARSE(LINE, CALC_TAB)
	RETURN
	END
	SUBROUTINE CALC_CHKCLI(ICODE,LINE)
*******************************************************************************
* 
*    UNIT NAME:  CALC_CHKCLI
* 
*    PURPOSE:  TO FIXUP AND HANDLE SPECIAL COMMAND FORMATS
* 
*    INVOCATION METHOD:
* 	CALL CALC_CHKCLI(ICODE,LINE)
* 
*    ARGUMENT LIST:
*      NAME               TYPE  USE    FULL NAME:DESCRIPTION
*    -------------------- ----  ---    ---------------------
*    ICODE                 I*4   I     ERROR CODE FROM CALC_CLI
*    LINE                 C*(*)  I     COMMAND LINE (WITHOUT "/")
* 
*    LOCAL VARIABLES:
*      NAME      	  TYPE         FULL NAME:DESCRIPTION
*    -------------------- ----         ---------------------
*    MSGVEC(2)             I*4         MESSAGE VECTOR FOR CALL TO SYS$PUTMSG
*    NEWLINE              C*132        COMMAND LINE WITH " INSERTED
*    VERB                 C*4          COMMAND VERB
*
*    CLI_IVVERB                        INVALID VERB RETURN CODE
*    CLI_NOQUAL                        NO QUALIFIER ALLOWED RETURN CODE
* 
*    MODULES CALLED:
*      NAME           PURPOSE
*    -------------    --------------------------------------
*    CALC_CLI         TO PARSE MODIFIED COMMAND LINE
*    CLI$GET_VALUE    TO GET VERB FROM COMMAND LINE
*    CLI$DISPATCH     TO PROCESS COMMAND
*    SYS$PUTMSG       TO PUT ERROR MESSAGE
* 
*    DEVELOPMENT HISTORY:
*      AUTHOR	            DATE  	COMMENTS
*    D. FITZGERALD         4/14/83        
* 
*******************************************************************************
*
*		SPECIFICATIONS
*
	INTEGER CLI$GET_VALUE, CALC_CLI
	INTEGER*4 MSGVEC(2) /'90001'X,0/
	CHARACTER*(*) LINE,NEWLINE*132
	CHARACTER*4 VERB
	INTEGER CLI_IVVERB, CLI_NOQUAL
	PARAMETER (CLI_IVVERB = 229520,
     +		   CLI_NOQUAL = 229576)
*
*		CODE SECTION
*
	MSGVEC(2) = ICODE
	IF (ICODE .NE. CLI_IVVERB ) THEN
	    IB = INDEX(LINE,' ')
	    IF (IB.NE.0) THEN
	        NEWLINE = LINE(1:IB) // '"' // LINE(IB+1:)
D	        PRINT *,'**CALC_CHKCLI**  NEWLINE=',NEWLINE
	        ISTAT2 = CALC_CLI(NEWLINE)
D	        PRINT *,'**CALC_CHKCLI**  GETTING VERB'
                ISTAT = CLI$GET_VALUE('$VERB',VERB)
D	        PRINT *,'**CALC_CHKCLI**  ISTAT FROM GET_VALUE = ',ISTAT
	        IF (ISTAT) THEN
D	            PRINT *,'**CALC_CHKCLI**  VERB=',VERB
	            IF ((VERB .EQ. 'HEXA') .OR.
     +	                (VERB .EQ. 'OCTA') .OR.
     +	                (VERB .EQ. 'HELP')) THEN
		        CALL CLI$DISPATCH
		    ELSE
		        CALL SYS$PUTMSG(MSGVEC,,'	**',)
		    ENDIF
	        ELSE
		    MSGVEC(2) = ISTAT
		    CALL SYS$PUTMSG(MSGVEC,,'	**',)
	        ENDIF
	    ELSE
		CALL SYS$PUTMSG(MSGVEC,,'	**',)
	    ENDIF
	ELSE
            CALL SYS$PUTMSG(MSGVEC,,'	**',)
	ENDIF
	RETURN
	END
	SUBROUTINE CALC_SET_SYM(SYMENT)
*******************************************************************************
* 
*    UNIT NAME:  CALC_SET_SYM
* 
*    PURPOSE:  SET DCL SYMBOL, "CALC$VALUE" TO  SYMBOL VALUES 
* 
*    INVOCATION METHOD:
* 	CALL CALC_LIST_SYM(SYMENT)
* 
*    ARGUMENT LIST:
*      NAME               TYPE  USE    FULL NAME:DESCRIPTION
*    -------------------- ----  ---    ---------------------
*    SYMENT                *     I     SYMBOL TABLE ENTRY
* 
*    LOCAL VARIABLES:
*      NAME      	  TYPE         FULL NAME:DESCRIPTION
*    -------------------- ----         ---------------------
*    VALUE                 I*4         VALUE FROM SYMBOL TABLE
*    ITYPE                 I*2         TYPE FROM SYMBOL TABLE
*    IVALUE/RVALUE       I*4/R*4       EQUIVALENCE PAIR FOR VALUE FORMATTING
*    OUTSTR                C*80        OUTPUT STRING
* 
*    MODULES CALLED:
*      NAME           PURPOSE
*    -------------    --------------------------------------
*    CALC_DECODE      DECODE FIELDS FROM SYMBOL TABLE
*    LIB$SET_SYMBOL   SET DCL SYMBOL
* 
*    DEVELOPMENT HISTORY:
*      AUTHOR	            DATE  	COMMENTS
*    D. FITZGERALD         4/14/83        
* 
*******************************************************************************
*
*		SPECIFICATIONS
*
	LOGICAL*2 SYMENT(12)
*
	INTEGER*2 ITYPE
	INTEGER*4 VALUE
	CHARACTER*20 OUTSTR
	REAL*4 RVALUE
	INTEGER*4 IVALUE
	EQUIVALENCE (RVALUE,IVALUE)
*
*		CODE SECTION
*
	CALL CALC_DECODE(SYMENT, ITYPE, FLAGS, VALUE)
	IVALUE = VALUE
	IF (ITYPE.EQ.1) THEN
	    I=NINT(RVALUE)
	    IVALUE=I
	ENDIF
	WRITE (OUTSTR,1000) IVALUE
	IB = LIB$SKPC(' ',OUTSTR)
	CALL LIB$SET_SYMBOL('CALC$VALUE',OUTSTR(IB:))
	RETURN
1000	FORMAT(' ',I19)
	END
