SUBROUTINE CMND(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  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	SUBROUTINE CMND(RETCD)
C
C
	INTEGER*2 LEVEL,NONBLK,LEND
	INTEGER*2  RETCD,RETCD2,VIEWSW,BASED
	INTEGER*2 IOLVL
	COMMON/IOLVL/IOLVL
	INTEGER*2 ZNEG,ITCNTV(6)
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	LOGICAL*1 WRK2(128)
C DEFINE SOME LARGER ARRAYS TO NULL TERMINATE WRK AND WRK2 ARRAYS.
	LOGICAL*1 WRKX(130),WRK2X(130)
	EQUIVALENCE(WRK(1),WRKX(1))
	EQUIVALENCE(WRK2(1),WRK2X(1))
	LOGICAL*1 AVBLS(20,27),WRK(128),VBLS(8,RRWP,RCLP)
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	REAL*8 XAC,XVBLS(RRWP,RCLP)
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(XAC,AVBLS(1,27))
	EQUIVALENCE(VBLS(1,1,1),JVBLS(1,1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	LOGICAL*1 FVLD(RRWP,RCLP)
	COMMON/FVLDC/FVLD
C
	LOGICAL*1  LINE(80),KIND(23),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
     1/'@','A','B','C','D','E','H','I','M','N','O','R','S','V','Z'
     2,'P','W','G','Q','F','J','X','U'/
C NOTE PWGQFJX ADDED BY GCE FOR PORTACALC INTERFACE.
C  FREE: K,U,Y, + SPECIAL CHARACTERS (LIKE .,;'"#$%^, ETC.)
	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'/
	DATA WRKX/130*0/,WRK2X/130*0/
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,23
	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,
     1  130,140,210,220,250,290,330,360,480,780),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	CONTINUE
C SET RETCD=4 ON EXIT IF EXIT COMMAND, SO CALC RETURNS TO ITS CALLER.
	IF (LEVEL.EQ.1) RETCD=4
	IF (LEVEL.EQ.1) RETURN
C	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(' CALR>',$)
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
	REWIND LEVEL
	GO TO 998
995	I=3
998	CALL ERRMSG(I)
999	RETCD=3
1000	CONTINUE
	RETURN


C P COMMAND - SET PLACEMENT OF PHYSICAL POSN IN SHEET
C *P WILL PROMPT FOR INPUTS OF LOCATIONS.
C
210	CONTINUE
C
	RETCD=1
C IF THE COMMAND IS *P VAR THEN SET TO VARIABLE LOCATION.
	KK1=3
	KK2=20
	IF(LINE(3).EQ.'@')GOTO 217
C ONLY LOOK IN COLS 3-20. COLUMNS 1,2 ARE THE *W COMMAND.
	CALL VARSCN(LINE,KK1,KK2,KEK,KK,KKK,IVLD)
	IF(IVLD.NE.0)GOTO 216
	GOTO 218
217	CONTINUE
C ALLOW *W@V1,V2 TO GOTO LOCATION OF V1,V2 (COL,ROW)
C  THIS ALLOWS PROGRAMMED ACCESS TO VARIABLES.
	L1=4
	L2=60
	CALL VARSCN(LINE,L1,L2,LSTCH,ID1A,ID2A,IVLD1)
	IF(IVLD1.EQ.0)GOTO 1000
	CALL TYPGET(ID1A,ID2A,TYPE(1,1))
	IF(TYPE(1,1).EQ.2)GOTO 219
	CALL JVBLGT(1,ID1A,ID2A,JVBLS(1,1,1))
	LCL=JVBLS(1,1,1)
	GOTO 2200
219	CONTINUE
	CALL XVBLGT(ID1A,ID2A,XVBLS(1,1))
	LCL=XVBLS(1,1)
2200	CONTINUE
C NOW HAVE COLUMN NUMBER. PASS DELIMITER (WHATEVER IT IS) AND GO ON
	L1=LSTCH+1
	L2=60
C ASSUME WE GET THERE WITHIN 60 CHARACTERS...
	CALL VARSCN(LINE,L1,L2,LSTCH,ID1B,ID2B,IVLD2)
	IF(IVLD2.EQ.0)GOTO 1000
C SEEMS LIKE OK VARIABLE... GO AHEAD
	CALL TYPGET(ID1B,ID2B,TYPE(1,1))
	CALL JVBLGT(1,ID1B,ID2B,JVBLS(1,1,1))
	LRW=JVBLS(1,1,1)
	IF(TYPE(1,1).EQ.2)CALL XVBLGT(ID1B,ID2B,XVBLS(1,1))
	IF(TYPE(1,1).EQ.2)LRW=XVBLS(1,1)
C ADJUST FOR ACCUMULATOR ROW BY ADDING 1
	LRW=LRW+1
C NOW HAVE COLUMN AND ROW NUMBERS. GET VARIABLE USING THEM AFTER
C CLAMPING TO MAX VALUES.
	LCL=MAX0(1,LCL)
	LRW=MAX0(1,LRW)
	LCL=MIN0(LCL,RRW)
	LRW=MIN0(LRW,RCL)
	KK=LCL
	KKK=LRW
	GOTO 216
218	CONTINUE
	IF(LEVEL.EQ.1)WRITE(1,211)
211	FORMAT(' SET PHYS LOC. COLUMN=')
	READ(LEVEL,212,END=700,ERR=700)KK
212	FORMAT(I7)
	IF(LEVEL.EQ.1)WRITE(1,213)
213	FORMAT(' SET PHYS LOC. ROW =')
	READ(LEVEL,212,END=700,ERR=700)KKK
	KKK=KKK+1
216	KK=MAX0(1,KK)
	KKK=MAX0(1,KKK)
	KK=MIN0(RRW,KK)
	KKK=MIN0(RCL,KKK)
C CLAMP TO LEGAL SIZE
	PROW=KK
	PCOL=KKK
	RETURN
700	CONTINUE
	REWIND LEVEL
	IF(ITCNTV(LEVEL).EQ.0)GOTO 55
	IF(ZNEG(ITCNTV(LEVEL)).EQ.1)GOTO 55
	RETURN
C W COMMAND - WRITE % TO CURRENT PHYSICAL LOC IN SHEET. USE E32.25
C FORMAT.
C  DOES NOT PROMPT. THEREFORE, IF USED INSIDE SPREADSHEET, HAS THE
C  EFFECT OF CONVERTING CURRENT CELL'S FORMULA TO A LITERAL NUMBER
C  AND FREEZING IT THAT WAY. THEREFORE A FORMULA CONTAINING *W WILL
C  NORMALLY ONLY EXECUTE THE *W ONCE (AFTERWARDS BEING OVERWRITTEN).
C
220	CONTINUE
	RETCD=1
C	IRX=(PCOL-1)*RRW+PROW
	CALL REFLEC(PCOL,PROW,IRX)
	CALL WRKFIL(IRX,WRK,0)
	IF(LINE(3).EQ.'F')GOTO 224
C	READ(7'IRX)WRK
C GET RECORD INTO MEMORY
	ENCODE(35,221,WRK,ERR=225)XAC
C PUT VARIABLE VALUE AS STRING INTO FILE BUFFER
221	FORMAT(E32.25)
	GOTO 225
224	CONTINUE
C WRITE AND USE LOCAL FORMAT
	WRK2(1)='('
	DO 226 K=1,9
226	WRK2(K+1)=WRK(119+K)
	WRK2(11)=')'
	WRK2(12)=0
C FAILS IF MORE THAN 40 CHARACTERS FILLED BY FORMAT
	ENCODE(40,WRK2,WRK,ERR=225)XAC
225	CONTINUE
	DO 222 K=36,110
222	WRK(K)=32
	CALL WRKFIL(IRX,WRK,1)
C	WRITE(7'IRX)WRK
	RETURN
C
C *G SEEN.
C THE SYNTAX OF *G IS *G V1,V2 WHICH WILL GET VALUE OF VBLS(G1,G2)
C  AND LOAD IT INTO %. THE DIMENSIONS ARE CLAMPED TO LEGAL BOUNDS
C  AND TYPE=4 MEANS USE INTEGER, TYPE=2 CONVERTS VARIABLES TO
C  INTEGER. CALLS VARSCN TO DO THIS STUFF.
C  THIS GIVES A MEASURE OF INDIRECTION.
250	CONTINUE
	RETCD=1
C SAY ALL'S WELL.
	L1=3
	L2=60
	CALL VARSCN(LINE,L1,L2,LSTCH,ID1A,ID2A,IVLD1)
	IF(IVLD1.EQ.0)GOTO 1000
	CALL TYPGET(ID1A,ID2A,TYPE(1,1))
	IF(TYPE(1,1).EQ.2)GOTO 251
	CALL JVBLGT(1,ID1A,ID2A,JVBLS(1,1,1))
	LCL=JVBLS(1,1,1)
	GOTO 252
251	CALL XVBLGT(ID1A,ID2A,XVBLS(1,1))
	LCL=XVBLS(1,1)
252	CONTINUE
C NOW HAVE COLUMN NUMBER. PASS DELIMITER (WHATEVER IT IS) AND GO ON
	L1=LSTCH+1
	L2=60
C ASSUME WE GET THERE WITHIN 60 CHARACTERS...
	CALL VARSCN(LINE,L1,L2,LSTCH,ID1B,ID2B,IVLD2)
	IF(IVLD2.EQ.0)GOTO 1000
C SEEMS LIKE OK VARIABLE... GO AHEAD
	CALL JVBLGT(1,ID1B,ID2B,JVBLS(1,1,1))
	CALL TYPGET(ID1B,ID2B,TYPE(1,1))
	LRW=JVBLS(1,1,1)
	IF(TYPE(1,1).EQ.2)CALL XVBLGT(ID1B,ID2B,XVBLS(1,1))
	IF(TYPE(1,1).EQ.2)LRW=XVBLS(1,1)
C ADJUST FOR ACCUMULATOR ROW BY ADDING 1
	LRW=LRW+1
C NOW HAVE COLUMN AND ROW NUMBERS. GET VARIABLE USING THEM AFTER
C CLAMPING TO MAX VALUES.
	LCL=MAX0(1,LCL)
	LRW=MAX0(1,LRW)
	LCL=MIN0(LCL,RRW)
	LRW=MIN0(LRW,RCL)
C RETURN VALUE.
	CALL TYPGET(LCL,LRW,TYPE(1,1))
	IF(TYPE(1,1).EQ.2)CALL XVBLGT(LCL,LRW,XAC)
	IF(TYPE(1,1).NE.2)CALL JVBLGT(1,LCL,LRW,JVBLS(1,1,1))
	IF(TYPE(1,1).NE.2)XAC=JVBLS(1,1,1)
C USE IMPLICIT CONVERSION FROM FORTRAN HERE. NOTE WE RETURN WITH
C THE LOOKED UP VALUE IN XAC.
	RETURN
C
C *Q QUERY DATABASE COMMAND
C
C
C THIS COMMAND IS DESIGNED TO PERMIT CALC TO ACCESS SEQUENTIAL (FOR NOW)
C FILES AND PULL IN VALUES. ARRAY WRK IS USED TO HOLD THE RECORDS AND
C MAY DISPLAY WHATEVER IS DESIRED.
C
C OPERATION IS AS FOLLOWS:
C
C *Q[W/F] filespec ?KEYSTRING? <cc>
C WHERE THE W/F FLAG MEANS WRITE TO FORMULA AT CURRENT LOC (MAYBE MODIFIED
C EARLIER BY THE *P COMMAND) AND F FLAG MEANS RETURN % AS VALUE OBTAINED BY
C ATTEMPTING A DECODE ON THE FILE LINE BETWEEN DELIMITER CHARACTERS
C cc GIVEN INSIDE [] CHARACTERS. FILE IS ASSUMED TO START WITH
C "KEYSTRING" WHERE ANY CHARACTER IS A MATCH EXACTLY EXCEPT THAT
C THE _ CHARACTER INDICATES A WILDCARD.
C SPECIAL CASES:
C  IF ` IS 1ST CHAR OF KEYSTRING, RECORDS MUST HAVE KEYSTRING STARTING
C AT COL 1 (EXCLUDING THE `)
C  IF <CC> STRING HAS ` AS 1ST CHARACTER, THEN IT IS OF FORM
C <`NM> WHERE N=ASCII CODE FOR COLUMN WANTED + 32 AND M = ASCII CODE
C   FOR LENGTH DESIRED + 32
C  THIS ALLOWS POSITIONAL RETRIEVAL (THOUGH PAINFULLY)
C
C A SECOND KEYSTRING MAY BE ENTERED INSIDE A SECOND PAIR OF ? CHARACTERS TOO.
C  THE SEARCH WILL SEEK THE KEYS ANYWHERE IN THE RECORDS READ, UP TO 128
C  CHARACTERS LONG EACH.
C SECOND KEYSTRING MAY NOT BE ANCHORED TO START OF LINE.
C  AS AN ADDED ATTRACTION:
C   *QFK  OR *QFN  WON'T CLOSE LUN 4 AT END. IN ADDITION *QFN WON'T
C  CLOSE IT AT START EITHER ALLOWING SEQUENTIAL RETRIEVALS OUT OF
C  DATA FILES. DITTO *QW VARIANTS.
C
C
290	CONTINUE
	RETCD=1
C	IRX=(PCOL-1)*RRW+PROW
	CALL REFLEC(PCOL,PROW,IRX)
C	IF(LINE(3).EQ.'W')READ(7'IRX)WRK
	IF(LINE(3).EQ.'W')CALL WRKFIL(IRX,WRK,0)
	IF(LINE(3).NE.'W'.AND.LINE(3).NE.'F')RETURN
	IL=INDEX(LINE,32)
	IF(IL.GT.40)GOTO 299
	IL2=INDEX(LINE(IL+1),32)
	IF(IL2.GT.38)GOTO 299
C ENSURE LUN 4 AVAILABLE
	IF(LINE(4).NE.'C'.AND.LINE(4).NE.'N')CLOSE(UNIT=4)
	LINE(IL2+IL)=0
	IF(LINE(4).NE.'N'.AND.LINE(4).NE.'C')
     1   CALL ASSIGN(4,LINE(IL+1))
C THIS MAKES LUN 4 BE THE ONE WE WANT
	LINE(IL2+IL)=32
	IQ1=INDEX(LINE,'?')
C LOCATE THE KEY
	IF(IQ1.GE.70)GOTO 299
	IQ2=INDEX(LINE(IQ1+1),'?')
	IF(IQ2.GE.72)GOTO 299
C NOW KNOW KEY IS IQ2-1 LONG, STARTS AT IQ1+1
C
C ALLOW DOUBLE KEYS IF ANOTHER ?? PAIR IS SEEN.
	KEYS2=0
	IQ3=INDEX(LINE(IQ1+IQ2+1),'?')
	IF(IQ3.GT.3)GOTO 297
C WELL, THERE'S A 2ND STRING THERE MAYBE.
	IQ4=INDEX(LINE(IQ3+IQ1+IQ2+1),'?')
	IF(IQ4.GT.30)GOTO 297
	IF(IQ4.EQ.1)GOTO 297
	KEYS2=1
C FLAG WE HAVE A SECOND KEY. SOMETHING'S THERE.
	LCL=IQ3+IQ2+IQ1+1
	LRW=LCL+IQ4-1
297	READ(4,332,END=299,ERR=299)WRK2
	IQQ=IQ2-1
	IXX=128-IQ2
C COMPARE THE ENTIRE RECORD FOR THE KEY, MATCH ANYWHERE.
	IF(LINE(IQ1+1).NE.'`')GOTO 376
C IF 1ST CHAR OF KEY IS ` THEN SEARCH BEGINS AT LINE START ONLY. KEY IS
C 1 LESS.
	IQ1=1+IQ1
	IXX=1
	IQQ=IQQ-1
C ADJUST SO SEARCH IS 1 CHAR LESS.
376	CONTINUE
	DO 350 KKK=1,IXX
	CALL SCMP(LINE(IQ1+1),WRK2(KKK),IQQ,ICOD)
	IF(ICOD.NE.0)GOTO 351
350	CONTINUE
C DON'T JUST FALL THRU
	GOTO 353
351	CONTINUE
	IF(KEYS2.EQ.0)GOTO 353
C CHECK SECOND KEY STRING IN RECORD IF ANY WAS ASKED FOR.
C (THAT'S ALL YOU GET. 2 KEYS MAX.)
C LINE(LCL) TO LINE(LRW) CONTAINS KEY.
	IXY=128-IQ4+1
	ICC=IQ4-1
	DO 354 KKK=1,IXY
	CALL SCMP(LINE(LCL),WRK2(KKK),ICC,ICOD)
	IF(ICOD.NE.0)GOTO 355
354	CONTINUE
355	CONTINUE
353	IF(ICOD.EQ.0)GOTO 297
C HERE FOUND THE KEYED RECORD. NOW EXAMINE COMMAND LINE FOR
C SPECIAL CHARACTERS. IF NONE, JUST COPY THE FIRST CHARACTERS
C IN THE TEXT INTO EITHER THE BUFFER OR ENCODE THEM.
	IQ1=INDEX(LINE,'<')
	IF(IQ1.GT.75)GOTO 296
	IQ2=INDEX(LINE(IQ1+1),'>')
	IF(IQ2.GT.8)GOTO 296
	KKQ=LINE(IQ1+1).AND.255
	KK=INDEX(WRK2,KKQ)
C	KK=INDEX(WRK2,LINE(IQ1+1))
C MUNGE THE SEARCH SO THAT IF THE SPECIAL CHAR IS ` THEN THE NEXT 2
C CHARACTERS HAVE START AND LENGTH ENCODED AS ASCII CODE -32 DECIMAL
C WHICH ALLOWS FIELDS TO BE PLACED ANYWHERE (THOUGH SOMEWHAT PAINFULLY)
	IF(LINE(IQ1+1).EQ.'`')KK=LINE(IQ1+2)-32
	IF(KK.GT.125)GOTO 299
C NOTE THAT THE KEY FORM WOULD THEN GIVE
C  <`!@> FOR START COLUMN=1 AND LENGTH =32 (ASCII 64 = @ AND ASCII 33 = !)
C THIS MEANS USER HAS TO KNOW ASCII ORDER BUT AT LEAST IT'S IN MANUAL.
	IF(LINE(IQ1+1).EQ.'`')KKK=LINE(IQ1+3)-32
	KKQ=LINE(IQ1+2).AND.255
	IF(LINE(IQ1+1).NE.'`')KKK=INDEX(WRK2(KK+1),KKQ)+KK
C	IF(LINE(IQ1+1).NE.'`')KKK=INDEX(WRK2(KK+1),LINE(IQ1+2))+KK
	GOTO 295
296	CONTINUE
C DEFAULT, NO SPECIAL CHARS.
	KK=0
	KKK=110
295	CONTINUE
	KL=KKK-KK-1
	KK=KK+1
	IF(LINE(3).NE.'W')GOTO 294
	KL=MIN0(KL,109)
	DO 293 N=1,KL
	WRK(N)=WRK2(KK)
293	KK=KK+1
	WRK(KL+1)=0
C WRITE OUT THE RECORD'S KEY PART INTO SHEET FILE
	CALL WRKFIL(IRX,WRK,1)
C	WRITE(7'IRX)WRK
	XAC=1.
	GOTO 298
294	CONTINUE
C FLOAT THE VALUE, RETURN IN XAC
	DECODE(KL,221,WRK2(KK),ERR=299)XAC
298	CONTINUE
C IF IT'S A KEEP OR NEXT TYPE OPERATION, LEAVE LUN 4 OPEN.
C FIRST ONE MUST BE A KEEP (TO OPEN FILE IN THE FIRST PLACE)
C AND SUBSEQUENT OPERATIONS MAY BE A N OPERATIONS, WHICH
C WILL JUST CONTINUE SEQUENTIAL READIN OF DATA. USER HAS TO
C KEEP TRACK. NOTE RETURN VALUE IS -999999. (6 9'S) IF WE
C FAIL AND HAVE TO CLOSE FILE.
	IF(LINE(4).EQ.'K'.OR.LINE(4).EQ.'N')RETURN
	CLOSE(UNIT=4)
	RETURN
299	CONTINUE
C RETURN -999999 IF WE FAIL IN FINDING FILE.
	XAC=-999999.
	CLOSE(UNIT=4)
C	COME HERE FOR NON-RECOVERABLE ERRORS IN FORMAT TOO.
	RETURN
C
C *F LABEL  GOTO LABEL COMMAND (CONDITIONAL)
C
C
C THE SYNTAX OF THE *F COMMAND IS :
C  *F LABEL
C  WITH THE OPERATION OF LOCATING A LINE BEGINNING WITH THE
C  STRING "*CLABEL" (SO IT IS PASSED OVER BY NORMAL CALC
C  PROCESSING). THE INPUT FILE ON IOLVL IS REWOUND AND
C  SCANNING GOES TO THE EOF OR UNTIL THE STRING IS FOUND.
C  RETCD=2 IF NO SUCH LABEL IS FOUND.
C
C  AS A FURTHER AID, IF THE % VARIABLE IS 0 OR NEGATIVE, THE
C  COMMAND IS IGNORED.
330	CONTINUE
	RETCD=1
	IF(XAC.LE.0)RETURN
	REWIND IOLVL
333	READ(IOLVL,332,END=331,ERR=331)WRK
332	FORMAT(128A1)
	IF(WRK(1).NE.'*'.OR.WRK(2).NE.'C')GOTO 333
	ISSL=2
	ISSS=2
	IF(LINE(3).EQ.' ')ISSL=3
	IF(WRK(3).EQ.' ')ISSS=3
	CALL SCMP(LINE(ISSL),WRK(ISSS),80,ICODE)
	IF(ICODE.EQ.0)GOTO 333
	RETURN
C ERROR ENTRY WHERE WE SEE WE FAILED TO FIND LABEL.
331	CONTINUE
	IF(IOLVL.NE.5)CLOSE(UNIT=IOLVL)
	IOLVL=5
	RETCD=2
	RETURN
C
C *J LABEL - JUST LIKE *F LABEL BUT ON CALC'S COMMAND FILES.
C I.E., FINDS A LINE STARTING WITH *CLABEL
C (NOTE IT STARTS FROM START OF FILE AND DOES THIS ONLY IF % IS POSITIVE).
C ITERATION OF COMMAND FILES REMAINS UNDER NORMAL CONTROL.
360	CONTINUE
	RETCD=1
	IF(XAC.LE.0)RETURN
	REWIND LEVEL
363	READ(LEVEL,362,END=55,ERR=55)WRK
362	FORMAT(128A1)
	IF(WRK(1).NE.'*'.OR.WRK(2).NE.'C')GOTO 363
	ISSL=2
	ISSS=2
	IF(LINE(3).EQ.' ')ISSL=3
	IF(WRK(3).EQ.' ')ISSS=3
	CALL SCMP(LINE(ISSL),WRK(ISSS),80,ICODE)
	IF(ICODE.EQ.0)GOTO 363
	RETURN
C *X COMMAND
C  X[C] FILESPEC CELLNAME
C    READS FILESPEC AS A SAVED SPEADSHEET (NUMERIC OR FORMULA)
C  AND LOADS ITS VALUE INTO CURRENT CELL AND % ACCUMULATOR. DOES
C  NOT LOAD FORMULA UNLESS F SEEN. THUS 2 VARIANTS:
C   *XF FILESPEC CELLNAME	LOAD FORMULA AND VALUE
C   *XV FILESPEC CELLNAME	LOAD VALUE
C NOTE ANY CHARACTER AFTER *X THAT ISN'T "F" IS EQUIVALENT TO V FOR EASY USE.
480	CONTINUE
	RETCD=1
C NOW GET THE ARGS
	JFFG=0
	IF(LINE(3).EQ.'F')JFFG=1
C NOW HAVE FORMULA FLAG.
	IQ3=4
C ALLOW 1 SPACE OPTIONALLY
	IF(LINE(IQ3).EQ.' ')IQ3=5
	IQ1=INDEX(LINE(IQ3),32)
	IQ1=IQ1+IQ3-1
C NULL TERMINATE FILENAME WHILE PARSING IT (DON'T LET ASSIGN SEE VBL NAME)
	LINE(IQ1)=0
	CLOSE(UNIT=4,ERR=9770)
9770	CALL ASSIGN(4,LINE(IQ3))
C REPLACE THE SPACE FOR VARSCN'S SIGHT
	LINE(IQ1)=32
C IQ1 NOW HAS START INDEX FOR VARSCN DESIRED... GO GET VRBL NAME.
	KK1=IQ1
	KK2=IQ1+20
	CALL VARSCN(LINE,KK1,KK2,KEK,KK,KKK,IVLD)
	IF(IVLD.LE.0)GOTO 481
C GOT VALID VARIABLE NAME. KK,KKK ARE ROW,COL
C NOW WE KNOW HOW TO RETRIEVE THE DATA OFF FILE IN UNIT 4
C READ INTO WRK ARRAY TILL WE GET IT.
	IQ3=KK
	IQ4=KKK-1
483	READ(4,332)WRK
C IGNORE TITLE
486	CONTINUE
C NOTE WE READ IN THE NUMBER IN NUMERIC FORMAT. EASIER THAT WAY.
	IF(JFFG.EQ.0)READ(4,484,END=488,ERR=488)IRRW,ICCL,XYVAL
	IF(JFFG.NE.0)READ(4,489,END=488,ERR=488)IRRW,ICCL,
     1  (WRK(IV),IV=1,110)
484	FORMAT(X,I5,X,I5,X,D30.19)
489	FORMAT(X,I5,X,I5,X,110A1)
	READ(4,485,END=488,ERR=488)LFVLD,(WRK(IV),IV=120,128),KKTYP
C ALLOW FLAG OF 3 FOR NUMERIC,RECALCULATE... 2 FOR NUMERIC, NO RECALC.
C 1 CONTINUES TO MEAN ALWAYS RECALCULATE.
	IF(LFVLD.LT.-1)LFVLD=-3
	IF(LFVLD.GT.1)LFVLD=3
C
485	FORMAT(I3,X,9A1,X,I5)
C READS IN AN ENTRY OF SAVED SHEET. TEST IF IN OUR RANGE.
	IF(IRRW.EQ.IQ3.AND.ICCL.EQ.IQ4)GOTO 487
	GOTO 486
487	CONTINUE
C SUCCESS. NOW FILL IN VALUE OR FORMULA.
C	IRX=(PCOL-1)*RRW+PROW
	CALL REFLEC(PCOL,PROW,IRX)
	WRK(118)=115
	WRK(119)=LFVLD
	CALL FVLDST(PROW,PCOL,LFVLD)
C	FVLD(PROW,PCOL)=LFVLD
C SET UP TO SAVE FORMULA.
C SAVE EITHER FORMULA OR VALUE.
C	IF(JFFG.NE.0)WRITE(7'IRX)WRK
	IF(JFFG.NE.0)CALL WRKFIL(IRX,WRK,1)
	IF(JFFG.NE.0)GOTO 488
C SET UP NUMBER IF HERE.
	CALL TYPSET(PROW,PCOL,KKTYP)
C	TYPE(PROW,PCOL)=KKTYP
	CALL FVLDST(PROW,PCOL,LFVLD)
C	FVLD(PROW,PCOL)=LFVLD
	CALL XVBLST(PROW,PCOL,XYVAL)
C	XVBLS(PROW,PCOL)=XYVAL
	XAC=XYVAL
488	CONTINUE
	CLOSE(UNIT=4)
	RETURN
481	CONTINUE
	CLOSE(UNIT=4)
	RETCD=2
	RETURN
C *U FUNCTION ARGS
C HANDLE USER FUNCTION CALL...
780	CONTINUE
	RETCD=1
C PASS LINE AND ARGS TO SUBROUTINE TO PARSE (EXTERNALIZE THE WORK)
C COMMON /V/ HAS DATA NEEDED FOR ARGUMENTS...
	CALL USRFCT(LINE,RETCD)
C IF RETCD CHANGES IN USRFCT THIS ALLOWS ERROR CODES BACK.
	RETURN
	END
C STRING COMPARE 2 ARRAYS UNTIL EITHER ENDSTRING IS SEEN
C ON ONE OR MISMATCH IS SEEN.
	SUBROUTINE SCMP(LINA,LINB,LENM,ICODE)
	DIMENSION LINA(1),LINB(1)
	LOGICAL*1 LINA,LINB
	ICODE=1
	DO 1 N=1,LENM
	IF(LINA(N).EQ.0.OR.LINB(N).EQ.0)GOTO 2
C ALLOW _ TO BE A WILDCARD.
	IF(LINA(N).EQ.'_'.OR.LINB(N).EQ.'_')GOTO 1
	IF(LINA(N).NE.LINB(N))ICODE=0
	IF(ICODE.NE.1)GOTO 2
1	CONTINUE
2	CONTINUE
	RETURN
	END