*20
/
/DBLFLT3
/
/A PACKAGE OF MATHEMATICAL ROUTINES
/  IN DBLFLT FORMAT
/  DESIGNED FOR INTER-MEMORY-SEGMENT USE
/	BY PAUL F. SULLIVAN
/	AND RAYNA B. COLE
/	NASA ELECTRONICS RESEARCH CENTER
/	CAMBRIDGE, MASS.
/
/THE CENTRAL MATH PROGRAM IS DBLFLT1
/	BY MICHAEL MCDONALD
/	BIOMEDICAL COMPUTOR LAB.
/	WASHINGTON UNIVERSITY
/	ST. LOUIS, MO.
/
/REVISED FOR PDP-12
/	BY D.A.OVERTON, 7-7-70
/
/FOR INSTRUCTIONS SEE
/	DECUS 12-7 DOCUMENT
/
/DBLFLT3 HAS 2 PARTS: DBLFLTA ? DBLFLTB
/	DBLFLTA FILLS SEGMENT SEGA
/	DBLFLTB FILLS 2/3 OF SEGMENT SEGB
/
/BOTH MAY BE OUTSIDE THE CALLING PROGRAM
/  INSTRUCTION FIELD. THEY ARE REACHED
/  VIA DBL3GO WHICH MUST BE INCLUDED
/  IN EACH CALLING PGM INSTRUCTION FIELD
/
/MEMORY SEGMENT ASSIGNMENTS:
/(CHANGE THESE EQUALITIES TO RELOCATE PGRM)
/FOR DBLFLTA
	SEGA=3
/FOR DBLFLTB
	SEGB=1
/
/
/DBLFLTA STARTS HERE:
/USES IR. 1-5 ? 12-17
/
	SEGMNT SEGA  /SEG 3 UNLESS MOVED
	*20
/
/DBLFLTA CONTROL PROGRAM:
/BY P.F.SULLIVAN
/ MODIFIED BY D.A.OVERTON
/SUPERVISES COMMUNICATIONS BETWEEN
/ CALLING PGMS AND DBLFLTA ROUTINES
/ USES IR. 4,5,12 ? 17
/ TAKES 0.25 MILLISEC.
/
/ENTRY POINT:
ENTERA,	STC V3	/SAVE ACC.
/COMPUTE FIELDS SET PRIOR TO ENTRY TO DBL3GO
	IOB
	6234	/RIB - SAVE FIELD REG.TO ACC.
	ROL 2	/PUT INST FIELD
	SCR 5	/ IN RIGHT 5 BITS
	ADA I	/MAKE LIF INST
	LIF
	STC V4+4 /SAVE FOR RTN TO CALLING PGM
	IOB
	6214	/RDF - READ DATA FIELD
	SCR 1	/PUT IN RIGHT 5 BITS
	ADA I	/MAKE LDF INST
	LDF
	STA	/SAVE FOR RTN TO CALLING PGM
	V4+3
	STC V3+1 /SAVE FOR DBLFLTA OPERATION
	ADD V4+4 /WHAT FIELD CALLED DBLFLTA?
	ADA I	/MAKE LDF INST
	LDF-LIF
	STC .+1
V1,	0	/SET DATA FIELD TO CALLING PGM
	STC 12	/CLEAR LOCATION 12
/SAVE .+1 RTN JMP LOCATION
	SET 17
	2\0
	ADD 17
	STC V1
/FIND DBLFLTA ENTRY POINT
	LDA	/HOW MANY OF XSK I 17?
	2\17
	ADA I
	LISTA
	STC .+2
	LDA	/GET JMP FROM LIST
V6,	0
	STC V3+3
/CLEAR IR.17 IN CALLING SEGMENT
	STA
	2\17
/SETUP TO TRANSFER ARGUMENTS, IF ANY
	SET I 4 /TRANSFER 3 ARGS. (MAX.)
	-3
	SET I 5 /INTO V3+4, V3+5, ? V3+6
	V3+3
/IS IT AN ARGUMENTED INSTRUCTION?
	ADD V6
	ADA I	 /THERE ARE 8 ARGUMENTED
	-LISTA-7 / ENTRIES IN LISTA TO LISTA+7
	APO I	 /ARGUMENTED ?
	JMP V3-6 /NO
/YES: TRANSFER ARGUMENTS
	LDA 17	/GET 1ST ARGUMENT
	STA I 5	/? STORE IT
	APO	/LAST ARGUMENT?
	JMP V3-3 /YES
	LDA I 17 /NO: GET NEXT ARGUMENT
	XSK I 4  /4TH ARGUMENT?
	JMP .-5	 /NO: STORE IT
	JMP V3-1 /YES: IGNORE IT ? GO ON
/FILL BLANKS WITH ADDRESS COUNTING INSTRUCTS.
	LDA I
	XSK I 12
	STA I 5
	XSK I 4	/3RD BLANK FILLED?
	JMP .-4	/NO:FILL ANOTHER WITH XSK I 12
/JUMP TO DBLFLTA ROUTINE
	LDA I	/RESTORE ACC.
V3,	0
	LDF	/RESTORE DATA FIELD
	NOP	/PATCH HERE TO CHANGE DATA FLD
	JMP	/JMP TO DESIRED DBLFLT ROUTINE
	0	/A  (ARGUMENT, OR XSK I 12)
	0	/B	"	"
	0	/C	"	"
	XSK I 12 /EXTRA XSK FOR COMPARE RTN
	STC V3	/SAVE ACC.
	ADD DC6+4 /ADD NOP
	STC V3+2 /REMOVE LDF PATCH, IF ANY
/CALCULATE RTN JMP TO CALLING PGM
	ADD 12	/NUMBER OF XSK I 12
	COM
	ADD DC10 /ADD 4
V4,	ADD V1	/ADD .+1 RTN JMP
	STC .+4
	ADD V3	/RESTORE ACC.
	LDF	/RESTORE DATA FIELD
	LIF	/CALLING PGM INST.FIELD
	JMP	/RTN TO CALLING PGM
	/END DBLFLTA CONTROL PGM
/
/COMPARE :
/BY P.F.SULLIVAN AND R.B.COLE, 10-28-68
/COMPARES TWO NUMBERS, A AND B
/ENTER VIA: JMP COMPRA
/ FOLLOWED BY 1 OR 2 ARGUMENTS
/RETURNS TO:
/ .+1 FOR A=B
/ .+2 FOR A>B
/ .+3 FOR A<B
/USES IR.1-3
/
COMPRA,	CLR	/CLEAR ACC
	ADD 0	/PUT RTN ADDRESS IN ACC
	JMP SETUP /USE DBLFLT1 SETUP
	SET 3 /PUT RTN ADDRESS IN IR.3
	DT7
	LDA I 2	/GET MOST SIG.PART OF B
	BCO I 1
	APO I /DO A ? B HAVE SAME SIGN ?
	JMP .+3	/YES, WHAT IS IT?
	LDA 2 /NO, PROBLEM SOLVED. GET B
	JMP COMPR2 /CHECK ITS SIGN
	LDA 1	/GET MOST SIG.PART OF A
	APO I	/ARE THEY POSITIVE?
	JMP .+4/YES,DO DIRECT COMPARISON
	LDA I  /NO, DO COMPLEMENTARY COMPARISON
	COM
	JMP .+3
	LDA I 
	NOP
/SET POINTERS TO A AND B
	SET I 2
	ARG2-1
	SET I 1
	ARG1-1
	JMP COMPR1 /COMPARE EXPONENTS
	ADD .-6 /NOP,FOR DIRECT COMPARISON
	JMP COMPR1 /COMPARE MOST SIG. PARTS
	ADD DD5+3 /ROR 1,TO RELOCATE SIGN BIT
	JMP COMPR1 /COMPARE LEAST SIG.PARTS
	JMP 3	/A=B, RTN TO .+1
COMPR1,	STC COMPR2-1 /SET COMPARISON TYPE
	LDA I 1	/SUBTRACT WORD OF A
	COM
	ADA I 2 /FROM WORD OF B
	AZE I	/DOES ACC =0?
	JMP 0	/YES, TRY AGAIN
	FLO I	/NO, WAS THERE OVERFLOW?
	COM	/YES: CORRECT THE SIGN
	0	/ADJUST SIGN
