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   *         SUBROUTINE  CMND                        *
C   *                                                 *
C   ***************************************************
C
C
C  UPON ENTRANCE, NONBLK POINT TO THE "*" IN LINE
C  INDICATING A COMMAND.  THIS ROUTINE DETERMINES WHICH COMMAND
C  IS DESIRED AND CALLS THE APPROPRIATE SUBROUTINE.
C
C  RETCD:
C  1=NORMAL
C  2=BYPASS NEXT READ BECAUSE READ COMMAND HAS BEEN EXECUTED  
C     TO CHANGE LINE(80)
C  3=ERROR, SO GO TO 1000 TO SET LEVEL=1
C
C
C MODIFY CLASSES: M1
C
C
C   CMND CALLS
C
C  AT      TO PROCESS A FILE OF CALC COMMANDS
C  BASCNG  TO CHANGE THE DEFAULT BASE FOR CONSTANTS
C  CLOSE   CLOSE FILE OF CALC COMMANDS
C  DECLR   DECLARE VAIABLES TO BE A CERTAIN DATA TYPE
C  ERRMSG  PRINTS ERROR MESSAGES
C  EXIT    RETURN TO OPERATING SYSTEM
C  GETNNB  GETS NEXT NON-BLANK FROM LINE(80)
C  STRCMP  LOOKS FOR A SPECIFIED STRING IN LINE(80)
C  ZERO    ZEROES ALL VARIABLES
C  ZNEG    TO SEE IF A VARIABLE HAS POSITIVE VALUE
C
C
C
C  CMND IS CALLED BY CALC WHO HAS IDENTIFIED THE '*'
C  INDICATING A COMMAND IS DESIRED.
C
C
C
C
C   VARIABLE      USE
C
C 
C  CHAR      TEMPORARILY HOLDS A SINGLE CHARACTER.
C  DIGITS    HOLDS ASCII REPRESENTATION OF DIGITS.
C  I         TEMPORARY INDEX.
C  ID        ARGUMENT FOR SUBROUTINE DECLR. INDICATES
C            A PARTICULAR DATA TYPE.
C  IPT       POINTER FOR LINE(80).
C  ITCNTV    0 IF NO ITERATION. IF POSITIVE, INDEX
C            OF VARIABLE USED TO CONTROL ITERATION ON THAT LEVEL.
C  KIND(15)  HOLDS FIRST LETTER OF ALL LEGAL COMMANDS.
C  LEVEL     HOLDS LOGICAL I/O UNIT WHERE NEXT COMMAND COMES FROM.
C  LINE(80)  HOLDS COMMAND LINE.
C  NONBLK    POINTER FOR LINE(80).
C  RETCD     HOLDS RETURN CODE.
C  RETCD2    HOLDS RETURN CODE.
C  VIEWSW    VIEW SWITCH:
C            0 = OFF
C            1 = DISPLAY COMMAND LINES
C            2 = DISPLAY VALUE OF EXPRESSIONS
C            3 = DISPLAY ALL
C
C
C
C
C   
	SUBROUTINE CMND(RETCD)
C
C
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2  RETCD,RETCD2,VIEWSW,BASED
	INTEGER*2 ZNEG,ITCNTV(6)
C
	LOGICAL*1  LINE(80),KIND(15),ASCII(4),DEC(6),HEX(2),INT(6),
     ;  M10(2),M8(1),M16(2),OCTAL(4),REAL(3),CHAR
	LOGICAL*1 DIGITS(16,3)
C
	COMMON  LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED
	COMMON /ITERA/ITCNTV
	COMMON /DIGV/ DIGITS
C
	DATA KIND
     ;/'@','A','B','C','D','E','H','I','M','N','O','R','S','V','Z'/
	DATA  ASCII/'S','C','I','I'/,  DEC/'E','C','I','M','A','L'/
	DATA  HEX/'E','X'/, INT/'N','T','E','G','E','R'/
	DATA  M10/'1','0'/,  M8/'8'/
	DATA  M16/'1','6'/
	DATA  OCTAL/'C','T','A','L'/
	DATA  REAL/'E','A','L'/
C
C
C
C PICK UP NON-BLANK CHARACTER AFTER '*'
	RETCD=1
	CALL GETNNB(IPT,RETCD2)
	GOTO(2,4),RETCD2
	STOP 2
2	NONBLK=IPT
C NONBLK POINTS TO 1ST NONBLANK CHARACTER AFTER *
C
	DO 3 I=1,15
	IF (LINE(NONBLK).EQ.KIND(I)) GOTO 6
3	CONTINUE
C
C
C UNIDENTIFIED COMMAND
4	GOTO 995
C
C
C
C GO TO DIFFERENT SECTIONS ON THE BASIS OF THE FIRST CHARACTER
C OF THE COMMAND.
6	GOTO (10,20,30,1000,40,50,60,70,80,90,100,110,50,130,140),I
	STOP 6
C
C
C
C
C **************************************************
C *****    *@  INDIRECT COMMAND PROCESSING    ******
C **************************************************
10	CALL AT(RETCD)
	GOTO (1000,999),RETCD
	STOP 10
C
C
C
C
C **************************************************
C ******      *A     DECLARE TYPE ASCII       ******
C **************************************************
20	CALL STRCMP (ASCII,4,RETCD2)
	ID=1
	GOTO (200,995),RETCD2
	STOP 20
C
C
C
C
C **************************************************
C ******       *B      BASE DEFAULT          *******
C **************************************************
30	CONTINUE
	CALL BASCNG(RETCD2)
	IF(VIEWSW.NE.0)WRITE(1,34) BASED
