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 ***               CALC   MAINLINE                   ***
C ***                                                 ***
C *******************************************************
C *******************************************************
C
C
C THIS PROGRAM EVALUATES ARITHMETIC EXPRESSIONS INPUT TO IT
C AND ALLOWS VARIABLES TO BE ASSIGNED VALUES. IT FEATURES
C MULTIPLE PRECISION ARITHMETIC IN BASE 10, OCTAL, AND
C HEXADECIMAL. SEE CALC.MEM FOR A COMPLETE DESCRIPTION IN 
C THE FORM OF A USERS GUIDE. TYPE ? TO OBTAIN A LIST OF
C POSSIBLE COMMANDS.
C
C
C
C    CALC CALLS
C
C  ASSIGN    OPENS A FILE AND ASSIGNS IT TO A LOGICAL I/O UNIT.
C  CLOSE     CLOSES A FILE ASSOCIATED WITH A LOGICAL I/O UNIT.
C  CMND      DETERMINES WHAT CALC COMMAND IS REQUIRED.
C  ERRCX     CHECKS THE EXPRESSION IN AN INPUT LINE FOR SYNTAX ERRORS.
C  ERRMSG    PRINTS OUT ERROR MESSAGES.
C  HALT      RETURNS TO OPERATING SYSTEM.
C  EXIT      RETURNS TO OPERATING SYSTEM WITH TIME MESSAGE.
C  GETMCR    GETS THE COMMAND LINE USED TO INVOKE CALC. IF AN ARGUMENT
C            IS PRESENT, CALC HALTS AFTER THAT ONE COMMAND IS EXECUTED.
C  INPOST    CONVERTS AN INFIX EXPRESSION TO POSTFIX FORM.
C  LIST      LISTS THE LEGAL CALC COMMANDS.
C  POSTVL    CONVERTS AN EXPRESSION IN POSTFIX NOTATION ON STACK 1 TO
C            A VALUE.
C  SLEND     FINDS THE LAST NON-BLANK IN LINE(80).
C  VAROUT    PRINTS OUT THE VALUE OF A VARIABLE.
C  ZNEG      DETERMINES IF A VARIABLE IS POSITIVE IN VALUE
C
C
C
C
C
C
C
C   VARIABLE      USE
C
C  BASED        DEFAULT BASE WHEN CONSTANTS ARE ENTERED.
C  BLANK        ' '
C  DIGITS(16,3) HOLDS DECIMAL, OCTAL, AND HEXADECIMAL DIGITS. THE
C               SECOND SUBSCRIPT IS
C                     1 FOR DECIMAL
C                     2 FOR OCTAL
C                     3 FOR HEXADECIMAL
C  I,J          HOLD TEMPORARY VALUES.
C  ITCNTV(6)    INDEXED BY LEVEL. 0 INDICATES THAT NO ITERATION ON THE
C               INDIRECT COMMAND FILE IS TO TAKE PLACE. IF POSITIVE, IT
C               HOLDS THE INDEX INTO VBLS AND REPRESENTS THE VARIABLE
C               USED TO CONTROL ITERATION.
C  LEND         POINTS TO LAST NON-BLANK CHARACTER IN LINE(80)
C  LEVEL        HOLDS THE LOGICAL I/O UNIT WHERE THE NEXT CALC COMMAND
C               LINES COME FROM.
C  LINE(80)     COMMAND INPUT LINE.
C  NONBLK       POINTS TO LAST NON-BLANK FOUND IN LINE(80).
C  ONCE         HOLDS 1 IF ONLY ONE COMMAND LINE IS TO BE EXECUTED,
C               0 OTHERWISE.
C  STAR         '*'
C  VIEWSW           VIEW SWITCH
C                    0 = OUTPUT ERROR MESSAGES
C                    1 = OUTPUT ERROR MESSAGES AND FILE COMMAND LINES
C                    2 = OUTPUT ERROR MESSAGES AND VALUE OF EXPRESSIONS
C                        EVALUATED.
C                    3 = OUTPUT EVERYTHING
C  WHAT         '?' SIGNIFIES THAT A LIST OF POSSIBLE COMMANDS
C               SHOULD BE OUTPUT.
C
C
C
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2 RETCD,VIEWSW,BASED
	INTEGER*2 ONCE
	INTEGER*2 ZNEG,ITCNTV(6)
C
	LOGICAL*1  LINE(80),WHAT,STAR,QUOTE
	LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ
	LOGICAL*1 DIGITS(16,3)
C
	COMMON  LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
	COMMON  /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ
	COMMON /DIGV/ DIGITS
	COMMON/ITERA/ITCNTV