COMPR2,	APO I	/IS ACC>0?
	XSK I 3 /YES, THEN A<B
	XSK I 3 /NO, THEN A>B
	JMP 3	/RTN
	/END COMPARE
/
/DECIMAL TTY INPUT CONVERSION
/BY MICHAEL MCDONALD
/ MODIFIED FOR PDP12 BY D.A.OVERTON
/ACCEPTS THE NUMBER XYZ IN THESE FORMATS
/	XYZ
/	XYZ.
/	XYZ.0
/	XY.Z00 E+1
/	.XYZ E3
/	XYZ0 E-1
/GENERATES DBLFLT NO. IN FAC
/ENTER VIA: JMP TTYINA
/  WITH THE 1ST 8-BIT ASCII CHARACTER
/  IN THE AC. OR WITH AC=0
/RTNS TO .+1 ON RUBOUT
/ .+2 OTHERWISE
/USES I.R.13-17, TEM1, TEM2, TEM3, FAC
/USES DBLFLT1,TELETYPE,TTYOUT, 10 TO N
/
TTYINA,	SET 15	/SAVE RTN JMP
	0
	STC TM3	/SAVE CHAR
	ADD TTYOUA+5 /ALTER FOR FIXING
	STC FIXA+7 / WITHIN 11 BITS
	SET I 14 /INDICATOR FOR NO E YET
	-0
	ADD TM3	 /GET CHAR
TB3,	SET I 13 /SET INDICATOR FOR
	-0	 / NO DECIMAL POINT YET
	STC TD3	/SAVE CHAR
	STC 16	/16=+0 INDICATES NO - SIGN
	JMP TRANSA /PUT 0 INTO FAC
	DC0	/ WHERE INPUT NUMBER
	-FAC	/ WILL BE ACCUMULATED
	JMP TRANSA /PUT 10.0 INTO TEM1
	DC10
	-TEM1
	ADD TD3	/GET CHAR
TC3,	STA I	/SAVE CHAR
TD3,	0
	SAE I
	377	/IS IT RUBOUT ?
	SKP
	JMP TS3	/YES: EXIT AT .+1
	SAE I
	215	/IS IT RETURN ?
	SKP
	JMP TG3	/TERMINATE ON RETURN
	JMP TTYP8  /PRINT CHAR
	ADD TD3	/RELOAD CHAR
	SHD I
	5500	/IS IT - ?
	SET I 16 /YES:SET 16 NEGATIVE ON -
	JMP .+1
	SHD I
	5600	/IS IT . ?
	XSK I 13 /YES: BUMP 13 FROM -0 ON .
	SAE I
	305	/IS IT E ?
	JMP TF3 /NO
	XSK I 14 /YES:BUMP 14 FROM -0 ON E
	JMP TRANSA /MOVE NUMBER INTO TEM3
	-TEM3
	ADD 16	/SAVE INDICATOR OF SIGN
	STC TM3	/ OF MANTISSA
	JMP TKBDI8 /GET 1ST CHAR OF EXPONENT
	JMP TB3
TF3,	ADA I	/IS IT A LEGAL DIGIT ?
	-271
	APO I	/ < 272 ?
	JMP TE3+4 /NO: IGNORE IT
	ADA I
	12
	APO	/ > 257 ?
	JMP TE3+4 /NO: IGNORE IT
	LDA
	TD3
	BCL I	/YES:MAKE BINARY
	7760
	STC TEM2+2 /SAVE IT
	STC TEM2+1 /	"
	JMP FLOATA /FLOAT DIGIT
	-TEM2
	XSK 13	/DECIMAL PT. INPUT YET?
	JMP TE3+6 /YES
TE3,	JMP MULTA /NO:MUL.CURRENT SUM BY 10
	-DC10
	JMP ADDTA /ADD CURRENT DIGIT TO SUM
	-TEM2
	JMP TKBDI8 /NEXT CHAR
	JMP TC3
	JMP DIVIDA /AFTER DECIMAL POINT,
	TEM2	/ DIVIDE DIGIT BY TEM1
	TEM1	/ WHICH CONTAINS A POWER OF 10
	TEM2
	JMP MULTA /INCREASE POWER OF 10
	TEM1	/ IN TEM1 BY 1
	DC10
	TEM1
	JMP TE3+2
TG3,	XSK 14	/HAS E BEEN INPUT?
	JMP TI3	/YES
TH3,	CLR	/NO
	ADD 16
	APO I	/IS NO. TO BE + OR - ?
	JMP TI3-2 /+
	SET I 1	  / -, SO COMPLEMENT FAC
	FAC
	JMP COM1A
	XSK I 15
	JMP TS3	/NORMAL EXIT AT .+2
TI3,	JMP FIXA /FIX EXPON.
	-FAC
	AZE	/DID IT WORK
	HLT	/OVERFLOW HLT - TOO BIG TO FIX
	ADD FAC+1 /PUT FIXED EXP.IN TEM2
	STC TEM2
	ADD 16	/PUT INDICATOR OF SIGN
	STC L4	/ OF EXPON. IN L4
TJ3,	JMP TENH4 /RAISE 10 TO POWER IN TEM2
	JMP MULTA /MULTIPLY NO. IN TEM3
	TEM3	/ BY THIS POWER OF 10
	-TEM1	/ RESULT LEFT IN FAC
	ADD TM3	/GET INDICATOR OF MANTISA SIGN
	JMP TH3+2
TS3,	LDA I	/RESTORE FIX ROUTINE
	-27
	STC FIXA+7
	JMP 15	/EXIT
	/END DECIMAL TTY INPUT
/
/DECIMAL TTY OUTPUT CONVERSION
/ FOR ASR33 TELETYPE
/BY MICHAEL MCDONALD
/ MODIFIED FOR PDP-12 BY D.A.OVERTON
/TYPES DBLFLT NUMBERS IN THE FORMAT:
/   +/- X.XXXXXX  E +/- YYY
/ENTER VIA: JMP TTYOUA
/  WITH THE NUMBER TO BE TYPED IN FAC
/RTNS TO .+1
/USES I.R. 13-17, TEM1, TEM2, TEM3, FAC
/USES DBLFLT1, TELETYPE, TTYIN, 10 TO N
/
TTYOUA,	SET 15	/SAVE RTN JMP
	0
	JMP TRANSA /MOVE NO. TO TEM3
	-TEM3
	LDA I	/ALTER FOR FIXING
	-13	/ WITHIN 11 BITS
	STC FIXA+7
	SET I 14 /7 DIGITS TO BE PRINTED
	-7
	SET I 13 /INDICATES DECIMAL PT.
	-0	 / IS NOT YET PRINTED
	ADD TEM3+1 /MOST SIG.PART OF MANTISSA
	AZE I	/DOES NUMBER = 0 ?
	STC TEM3 /YES: SET EXPON. TO 0
	CLR
	ADD TEM3 /GET EXPON.
	STA	/SETUP TO FLOAT EXPON.
	FAC+2
	SCR 13
	STC FAC+1
	JMP FLOATA /FLOAT EXPON.
	-FAC
	JMP MULTA /MULTIPLY EXPON. BY
	-DCLOG2	/ LOG BASE 10 OF 2.
	JMP FIXA/FIX AND SAVE THE RESULT
	-FAC	/ [THE APPROXIMATE POWER
	ADD FAC+1/OF 10 IN X HAS BEEN
	STA I	/ FOUND SINCE:  LOG X =
		/ (EXP.)LOG2 + LOG(FRACTION)].
TM3,	0
	STC L4
	ADD TEM3+1 /GET HALF OF MANTISSA
	ROL I 1	 /SIGN TO LINK
	LDA I
	253	/ "+"
	LZE	/NEGATIVE ?
	ADD T0002 /YES: CHANGE + TO -
	JMP TTYP8 /PRINT + OR -
	ADD TM3	/PUT ABS. VALUE
	APO	/ OF POWER OF 10
	COM	/ INTO TEM2
	STC TEM2
	JMP TENH4 /RAISE 10 TO THIS POWER
	SET I 1	/SET 1 TO L(X)
	TEM3	/	"
	JMP ABS1A /TAKE ABS. VALUE OF X
	SET I 16 /SET COUNTER TO 0
	0
