
;START THE WORK AREA AND GLOBAL VARIABLES HERE

WORK:	.WORD	0,0,0,0,0,0,0,0,0,0	;THIS IS THE WORK AREA
	.WORD	0,0,0,0,0,0,0,0,0,0	;FOR ALL ROUTINES DOING INPUT
	.WORD	0,0,0,0,0,0,0,0,0,0	;FROM EITHER THE OLD DEVICE
	.WORD	0,0,0,0,0,0,0,0,0,0	;OR THE CONSOLE TTY
ENDW	=	.-1			;END ADDRESS OF THE WORK AREA

LINENO:	.WORD	0	;TEMPORARY LINE NUMBER CELL
USR:	.WORD	0	;START OF USER STACK
RUNF:	.WORD	0	;RUN FLAG
ENDTXT:	.WORD	0	;END OF USER TEXT
DATI:	.WORD	0	;DATA STATEMENT POSITION POINTER
POSITN:	.WORD	0	;CHARACTER POINTER ON OUTPUT
OLDF:	.WORD	0	;OLD COMMAND IN PROGRESS
SAVF:	.WORD	0	;SAVE COMMAND IN PROGRESS
ECHO:	.WORD	1	;TURN OFF ECHO IF 0
CTRLP:	.WORD	0	;CTRL P ALLOWED FLAG
DEVLOC:	.WORD	0	;OLD DEVIC ADDRESS
SVLOC:	.WORD	0	;SAVE DEVICE LOCATION
RNDM:	.WORD	1	;RANDOMIZE WORD
ENDUSR:	.WORD	ENDW+1	;A PLACE TO START A STACK
;SIN,COS,LOG,EXP,SQR,ATN
;
;POWER FUNCTION
;
PWRF00:	MOV	R1,-(SP)	;INITIALIZE THE STACK WITH DEFA AND SEFA
	MOV	R0,-(SP)
	SUB	#6,SP		;AND PUT ROOM FOR A NUMBER ON THERE TOO
	MOV	R0,R1		;START WITH LN(A)
	MOV	SP,R0		;AND PUT IT ON THE STACK
	JSR	PC,LOG00
	MOV	10(SP),R1	;CONTINUE WITH B*LN(A)
	MOV	SP,R0
	MULF
	MOV	6(SP),R0	;FINISH UP WITH EXP(B*LN(A)) TO THE 
	MOV	SP,R1		;DESTINATION WITH STACK AS SOURCE
	JSR	PC,EXPF00
	ADD	#12,SP		;ONE MUST BE NEAT ABOUT THE STACK
	RTS	PC		;OFF WE GO INTO THE WILD BLUE YONDER!!
;
;FLOATING POINT NATURAL LOGARITHIM ROUTINE
;SOURCE POINTER IN R1
;DESTINATION POINTER IN R0
;
LOG00:	M.INI2
	TST 2(R0)		;Y .LE. 0?
	BGT M.XY
M.YY:	LOGERR
	ADD	#4,SP
	RTS	PC
M.XY:	MOV R0,R1		;DOES Y=1?
	TST (R1)+
	BNE M.XX		;DOES LOW FRACTION=0?
	CMP (R1)+,#40000	;YES. DOES HIGH FRACTION =40000?
	BNE M.XX
	CMP (R1)+,#100001	;YES. DOES EXPONENT =1?
	BNE M.XX
	CLR (R0)+		;YES. CLEAR DESTINATION
	CLR (R0)+
	CLR (R0)+
	ADD #4,SP
	RTS	PC
M.XX:	MOV 4(R0),-(SP)		;LET N=EXP (Y)
	ADD	#100000,@SP
	MOV	#100000,4(R0)	;LET EXP (Y)=0
	MOV @SP,R1		;FLOAT N AND LEAVE RESULT ON STACK
	SUB #6,SP
	MOV SP,R0
	FLT
	MOV 10(SP),R0		;SAVE X ON STACK
	M.MOVE
	MOV #M.RT2B2,R1
	SUBF			;DEST=DEST-SQR(2)
	MOV SP,R0		;LET X(STK)=X(STK)+SQR(2)/2
	MOV #M.RT2B2,R1
	ADDF
	MOV 16(SP),R0		;LET DEST=DEST/X(STK)
	MOV SP,R1
	DIVF
	MOV #M.TABL,R4		;SET UP SETUP ROUTINE
	MOV 16(SP),R0		;LOC OF DESTINATION
	MOV #4,R3		;NUMBER OF CONSTANTS.
	M.SETU
	M.DOPO			;EVALUATE THE POLYNOMIAL
	MOV 16(SP),R0		;LET DEST=DEST-(LN 2)/2
	MOV #M.LGB2,R1
	SUBF
	ADD #6,SP		;POP TO FLOATED N
	MOV SP,R0
	MOV #M.LOGE,R1		;LET N=N*LN 2
	MULF
	MOV SP,R1		;LET DEST=DEST+N
	MOV 10(SP),R0
	ADDF
