
;EVAL THE POLYNOMIAL
M.EVA1:	MOV 6(SP),R0		;POINTER TO DEST
	MOV #M.TAB2,R4		;POINTER TOCONSTANT TABLE
	MOV #5,R3		;NUMBER OF CONSTANTS
	M.SETU			;SET UP DOPOL
	M.DOPO
	MOV SP,R1		;LET DEST=DEST+C
	MOV 6(SP),R0
	ADDF
	ADD #6,SP		;POP PAST C
	TST 4(SP)		;AFLAG=0?
	BEQ M.P6
	MOV @SP,R0		;NO.LET DEST=PI/2-DEST
	MOV #M.PI2,R1
	SUBF
	MOV @SP,R0
	MOV R0,R1
	NEGF
M.P6:	TST 6(SP)		;WAS NFLAG SET?
	BEQ M.TT9
	MOV @SP,R0
	MOV R0,R1
	NEGF			;LET DEST=-DEST
M.TT9:	ADD #10,SP
	CLV
	RTS	PC
;
;ARCTAN
M.OT32:	050574,042230,077777	;2-SQRT(3)
M.ROT3:	165640,067331,100001	;SQRT(3)
M.PI6:	044336,041405,100000	;PI/6
M.TAB2:	113440,060462,077775	;.09491954952
	107717,133556,077776	;-.14173460613
	155646,063141,077776	;.19996534780
	131012,125252,077777	;-.33333289364
	177776,077777,100000	;.99999999843
SQRT00:	M.INIT			;CLEAR NFLAG,PUSH POINTERS.
	TST 2(R0)		;IS X<0?
	BEQ	M.BR3
	BGE M.BR1
	INC 4(SP)		;YES .SET NFLAG
	MOV R0,R1
	NEGF			;LET X=-X
M.BR1:	CLR 2(SP)		;CLEAR OFLAG
	MOV @SP,R0
	CMP	(R0)+,(R0)+
	ADD	#100000,@R0
	ASR	@R0		;SHIFT EXP(X) ONCE RIGHT TO SEE IF IS ODD AND
	ADC	2(SP)
	MOV @R0,-(SP)		;TO DIVIDE IT BY TWO. SAVE IT ON STACK
	MOV	#100000,@R0	;LET EXP(X)=0.
	MOV 2(SP),R0		;SAVE X ON THE STACK
	M.MOVE
	MOV #M.BB,R1		;LET X=B*X
	MULF
	MOV 10(SP),R0
	MOV #M.AA,R1		;LET X=X+A
	ADDF
	M.APPR			;DO FIRST APPROXIMATION
	M.APPR			;DO SECOND ITERATION
	M.APPR			;BOY OH BOY ARE WE PRECISE TODAY!
	ADD 6(SP),4(R0)		;ADD SAVED EXPOONENT TO EXP(DEST)
	ADD #10,SP
	TST 2(SP)		;WAS OFLAG SET
	BEQ M.BR2
	MOV #M.ROOT,R1		;YES. MULT BY SQT(2)
	MULF
M.BR2:	TST 4(SP)		;WAS NFLAG SET?
	BEQ	M.BR3
	SQRERR
M.BR3:	ADD	#6,SP
	CLV
	RTS	PC
;SUBROUTINE PERFORMS AN APPROXIMATION
;OF THE FORM Y0=.5(Y0+X/Y0)
;
MAPPR:	MOV	SP,R0
	TST (R0)+		;ADD 2 TO R0
	M.MOVE			;SAVE X ON STACK
	MOV SP,R0		;SET UP DESTINATION
	MOV 20(SP),R1		;SET UP SOURCE
	DIVF			;COMPUTE X/Y0
	MOV SP,R1
	MOV 20(SP),R0
	ADDF			;LET Y0=Y0+X/Y0
	MOV 20(SP),R0
	DEC 4(R0)
	ADD #6,SP
	RTS	PC
;
;SQUARE ROOT
M.ROOT:	074626,055202,100001	;SQRT(2)
M.AA:	125672,065324,077777	;.41730760
M.BB:	067102,045612,100000	;.59016207
;
USER	=	.
;
;
; BASIC INITIALIZATION -- STORED IN USER AREA
;	THIS CODE IS DESTROYED AFTER IT IS USED ONCE AND IS
;	THEREFORE NON-REUSEABLE!!
.	=	USER
;
BASIC:	MOV	ENDUSR,SP	;SET UP TEMPORARY STACK
	CRLF
	MOV	#BAS17,TRP04	;SET UP ILLEGAL MEMORY REF CELL
	MOV	HSR,R1		;SEE IF IT'S THERE
	BR	BAS30		;BRANCH AROUND TO MEMORY TEST