34	FORMAT(' DEFAULT BASE IS ',I2)
	GO TO (1000,999),RETCD2
	STOP 30
C
C
C
C
C ********************************************************
C **   *C   COMMENT, JUST RETURN (VIA STATEMENT 1000)   **
C ********************************************************
C
C
C
C **************************************************
C *******     *D     DECLARE TYPE DECIMAL    *******
C **************************************************
40	CALL STRCMP(DEC,6,RETCD2)
	ID=2
	GOTO (200,995),RETCD2
	STOP 40
C
C
C **************************************************
C **********          *E   EXIT             ********
C **************************************************
50	IF (LEVEL.EQ.1) CALL EXIT
	IF(ITCNTV(LEVEL).EQ.0)GOTO 55
	IF(ZNEG(ITCNTV(LEVEL)).EQ.1)GOTO 55
C ITERATION VARIABLE IS POSITIVE SO EXECUTE FILE AGAIN
	REWIND LEVEL
	GO TO 1000
C
C NOTE THAT WHEN EXITING A LEVEL THAT WAS ITERATED, ITCNTV
C IS NOT SET TO ZERO. THIS REQUIRES THAT WHEN ENTERED AT
C SUBROUTINE 'AT' AND ITERATION IS NOT DESIRED, THAT ITCNTV
C MUST BE SET TO ZERO THERE
55	CALL CLOSE(LEVEL)
	LEVEL=LEVEL-1
59	GOTO 1000
C
C
C
C
C
C **************************************************
C * *H DECLARE VARIABLES TO BE OF TYPE HEXADECIMAL *
C **************************************************
60	CALL STRCMP (HEX,2,RETCD2)
	ID=3
	GOTO (200,995),RETCD2
	STOP 60
C
C
C
C
C **************************************************
C * *I DECLARE VARIABLE TO BE OF TYPE INTEGER (*4) *
C **************************************************
70	CALL STRCMP (INT,6,RETCD2)
	ID=4
	GOTO (200,995),RETCD2
	STOP 70
C
C
C **************************************************
C *  *M  DECLARE VARIABLE TO BE MULTIPLE PRECISION *
C **************************************************
80	CALL STRCMP (M10,2,RETCD2)
	ID=5
	GOTO (200,84),RETCD2
	STOP '80'
C
C
C  SEE IF MULTIPLE PRECISION IS OCTAL
84	CALL STRCMP (M8,1,RETCD2)
	ID=6
	GOTO (200,88),RETCD2
	STOP '84'
C
C
C  SEE IF MULTIPLE PRECISION HEXADECIMAL
88	CALL STRCMP (M16,2,RETCD2)
	ID=7
	GOTO (200,995),RETCD2
	STOP '88'
C
C
C
C
C ************************************************************
C **  *N SUPPRESS PRINTING OF VARIABLES WHEN VALUES CHANGE  **
C ************************************************************
90	VIEWSW=1
	GOTO 1000
C
C
C
C
C **************************************************
C ***  *O  DECLARE VARIABLE TO BE OF TYPE OCTAL  ***
C **************************************************
100	CALL STRCMP (OCTAL,4,RETCD2)
	ID=8
	GOTO (200,995),RETCD2
	STOP 100
C
C
C
C
C
C **************************************************
C ***********     *R ENCOUNTERED       *************
C **************************************************
C
C  *R	SEE IF A REAL DECLARATION
110	CALL STRCMP (REAL,3,RETCD2)
	ID=9
	GOTO (200,114),RETCD2
	STOP 110
C
C
C  OTHERWISE ASSUME A READ IS REQUIRED
114	IF (LEVEL.NE.1) GOTO 117
	WRITE(1,116) 
	GOTO 118
116	FORMAT(' CALC>',$)
117	WRITE (1,119) LEVEL
119	FORMAT (' CALC<',I1,'>',$)
118	READ (1,115,END=1000,ERR=990) LINE
115	FORMAT (80A1)
C
C  NOTE THAT IF <CR> IS HIT AS THE ONLY INPUT, RETURN IS NORMAL
C  AND PROCESSING CONTINUES ON LEVEL (RETCD=2)
	RETCD=2
	GOTO 1000
C
C
C
C
C
C ************************************************************
C ***  *V ACTIVATE PRINTING OF VARIABLE WHEN VALUES CHANGE ***
C ************************************************************
129	NONBLK=IPT
130	CALL GETNNB(IPT,RETCD2)
	GO TO (129,132),RETCD2
	STOP  130
132	CHAR=LINE(NONBLK)
	IF(CHAR.NE.DIGITS(10,1))GO TO 134
C
C  *VIEW 0 ENCOUNTERED
	VIEWSW=0
	GO TO 1000
134	IF(CHAR.NE.DIGITS(1,1))GO TO 136
C
C *VIEW 1 ENCOUNTERED
	VIEWSW=1
	GO TO 1000
136	IF(CHAR.NE.DIGITS(2,1))GO TO 138
	VIEWSW=2
	GO TO 1000
138	VIEWSW=3
	GOTO 1000
C
C
C
C
C **************************************************
C **********   *Z   ZERO OUT ALL VARIABLES  ********
C **************************************************
140	CALL ZERO
	GOTO 1000
C
C
C
C
C
C MAKE DECLARATIONS
200	CALL DECLR(ID,RETCD2)
	GO TO(1000,999),RETCD2
	STOP 200
C
C
C
C
C
C **** ERROR PROCESSING ****
C
990	I=27
	GO TO 998
995	I=3
998	CALL ERRMSG(I)
999	RETCD=3
1000	CONTINUE
	RETURN
	END