perm filename CHS3.F4[1,VDS]1 blob
sn#099237 filedate 1974-04-23 generic text, type C, neo UTF8
COMMENT ā VALID 00022 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 C MAIN PROGRAM -- 'LOOK-UP'
C00014 00003 BLOCK DATA
C00016 00004 SUBROUTINE OUTPUT (SKIP, PRINT)
C00023 00005 SUBROUTINE MESAGE
C00027 00006 SUBROUTINE UPDATE
C00032 00007 SUBROUTINE LPAREN
C00037 00008 SUBROUTINE EQUAL
C00040 00009 SUBROUTINE CLEAR
C00043 00010 SUBROUTINE DROP
C00047 00011 SUBROUTINE MULT
C00050 00012 SUBROUTINE COLAPS (*)
C00052 00013 SUBROUTINE COMBIN (*)
C00056 00014 SUBROUTINE CLEARX
C00057 00015 SUBROUTINE ENTRY
C00061 00016 SUBROUTINE DIGIT
C00064 00017 SUBROUTINE DECPT
C00067 00018 SUBROUTINE CORECT
C00069 00019 SUBROUTINE RECALL
C00073 00020 SUBROUTINE STORE
C00077 00021 SUBROUTINE REG (RN)
C00081 00022 SUBROUTINE FIXN
C00084 ENDMK
Cā;
C MAIN PROGRAM -- 'LOOK-UP'
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
REAL Y
REAL*8 DATE
LOGICAL EEX,DP,START,JUMP,READ,NEXT,JMP,FIXFLG,CONTNU,PRINT
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
DO 1 I=2,21
DO 1 J=1,17
R(I,J)=0
1 R(I,2)=15
R(21,2)=1
R(21,3)=5
C *** REGISTERS ARE ALLOCATED AS FOLLOWS: R(1)="PI", R(2)="A",
C R(3)="LST X", R(4)="LST Y", R(5)="R0", ..., R(20)="R15",
C R(21)="HIGHEST REG NO. AVAILABLE"
C SIZE = NO. OF KEYS ON KEYBOARD (SEE DECODER BELOW)
SIZE=39
C *** READ CONTROL DATA
C NEQNS = NO. OF TESTS TO BE RUN
C READ = SWITCH FOR INPUT MODE (F = RANDOM)
C SWITCH = OUTPUT CONTROL (0 -> NORMAL, 1 -> SHORT)
C CONTNU = CONTROL AFTER AN ERROR (T = CONTINUE, F = STOP THIS TEST)
C FIXFLG = 'DISPLAY' CONTROL (T = FIX MODE)
C FIX = NUMBER OF DECIMAL DIGITS IN FIX MODE (0-9)
C SCI = NUMBER OF DECIMAL DIGITS IN SCI MODE (0-9)
C DATE = DATE OF RUN ('MO/DY/YR')
C NKEYS = NO. OF KEY-STROKES PER TEST
C IY = RANDOM NO.
C
NEQNS=99
CONTNU=.FALSE.
PRINT=.FALSE.
TYPE 1000
ACCEPT 1010, START
IF (START) GO TO 12
TYPE 1001
ACCEPT 1011, NEQNS
TYPE 1002
ACCEPT 1010, READ
READ=.NOT.READ
IF (READ) GO TO 11
TYPE 1003
ACCEPT 1012, NKEYS, IY
11 TYPE 1004
ACCEPT 1010, START
IF (START) SWITCH=1
TYPE 1005
ACCEPT 1010, CONTNU
TYPE 1006
ACCEPT 1010, START
IF (START) GO TO 12
TYPE 1007
ACCEPT 1010, FIXFLG
TYPE 1008
ACCEPT 1012, FIX, SCI
C CONSIDER 'NEQNS' EQUATIONS
12 DO 160 TEST=1,NEQNS
ERROR=0
OLD=1
DO 2 II=1,50
INPUT(II)=15
2 EXPR(II)=15
CALL CLEAR
TYPE 1013, TEST
IF (READ) GO TO 6
3 DO 5 II=1,NKEYS
4 CALL RANDOM (IY, Y, 0)
JJ=(SIZE-1)*Y+1.5
IF (JJ.EQ.15.OR.JJ.EQ.29.OR.JJ.EQ.30) GO TO 4
5 INPUT(II)=JJ
6 CALL OUTPUT (-1, PRINT)
KEY=0
7 KEY=KEY+1
C OBTAIN NEXT KEY-CODE
CALL CONTRL
C DECODE KEY-CODE
8 IF (JUMP) JUMP=.FALSE.
IF (CODE.EQ.99) GO TO 160
IF (CODE.EQ.999) GO TO 170
IF (CODE.GT.SIZE) GO TO 9
IF (CODE.LE.12) GO TO 10
IF (CODE.EQ.13.OR.CODE.EQ.14) GO TO 20
IF (CODE.GT.15.AND.CODE.LT.20.AND.CODE.NE.18) GO TO 30
IF (CODE.EQ.18) GO TO 40
IF (CODE.EQ.20) GO TO 50
IF (CODE.EQ.22) GO TO 60
IF (CODE.GT.22.AND.CODE.LT.26 .OR. CODE.EQ.38 .OR.
* CODE.EQ.39) GO TO 70
IF (CODE.EQ.26) GO TO 80
IF (CODE.EQ.27) GO TO 90
IF (CODE.EQ.28) GO TO 10
IF (CODE.EQ.21) GO TO 100
IF (CODE.EQ.31) GO TO 110
IF (CODE.EQ.32) GO TO 111
IF (CODE.EQ.33) GO TO 112
IF (CODE.EQ.34) GO TO 113
IF (CODE.EQ.35) GO TO 114
IF (CODE.EQ.36 .OR. CODE.EQ.37) GO TO 120
IF (CODE.EQ.15.OR.CODE.EQ.29.OR.CODE.EQ.30) GO TO 140
C KEY-CODE ERROR
9 ERROR=17
GO TO 120
C CALL KEY ROUTINE
10 CALL ENTRY
GO TO 120
20 CALL SIGN
GO TO 120
30 CALL MULT
GO TO 120
40 CALL LPAREN
GO TO 120
50 CALL RPAREN
GO TO 120
60 CALL EQUAL
GO TO 120
70 CALL RECALL
GO TO 120
80 CALL CLEAR
GO TO 120
90 CALL CLEARX
GO TO 120
100 CALL ABSFCN
GO TO 120
110 CALL STORE
GO TO 120
111 CALL FIXN
GO TO 120
112 CALL SCIN
GO TO 120
113 CALL IMEDEX
GO TO 120
114 CALL EXCH
C PRINT EXPRESSION, STACK, VARIABLES
120 IF (ERROR.GT.0) CALL MESAGE
CALL OUTPUT (SWITCH, PRINT)
C IF ERROR HAS OCCURRED PRINT MESSAGE & START NEW EXPRESSION
IF (ERROR.EQ.0) GO TO 140
ERROR=0
IF (.NOT.CONTNU) GO TO 160
140 IF(JUMP) GO TO 8
IF(JMP) GO TO 10
150 IF (KEY.LT.NKEYS) GO TO 7
160 CONTINUE
170 STOP
1000 FORMAT (///' THE STANDARD CONTROL SETTINGS ARE:'
* /' CONSIDER 99 EQUATIONS'
* /' ACCEPT KEYSTROKES FROM TTY'
* /' PRODUCE SHORT OUTPUT'
* /' STOP EQUATION AFTER AN ERROR'
* /' DISPLAY IN FIX MODE W/ FIX=2 & SCI=5'
* //' THESE ARE OKAY. (T OR F)'/)
1001 FORMAT (/' HOW MANY EQUATIONS ARE YOU GOING TO TRY? (NN)'/)
1002 FORMAT (/' THE KEYSTROKES ARE TO BE GENERATED RANDOMLY.',
* ' (T OR F)'/)
1003 FORMAT (/' ENTER THE NUMBER OF KEYSTROKES TO BE GENERATED '
* /' AND AN INITIAL RANDOM NUMBER. (NN <SP> MM)'/)
1004 FORMAT (/' ABBREVIATED OUTPUT IS DESIRED. (T OR F)'/)
1005 FORMAT (/' THE SAME EQUATION SHOULD BE CONTINUED AFTER AN '
* /' ERROR. (T OR F)'/)
1006 FORMAT (/' THE STANDARD DISPLAY SETTINGS ARE WANTED.',
* ' (T OR F)'/)
1007 FORMAT (/' FIX MODE DISPLAY IS WANTED INITIALLY. (T OR F)'/)
1008 FORMAT (/' ENTER NUMBER OF DECIMAL DIGITS DESIRED IN FIX'
* /' AND SCI MODES, RESPECTIVELY. (N <SP> M)'/)
1010 FORMAT (L1)
1011 FORMAT (I)
1012 FORMAT (2I)
1013 FORMAT ('1 TEST NO.',I3/)
END
BLOCK DATA
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
LOGICAL JUMP, NEXT, JMP, FIXFLG, READ
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
DATA P /6*0/, OP /6*0/, D /16*13/, X /102*13/,
* JUMP, JMP, NEXT /3*.FALSE./, NKEYS, SWITCH /50, 1/,
* FIXFLG, READ, FIX, SCI /2*.TRUE., 2, 5/,
* R(1,1),R(1,2),R(1,3),R(1,4),R(1,5),R(1,6),R(1,7),R(1,8),
* R(1,9),R(1,10),R(1,11),R(1,12),R(1,13),R(1,14),R(1,15),
* R(1,16),R(1,17) /15,3,1,4,1,5,9,2,6,5,3,5,9,0,15,0,0/
END
SUBROUTINE OUTPUT (SKIP, PRINT)
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
INTEGER*2 CHAR(39),STROKE(50),SIGN(6),ESN(6),DISPLY(16)
LOGICAL EEX, DP, START, FIXFLG, PRINT
REAL*8 NAME(3)
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
2 /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
3 /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
4 /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
DATA CHAR( 1),CHAR( 2),CHAR( 3),CHAR( 4)/' 1',' 2',' 3',' 4'/,
2 CHAR( 5),CHAR( 6),CHAR( 7),CHAR( 8)/' 5',' 6',' 7',' 8'/,
3 CHAR( 9),CHAR(10),CHAR(11),CHAR(12)/' 9',' 0',' .','EE'/,
4 CHAR(13),CHAR(14),CHAR(15),CHAR(16)/' -',' +',' ',' /'/,
5 CHAR(17),CHAR(18),CHAR(19),CHAR(20)/' *',' (','**',' )'/,
6 CHAR(21),CHAR(22),CHAR(23),CHAR(24)/'AB',' =',' A','PI'/,
7 CHAR(25),CHAR(26),CHAR(27),CHAR(28)/' R','CL','CX','CO'/,
8 CHAR(29),CHAR(30),CHAR(31),CHAR(32)/' E','SV','->','FX'/,
9 CHAR(33),CHAR(34),CHAR(35),CHAR(36)/'SN','IX','XC',' ;'/,
A CHAR(37),CHAR(38),CHAR(39) /' ,','LX','LY'/
DATA NAME /' A =', 'LAST X =','LAST Y ='/
IF (SKIP.LT.0) GO TO 30
10 DO 20 I=OLD,KEY
J=EXPR(I)
IF (J.EQ.0) J=10
20 STROKE(I)=CHAR(J)
TYPE 100, (STROKE(I),I=1,KEY)
OLD=KEY+1
IF (SKIP.EQ.2) GO TO 75
GO TO 60
30 DO 50 I=1,50
50 STROKE(I)=CHAR(15)
TYPE 100, STROKE(1)
60 DO 70 I=1,6
J=X(I,1)
IF (J.EQ.0) J=15
SIGN(I)=CHAR(J)
K=X(I,15)
IF (K.EQ.0) K=15
70 ESN(I)=CHAR(K)
75 DO 80 I=1,16
J=D(I)
IF (J.EQ.0) J=10
80 DISPLY(I)=CHAR(J)
IF (SKIP.EQ.2) GO TO 95
IF (SKIP.EQ.1) GO TO 90
TYPE 200, P(6),SIGN(6),(X(6,N),N=2,14),ESN(6),X(6,16),
2 X(6,17),OP(6),START,L,
3 P(5),SIGN(5),(X(5,N),N=2,14),ESN(5),X(5,16),
4 X(5,17),OP(5),DP,M,
5 P(4),SIGN(4),(X(4,N),N=2,14),ESN(4),X(4,16),
6 X(4,17),OP(4),EEX,FIX,
7 P(3),SIGN(3),(X(3,N),N=2,14),ESN(3),X(3,16),
8 X(3,17),OP(3),FIXFLG,SCI
90 TYPE 300, P(2),SIGN(2),(X(2,N),N=2,14),ESN(2),X(2,16),
2 X(2,17),OP(2),ERROR
TYPE 400, P(1),SIGN(1),(X(1,N),N=2,14),ESN(1),X(1,16),
2 X(1,17),OP(1)
95 TYPE 500, DISPLY
IF (SKIP.EQ.2) RETURN
DO 96 I=2,4
IF (R(I,2).NE.15) TYPE 600, NAME(I-1), (R(I,N), N=1,17)
96 CONTINUE
DO 97 I=5,20
IF (R(I,2).EQ.15) GO TO 97
J=I-5
TYPE 700, J, (R(I,N), N=1,17)
97 CONTINUE
RETURN
100 FORMAT (6X,'EXPRESSION: ',39A3/30X,11A3)
200 FORMAT (//14X,'STACK: S(6) -',4X,I2,' / ',A2,I2,' .',12I2,
2 A2,2I2,' /',I3,10X,'FLAGS: START - ',L2,10X,
3 'INDICES: L -',I3//
4 22X,'S(5) -',4X,I2,' / ',A2,I2,' .',12I2,A2,2I2,' /',
5 I3,18X,'DP - ',L2,20X,'M -',I3//
6 22X,'S(4) -',4X,I2,' / ',A2,I2,' .',12I2,A2,2I2,' /',
7 I3,18X,'EEX - ',L2,20X,'FIX-',I3//
8 22X,'S(3) -',4X,I2,' / ',A2,I2,' .',12I2,A2,2I2,' /',
9 I3,18X,'FIXFLG- ',L2,20X,'SCI-'I3)
300 FORMAT (/22X,'S(2) -',4X,I2,' / ',A2,I2,' .',12I2,A2,2I2,' /',
2 I3,18X,'ERROR - ',I2/)
400 FORMAT (22X,'S(1) -',4X,I2,' / ',A2,I2,' .',12I2,A2,2I2,' /',
2 I3/)
500 FORMAT (/14X,'DISPLAY:',9X,16A3///)
600 FORMAT (22X,A8,I3,I2,' .',15I2)
700 FORMAT (22X,'REG(',I2,') =',I3,I2,' .',15I2)
END
SUBROUTINE MESAGE
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
DO 1 I=1,17
1 R(3,I)=X(1,I)
OP(1)=1
D(1)=15
DO 2 I=2,16
2 D(I)=13
D(8)=29
D(9)=ERROR/10
D(10)=ERROR-10*D(9)
IF (ERROR.GT.1) GO TO 3
D(15)=CODE/10
D(16)=CODE-10*D(15)
3 RETURN
END
C
C
C
C
C
SUBROUTINE CONTRL
C DATE OF LAST CHANGE - 740101
IMPLICIT INTEGER (A-Z)
DIMENSION INPUT(50), EXPR(50)
COMMON /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
TYPE 1
ACCEPT 2, CODE
EXPR(KEY)=CODE
IF (CODE.EQ.10) CODE=0
RETURN
1 FORMAT (' ?'/)
2 FORMAT (I)
END
C
C
C
C
C
SUBROUTINE RESET
C DATE OF LAST CHANGE - 740210
IMPLICIT INTEGER (A-Z)
LOGICAL EEX, DP
DIMENSION R(21,17), W(17)
COMMON /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
L=1
M=1
DP=.FALSE.
EEX=.FALSE.
CALL UPDATE
RETURN
END
SUBROUTINE UPDATE
C DATE OF LAST CHANGE - 740209
IMPLICIT INTEGER (A-Z)
LOGICAL FIXFLG
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (X(1,2).GT.15) RETURN
D(1)=X(1,1)
IF (D(1).EQ.14) D(1)=15
D(2)=X(1,2)
IF (X(1,2).EQ.15) D(2)=0
IF (D(1).EQ.13 .AND. D(2).EQ.0) D(1)=15
IF (.NOT.FIXFLG) GO TO 12
C DISPLAY IN "FIX" FORMAT
IF (X(1,16).GT.0) GO TO 12
EXPX=X(1,17)
IF (X(1,15).EQ.13) GO TO 5
K=EXPX+FIX+1
IF (K.GT.10) GO TO 12
DO 1 I=13,16
1 D(I)=15
CALL ROUND (K)
K=EXPX+2
DO 2 I=3,K
2 D(I)=W(I)
K=K+1
D(K)=11
IF (FIX.EQ.0) GO TO 4
DO 3 I=1,FIX
3 D(I+K)=W(I+K-1)
4 K=K+FIX+1
GO TO 15
5 D(2)=10
D(3)=11
K=FIX-EXPX+1
IF (K.LE.0) GO TO 8
CALL ROUND (K)
J=EXPX+2
DO 6 I=4,J
6 D(I)=10
DO 7 I=1,K
7 D(J+I)=W(I+1)
GO TO 10
8 J=FIX+3
DO 9 I=4,J
9 D(I)=10
10 K=FIX+4
DO 11 I=13,16
11 D(I)=15
GO TO 15
C DISPLAY IN "SCI" FORMAT
12 CALL ROUND (SCI)
D(13)=29
DO 13 I=14,16
13 D(I)=W(I+1)
D(3)=11
K=SCI+3
DO 14 I=5,K
14 D(I-1)=W(I-2)
15 DO 16 I=K,12
16 D(I)=15
RETURN
END
C
C
C
C
C
C
C
C
C
C
SUBROUTINE ROUND (N)
C DATE OF LAST CHANGE - 740209
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
DO 1 I=1,17
1 W(I)=X(1,I)
IF (W(N+2)-5) 6,2,4
2 K=N+3
DO 3 I=K,14
IF (W(I).GT.0) GO TO 4
3 CONTINUE
K=N+1
IF (2*(W(K)/2) .EQ. W(K)) GO TO 6
4 K=N+1
W(K)=W(K)+1
DO 5 I=3,K
J=N+4-I
IF (W(J).LT.10) GO TO 6
W(J)=W(J)-10
5 W(J-1)=W(J-1)+1
6 RETURN
END
SUBROUTINE LPAREN
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
LOGICAL START
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (P(1).NE.3) GO TO 1
ERROR=2
RETURN
1 IF (START) GO TO 6
IF (X(1,2).NE.15) GO TO 2
IF (X(1,1).NE.13) GO TO 6
X(1,2)=1
GO TO 3
2 IF (OP(1).NE.0) GO TO 4
3 OP(1)=50
GO TO 5
4 IF (OP(1).NE.1) GO TO 5
CALL CLEARX
GO TO 6
5 CALL ENTRUP (&7)
6 P(1)=P(1)+1
7 RETURN
END
C
C
C
C
C
C
C
C
C
C
SUBROUTINE RPAREN
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
LOGICAL START
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (START) GO TO 1
IF (OP(1).EQ.0) GO TO 2
1 ERROR=1
RETURN
2 IF (P(1).NE.0) GO TO 3
IF (OP(2).EQ.0) GO TO 1
CALL EXECUT (&4)
GO TO 2
3 P(1)=P(1)-1
IF (P(1).NE.0) RETURN
IF (OP(2).NE.71) RETURN
CALL EXECUT (&4)
4 RETURN
END
SUBROUTINE EQUAL
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (X(1,2).EQ.15) GO TO 1
IF (OP(1).EQ.0) GO TO 2
IF (OP(1).EQ.1) RETURN
1 ERROR=1
RETURN
2 IF (OP(2).EQ.0) GO TO 3
CALL EXECUT (&5)
GO TO 2
3 IF (P(1).EQ.0) GO TO 4
ERROR=4
RETURN
4 OP(1)=1
5 RETURN
END
C
C
C
C
C
SUBROUTINE IMEDEX
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
IF (OP(1).EQ.1) RETURN
IF (OP(1).EQ.0) GO TO 1
IF (X(1,2).EQ.15) GO TO 1
IF (OP(2).EQ.0) GO TO 2
1 ERROR=1
RETURN
2 OP(2)=OP(1)
CALL EXECUT
RETURN
END
C
C
C
C
C
SUBROUTINE EXCH
C DATE OF LAST CHANGE - 740215
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
DO 1 I=1,17
W=X(1,I)
X(1,I)=X(2,I)
1 X(2,I)=W
CALL RESET
RETURN
END
SUBROUTINE CLEAR
C DATE OF LAST CHANGE - 731224
IMPLICIT INTEGER (A-Z)
LOGICAL START
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
CALL CLEARS
DO 1 II=2,6
JJ=II-1
P(II)=P(JJ)
OP(II)=OP(JJ)
DO 1 KK=1,17
1 X(II,KK)=X(JJ,KK)
START=.TRUE.
RETURN
END
C
C
C
C
C
SUBROUTINE CLEARS
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
P(1)=0
CALL CLEARX
RETURN
END
C
C
C
C
C
SUBROUTINE ENTRUP (*)
C DATE OF LAST CHANGE - 740106
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (X(6,2).EQ.15) GO TO 1
ERROR=3
RETURN 1
1 DO 2 II=1,5
JJ=6-II
KK=JJ+1
P(KK)=P(JJ)
OP(KK)=OP(JJ)
DO 2 LL=1,17
2 X(KK,LL)=X(JJ,LL)
CALL CLEARS
RETURN
END
SUBROUTINE DROP
C DATE OF LAST CHANGE - 731224
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
P(1)=P(2)
C USUALLY DROP 3 -> 2, ETC.; AFTER 'CLEAR X' DROP 2 -> 1, ETC.
J=2
IF (X(1,2).EQ.15) J=1
DO 1 II=J,5
JJ=II+1
P(II)=P(JJ)
OP(II)=OP(JJ)
DO 1 KK=1,17
1 X(II,KK)=X(JJ,KK)
IF (OP(6).EQ.0) RETURN
OP(6)=0
P(6)=0
DO 2 II=1,17
2 X(6,II)=0
X(6,2)=15
RETURN
END
C
C
C
C
C
C
C
C
C
C
SUBROUTINE SIGN
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
LOGICAL START, JMP
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
IF (OP(1).NE.0) GO TO 2
IF (X(1,2).EQ.15) GO TO 3
1 OP(1)=CODE+17
CALL COLAPS (&4)
RETURN
2 IF (OP(1).EQ.1) GO TO 1
CALL ENTRUP (&4)
3 IF (START) START=.FALSE.
IF (CODE.NE.13) RETURN
IF (X(1,1).EQ.13) X(1,1)=14
IF (X(1,1).NE.13) X(1,1)=13
D(1)=X(1,1)
4 RETURN
END
SUBROUTINE MULT
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (X(1,2).EQ.15) GO TO 1
IF (OP(1).LT.2) GO TO 2
1 ERROR=1
RETURN
2 OP(1)=CODE+24
IF (CODE.EQ.19) OP(1)=60
CALL COLAPS (&3)
3 RETURN
END
C
C
C
C
C
C
C
C
C
C
SUBROUTINE ABSFCN
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
LOGICAL START
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
IF (.NOT.START) GO TO 1
START=.FALSE.
GO TO 4
1 IF (X(1,2).EQ.15) GO TO 4
IF (OP(1).NE.0) GO TO 2
OP(1)=50
GO TO 3
2 IF (OP(1).NE.1) GO TO 3
CALL CLEARX
GO TO 4
3 CALL ENTRUP (&5)
4 OP(1)=71
X(1,2)=21
5 RETURN
END
SUBROUTINE COLAPS (*)
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
1 IF (P(1).NE.0) RETURN
IF (OP(1)/10 .GT. OP(2)/10) RETURN
IF (OP(2).NE.0) GO TO 3
ERROR=18
2 RETURN 1
3 CALL EXECUT (&2)
GO TO 1
END
C
C
C
C
C
C
C
C
C
C
SUBROUTINE EXECUT (*)
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
IF (OP(2).EQ.71) GO TO 1
CALL COMBIN (&3)
GO TO 2
1 IF (X(1,1).EQ.13) X(1,1)=14
IF (X(2,1).EQ.13) X(1,1)=13
2 CALL DROP
CALL UPDATE
RETURN
3 RETURN 1
END
SUBROUTINE COMBIN (*)
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
REAL RX(2), X1, ALOG10, ABS, ALOG, EXP
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
C SAVE X(1,N) IN "LST X" & X(2,N) IN "LST Y"
DO 14 N=1,17
R(3,N)=X(1,N)
14 R(4,N)=X(2,N)
C CONVERT X(I,N) TO RX(I)
DO 2 I=1,2
RX(I)=X(I,14)
DO 1 J=1,12
K=14-J
1 RX(I)=0.1*RX(I)+X(I,K)
IF (X(I,1).EQ.13) RX(I)=-RX(I)
J=10*X(I,16)+X(I,17)
IF (J.GT.30) J=30
IF (X(I,15).EQ.13) J=-J
2 RX(I)=RX(I)*10**J
X1=RX(1)
C NOW EXECUTE RX(2), OP(2), RX(1) -> RX(1)=X1
IF (OP(2).GT.31) GO TO 3
IF (OP(2).EQ.30) X1=-X1
X1=RX(2)+X1
GO TO 6
3 IF (OP(2).EQ.40) GO TO 4
IF (OP(2).EQ.60) GO TO 5
X1=RX(2)*X1
GO TO 6
4 IF (X1.NE.0) GO TO 45
41 ERROR=7
RETURN 1
45 X1=RX(2)/X1
GO TO 6
5 IF (RX(2).LE.0.) GO TO 41
X1=X1*ALOG(RX(2))
IF (ABS(X1).GT.174) ERROR=8
IF (ABS(X1).GT.174.) X1=174.*X1/ABS(X1)
X1=EXP(X1)
C EXTRACT EXPONENT, -> X(1,15),..., X(1,17)
6 IF (X1.EQ.0.) GO TO 7
K=ALOG10(ABS(X1))
GO TO 8
7 K=0
8 X1=X1/10**K
IF (K.GE.0) GO TO 9
X(1,15)=13
GO TO 10
9 X(1,15)=14
10 X(1,16)=K/10
X(1,17)=K-10*X(1,16)
IF (X1.GT.0) GO TO 11
X(1,1)=13
X1=-X1
GO TO 12
11 X(1,1)=14
C CONVERT X1=RX(1) TO X(1,N)
12 X(1,2)=X1
DO 13 I=3,7
J=I-1
X1=10.*(X1-X(1,J))
13 X(1,I)=X1
RETURN
END
SUBROUTINE CLEARX
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16)
COMMON /STACK/ P, X, OP, D
OP(1)=0
C THIS STATEMENT IS NUMBERED FOR REFERENCE IN 'CORECT'
X(1,1)=15
X(1,2)=15
1 DO 2 II=3,17
2 X(1,II)=0
C UNCLEAR WHETHER SHOULDN'T JUST 'CALL UPDATE' HERE
CALL RESET
RETURN
END
SUBROUTINE ENTRY
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
LOGICAL EEX, START, JUMP, JMP
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (JMP) GO TO 13
IF (.NOT.START) GO TO 1
START=.FALSE.
GO TO 4
1 IF (X(1,2).EQ.15) GO TO 4
IF (OP(1).NE.0) GO TO 2
OP(1)=50
GO TO 3
2 IF (OP(1).NE.1) GO TO 3
CALL CLEARX
GO TO 4
3 CALL ENTRUP (&12)
4 DO 45 I=2,16
45 D(I)=15
IF (CODE.GT.10) GO TO 5
CALL DIGIT
GO TO 14
5 IF (CODE.NE.11) GO TO 6
CALL DECPT
GO TO 14
6 IF (CODE.NE.12) GO TO 65
CALL ENTEXP
GO TO 14
65 IF (CODE.NE.28) GO TO 66
CALL CORECT
IF (.NOT.JUMP) GO TO 14
JUMP=.FALSE.
RETURN
66 IF (CODE.NE.32 .AND. CODE.NE.33) GO TO 7
IF (CODE.EQ.32) CALL FIXN
IF (CODE.EQ.33) CALL SCIN
GO TO 14
7 IF (.NOT.EEX.OR.(CODE.NE.13.AND.CODE.NE.14)) GO TO 8
IF (D(15).EQ.15) D(15)=0
IF (D(16).EQ.15) D(16)=0
J=10*D(15)+D(16)
IF (J.NE.0) GO TO 8
D(14)=CODE
GO TO 14
8 IF (X(1,2).EQ.15) GO TO 11
C ADD EXPONENT OF D TO THAT OF X(1)
J=10*X(1,16)+X(1,17)
IF (X(1,15).EQ.13) J=-J
IF (D(15).EQ.15) D(15)=0
IF (D(16).EQ.15) D(16)=0
K=10*D(15)+D(16)
IF (D(14).EQ.13) K=-K
J=J+K
IF (J.GE.0) GO TO 9
J=-J
X(1,15)=13
GO TO 10
9 X(1,15)=14
10 X(1,16)=J/10
X(1,17)=J-X(1,16)*10
IF (X(1,16).LT.10) GO TO 12
ERROR=3
GO TO 12
11 X(1,2)=0
12 JUMP=.TRUE.
CALL RESET
RETURN
13 JMP=.FALSE.
14 CALL OUTPUT (2,.FALSE.)
KEY=KEY+1
CALL CONTRL
GO TO 4
END
SUBROUTINE DIGIT
C DATE OF LAST CHANGE - 731206
IMPLICIT INTEGER (A-Z)
LOGICAL EEX, DP
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (.NOT.EEX) GO TO 1
D(15)=D(16)
D(16)=CODE
RETURN
1 IF (L.GT.13) GO TO 7
IF (DP) GO TO 3
IF (L.EQ.1) GO TO 4
CALL EXPON (X(1,15),X(1,16),X(1,17),1)
GO TO 5
3 IF (L.NE.1) GO TO 5
CALL EXPON (X(1,15),X(1,16),X(1,17),-1)
4 IF (CODE.EQ.0) GO TO 6
5 L=L+1
X(1,L)=CODE
6 IF (M.GT.13) GO TO 7
M=M+1
D(M)=CODE
RETURN
7 IF (DP) RETURN
CALL EXPON (D(14),D(15),D(16),1)
RETURN
END
C
C
C
C
C
C
C
C
C
SUBROUTINE EXPON (A,B,C,N)
C DATE OF LAST CHANGE - 740210
C ADD 'N' TO THE EXPONENT 'ABC'
IMPLICIT INTEGER (A-Z)
IF (B.EQ.15) B=0
IF (C.EQ.15) C=0
K=10*B+C
IF (A.EQ.13) K=-K
K=K+N
IF (K.GE.0) GO TO 1
K=-K
A=13
GO TO 2
1 A=14
2 B=K/10
C=K-10*B
RETURN
END
SUBROUTINE DECPT
C DATE OF LAST CHANGE - 740404
IMPLICIT INTEGER (A-Z)
LOGICAL EEX, DP
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (EEX) GO TO 4
IF (.NOT.DP) GO TO 1
OP(1)=50
CALL ENTRUP (&3)
GO TO 2
1 DP=.TRUE.
2 M=M+1
D(M)=11
3 RETURN
4 EEX=.FALSE.
RETURN
END
C
C
C
C
C
C
C
C
C
C
SUBROUTINE ENTEXP
C DATE OF LAST CHANGE - 740404
IMPLICIT INTEGER (A-Z)
LOGICAL EEX
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (.NOT.EEX) GO TO 1
OP(1)=50
CALL COLAPS (&4)
CALL ENTRUP (&4)
GO TO 3
1 IF (D(13).EQ.29) GO TO 2
D(13)=29
D(14)=15
D(15)=0
D(16)=0
2 EEX=.TRUE.
IF (M.GT.1) RETURN
3 X(1,1)=14
X(1,2)=1
D(1)=15
D(2)=1
D(3)=11
4 RETURN
END
SUBROUTINE CORECT
C DATE OF LAST CHANGE - 740404
IMPLICIT INTEGER (A-Z)
LOGICAL EEX, DP, JUMP
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (OP(1).NE.0) GO TO 7
IF (M.EQ.1) RETURN
IF (EEX) GO TO 5
IF (DP) GO TO 3
IF (L.EQ.2) GO TO 1
IF (L.EQ.1) GO TO 2
CALL EXPON (X(1,15),X(1,16),X(1,17),-1)
1 X(1,L)=0
L=L-1
2 D(M)=15
M=M-1
IF (M.NE.1) RETURN
C SHOULD 'GO TO' STATEMENT #1 OF CLEARX, BUT IT'S 'CALLED' FOR CONVENIENCE
CALL CLEARX
JUMP=.TRUE.
RETURN
3 IF (D(M).NE.11) GO TO 4
DP=.FALSE.
GO TO 2
4 IF (L.GT.2) GO TO 1
CALL EXPON (X(1,15),X(1,16),X(1,17),1)
IF (L.EQ.1) GO TO 2
GO TO 1
5 DO 6 I=13,16
6 D(I)=15
EEX=.FALSE.
RETURN
7 OP(1)=0
RETURN
END
SUBROUTINE RECALL
C DATE OF LAST CHANGE - 740310
IMPLICIT INTEGER (A-Z)
LOGICAL START, JUMP, NEXT
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IF (.NOT.START) GO TO 1
START=.FALSE.
GO TO 4
1 IF (X(1,2).EQ.15) GO TO 4
IF (OP(1).NE.0) GO TO 2
OP(1)=50
GO TO 3
2 IF (OP(1).NE.1) GO TO 3
CALL CLEARX
GO TO 4
3 CALL ENTRUP (&14)
4 IF (CODE-24) 5, 6, 7
5 REGNO=-3
GO TO 9
6 REGNO=-4
GO TO 9
7 IF (CODE.EQ.25) GO TO 8
REGNO=CODE-40
GO TO 9
8 CALL REG (REGNO)
IF (ERROR.NE.0) RETURN
9 IF (X(1,1).EQ.13) GO TO 10
CALL TRANS (REGNO,.FALSE.)
GO TO 12
10 CALL TRANS (REGNO,.FALSE.)
IF (X(1,1).EQ.13) GO TO 11
X(1,1)=13
GO TO 12
11 X(1,1)=14
12 IF (X(1,2).NE.15) GO TO 13
ERROR=6
RETURN
13 CALL UPDATE
IF (NEXT) JUMP=.TRUE.
14 RETURN
END
SUBROUTINE STORE
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
LOGICAL JUMP, NEXT
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17), OPCD(19)
COMMON /STACK/ P, X, OP, D
* /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
DATA OPCD /12*0, 30, 31, 0, 40, 41, 0, 60/
CALL EQUAL
IF (ERROR.NE.0) RETURN
KMAX=2
OPCODE=0
1 CALL FINDN (K,KMAX,REGNO)
IF (K.NE.0) GO TO 5
IF (CODE.EQ.23) GO TO 3
IF (CODE.EQ.25) GO TO 4
IF (CODE.GT.12.AND.CODE.LT.18.AND.CODE.NE.15) GO TO 2
ERROR=1
RETURN
2 OPCODE=OPCD(CODE)
GO TO 1
3 REGNO=-3
GO TO 6
4 CALL REG (REGNO)
5 IF (REGNO.LE.16) GO TO 6
ERROR=5
RETURN
6 IF (OPCODE.EQ.0) GO TO 8
OP(1)=OPCODE
CALL ENTRUP (&9)
CALL TRANS (REGNO,.FALSE.)
DO 7 I=1,17
J=X(1,I)
X(1,I)=X(2,I)
7 X(2,I)=J
CALL EXECUT (&9)
8 CALL TRANS (REGNO,.TRUE.)
IF (NEXT) JUMP=.TRUE.
9 RETURN
END
C
SUBROUTINE TRANS (REGNO,STORE)
C DATE OF LAST CHANGE - 740101
IMPLICIT INTEGER (A-Z)
LOGICAL STORE
DIMENSION P(6), X(6,17), OP(6), D(16), R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
K=REGNO+5
IF (STORE) GO TO 2
DO 1 I=1,17
1 X(1,I)=R(K,I)
RETURN
2 DO 3 I=1,17
3 R(K,I)=X(1,I)
RETURN
END
SUBROUTINE REG (RN)
C DATE OF LAST CHANGE - 740306
IMPLICIT INTEGER (A-Z)
DIMENSION P(6), X(6,17), OP(6), D(16), INPUT(50), EXPR(50),
* R(21,17), W(17)
COMMON /STACK/ P, X, OP, D
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
IND=0
KMAX=2
1 CALL FINDN (K,KMAX,RN)
IF (K.NE.0) GO TO 4
IF (CODE.EQ.25) GO TO 3
IF (CODE.EQ.22) GO TO 2
ERROR=9
RETURN
2 RN=16
OP(1)=1
RETURN
3 IND=IND+1
GO TO 1
4 IF (RN.LE.16) GO TO 5
ERROR=5
RETURN
5 IF (IND.EQ.0) RETURN
IF (R(RN,2).EQ.15) GO TO 6
RN=(R(RN,2)+0.1*R(RN,3))*10**R(RN,17)
IND=IND-1
GO TO 4
6 ERROR=6
RETURN
END
C
C
C
SUBROUTINE FINDN (K,KMAX,RN)
C DATE OF LAST CHANGE - 740227
IMPLICIT INTEGER (A-Z)
INTEGER INPUT(50), EXPR(50)
LOGICAL NEXT
COMMON /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
NEXT=.FALSE.
K=0
RN=0
1 KEY=KEY+1
CALL CONTRL
IF (CODE.GT.10) GO TO 4
K=K+1
KMAX=KMAX-1
IF (K.GT.1) GO TO 2
RN=CODE
GO TO 3
2 RN=10*RN+CODE
3 IF (KMAX.NE.0) GO TO 1
RETURN
4 NEXT=.TRUE.
RETURN
END
SUBROUTINE FIXN
IMPLICIT INTEGER (A-Z)
LOGICAL JUMP, FIXFLG
DIMENSION INPUT(50), EXPR(50), R(21,17), W(17)
COMMON /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
FIXFLG=.TRUE.
KEY=KEY+1
CALL CONTRL
IF (CODE.LT.11) GO TO 1
JUMP=.TRUE.
GO TO 2
1 FIX=CODE
2 CALL UPDATE
RETURN
END
C
C
C
C
C
C
C
C
C
C
SUBROUTINE SCIN
C DATE OF LAST CHANGE - 740225
IMPLICIT INTEGER (A-Z)
LOGICAL JUMP, FIXFLG
DIMENSION INPUT(50), EXPR(50), R(21,17), W(17)
COMMON /FLAGS/ EEX, DP, START, JUMP, NEXT, JMP, FIXFLG
* /INPUTS/ INPUT, CODE, EXPR, READ, KEY, NKEYS
* /MISC/ L, M, ERROR, OLD, R, SWITCH, FIX, SCI, W
FIXFLG=.FALSE.
KEY=KEY+1
CALL CONTRL
IF (CODE.LT.11) GO TO 1
JUMP=.TRUE.
GO TO 2
1 SCI=CODE+1
IF (SCI.EQ.11) SCI=1
2 CALL UPDATE
RETURN
END