BAS17:	INC	RFLG		;SET LOW SPEED FLAG
BAS30:	MOV	#BAS14,TRP04	;SET A NEW ILLEGAL MEM REF CELL
	CMP	-(SP),-(SP)	;FAKE AN INTERRUPT
	MOV	#160000,R1	;POSSIBLE END OF CORE
BAS14:	CMP	(SP)+,(SP)+	;GET RID OF THE TRAP STUFF
	MOV	-(R1),(R1)	;SEE IF IT'S READ WRITE MEMORY
	SUB	#302,R1		;BE KIND TO THE LOADERS
	MOV	R1,MFLG		;SAVE THE NUMBER FOR LATTER
	MOV	#MSG001,R0	;TYPE OUT THE PREAMBLE TO TELL USER
	BASQ			;TELL USER ABOUT BASIC AND GET HIS RESPONSE
BASIC1:	CMPB	#'L,R2		;LOW SPEED STUFF
	BEQ	BASIC2		;YES
	CMPB	#'D,R2		;DELETE EXTENDED JUNK?
	BEQ	BASIC3		;YES
	CMPB	#'E,R2
	BEQ	BASIC5		;DELETE EXP AND LOG
	CMPB	#'H,R2		;HALT FOR EXF?
	BEQ	BASIC4		;YES
	CMPB	#12,R2		;DONE?
	BEQ	BASIC7		;YES
	TSTCH			;CHECK FOR NUMBER
	BNE	BASIC8		; NOT RECOGNIZED
	DEC	R1		;MOVE POINTER BACK ONE
	ATOI			;CONVERT NUMBER
	MOV	R0,XFLG		;SAVE THE VALUE
BASIC6:	SKIP			;GET A CHARACTER
	CMPB	#12,R2		;QUIT
	BEQ	BASIC7		; IF END OF LINE
	CMPB	#',,R2		;LOOK
	BNE	BASIC6		; UNTIL COMMA FOUND
	SKIP
	BR	BASIC1		;GO BACK TO LOOP WITH NEXT CHARACTER
BASIC2:	INC	LFLG		;SET LOW SPEED READER FLAG
	BR	BASIC6
BASIC5:	INC	EFLG		;DELETE LOG AND EXP
BASIC3:	INC	DFLG		;DELETE THE EXTENDED FUNCTIONS
	BR	BASIC6		;GO BACK TO LOOP
BASIC4:	DEC	FFLG
	BR	BASIC6
BASIC8:	CLR	XFLG		;CLEAR ALL FLAGS
	CLR	LFLG		; IN CASE
	CLR	DFLG		;  HE BLEW
	CLR	EFLG		;   THE SHORT FORM
	CLR	FFLG
	MOV	#MSG005,R0	;ASK ABOUT
	BASQ			;FUNCTIONS
	MOV	R3,DFLG
	BLE	BAS019
	MOV	#MSG003,R0	;ASK ABOUT
	BASQ			; EXP AND LOG
	MOV	R3,EFLG
BAS019:	TST	RFLG		;SEE IF WE EVEN HAVE A HSR
	BNE	BAS010		;IF NON-ZERO WE AIN'T GOT NONE
	MOV	#MSG007,R0	;ASK ABOUT
	BASQ			;   HSR/P
	MOV	R3,LFLG		;SET LSR/P FLAG
BAS010:	MOV	#MSG008,R0	;ASK ABOUT "EXF"
	BASQ
	MOV	R3,FFLG		;YES, WE STOP
	MOV	#MSG011,R0	;ASK HOW MUCH
	PRINTL			;  MEMORY
	PACK			;GET NUMBER
	ATOI			;CONVERT TO INTEGER
	MOV	R0,XFLG		;SAVE VALUE
BASIC7:	ADD	RFLG,LFLG
	TST	LFLG		;IS THE DEVICE LOW SPEED?
	BLE	BAS012		;NO
	MOV	#LSR,DEVLOC	;YES, SET
	MOV	#LSP,SVLOC	;  UP LOW SPEED STUFF
	BR	BAS013