M.OUT:	ADD #14,SP		;RESTORE SP TO ORIGINAL POSITION
	CLV
	RTS	PC
;
;LOG
M.RT2B:	074626,055202,100000	;SQRT(2)/2
M.LOGE:	005776,054271,100000	;LN 2
M.TABL:	125112,046414,077777	;.300974506336
	007411,063120,077777	;.399659100019
	066333,052525,100000	;.666669470507
	177772,077777,100001	;1.999999993788
EXPF00:	M.INI2			;GET POINTERS
	CMP	4(R0),#100016	;IS EXP(Y)>14
	BHI	M.YY		;YES, ERROR
M.EHEE:	MOV #M.LOG2,R1		;NO.
	M.FRAC			;COMPUTE FRACTIONAL PART. RESULT IS IN DEST.
	MOV 2(SP),R0		;LET Y=Y*[LN(2)/2]
	MOV #M.LGB2,R1
	MULF
	MOV 2(SP),R0		;SAVE IT TWICE ON STACK
	M.MOVE
	M.MOVE
	MOV SP,R0		;LET TEM1(STK)=A0-Y
	MOV #M.MA0,R1
	ADDF
	MOV SP,R0
	MOV R0,R1
	NEGF
	INC 12(SP)		;LET NUM(STK)=2Y
	MOV 16(SP),R0
	MOV R0,R1		;LET Y=Y^2
	MULF
;AT THIS POINT DEST =Y^2, AND A0-Y AND 2Y ARE ON STACK
	MOV 16(SP),R0		;LET DEST=DEST+B1
	MOV #M.BB1,R1
	ADDF
	MOV #M.AA1,R0		;MOVE AA1 ON STACK
	M.MOVE
	MOV SP,R0		;LET A1=A1/DEST
	MOV 24(SP),R1
	DIVF
	MOV SP,R0		;LET A1=A1+TEM1(STK). TEM1=A0-Y
	MOV R0,R1
	ADD #6,R1
	ADDF
	MOV SP,R1		;LET NUM(STK)=;A1. NUM=2Y
	MOV R1,R0
	ADD #14,R0
	DIVF
	ADD #14,SP		;POP TO NUM
	MOV SP,R0
	MOV #M.ONE,R1		;LET NUM=NUM+1
	ADDF
	MOV SP,R0
	MOV R0,R1
	MULF			;LET NUM=NUM^2
	MOV SP,R1
	MOV 10(SP),R0		;MOVE NUM TO DEST
	MOVF
	MOV 10(SP),R0		;EXP(DEST)=EXP(DEST)+INT
	ADD 6(SP),4(R0)
	JMP M.OUT
;
;EXPONENTIAL
M.LOG2:	016624,056125,100001	;LOG(2) E
M.LGB2:	005776,054271,077777	;(LN 2)/2
M.MA0:	037347,117741,100004	;-12.015016753875
M.AA1:	041565,132306,100012	;-601.8042666979565
M.BB1:	026570,074056,100006	;60.09019073192600
;
;EVALS A POLYNOMIAL ACCORDING TO PARAMETERS ON THE STACK
;# OF CONSTANTS
;LOC OF X ON STACK
;LOC OF U1 ON STACK;LOC OF DEST ON STACK
;STARTING LOC OF CONSTANTS
MDOPO:	SUB #2,2(SP)
	MOV 10(SP),R0		;LET DEST=DEST*K(1)
	MOV 12(SP),R1
	MOV R0,-(SP)
	MULF
M.LOOP:	ADD #6,14(SP)		;UPDATE CPNSTANT POINTER
	MOV @SP,R0		;DEST = DEST+K(N)
	MOV 14(SP),R1
	ADDF
	TST 4(SP)		;TEST THE COUNTER
	BEQ M.HANK		;IF IT ='S 0 THEN GOTO HANK
	MOV @SP,R0		;DEST=DEST*U
	MOV 10(SP),R1
	MULF
	DEC 4(SP)		;CNTR=CNTR-1
	BR M.LOOP		;LOOP DONE?