TN3,	JMP SUBTA /SUBTRACT POWER OF 10
	TEM3	/ FROM X
	TEM1	/ SAVE IN TEM2
	TEM2
	ADD TEM2+1
	APO	/IS RESULT NEGATIVE ?
	JMP TO3	/YES, GO TO PRINT DIGIT
	CLR	/NO
	ADD 16
	SHD I	/IS COUNTER AT 9 ?
	1100
	JMP TO3	/YES: PRINT DIGIT
	XSK I 16 /NO: BUMP COUNTER
	JMP TRANSA /REPLACE X BY
	TEM2	/ X MINUS POWER OF 10
	-TEM3
	JMP TN3
TO3,	CLR
	ADD 16
	AZE    /IS DIGIT FROM COUNTER 0?
	JMP .+6 /NO: PRINT
	XSK 13  /DECIMAL PT. PRINTED?
	JMP .+4	/YES:PRINT
	ADD TEM3+1 /NO
	AZE	/IS X = 0.0?
	JMP TQ3-4 /NO
	JMP TYPDIG /PRINT DIGIT
	XSK 13	/DECIMAL PT. PRINTED?
	JMP TP3	/YES
	LDA I	/NO: PRINT DECIMAL PT.
	256	/ "."
	JMP TTYP8
	XSK I 13 /SET DECIMAL PT.INDICATOR
TP3,	XSK I 14 /ALL DIGITS PRINTED?
	JMP TQ3	/NO: CONTINUE
	SRO I	/YES: BEEN HERE BEFORE?
	5252
	JMP TS3	/YES: EXIT AT .+1
	LDA I	/NO: PRINT E
	305
	JMP TTYP8
	SET I 14 /EXP. HAS 3 DIGITS
	-3
	ADD TM3	/PREPARE TO FLOAT
	STA	/ POWER OF 10
	TEM3+2
	SCR 13
	STC TEM3+1
	JMP FLOATA /FLOAT POWER OF 10
	-TEM3	/ LEAVE IN TEM3
	LDA I	/SET APPROX HIGHEST PWR
T0002,	2	/ OF 10 FOR EXP. TO 2
	JMP TM3-1 /CONTINUE PRINTING
	CLR
	ADD TM3	/LOWER APPROX PWR OF 10 BY 1
	ADD DL7
	STC TM3
TQ3,	JMP DIVIDA /DIVIDE POWER OF 10
	TEM1	/ IN TEM1
	DC10	/ BY 10
	TEM1
	JMP TN3-2
	/END DECIMAL TTY OUTPUT
/
/10 TO N
/COMPUTES 10 TO THE POWER N
/BY MICHAEL MCDONALD
/ MODIFIED BY D.A.OVERTON
/N IS A 12-BIT FIXED POINT NUMBER
/ SMALLER THAN +/- 1000 (OCTAL)
/ENTER AT TEN2NA WITH N IN ACCUMULATOR
/OR AT TENH4 WITH \N\ IN TEM2 ? SIGN IN L4
/RTNS TO .+1
/ WITH FLOATED RESULT LEFT IN TEM1
/USES IR.17 TEM1, TEM2, FAC
/
TEN2NA,	STA	/SIGN INTO L4
	L4
	APO	/  \N\ INTO TEM2
	COM
	STC TEM2
TENH4,	SET 17	/SAVE RTN
	0
	JMP TRANSA /SET FAC=10
	DC10
	-FAC
	JMP TRANSA /SET TEM1=1
	DC1
	-TEM1
TENI4,	ADD TEM2 /GET FIXED POINT EXPONENT (N)
	AZE I	/IS IT 0?
	JMP TENM4 /YES:
	SCR I 1 /NO: EXAMINE NEXT BIT
	STC TEM2
	LZE I	/IS BIT A 0?
	JMP TENJ4 /YES
	JMP MULTA /NO:MULT. TEM1 BY FAC
	TEM1
	FAC
	TEM1
TENJ4,	JMP MULTA /SQUARE FAC
	-FAC
	JMP TENI4 /TEST NEXT BIT OF EXP.
TENM4,	ADD L4	/FINISHED. NOW FIX SIGN
	APO I	/IS SIGN POSITIVE?
	JMP .+5	/YES: EXIT
	JMP DIVIDA /NO:DIVIDE
	DC1	/ 1.0 BY
	TEM1	/ CALCULATED POWER OF 10
	TEM1
	JMP 17 /EXIT WITH POWER OF 10 IN TEM1
	/END 10 TO N
/
/TELETYPE ROUTINE
/D.A.OVERTON, 9-9-70
/USES IR.4
/
/JMP TKBDI8:
/  WAITS FOR CHAR
/  RTNS WITH 8-BIT ASCII IN AC
TKBDI8,	SET 4	/SAVE RTN
	0
	LDA I	/SET UP TO WAIT FOR CHAR
	JMP .+7
	JMP .+5
/JMP TKBD8:
/  RTNS WITH 8-BIT ASCII IN AC
/  OR WITH AC=0 IF NO CHAR IS WAITING
TKBD8,	SET 4
	0
	LDA I	/SETUP TO RTN
	JMP 4
	STC .+2
	KST	/CHAR ?
	JMP	/NO:RETURN OR WAIT
	IOB	/YES:READ IT
	6036	/KRB
	JMP 4	/RETURN
/
	100	/CONSTANTS FOR TYP6
	200
/JMP TYPDIG: WITH BINARY IN AC.
TYPDIG,	ADA I
	60
/JMP TTYP6: WITH 6-BIT ASCII IN ACC.
TTYP6,	STA I
	0	/SAVE ASCII
	BCL I
	7737
	AZE I	/ADD 200 OR 300?
	ADD .-11
	ADD .-11
	BCL I	/CLEAR BIT 6
	40
	ADD .-10  /ADD IN BITS 6-11
/JMP TTYP8: WITH 8 BIT ASCII IN AC.
TTYP8,	SET 4
	0
	IOB
	6046	/TLS
	IOB
	6041	/TSF
	JMP .-2 /WAIT FOR FLAG
	CLR
	JMP 4	/RTN
	/END TELETYPE
/
/
/DBLFLT1
/FROM DBLFLT BY MICHAEL MCDONALD
/USES IR.1-5
/
/ADDITION
ADDTA,	CLR
	ADD 0
	JMP SETUP
	LDA 1
	COM
	ADA 2
	FLO
	JMP .+4
	SCR 14
	BCO I
	7737
	SCR I 1
	ROL I 1
	LZE I
	COM
	STC DM7+1
	JMP DI6
	LZE
	JMP DH6
	LDA 1
	STA 3
	LDA I 2
	STA I 3
	LDA I 2
	STA I 3
	JMP DM7
	JMP DH7
	JMP DI7-2
	JMP DG6
	LDA I 3
	JMP DC6+2
	SET 1
	DG6+1
	JMP ABS1A
	JMP EXIT
/SUBTRACTION
SUBTA,	CLR
	ADD 0
	JMP SETUP
	JMP DI6+2
	JMP COM1A
	JMP DH6
	JMP ADDTA+3
/MULTIPLY
MULTA,	CLR
	ADD 0
	JMP SETUP
	LDA 1
	ADA 2
	JMP DE6+1
	STC DE5
	JMP DC6
	JMP DI6+2
	JMP ABS1A
	JMP DH6
	JMP DD6
	LDA I 2
	LDA I 2
	ROR 1
	STA 2
	JMP DH6
	LDA I 1
	MUL I 2
	STA 3
	QAC
	STA I 3
	LDA I 1
	ROR 1
	MUL I 2
	ROL 1
	STA I 3
	JMP DH6+2
	LDA I 1
	MUL 2
	JMP DF5