BAS012:	MOV	#HSR,DEVLOC	;SO SET
	MOV	#HSP,SVLOC	; UP HIGH-SPEED STUFF INSTEAD
BAS013:	MOV	MFLG,R1		;GET OUR REAL SIZE
	MOV	XFLG,R0		;SEE WHAT HE TYPED
	BEQ	BAS15		;IF ZERO USE OUR FIGURE
	SWAB	R0		;DO A FAST 8 BIT SHIFT
	ASL	R0		;9 BIT
	ASL	R0		;10 BIT
	ASL	R0		;11 BIT
	BIC	#3777,R0	;MASK TO ZREO
	CMP	R0,#20000	;DIDN'T HE ASK FOR ENOUGH?
	BLO	BASIC8		;NO, ASK AGAIN
	CMP	R0,R1		;SEE WHO TO BELIEVE
	BHI	BAS15		;HE LIES
	MOV	R0,R1		;HE'S QUITE CONSERVATIVE
BAS15:	MOV	R1,SP		;SET UP THE STACK
	MOV	#TRP04+2,TRP04	;NO-OP OUT THE TRAP VECTOR
	MOV	R1,ENDUSR	;SAVE FOR A FATAL ERROR
	MOV	#USER,R1	;SEE WHERE TO PUT HIS TEXT AREA
	TST	DFLG		;TEST DELETE FUNCTIONS FLAG
	BLE	BAS16		;OMIT DELETE IF ZERO
	CLR	BAS99		;DELETE SIN
	CLR	BAS98		;DELETE COS
	CLR	BAS97		;DELETE ATN
	CLR	BAS96		;DELETE SQR
	MOV	#USER1,R1	;SET NEW TEXT AREA
	TST	EFLG		;SEE ABOUT LOG AND EXP
	BLE	BAS16		;BRANCH IF NO ACTION
	CLR	BAS94		;DELETE EXP
	CLR	BAS93		;DELETE LOG
	MOV	#NPWRFE-NPWRF,R0	;SET UP FOR THE MOVE
	ASR	R0		;CONVERT TO WORDS
	MOV	#PWRF00,R1	;DESTINATION
	MOV	#NPWRF,R2	;SOURCE
BAS18:	MOV	(R2)+,(R1)+	;MOVE A WORD
	DEC	R0		;DECREMENT COUNTER
	BGT	BAS18		;LOOP IF  MORE TO DO
BAS16:	TST	FFLG		;EXF?
	BGE	BAS19		;NO
	MOV	#BAS22,USRRET+2	;YES, SET USER RETURN ADDRESS
	MOV	R1,CTRLP	;SAVE IN TEMPORY
	HALT
BAS22:	MOV	CTRLP,R1	;RESTORE THE VALUE OF R1
	MOV	#EXF02-EXF00,R0
	ASR	R0		;FROM BYTES TO WORDS IN ONE EASY LESSON
	MOV	#EXF00,R2	;SET UP FOR TRANSFER
	MOV	R1,GTP25	;TELL BASIC
	MOV	R1,GTP26	; WHERE "EXF" WILL BE
	MOV	#EXF01-EXF00,R3	;ALSO COMPUTE
	ADD	R1,R3		; THE RETURN ADDRESS
	MOV	R3,USRRET+2	;  AND SET IT UP
BAS20:	MOV	(R2)+,(R1)+	;MOVE A WORD
	DEC	R0		;DECREMENT COUNTER
	BGT	BAS20
	MOV	USRLOC,SP	;SET UP END OF USER STORAGE
	MOV	SP,ENDUSR	;TO BEGINNING OF USER FUNCTION
	BR	BAS21
BAS19:	CLR	BAS91
BAS21:	MOV	R1,USR		;SET UP USER AREA
	MOV	USR,R5		;SET UP START OF USER TEXT
	MOVB	#12,(R5)+	;AT THIS POINT
	CLR	CTRLP		;TURN OFF ^P
	JMP	INIT00
BASX:	PRINTL			;PRINT A LINE ASK FOR A RESPONSE
	PACK 			;AND SET R3=1 FOR NO
	SKIP			;-1 FOR YES OR 0 FOR OTHER
	CLR	R3		;CLEAR R3 FOR LATER
	CMPB	R2,#'Y		;SEE IF ITS A Y
	BNE	BASX1
	DEC	R3		;SET R3 TO -1