M.HANK:	MOV @SP,R0		;YES. DIVIDE BY X
	MOV 6(SP),R1
	MULF
	TST (SP)+
	MOV (SP)+,R3		;SAVE SAVED R5
	ADD #26,SP
	MOV R3,-(SP)
	RTS	PC
;FOLLOWING SUBROUTINE PUSHES THE POINTERS, WHICH ARE
;CONTAINED IN R0 AND R1 ONTO THE STACK, ALONG WITH A FLAG.
;IT ALSO TRANSFERS THE SOURCE FLOATING WORD TO THE DSTINATION
;FLOATING WORD.
MINIT:	MOV (SP)+,R3		;SAVED SAVED R5
	CLR -(SP)		;CLEAR A FLAG
MINI3:	MOV R1,-(SP)		;PUSH ON SOURCE POINTER
	MOV R0,-(SP)		;PUSH ON DEST POINTER
	MOVF			;MOVE SOURCE TO DEST
	MOV	R3,PC		;BOY CAN WE BRANCH FAST
MINI2:	MOV	(SP)+,R3		;GET THE RETURN ADDRESS
	BR	MINI3

;SETS UP DOPOL
;POINTER TO DEST IN R0,# OF CONSTANTS IN R3
;LOC OF FIRST CONSTANT IN R4
;SETS UP STACK IN FOLLOWING MANNER: 
;			STARTING LOC OF CONSTANTS (TOP OF STACK)
;		        LOC  OF DESTINATION
;    		        LOC OF THE CONTENTS OF DESTINATION SQUARED
;		        NUMBER OF CONSTANTS
MSETU:	MOV	(SP)+,R1	;SAVE SAVED R5
	M.MOVE			;SAVE X ON STACK
	MOV R1,-(SP)
	MOV R4,-(SP)
	MOV R3,-(SP)
	MOV R0,-(SP)		;SAVE REGISTERS
	MOV R0,R1
	MULF
	MOV (SP)+,R0
	MOV (SP)+,R3
	MOV (SP)+,R4
	MOV (SP)+,R1
	M.MOVE			;SAVE  X^2 ON STACK
	MOV R4,-(SP)		;PUSH LOC OF CONSTANT POINTER
	MOV R0,-(SP)		;DEST POINTER
	MOV SP,-(SP)		;U1 POINTER
	ADD #6,@SP
	MOV SP,-(SP)		;X POINTER
	ADD #16,@SP
	MOV R3,-(SP)		;CNTR
	MOV	R1,PC		;BRANCH BACK
;COMPUTES THE FRACTIONAL PART OF SOME NUMBER TIMES DESTINATION.
;R1 POINTS TO THE NUMBER
;R0 POINTS TO THE DESTINATION
;COMPUTATION IS DONE AS FOLLOWS: DEST=DEST-INT(DEST)
MFRAC:	MOV 2(SP),R0
	MULF
	MOV (SP)+,2(SP)		;SAVE SAVED R5
	MOV @SP,R1		;PUT DEST POINTER IN R1
	FIXS
	MOV	R0,-(SP)
	MOV @SP,R1		;MAKE R1 POINT TO INT
	SUB #6,SP		;MAKE ROOM FOR THE FLOATED INT WHICH WILL BE PUT THERE
	MOV SP,R0
	FLT			;FLOAT THE INT AND PUT RESULT ON STACK
	MOV SP,R1		;LET DEST=DEST-INT(DEST)
	MOV 10(SP),R0
	SUBF
	ADD #6,SP		;POP PAST FLOATED INT
	MOV 4(SP),-(SP)		;RESTORE SAVED R5
	RTS	PC

USER1	=	.
;DELETE TO HERE IF DELETING JUST EXTRA FUNCTIONS
SINE00:	M.INIT			;CLEAR FLAGS, PUSH POINTERS
M.SIN1:	TST 2(R0)		;TEST Y
	BGE M.NOTN		;Y<0?
	MOV R0,R1
	NEGF			;YES. LET Y=-Y
	INC 4(SP)		;LET NFLAG=1
	BR M.NOTE
M.NOTN:	BNE M.NOTE		;Y=0?
M.EXIT:	ADD #6,SP		;YES. RESTORE SP TO STARTING POSITION
	RTS	PC
