SUBROUTINE DOIT1
C
C	PURPOSE: EXECUTES BASIC SINGLE STEP PROGRAM FUNCTIONS FOR INTERNAL
C	 COMMAND CODE #'S -128 TO -100 (CLX TO LOG)
C
C	SORENSON 2/81
C
	COMMON/UNIT/LUNCMD,LUNOUT,LUNTI,LUNFIL
	COMMON/FLAGS/STATE,ERROR,STKLFT,NEST,ANGLES,DIGITS,RADIX,FLAG(4)
	BYTE FLAG,STATE,ERROR,STKLFT,ANGLES,DIGITS,NEST,RADIX
	COMMON/COMAND/LENGTH,CMND(40)
	BYTE CMND
	COMMON/STACK/X,Y,Z,T,XLST
	DOUBLE PRECISION X,Y,Z,T,XLST
	COMMON/REGS/R(256)
	DOUBLE PRECISION R
	DOUBLE PRECISION DTEMP
	DATA NREG/256/
C
C	READJUST CODE #'S FOR USE IN COMPUTED GO TO STATEMENT
C
	I=CMND(1)+129
	IF(I.GT.29)GO TO 8
	IF(I.GT.10)GO TO 5
	GOTO(10,20,30,40,50,60,70,80,90,100),I
C
C	CODE #'S -100 TO -118 SAVE CURRENT X IN LASTX REGISTER; EXCEPT FOR
C	PI (CODE # -115) OR % (CODE # -110).
C
5	IF(I.EQ.14.OR.I.EQ.19)GO TO 7
	XLST=X
7	I=I-10
	GOTO(110,120,130,140,150,160,170,180,190,200,210,220,230,
	1240,250,260,270,280,290),I
C
C	CALLER MADE A MISTAKE, COMMAND IS NOT HANDLED BY THIS ROUTINE.
C	RETURN ERROR -2 UNRECOGNIZED COMMAND.
C
8	ERROR=-2
	RETURN
C*****	HANDLE COMMANDS HERE
C
C	CLEAR X REGISTER--ALSO DISABLE STACK LIFT ON NEXT ENTRY
C
10	X=0.D0
	GO TO 510
C
C	CLEAR STACK REGISTERS
C
20	X=0.D0
	Y=0.D0
	Z=0.D0
	T=0.D0
	GO TO 500
C
C	CLEAR ALL REGISTERS
C
30	DO 32 I=1,NREG
32	R(I)=0.D0
	GO TO 500
C
C	ENTER VALUE--DISABLE STACK LIFT
C
40	CALL PUSH
	GO TO 510
C
C	ROLL UP STACK
C
50	DTEMP=T
	T=Z
	Z=Y
	Y=X
	X=DTEMP
	GO TO 500
C
C	ROLL DOWN STACK
C
60	DTEMP=X
	X=Y
	Y=Z
	Z=T
	T=DTEMP
	GO TO 500
C
C	INTERCHANGE X AND Y ON STACK
C
70	DTEMP=Y
	Y=X
	X=DTEMP
	GO TO 500
C
C	RECALL LAST X REGISTER
C
80	CALL PUSH
	X=XLST
	GO TO 500
C
C	DISPLAY CURRENT STACK -- LEAVE STACK LIFT STATUS ALONE
C
90	WRITE(LUNOUT,91)T,Z,Y,X,XLST
91	FORMAT('0 T = ',G22.15/
	1'  Z = ',G22.15/
	1'  Y = ',G22.15/
	1'  X = ',G22.15,5X,'LAST X = ',G22.15/)
	GO TO 520
C
C	CHANGE SIGN OF X
C
100	X=-X
	GO TO 500
C
C	ABSOLUTE VALUE OF X
C
110	X=DABS(X)
	GO TO 500
C
C	X=INTEGER PART OF X
C
120	X=X-DMOD(X,1.D0)
	GO TO 500
C
C	X=FRACTIONAL PART OF X
C
130	X=DMOD(X,1.D0)
	GO TO 500
C
C	X=PI
C
140	CALL PUSH
	X=3.141592653589793D0
	GO TO 500
C
C	X=X+Y -- POP STACK
C
150	Y=X+Y
	CALL POP
	GO TO 500
C
C	X=Y-X -- POP STACK
C
160	Y=Y-X
	CALL POP
	GO TO 500
C
C	X=X*Y -- POP STACK
C
170	Y=X*Y
	CALL POP
	GO TO 500
C
C	X=Y/X -- POP STACK
C
180	Y=Y/X
	CALL POP
	GO TO 500
C
C	X % OF Y = X*Y/100 -- REPLACE X
C
190	X=X*Y*1.D-2
	GO TO 500
C
C	X % CHANGE OF Y = (X-Y)/Y *100 -- REPLACE X
C
200	X=(X-Y)*1.D2/Y
	GO TO 500
C
C	N! - DEFINED FOR POSITIVE INTEGERS ONLY -- REPLACE X
C
210	IF(DMOD(X,1.D0).NE.0.D0)GO TO 218
	I=INT(SNGL(X))
	IF(I.LT.0)GO TO 218
	X=1.D0
	IF(I.LT.2)GO TO 219
	DO 216 J=2,I
216	X=X*DBLE(FLOAT(J))
	GO TO 500
218	ERROR=-24
219	GO TO 500
C
C	1/X -- REPLACE X
C
220	X=1.D0/X
	GO TO 500
C
C	SQRE
C
230	X=X*X
	GO TO 500
C
C	SQRT
C
240	X=DSQRT(X)
	GO TO 500
C
C	Y^X - RAISE Y TO X POWER -- PUSH STACK DOWN
C
250	Y=Y**X
	CALL POP
	GO TO 500
C
C	^X - RAISE 10 TO X POWER -- REPLACE X
C
260	X=1.D1**X
	GO TO 500
C
C	E^X - RAISE "E" TO X POWER -- REPLACE X
C
270	X=DEXP(X)
	GO TO 500
C
C	LN - NATURAL LOG OF X -- REPLACE X
C
280	X=DLOG(X)
	GO TO 500
C
C	LOG - COMMON (BASE 10) LOG OF X -- REPLACE X
C
290	X=DLOG10(X)
	GO TO 500
C
C	3 OPTIONAL RETURNS; ENABLE STACK LIFT, DISABLE STACK LIFT, OR LEAVE
C	STACK LIFT ALONE
C
500	STKLFT=1
	GO TO 520
510	STKLFT=0
520	RETURN
	END