DD5,	JMP DH6
	LDA I 1
	LDA I 1
	ROR 1
	MUL I 2
	JMP DF5
	JMP DG6
	LDA I 3
	LDA I 3
	ROL I 1
	ROL 1
	BCL I
	7776
	STC DP7
	JMP DG6
	LDA I 3
	ROL I 1
	STA I 3
	JMP DG6
	LDA 3
	STA I 3
	JMP DG6
	LDA I
DE5,	0
	STA 3
	JMP EXIT
DF5,	STC ARG1
	JMP QAC12
	STC ARG1+1
	SET I 1
	ARG1-1
	JMP DG6
	JMP DH7
	SET I 2
	-0
	JMP DI7
	SRO I
	2525
	JMP DD5
	JMP DD5+6
/DIVISION
DIVIDA,	CLR
	ADD 0
	JMP SETUP
	ADD DK7
	STC DJ5+1
	LDA I 2
	AZE I
	HLT
	JMP DH6
	LDA 2
	COM
	ADA 1
	JMP DE6+1
	JMP DC6
	JMP DH6+2 
	JMP ABS1A
	JMP DI6+2
	JMP ABS1A
	JMP DH6
	LDA I 1
	STA I 3
	LDA I 1
	STA I 3
	LDA I 2
	COM
	STC ARG1+1
	LDA I 2
	COM
	STC ARG1+2
	STC ARG1
	STC ARG2
	SET I 2
	ARG1-3
DH5,	JMP DH6+2
	JMP .+2
DI5,	JMP DI6+2
	JMP DH7
DJ5,	SRO I
	1
	JMP DM5
	SET I 5
	-0
	JMP DG6
	LDA I 3
	AZE
	JMP DK5-3
	LDA I 3
	AZE I
	JMP DK5+2
	CLR
	JMP DG6
	LDA I 3
DK5,	APO
	JMP DL5
	LDA 2
	BSE
	DJ5+1
	STA 2
	XSK I 5
DL5,	SET 1
	DG6+1
	JMP DG6
	JMP DH7
	XSK 5
	JMP DH5
	JMP DI5
DM5,	XSK I 2
	XSK I 2
	XSK I 2
	SRO I
	3333
	JMP DJ5+3
	JMP DG6
	CLR
	ADD ARG1
	STA I 3
	CLR
	ADD ARG2
	STA I 3
	JMP EXIT
/MOVE VIA. IR.1?2
MOVE12,	LDA 1
	STA 2
	LDA I 1
	STA I 2
	LDA I 1
	STA I 2
	LDA I 1
	LDA I 2
	CLR
	JMP 0
/MQ TO ACC.
QAC12,	QAC
	ROL 1
	QLZ
	ADD DK7
	JMP 0
/COM SETUP
DC6,	LDA I 1
	BCO I 2
	ROL I 1
	LDA I
	NOP
	LZE
	ADD .+3
	STC DS7
	JMP 0
	JMP COM1A-NOP
/COMPLEMENT
COM1A,	SET I 2
	-0
/ABSOLUTE VALUE
	SKP
ABS1A,	SET I 2
	NOP
DD6,	LDA I 1
	SCR I 1
	ROL I 1
	XSK 2
	LZE
	COM
	STA 1
	LDA I 1
	XSK 2
	LZE
	COM
	STA 1
	LDA I 1
	CLR
	JMP 0
/OVERFLOW CHECK
DE6,	ADA 3
	AZE I
	CLR
	STA 3
	FLO
	JMP 0
	APO
	HLT
/SET RESULT=0
DF6,	JMP DG6
	LDA I
	-3777
	STA 3
	CLR
	STA I 3
	STA I 3
	JMP DT7
/SET IR.3
DG6,	SET I 3
	0
	JMP 0
/SET IR.1?2 NORMAL
DH6,	SET I 2
	4\ARG2	
	SET I 1
	ARG1	
	JMP 0
/SET IR.1?2 REVERSE
DI6,	SET I 2
	ARG1	
	SET I 1
	ARG2	
	JMP 0
/STANDARD SETUP
SETUP,	BCL I
	6000
	STC 4
	ADD 0
	STC DE7
	LDA 4
	JMP DG7
	JMP DF7
	STC DC7
	LDA I 4
	JMP DG7
	JMP DE7+1
	STC DD7
	LDA I 4
	JMP DG7
	NOP
	STC DG6+1
DB7,	JMP DI6
	SET I 1
DC7,	0
	JMP MOVE12
	SET I 1
DD7,	0
	JMP MOVE12
	XSK I 4
	ADD 4
	ADD SETUP+1
	STC DT7
	STC DP7
	JMP DG6
	JMP DH6
DE7,	JMP
	STC DD7
	ADD DF7+2
	JMP DB7-1
DF7,	STC DD7
	LDA I
	FAC
	STC DC7
	JMP DE7+2
/TEST ARGS.
DG7,	APO I
	XSK I 0
	APO
	COM
	ADA I
	-17
	SCR I 1
	ROL I 1
	ADD DG7+3
	LZE I
	JMP 0
	STC 1
	LDA 1
	ADD DS7-1
	STA 1
	ADA I
	-3
	JMP 0
/ADD 1 TO 3
DH7,	SET 4
	0
	CLR
	JMP DG6
	LDA I 1
	STC DJ7
	LDA I 3
	STC DJ7+2
	LDA 1
	LAM 3
	LDA I 1
	LAM I 3
	JMP DG6
	STC 0
	LAM I 3
	STC 0
	LAM I 3
	JMP 4
	SET I 2
	0
/ADD OVERFLOW CHECK
DI7,	SET 1
	0
	JMP DG6
	LDA I
DJ7,	0
	BCO I
	0
	APO
	JMP 1
	LDA I 3
	BCO
	DJ7
	APO I
	JMP 1
	JMP DG6
	LDA I
DK7,	1
	JMP DE6
	LDA I
DL7,	-1
	XSK 2
	JMP DM7+2
	ADD DP7
	XSK 2
	COM
	STC DP7
	JMP DG6
	LDA I 3
	BCO I
	4000
	STA 3
	JMP 1
/SCR N 3
DM7,	LDA I
	0
	SET 2
	0
	AZE I
	JMP 2
	STC 5
	SET I 4
	-30
DO7,	CLR
	JMP DG6
	LDA I 3
	SCR I 1
	STA 3
	LDA I 3
	ROR I 1
	STA 3
	XSK I 4
	JMP .+2
	JMP .+3
	XSK I 5
	JMP DO7
	JMP DG6
	LDA I 3
	ROL I 1
	LZE
	COM
	STC DP7
	JMP 2
DP7,	0
/NORMALIZE,ROUND ? EXIT
EXIT,	CLR
	STC 1
	ADD DP7
	ROR I 1
	JMP DG6
	LDA I 3
	SAE I 3
	JMP .+5
	AZE
	JMP .+3
	LZE I
	JMP DF6
	JMP DG6
	LDA I 3
	APO
	JMP DU7
	ROL 1
	APO I
	JMP DT7+1
DR7,	JMP DG6
	LDA I 3
	LDA I 3
	ROR I 1
	STC 0
	LAM 3
	JMP DG6
	STC 0
	LAM I 3
	APO
	JMP DV7
	JMP DG6
	CLR
	ADD 1
	COM
	JMP DE6
	SET 1
	3
DS7,	NOP	
	CLR
DT7,	JMP	/EXIT 
	LDA I 3
	ROL I 1
	STA 3
	JMP DG6
	LDA I 3
	ROL I 1
	STA 3
	XSK I 1
	JMP DR7-3
DU7,	JMP DV7
	JMP DR7
DV7,	CLR
	ADD 0
	STC DW7
	ADD DL7
	JMP DM7+2
	ADD DL7
	ADD 1
	STC 1
	LDA 3
	BCL I
	4000
	STA 3
DW7,	0
/TRANSFER
TRANSA,	CLR 
	ADD 0
	JMP SETUP
	SET 2
	DD7
	JMP MOVE12
	JMP DT7-1
/
FLOATA,	CLR
	ADD 0
	JMP SETUP
	ADD DD7
	STC DG6+1
	JMP DG6
	LDA I
	27
	STA 3
	JMP ADDTA+35