BASX2:	RTS	PC		;AND RETURN
BASX1:	CMPB	R2,#'N		;CHECK FOR A N
	BNE	BASX2		;EXIT IF OTHER
	INC	R3		;SET R3 TO 1
	RTS	PC
NPWRF:	MOV	R0,-(SP)	;SAVE THE DEFA
	M.MOVE			;PUSH THE DEFA
	MOV	R1,R0		;SET UP TO PUSH THE SEFA
	M.MOVE
	MOV	#M.ONE,R1
	MOV	14(SP),R0
	MOVF
	MOV	SP,R0		;SINCE THE ENGINEERS SCREWED UP
	MOV	R0,-(SP)	;LET'S NOT US DO IT TOO
	MOV	R0,-(SP)	; THIS IS EQUIVALENT TO MOV SP,-(SP)
	ADD	#6,(SP)		;ADJUST TO THE NUMBER
	MOV	2(SP),R0	;GET THE ADDRESS OF THE EXOPNENT
	MOV	R0,R1		;MAKE SEFA=DEFA
	JSR	PC,@#INT00	;CONVERT IT TO AN INTEGER
NPWRF0:	TST	6(SP)		;SEE IF POS OR NEG
	BGT	NPWRF1		;BRANCH IF POSITIVE
	BLT	NPWRF2		;BRANCH IF NEGATIVE
	ADD	#22,SP		;WHEN ZERO FINISH UP
	CLV
	RTS	PC
NPWRF1:	MOV	(SP),R1		;GET THE NUMBER ADDRESS
	MOV	20(SP),R0	;GET THE DEFA
	MULF
	MOV	#M.ONE,R1	;GET ADDR OF 1.
	MOV	2(SP),R0	;GET ADDR OF THE COUNT
	SUBF
	BR	NPWRF0		;LOOP FOR MORE
NPWRF2:	MOV	(SP),R1		;GET THE NUMBER ADDRESS
	MOV	20(SP),R0	;GET DEFA
	DIVF
	MOV	#M.ONE,R1	;GET ADDR OF 1.
	MOV	2(SP),R0	;GET COUNT ADDRESS
	ADDF
	BR	NPWRF0		;LOOP FOR MORE
NPWRFE	=	.
;
EXF00:	ADD	#10,SP		;DISCARD GENERALIZED STUFF
	MOV	R1,R0		;SOURCE POINTER TO R0
	MOV	(SP)+,R1	;TEXT POINTER TO R1
	MOV	@#USRLOC,R2	;GO DO
	JMP	@R2		; THE USER ROUTINE
EXF01:	MOV	(SP)+,R2	;GET
	MOV	(SP)+,R3	; VALUE
	MOV	(SP)+,R4	;  OF THE FUNCTION
	JMP	@#GTP24		;    AND RETURN TO BASIC
EXF02	=	.
LOCTMP	=	.
.	=	WORK


;	THIS MESSAGE GOES INTO THE WORKING STORAGE

MSG001:	.ASCII	/PDP-11 BASIC, VERSION 007A/
	.BYTE	15,12
	.ASCII	/*O /
	.BYTE	0
.	=	LOCTMP
MSG003:	.ASCII	/DO YOU REQUIRE EXP OR LOG (FLOATING ^)?/
	.BYTE	0
MSG005:	.ASCII	/DO YOU NEED THE EXTENDED FUNCTIONS?/
	.BYTE	0
MSG007:	.ASCII	\HIGH-SPEED READER/PUNCH?\
	.BYTE	0
MSG008:	.ASCII	/SET UP THE EXTERNAL FUNCTION?/
	.BYTE	0
MSG011:	.ASCII	/MEMORY?/
	.BYTE	0
	.EVEN
XFLG:	0		;STORAGE SPECIFIED IF NON-ZERO
LFLG:	0		;FORCE LSR IF NON-ZERO
DFLG:	0		;DELETE TRANSCENDENTALS IF NON-ZERO
EFLG:	0		;DELETE EXP AND LOG, TOO IF NON-ZERO
FFLG:	0		;SET UP THE EXTERNAL FUNCTION
MFLG:	0		;THE REAL MEMORY SIZE
RFLG:	0		;DO WE HAVE A HSR?
	.END	BASIC		;END OF TAPE 9
x*U*2