M.NOTE:	MOV #M.PIE2,R1		;LET Y=Y*(2/PI)
	M.FRAC			;COMPUTE FRACTIONAL PART. RESULT WILL BE IN DEST
;STACK HAS THE INT PART (NOT FLOATED),AND DESTINATION HAS THE
;FRACTIONAL PART (KNOWN AS F)
	MOV	(SP)+,R2
	BIC #177774,R2		;AND 11(BASE 2) WITH INT
	ASL R2
	ADD #M.TAB,R2		;COMPUTE ADDRESS OF TABLE OF BRANCHES
	MOV	@R2,PC		;BRANCH TO PROPER PLACE
M.Q2:	MOV #M.ONE,R1		;LET F=-(F-1)
	MOV @SP,R0
	SUBF
M.Q3:	MOV @SP,R0		;LET F=-F
	MOV R0,R1
	NEGF
	BR M.EVAL
M.Q4:	MOV #M.ONE,R1
	MOV @SP,R0
	SUBF			;LET F=F-1
;DEST NOW EQUALS X. EVALUATE THE POLYNOMIAL
M.EVAL:	MOV @SP,R0		;GET DEST POINTER
	MOV #M.A11,R4		;POINTER TO CONSTANT TABLE
	MOV #6,R3		;NUMBER OF CONSTANTS
	M.SETU			;SET UP DOPOL
	M.DOPO
	TST 4(SP)		;WAS NFLAG SET?
	BEQ M.EXIT
	MOV @SP,R0
	MOV	R0,R1
	NEGF			;YES. LET DEST=-DEST
	BR	M.EXIT
COS00:	M.INIT			;CLEAR FLAGS, PUSH POINTERS
	MOV #M.PI2,R1	
	ADDF			;LET Y=PI/2+Y
	MOV @SP,R0
	BR M.SIN1
;
;SIN
M.TAB:	M.EVAL,M.Q2,M.Q3,M.Q4
M.PIE2:	140671,050574,100000	;2/PI
M.A11:	017676,106516,077756	;-.00000341817225
	175316,051777,077764	;.00016021713430
	156214,131513,077771	;-.00468162023910
	167376,050632,077775	;.07969258728630
	006165,126521,100000	;-.64596409264401
M.PI2:	166516,062207,100001	;PI/2
ATN00:	CLR -(SP)		;CLEAR NFLAG
	M.INIT			;CLEAR AFLAG,PUSH POINTERS
	TST 2(R0)		;DOES X=0?
	BEQ M.TT9
	BGE M.P2		;X DOESN'T =0. IS  X<0?
	INC 6(SP)		;X IS MINUS. SET NFLAG
	MOV R0,R1		;LET X=-X
	NEGF
M.P2:	MOV #M.ONE,R1		;IS X>1, OR IS  X-1>0?
	MOV @SP,R0
	CMPF
	BGE M.P
	INC 4(SP)		;X IS >1. SET AFLAG
	MOV #M.ONE,R0		;LET X=1/X
	M.MOVE			;MOVE ONE ONTO THE STACK
	MOV SP,R0
	MOV 6(SP),R1
	DIVF
	MOV SP,R1		;MOVE RESULT BACK INTO DEST
	MOV 6(SP),R0
	MOVF
	ADD #6,SP		;POP PAST ONE
M.P:	MOV #M.OT32,R1		;IS X<2-SQT(3), OR IS X-[2-SQT(3)]<0?
	MOV @SP,R0
	CMPF
	BLE M.BR4
	CLR -(SP)		;IT IS. LET C=0
	CLR -(SP)
	CLR -(SP)
	BR M.EVA1
;LET X=[X*SQT(3)-1]/[X+SQT(3)]
;LET C=PI;6
M.BR4:	MOV #M.PI6,R0
	M.MOVE			;MOVE PI6 ONTO THE STACK
	MOV 6(SP),R0
	M.MOVE			;SAVE X ON STACK
	MOV #M.ROT3,R1
	MULF			;LET DEST=DEST*SQT(3)
	MOV 14(SP),R0
	MOV #M.ONE,R1		;LET DEST=DEST-1
	SUBF
;DEST NOW ='S X*SQT(3)-1
;COMPUTE X+SQT(3)
	MOV SP,R0
	MOV #M.ROT3,R1
	ADDF
	MOV 14(SP),R0		;DIVIDE DEST BY X+SQT(3)
	MOV SP,R1
	DIVF
	ADD #6,SP		;POP UP TO C

	.EOT			;END OF TAPE 8