/
FIXA,	CLR
	ADD 0
	JMP SETUP
	ADD DD7
	STC DG6+1
	JMP DG6
	LDA I
	-27
	JMP DE6
	APO I
	JMP DT7
	JMP DM7+2
	JMP DT7-1
	/END DBLFLT1
/
/SOME USEFUL CONSTANTS IN DBLFLT FORMAT:
/90.0
DC90,	0007
	2640
	0000
/3.0
DC3,	0002
	3000
/LN 2 = 0.6931473
DCLN2,	0000	/PART OF 3.0 ? LN 2
	2613
	4410
/LOG 2 = 0.30103
DCLOG2,	7776
	2321
	0116
/10.0
DC10,	0004
	2400
	0000
/0.0
DC0,	-3777
	0000
	0000
/1.0
DC1,	0001
	2000
	0000
/4.0
DC4,	0003
	2000
	0000
/ROOT 2 = 1.414214
DCRT2,	0001
	2650
	1174
/2.0
DC2,	0002
	2000
/ PI/4 = .78539816
DCPID4,	0000	/PART OF 2.0 ? PI/4
	3110
	3756
/PI = 3.141593
DCPI,	0002
	3110
	3756
/ PI/2 = 1.5707963
DCPID2,	0001
	3110
	3756
	/END CONSTANTS
/
/LIST OF ENTRY JUMPS FOR DBLFLTA CONTROL PGM
LISTA,	JMP ADDTA
	JMP SUBTA
	JMP MULTA
	JMP DIVIDA
	JMP TRANSA
	JMP FIXA
	JMP FLOATA
	JMP COMPRA
	JMP TTYP8	
	JMP ABS1A
	JMP COM1A
	JMP TTYINA
	JMP TTYOUA
	JMP TEN2NA
	JMP TTYP6
	JMP TKBDI8
	JMP TKBD8
	/END JUMP LIST
/
/UNUSED LOCATION
	0
/
/STORAGE LOCATIONS FOR USER PGMS
/(NOT USED BY DBLFLT3 ROUTINES)
DS1,	0
	0
	0
DS2,	0
	0
	0
DS3,	0
	0
	0
DS4,	0
	0
	0
DS5,	0
	0
	0
/
/RESERVED FOR DATA BREAK DISC CONTROL
	*1750
	0
	0
/
/MORE USER PGM STORAGE
DS6,	0
	0
	0
/
/STORAGE FOR DBLFLT1
/1ST ARGUMENT
ARG1,	0
	0
	0
/2ND ARGUMENT
ARG2,	0
	0
	0
/FLOATING POINT ACCUMULATOR (FAC)
FAC,	0
	0
	0
/
/STORAGE FOR DBLFLT3 ROUTINES
TEM1,	0
	0
	0
TEM2,	0
	0
	0
TEM3,	0
	0
	0
/
/STORAGE FOR 10 TO N
L4,	0
/
/NOTE: THE DIAL LOADER OVERLAYS 1761 TO
/1777 WHICH WILL NOT = 0 AFTER LOADING
	/END DBLFLTA
/
/
/
/DBLFLTB STARTS HERE:
/USES IR. 1-7, 12, 17
/
	SEGMNT SEGB  /SEG 1 UNLESS MOVED
/
/DBLFLTB CONTROL PROGRAM :
/BY PAUL SULLIVAN
/ MODIFIED BY D.OVERTON
/SUPERVISES COMMUNICATIONS BETWEEN
/ CALLING PROGRAMS AND DBLFLTB
/USES IR. 12 ? 17
/TAKES 0.15 MILLISEC.
/
	*17
	0	/XSK I 17 COUNTER
/ENTRY POINT:
ENTERB,	STC V4B	/SAVE ACC.
/COMPUTE FIELDS SET PRIOR TO JMP TO DBL3GO
	IOB
	6234	/RIB - SAVE FIELD REG. TO ACC
	ROL 2	/MOVE INST. FIELD
	SCR 5	/ TO RIGHT 5 BITS
	ADA I	/MAKE LIF X
	LIF
	STC V7B	/SAVE LIF FOR RTN TO USER PGM
	IOB
	6214	/RDF - READ DATA FIELD
	SCR 1	/DF IN RIGHT 5 BITS
	ADA I	/MAKE LDF X
	LDF
	STC V7B-1 /SAVE FOR RTN TO USER PGM
	ADD V7B	/WHAT MEM.SEG.CALLED DBLFLTB?
	ADA I	/MAKE LDF INST.
	LDF-LIF
	STC .+1
V3B,	LDF	/SET DATA FIELD TO CALLING PGM
/GET .+1 RTN ADDRESS FROM LOC 0 OF CALLING PGM
	LDA
	2\0
	STC 12	/SAVE IT
/FIND DBLFLTB ENTRY POINT
	LDA
	2\17
	ADA I
	LISTB
	STC .+2
	LDA	/GET JMP FROM TABLE
	0
	STC V4B+1 /SAVE ENTRY JMP FOR USE
	STA	/RESET IR.17
	2\17	/ IN CALLING PGM
	STC 17	/ ? IN THIS FIELD
/JUMP TO DBLFLTB ROUTINE
	LDF SEGA /POINTS TO DBLFLTA
	LDA I	/RESTORE ACC.
V4B,	0
	JMP	/JMP TO DBLFLTB ROUTINE
	JMP .+4	/DO NOT INCREMENT RTN ADDRESS
	SKP	/INCREMENT IT ONLY ONCE
	XSK I 12 /INCREMENT IT TWICE
	XSK I 12
	SET 0	/SET RTN ADDRESS
	12
	LDF	/RESTORE DATA FIELD
V7B,	LIF	/SET INST. FIELD FOR RTN
	JMP 0	/RTN TO CALLING PGM
	/END DBLFLTB CONTROL PROGRAM
/
/FLOT12
/FLOATS SINGLE PRECISION FIXED POINT NUMBERS
/ENTER VIA JMP FLOT1B
/ WITH THE INTEGER TO BE FLOATED
/ IN THE ACC.
/RTNS TO .+1 WITH THE FLOATED NUMBER
/ LEFT IN THE FAC
/USES IR.1
/
FLOT1B,	SET 1	/SAVE RTN
	0
	STA	/PREPARE TO FLOAT
	2\FAC+2
	SCR 13
	STA
	2\FAC+1
	JMP FLOATB
	-FAC
	JMP 1	/RETURN
/
/FIX12
/FIX DBLFLT NUMBER INTO SIGNED 12-BIT INTEGER
/BY D.A.OVERTON
/ENTER VIA: JMP FIX12B WITH DBLFLT NO. IN FAC
/RTNS TO .+1 IF NUMBER EXCEEDS + OR - 2047
/ WITH C(AC) = NUMBER OF BITS TOO MANY
/OTHERWISE, RTNS TO .+2
/ WITH 12-BIT INTEGER IN ACC.
/ FRACTIONAL PORTION IS ROUNDED INTO INTEGER
/USES IR.1 ? FAC
/
FIX12B,	SET 1	/SAVE RTN JMP
	0
	LDA I
	-13	/FIX INTO 12 BITS
	STA
	2\FIXA+7
	JMP FIXB
	-FAC
	STC .+6	/SAVE AC
	LDA I	/RESTORE FIX ROUTINE
	-27
	STA
	2\FIXA+7
	LDA I	/RESTORE AC
	0
	AZE	/OVERFLOW?
	JMP 1	/YES: RTN
	LDA I 1	/NO: INCREMENT RTN
	LDA	/GET INTEGER
	2\FAC+1
	SAE I	/3777?
	3777
	SKP
	JMP 1	/DO NOT ROUND
	SAE I	/4000?
	4000
	SKP
	JMP 1	/DITTO
	SCR 17	/SIGN INTO MQ BIT 11
	SCR 10
	LDA	/GET FRACT.
	2\FAC+2
	ROL I 1	/BIT 0 TO LINK
	STC 0	/CLEAR ACC
	QLZ	/ + ?
	COM	/AC=7777 IF -, AC=0 IF +
	LAM	/ADD IN LINK ? INTEGER
	2\FAC+1
	JMP 1	/RTN
	/END FIX12