C
	DATA  WHAT/'?'/, STAR/'*'/, QUOTE/''''/
	DATA ONCE/0/
C
C GET COMMAND LINE (MCR20 ROUTINE WRITTEN BY PAUL LEMAIRE TO
C	SIMULATE PDP-11'S GETMCR ROUTINE ON THE DEC-20)
C
	CALL MCR20 (LINE,LEND)
C
C THE FOLLOWING CALL TO ERRSET ASSURES THAT ARITHMETIC AND LIBRARY
C    ERROR MESSAGES WILL ALWAYS BE PRINTED
C
	CALL	ERRSET (1000000)
C
C
C
C LOGICAL I/O UNIT 1 IS ASSIGNED TO THE INVOKING TERMINAL
C IF YOU DON'T WANT TO RISK THE BUILDER TASK BUILDING (LINKING)
C THE MODULES PROPERLY, PUT IN A
C	CALL ASSIGN (1,'TI:')
C THE ADVANTAGE OF NOT DOING THIS IS THAT YOU CAN CREATE AN OUTPUT
C TEST FILE TO DISK TO HELP VERIFY CORRECTNESS AFTER A CHANGE TO THE
C SOURCE HAS BEEN MADE.
C
C
	CALL ASSIGN (1, 'TTY', 3)
C
	IF(LEND)20,20,5
5	CONTINUE
C
C  MCR20 STRIPS THE CALC COMMAND AND RETURNS THE EXPRESSION
C   LEFT-JUSTIFIED (NO LEADING SPACES)
C
	NONBLK = 1
	ONCE=1
	GO TO 106
C
C  ERROR RESET
10	IF(LEVEL.EQ.1) GO TO 12
	CALL CLOSE(LEVEL)
	LEVEL=LEVEL-1
	GO TO 10
12	CONTINUE
	VIEWSW=3
	BASED=10
C
C
C  GET NEXT INPUT LINE
20	IF(ONCE.EQ.1.AND.LEVEL.EQ.1) CALL HALT
	IF(LEVEL.EQ.1)WRITE(1,22)
22	FORMAT(' CALC>',$)
C
C
	READ (LEVEL,24,END=900,ERR=1000) LINE
24	FORMAT (80A1)
C
C
C
C FIND LAST NONBLANK, SAVE POSITION WITH VARIABLE 'LEND'
	CALL SLEND(RETCD)
	GO TO(30,20),RETCD
	STOP 30
30	CONTINUE
C
C
C
C SHOW WHAT WAS READ FROM FILE
	IF(LEVEL.NE.1.AND.(VIEWSW.EQ.1.OR.VIEWSW.EQ.3))
     1 WRITE(1,40)LEVEL,(LINE(I),I=1,LEND)
40	FORMAT (' CALC<',I1,'>',80A1)
103	CONTINUE
C
C  IDENTIFY FIRST NON-BLANK
	DO 104 NONBLK=1,LEND
	IF (LINE(NONBLK).NE.BLANK) GOTO 106
104	CONTINUE
	STOP 104
C
C  SEE IF A LIST OF POSSIBLE COMMANDS SHOULD BE PRINTED
106	IF (LINE(NONBLK).NE.WHAT) GOTO 110
	CALL LIST
	GOTO 20
C
C  SEE IF IT IS A COMMAND
110	IF (LINE(NONBLK).NE.STAR) GOTO 120
	CALL CMND (RETCD)
	GOTO (20,115,10), RETCD
	STOP 110
C
C
C A READ COMMAND WAS EXECUTED SO LINE HOLDS THE NEW COMMAND LINE.
115	CALL SLEND(RETCD)
	GO TO (103,20),RETCD
	STOP 115
C
C  SEE IF ONLY ONE ALPHA CHARACTER
120	J=NONBLK+1
	IF (LEND.NE.NONBLK) GOTO 130
	DO 124 I=1,27
	IF (LINE (NONBLK).EQ.ALPHA(I)) GOTO 126
124	CONTINUE
C
C ALLOW FOR A SINGLE DIGIT TO BE ASSIGNED TO %
	DO 125 I=1,10
	IF(LINE(NONBLK).EQ.DIGITS(I,1))GO TO 130
125	CONTINUE
C
C
C ALLOW FOR ENTERING THE ASCII BLANK
	IF(LINE(NONBLK).EQ.QUOTE)GO TO 130
	I=1
	GOTO 1001
C
C  OUTPUT VALUE OF SINGLE VARIABLE
126	CALL VAROUT(I)
	GOTO 20
C
C
C CHECK INPUT FOR SYNTAX ERRORS
130	CALL ERRCX (RETCD)
	GOTO (140,10),RETCD
	STOP 130
C
C  CHANGE FROM INFIX TO POSTFIX NOTATION
140	CALL INPOST (RETCD)
	GOTO (150,10), RETCD
C
C
C EVALUATE EXPRESSION
150	CONTINUE
	CALL POSTVL(RETCD)
	GOTO(20,10),RETCD
	STOP 150
C
C
C  EXIT
900	IF (LEVEL.EQ.1) CALL EXIT
	IF(ITCNTV(LEVEL).EQ.0)GOTO 910
	IF(ZNEG(ITCNTV(LEVEL)).EQ.1)GO TO 910
C
C VALUE OF ITERATION VARIABLE IS POSITIVE SO REWIND FILE
C AND EXECUTE AGAIN.
	REWIND LEVEL
	GO TO 20
C
C
C EXIT FROM THIS LEVEL BY CLOSING THE FILE AND DECREASING VALUE
C OF LEVEL BY ONE.
910	CALL CLOSE(LEVEL)
	LEVEL=LEVEL-1
	GOTO 20
C
C
C
C *** ERROR PROCESSING ***
1000	I=27
1001	CALL ERRMSG(I)
	GO TO 10
	END
 