/
/IRLOAD
/BY D.A.OVERTON
/TRANSFERS IR.1-11 ? 12-16
/ FROM CALLING PGM FIELD TO DBLFLTA ? DBLFLTB
/ENTER VIA: JMP IRLOAB
/RTNS TO .+1
/USES IR.17
/
IRLOAB,	LDA	/SAVE RTN
	0
	STC .+23
	ADD V3B	/GET LDF TO CALLING PGM
	STC .+3
	SET I 17/POINTER
	2000
	LDF	/SET DF TO CALLING PGM
	LDA I 17/GET C(IR.X)
	LDF SEGA
	STA 17	/SAVE IN DBLFLTA
	LDF SEGB
	STA 17	/SAVE IN DBLFLTB
	LDA
	17
	SHD I	/11 DONE?
	1100
	XSK I 17/YES:INCREMENT 17 TO SKIP 12
	SAE I	/16 MOVED?
	2016
	JMP IRLOAB+7 /NO: MOVE ANOTHER
	JMP	/YES: RTN
	/END IRLOAD
/
/SIGN TEST:
/BY P.F.SULLIVAN, 9-68
/DETERMINES WHETHER X=0, X<0, OR X>0
/ENTER AT SIGNB
/ WITH X IN FAC
/RETURNS TO:
/ .+1 FOR X=0
/ .+2 FOR X>0
/ .+3 FOR X<0
/
SIGNB,	LDA /GET MOST SIGNIF PART OF FAC
	2\FAC+1
	AZE I	/IS IT 0?
	JMP 0	/YES, RTN AT .+1
	XSK I 0 /NO,INDEX RTN ADDRESS
	APO I	/IS IT + ?
	JMP 0	/YES, RTN AT .+2
	XSK I 0 /NO,INDEX RTN ADDRESS
	JMP 0	/RTN AT .+3 IF NEGATIVE
	/END SIGN TST
/
/MAGNITUDE TEST :
/BY PAUL SULLIVAN, 9-68
/DETERMINES WHETHER ABSOLUTE VALUE X > 1
/ENTER AT MAGTSB
/ WITH X IN FAC
/RTNS TO .+1 FOR \X\>1
/RTNS TO .+2 OTHERWISE
/USES IR.1-2
/
MAGTSB,	SET 1	/SAVE RTN ADDRESS
	0
	SET I 2 /POINTER TO FAC
	2\FAC
	LDA 2	/LOAD EXP OF FAC
	APO	/IS IT POSITIVE?
	JMP .+16 /NO,THEN \X\<1. INDEX AND RTN
	AZE I	/IS IT +0?
	JMP .+14 /YES,THEN \X\<1.INDEX AND RTN
	ADD K7776 / -1
	AZE	/WAS IT +1?
	JMP 1	/NO, THEN \X\>1. RTN TO .+1
	LDA I 2	/YES,LOOK AT MANTISSA
	APO	/IS IT POSITIVE?
	COM	/NO, THEN COMPLEMENT IT
	SAE I	/WAS THE MOST SIGNIF.
	2000	/ PART + OR - 2000?
	JMP 1	/NO, THEN \X\>1. RETURN TO .+1
	LDA I 2	/YES, LOAD LEAST SIGNIF. PART
	AZE I	/IS IT + OR -0?
	XSK I 1	/YES,THEN \X\=1.
		/ INDEX RTN ADDRESS
	JMP 1	/RTN
	/END MAGTST
/
/NEGFAC:
/BY R.B.COLE, 10-18-68
/CALCULATES NEGATIVE OF FAC
/ENTER AT NEGFAB
/ WITH X IN FAC
/RTNS TO .+1
/ WITH -X IN FAC
/USES IR.1
/
NEGFAB,	SET I 1
	2\FAC
	LDA I 1
	COM
	STA 1
	LDA I 1
	COM
	STA 1
	JMP 0
	/END NEGFAC
/
/POWER SERIES :
/BY P.F.SULLIVAN, 9-68
/CALCULATES POWER SERIES
/ASSUMES ACCESS TO DBLFLTA
/ENTER AT POWSEB:
/WITH X IN TEM2,
/DATA FIELD ADDRESS OF LIST OF CONSTANTS IN AC
/AND [1-NO.OF TERMS] IN IR.4 OF SEGB
/RTNS TO .+1
/ WITH RESULT IN FAC
/USES IR.3-4 IN SEGB, IR.16 IN SEGA ? TEM2
/
POWSEB,	SET 3	/SAVE RTN ADDRESS
	0
	STA	/STORE ADDRESS OF CONSTANTS
	2\16	/ IN IR.16 OF SEGA
	JMP TRANSB /1ST CONSTANT TO FAC
	16
	-FAC
	JMP MULTB /MULTIPLY BY VARIABLE
	-TEM2
	JMP ADDTB /ADD NEW CONSTANT
	-16
	XSK I 4	/THROUGH?
	JMP .-5	/NO, DO IT AGAIN
	JMP 3	/YES, RTN
	/END POWSER
/
/SIN COS :
/BY P.F.SULLIVAN ? R.B.COLE, 10-23-58
/CALCULATES SINES AND COSINES
/FOR ANY ARGUMENT IN DEGREES OR RADIANS
/ASSUMES ACCESS TO DBLFLTA, MAGTST,
/  POWSER, AND NEGFAC
/ENTER AT:
/ SINDEB FOR SIN X DEGREES
/ SINRAB FOR SIN X RADIANS
/ SINPIB FOR SIN X PI/2 RADIANS
/ COSDEB FOR COS X DEGREES
/ COSRAB FOR COS X RADIANS
/ COSPIB FOR COS X PI/2 RADIANS
/WITH X IN FAC
/RTNS TO .+1
/ WITH ANSWER IN FAC
/USES IR.4,6,7, TEM1 ? TEM2
/
/ENTRY POINT FOR COS X DEGREES:
COSDEB,	SET 6
	0
	JMP DIVB /DIVIDE BY 90 DEGREES
	-DC90
	JMP COSPIB+2
/ENTRY POINT FOR COS X RADIANS:
COSRAB,	SET 6
	0
	JMP DIVB /DIVIDE BY PI/2
	-DCPID2
	JMP COSPIB+2
/ENTRY POINT FOR COSINE X PI/2 RADIANS:
COSPIB,	SET 6
	0
	JMP ADDTB /SHIFT TO SINE PHASE
	-DC1
	JMP SINPIB+2
/ENTRY POINT FOR SIN X DEGREES:
SINDEB,	SET 6
	0
	JMP DIVB /DIVIDE BY 90 DEGREES
	-DC90
	JMP SINPIB+2
/ENTRY POINT FOR SIN X RADIANS:
SINRAB,	SET 6
	0
	JMP DIVB /DIVIDE BY PI/2
	-DCPID2
	JMP SINPIB+2
/ENTRY POINT FOR SINE X PI/2 RADIANS:
SINPIB,	SET 6
	0
	SET I 7	/CLEAR FLAG
	5252
	JMP MAGTSB /MAG TST
	JMP SIN1 / \X\ TOO LARGE, REDUCE IT
	JMP TRANSB / \X\ OKAY, STORE X IN TEM1
	-TEM1
	JMP MULTB /SQUARE AND STORE IT
	TEM1
	TEM1
	TEM2
	SET I 4	/SET FOR FOUR TERM EXPANSION
	-3
	LDA I
	2\SINC
	JMP POWSEB
	JMP MULTB /MULT.RESULT BY X
	-TEM1
	SRO	/FLAG SET?
	7
	JMP NEGFAB /YES, COMPLEMENT
	JMP 6	/RTN
/SCALE X
SIN1,	SRO	/COMPLEMENT FLAG
	7
	NOP
	LDA	/CHECK SIGN OF X
	2\FAC
	APO I
	JMP .+5	/+: REDUCE BY PI
	SRO    /-: COMPLEMENT FLAG
	7
	NOP
	JMP NEGFAB /COMPLEMENT X
	JMP SUBTB /REDUCE PHASE BY PI
	-DC2
	JMP SINPIB+4 /TRY AGAIN
/SINE CONSTANTS:
/C7 = -.004362476
SINC,	7770
	5610
	3161
/C5 = 0.079487663
	7774
	2426
	2466
/C3 = -.645920978
	0000
	5325
	1165
/C1 = 1.570794852
	0001
	3110
	3750
	/END SIN COS
/
/SQUARE ROOT :
/BY P.F.SULLIVAN, 9-68
/CALCULATES SQUARE ROOT X
/ASSUMES ACCESS TO DBLFLTA, SIGN TST,
/  AND NEGFAC
/ENTER VIA: JMP SQROOB
/ WITH X IN FAC
/LEAVES WITH SQUARE ROOT \X\ IN FAC
/RTN IS TO .+1 FOR X<0
/  .+2 OTHERWISE
/USES IR.3-4, TEM2 ? TEM3
/
	XSK I 3	/INDEX RTN ADDRESS
	JMP 3	/RTN
/ENTRY POINT:
SQROOB,	SET 3	/SAVE RTN ADDRESS
	0
	JMP SIGNB /SIGN TST
	JMP SQROOB-2 /0: NO COMPUTATION NEEDED
	JMP SQRT1-1  / +, CALCULATE IT
	JMP NEGFAB / -, GET ABS. VALUE
	SKP	/? INDICATE AN IMAGINARY ROOT
	XSK I 3 /INDEX RTN ADDRESS
SQRT1,	JMP TRANSB /MOVE X
	 -TEM2	/TO TEM2
	SET I 4 /SET ITERATION COUNTER
	-13
	LDA	/GET EXPONENT ? DIVIDE IT BY 2
	2\FAC	/ (TO USE AS AN INITIAL GUESS)
	SCR 1	/
SQRT2,	AZE I
	CLR	/-0 BECOMES +0
	STA	/STORE NEW EXPON.
	2\FAC
	XSK I 4	/ENOUGH ITERATIONS?
	JMP .+2 /NO, KEEP GOING
	JMP 3  /YES,RTN WITH SQROOT \X\ IN FAC
	JMP DIVB /DIVIDE
	 TEM2	/  X
	 FAC	/  BY NEW APPROXIMATION (A)
	 TEM3	/  PUT (X/A) TEM3
	JMP ADDTB /FORM [(X/A) + A]
	 -TEM3		/IN FAC
	LDA	/FORM [(X/A) + A]/2
	2\FAC
	ADD K7776 /BY SUBTRACTING 1 FROM EXP.
	JMP SQRT2 /CONTINUE
	/END SQROOT
/
/ARCSIN :
/BY P.F.SULLIVAN, 9-68
/CALCULATES ARCSIN X
/ASSUMES ACCESS TO DBLFLTA, MAGTST,
/ SIGN TST, POWSER, SQROOT ? NEGFAC
/ENTER VIA: JMP ARCSIB
/ WITH X IN FAC
/RTNS TO .+1 FOR \X\>1
/ OTHERWISE RTNS TO .+2
/ WITH RESULT IN FAC
/USES IR.4,6 ? 7, TEM1, TEM2 ? TEM3
/
ARCSIB,	SET 6	/SAVE RTN ADDRESS
	0
	SET I 7	/CLEAR FLAG
	-0
	JMP MAGTSB /MAG TST
	JMP 6	/RTN, \X\ TOO LARGE
	XSK I 6 /INDEX RTN ADDRESS
		/ AND START CALCULATING
	JMP SIGNB /SIGN TEST
	JMP 6	/ZERO, NO CALCULATION NEEDED
	JMP .+4	/ +, START CALCULATING
	JMP NEGFAB / -, COMPLEMENT
	SET I 7 /AND SET A FLAG
	+0
	JMP TRANSB /MOVE X
	-TEM2	/ TO TEM2
	SET I 4 /SET COUNTER
	-5
	LDA I	/GET ADDRESS
	2\ASINC	/ OF ARCSIN CONSTANTS
	JMP POWSEB /POWSER
	JMP TRANSB /STORE IT
	-TEM1
	JMP SUBTB /CALCULATE 1-X
	DC1
	-TEM2
	JMP SQROOB /SQROOT
	HLT	/SOMETHING WRONG
	JMP MULTB /MULT.POWER SERIES
	-TEM1	/ BY SQ.ROOT [1-X]
	JMP SUBTB /SUBTRACT ANSWER FROM PI/2
	DCPID2
	-FAC
	XSK 7	/FLAG SET ?
	JMP NEGFAB /YES, COMPLEMENT
	JMP 6	/RTN
/ARCSIN CONSTANTS :
/A5=-.004337769
ASINC,	7770
	5616
	7023
/A4=.019349939
	7772
	2364
	0742
/A3=-.044958884
	7773
	5076
	6227
/A2=.087876311
	7774
	2637
	6100
/A1=-.214512362
	7775
	4442
	5555
/A0=1.570795207
	0001
	3110
	3750
	/END ARCSIN
/
/ARCTAN :
/BY P.F.SULLIVAN, 9-68
/CALCULATES ARCTANGENT X
/ASSUMES ACCESS TO DBLFLTA, SIGN TST,
/  POWSER, AND NEGFAC
/ENTER WITH JMP ARCTAB
/ WITH X IN FAC
/RTNS TO .+1
/ WITH ARCTAN X IN FAC
/USES IR.4,6 ? 7, TEM1 ? TEM2
/
ARCTAB,	SET 6	/SAVE RTN ADDRESS
	0
	SET I 7 /CLEAR FLAG
	-0
	JMP SIGNB /SIGN TEST
	JMP 6	/0: NO CALCULATION NEEDED
	JMP ATAN1 /+: START CALCULATING
	JMP NEGFAB /-: COMPLEMENT
	SET I 7 /AND SET A FLAG
	+0
ATAN1,	JMP ADDTB /CALCULATE X+1
	FAC
	DC1
	TEM1	/STORE IT
	JMP SUBTB /CALCULATE X-1
	-DC1
	JMP DIVB /DIV.BY X+1
	FAC
	TEM1
	TEM1	/STORE ANSWER
	JMP MULTB /SQUARE IT
	TEM1
	TEM1
	TEM2	/STORE IT
	SET I 4	/SET COUNTER
	-4
	LDA I
	2\ATANC
	JMP POWSEB
	JMP MULTB /MULT.POWER SERIES EXPANSION
	-TEM1	/ BY TEM1
	JMP ADDTB /ADD PI/4
	-DCPID4
	XSK 7	/FLAG SET ?
	JMP NEGFAB /YES, COMPLEMENT
	JMP 6	/RTN
/ARCTAN CONSTANTS :
/C9 = .0208351
ATANC,	-005
	2525
	3460
/C7 = -.0851330
	7774
	5215
	1343
/C5 = .1801410
	7775
	2703
	5562
/C3 = -.3302995
	7776
	5267
	0577
/C1 = .9998660
	0000
	3777
	5634
	/END ARCTAN
/
/LOGS :
/BY P.F.SULLIVAN, 9-30-69
/CALCULATES LOGARITHMS
/ASSUMES ACCESS TO DBLFLTA ? SIGN TST
/ENTER WITH X IN FAC VIA:
/ JMP LOG2B  FOR LOG BASE 2 OF X
/ JMP LOB10B FOR LOG BASE 10 OF X
/ JMP LOGNB  FOR NATURAL LOG OF X
/FOR X>0, RTNS TO .+2
/ WITH APPROPRIATE LOG IN FAC
/OTHERWISE RTNS TO .+1
/USES IR.3-5, TEM1, TEM2, TEM3
/
/ENTRY POINT FOR LOG BASE 2:
LOG2B,	SET 3	/SET RTN ADDRESS
	0
	JMP SIGNB /SIGN TST
	JMP 3	/0: LOG 0 IS UNDEFINED.
		/ RTN TO .+1
	JMP .+2	/+: CALCULATE LOG X
	JMP 3	/-: LOG OF NEGATIVE NUMBER
		/UNDEFINED.RTN TO .+1
	XSK I 3 /INDEX RTN ADDRESS
	LDA	/GET L
	2\FAC
	STA	/STORE IT
	2\TEM1+2
	SCR 13	/GET SIGN
	STA	/STORE IT
	2\TEM1+1
	JMP LOGS1 /RAISE Y1 TO 2**11
	STA	/STORE NEW EXPONENT M
	2\TEM2+2
	SCR 13	/GET SIGN
	STA	/SAVE IT
	2\TEM2+1
	JMP LOGS1 /RAISE Y2 TO 2**11
	STA	/STORE NEW EXPONENT N
	2\TEM3+2
	SCR 13	/GET SIGN
	STA	/STORE IT
	2\TEM3+1
	JMP FLOATB /FLOAT L
	-TEM1
	JMP FLOATB / M
	-TEM2
	JMP FLOATB / N
	-TEM3
/DIVIDE M BY 2**11
	LDA I 
	-13
	ADM
	2\TEM2
	FLO	/TEST FOR UNDERFLOW
	JMP .+4	/NO: GO ON
	JMP TRANSB /YES:SET ANSWER TO 0
	DC0
	-TEM2
/DIVIDE N BY 2**22
	LDA I
	-26
	ADM
	2\TEM3
	FLO	/SKIP ON UNDERFLOW
	JMP LOGS1-6 /NO: GO ON
	JMP TRANSB /YES: SET ANSWER TO 0
	DC0
	-TEM3
	JMP ADDTB
	TEM1	/  L
	-TEM2	/  M/2**11
	JMP ADDTB
	-TEM3	/  AND N/2**22
	JMP 3	/RTN TO .+2
LOGS1,	LDA	/SAVE RTN ADDRESS
	0
	STC .+13
	STA	/SET EXPONENT TO 0
	2\FAC
/RAISE Y TO 2**11
	SET I 4
	-13
	JMP MULTB
	-FAC
	XSK I 4
	JMP .-3
	LDA	/PUT NEW EXPONENT IN ACC
	2\FAC
	JMP	/RTN
/
/ENTRY POINT FOR LOG BASE 10:
LOG10B,	SET 5	/SET RTN ADDRESS
	0
	JMP LOG2B /GET LOG BASE 2 OF X
	JMP 5	/RTN TO .+1 IN MAIN PGM
		/ IF X<0 OR X=0
	XSK I 5 /INDEX RTN ADDRESS
	JMP MULTB /MULT. BY LOG BASE 10 OF 2
	-DCLOG2
	JMP 5	/RTN.TO .+2 IN MAIN PGM
/
/ENTRY POINT FOR NATURAL LOG:
LOGNB,	SET 5	/SET RTN ADDRESS
	0
	JMP LOG2B /GET LOG BASE 2 OF X
	JMP 5	/RTN TO .+1 IN MAIN PGM
		/ IF X<0 OR X=0
	XSK I 5 /INDEX RTN ADDRESS
	JMP MULTB /MULT. BY LN 2
	-DCLN2
	JMP 5	/RTN.TO .+2 IN MAIN PGM
	/END LOGS
/
/EXPONENTIAL :
/AUTHOR, M.D.MCDONALD
/ MODIFIED BY P.F.SULLIVAN, 9-68
/CALCULATES E TO THE X
/ASSUMES ACCESS TO DBLFLTA, SIGN TST, NEGFAC
/ENTER VIA: JMP EXPONB
/RTNS TO .+1
/ WITH E TO THE X IN FAC
/USES IR.3-4, TEM1, TEM2, TEM3
/TAYLOR SERIES METHOD
/
	JMP TRANSB /EXP 0 = 1
	DC1
	-FAC
	JMP 3	/RTN
/ENTRY POINT :
EXPONB,	SET 3	/SAVE RTN ADDRESS
	0
	SET I 4	/CLEAR FLAG
	0
	JMP SIGNB /SIGN TST
	JMP EXPONB-4 / 0: EXP 0 = 1
	JMP EXPON1 / +: CALCULATE EXP. X
	JMP NEGFAB / -: GET ABS. VALUE
	SET I 4 /AND SET FLAG
	-0
EXPON1,	JMP TRANSB /SAVE \X\
	-TEM1	/IN TEM1
	JMP TRANSB
	-TEM2	/AND TEM2
	JMP TRANSB /PUT 1.0
	DC1
	-FAC	/IN FAC
	JMP TRANSB
	-TEM3	/AND TEM3
EXPON2,	JMP ADDTB /ADD NEXT TERM
	-TEM2
/DOES THIS TERM INCREASE THE PARTIAL SUM
/BY MORE THAN 2**-22 OF ITS PREVIOUS VALUE ?
	LDA
	2\FAC
	COM
	ADA
	2\TEM2
	ADA I
	27
	APO
	JMP EXPON3 /NO, EXCEEDS ACCURACY
		/OF DBLFLT. GO ON.
/YES, CALCULATE NEXT TERM
	JMP ADDTB /ADD 1 TO NO. FOR FACTORIAL
	TEM3
	DC1
	TEM3
	JMP DIVB /DIVIDE
	TEM2	/ LAST TERM
	TEM3	/ BY INCREMENTED NUMBER
	TEM2	/ FOR FACTORIAL
	JMP MULTB /MULT.
	TEM2	/ LAST TERM
	TEM1	/ BY X
	TEM2
	JMP EXPON2 /ADD AND CHECK THIS TERM
EXPON3,	XSK 4	/WAS X NEGATIVE?
	JMP 3	/NO, RTN
	JMP DIVB /YES, GET RECIPROCAL
	DC1
	-FAC
	JMP 3	/RTN
	/END EXPONENTIAL
/
/LINE FEED ? CARRIAGE RETURN
/USES IR.1
TLFCR,	SET 1	/SET RTN
	0
	LDA I
	215	/CR
	JMP TYP8B /TYPE IT
	JMP TYP8B /EXTRA CHAR.FOR SLOW TTYS
	LDA I
	212	/LINE FEED
	JMP TYP8B
	JMP 1	/RTN
	/END LFCR
/
/DBL3GO (MODIFIED)
/ALLOWS DBLFLTB ROUTINES TO USE DBLFLTA
/ENTRY POINTS:
TYP8B,	XSK I 17
COMPRB,	XSK I 17
FLOATB,	XSK I 17
FIXB,	XSK I 17
TRANSB,	XSK I 17
DIVB,	XSK I 17
MULTB,	XSK I 17
SUBTB,	XSK I 17
ADDTB,	STC .+6	/SAVE ACC
	LDA I
	LDF SEGB
	STA	/PATCH DBLFLTA SO DATA
	2\V3+2	/ FIELD POINTS TO DBLFLTB
	LDA I	/RESTORE ACC
	0
	LIF SEGA
	JMP ENTERA /TO DBLFLTA CONTROL PGM
K7776,	-1	/CONSTANT
	/END DBL3GO (MODIFIED)
/
/LIST OF ENTRY JMPS FOR DBLFLTB CONTROL PGM
LISTB,	JMP FLOT1B	/FLOT12
	JMP FIX12B	/FIX12
	JMP IRLOAB	/IRLOAD
	JMP TLFCR	/LF ? CR
	JMP SQROOB	/SQROOT
	JMP COSDEB	/COSDEG
	JMP SINDEB	/SINDEG
	JMP COSRAB	/COSRAD
	JMP SINRAB	/SINRAD
	JMP LOG10B	/LOG10
	JMP LOGNB	/LOGN
	JMP SIGNB	/SIGN
	JMP MAGTSB	/MAGTST
	JMP EXPONB	/EXPON
	JMP POWSEB	/POWSER
	JMP ARCTAB	/ARCTAN
	JMP ARCSIB	/ARCSIN
	JMP LOG2B	/LOG2
	JMP COSPIB	/COSPI2
	JMP SINPIB	/SINPI2
	JMP NEGFAB	/NEGFAC
	/END JUMP LIST
	/END DBLFLTB
	/END DBLFLT3
/
/