/	FLOAT.ZZM


/	PAGE ZERO OF THE
/	FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL


/	SOURCE RECREATION, TIDYING UP BY:

/	CHARLES J. LASNER P?S NY

/	LAST EDIT:	08-APR-1987	23:00:00	CJL


	*40

EX1,	0			/OPERAND STORAGE
AC1H,	0
AC1L,	0
OVER1,	0

	FLAC=	.		/FLOATING ACCUMULATOR

EXP,	0			/F.A.
HORD,	0
LORD,	0
OVER2,	0

SIGNF,	0			/FLOATING SIGN

MINSKI,	ACMINS			/NEGATE FLAC SUBROUTINE
FISW,	2004			/OUTPUT FORMAT
INTEGER,FIX			/FIX FLAC



/	FUNCTIONS CONTAINED IN THIS SECTION

/	ARTN
/	FEXP
/	FLOG
/	FSIN
/	FCOS
/	XSQRT
/	FLOATING POINT PACKAGE - EXPONENTIAL

	GETSGN=	TAD	FLAC+1
	RETURN=	JMP I	EFUN3I

	*4600+20

FEXP,	GETSGN			/TAKE ABSOLUTE VALUE
	SPA CLA
	JMS I	NEGP
	DCA	T3		/C(SIGN)=-1 IF I X2<0
	FINT
	FMUL	LG2E
	FPUT I	X2
	FEXT
	JMS I	INTEGER		/TAKE INTEGER PART
	DCA	FLAG2		/SAVE LOW ORDER DATA
	FINT
	FNOR
	FPUT I	XSQ2
	FGET I	X2
	FSUB I	XSQ2
	FPUT I	X2
	FMUL I	X2
	FPUT I	XSQ2
	FADD	DF
	FPUT	TEMP
	FGET	CF
	FDIV	TEMP
	FSUB I	X2
	FADD	AF
	FPUT	TEMP
	FGET	BF
	FMUL I	XSQ2
	FADD	TEMP
	FPUT	TEMP
	FGET I	X2
	FDIV	TEMP
	FMUL	TWO
	FADD	ONE
	FEXT
	TAD	FLAG2
	TAD	FLAC
	DCA	FLAC
	ISZ	T3
	RETURN
	FINT
	FPUT I	X2
	FGET	ONE
	FDIV I	X2
	FEXT
	RETURN
/	CONSTANTS FOR FEXP

X2,	X
XSQ2,	XSQR
AF,	0004
	2372
	1402
BF,	7774
	2157
	5157
CF,	0012
	5454
	0343
DF,	0007
	2566
	5341
LG2E,	0001
	2705
	2435
ONE,	0001
	2000
	0000
TWO,	0002
	2000
	0000
NEGP,	FNEG

FLAG2,	0
TEMP,	0
	0
	0
	0
/	MAIN ALGORITHM FOR ARCTANGENT

ARCALG,	FINT
	FGET I	X2
	FMUL I	X2
	FPUT I	XSQ2
	FMUL	BET2
	FADD	BET1
	FMUL I	XSQ2
	FADD	BETZ
	FPUT	TEMP
	FGET	ALF2
	FMUL I	XSQ2
	FADD	ALF1
	FMUL I	XSQ2
	FADD	ALFZ
	FMUL I	X2
	FDIV	TEMP
	FEXT
	JMP I	.+1;	ARCRTN



/	CONSTANTS - FLOATING ARC TANGENT

ALFZ,	0000
	2437
	1643
ALF1,	7777
	3304
	4434
ALF2,	7773
	3306
	5454
BETZ,	0000
	2437
	1646
BET1,	0000
	2427
	2323
BET2,	7775
	3427
	7052
/	FLOATING POINT ARC TANGENT

	PAGE

ARTN,	GETSGN			/TAKE ABSOLUTE VALUE
	SPA CLA
	JMS	FNEG
	DCA	T3
	FINT
	FPUT I	X1
	FSUB I	CON1
	FEXT
	GETSGN
	SPA CLA
	JMP	GO		/LESS THAN ONE
	FINT
	FGET I	CON1
	FDIV I	X1
	FPUT I	X1
	FEXT
	CLA CMA
GO,	DCA	FLAG1		/SIGN FLAG OF RESULT
	JMP I	.+1;	ARCALG	/CALL ALGORITHM

ARCRTN,	ISZ	FLAG1		/RETURN HERE
	JMP I	EXIT1
	FINT
	FPUT I	X1
	FGET I	PI2
	FSUB I	X1
	FEXT
	JMP I	.+1
EXIT1,	EXIT2

/	CONSTANTS FOR ARCTANGENT

X1,	X
PI2,	PIOT
CON1,	ONE
FLOG,	GETSGN			/FLOATING LOGARITHM
	SNA
	ERROR3			/ZERO ARGUMENT FOR LOG
	SPA CLA
	JMS I	MINSKI		/NEGATIVE ARGUMENT
	FINT
	FPUT I	TEM
	FSUB I	CON1
	FEXT
	GETSGN
	SNA
	RETURN
	SMA CLA
	JMP	STARTL
	FINT
	FGET I	CON1
	FDIV I	TEM
	FPUT I	TEM
	FEXT
	CLA CMA
STARTL,	DCA	T3
	TAD	P13
	DCA	FLAC
	CMA
	TAD I	TEM
	DCA	FLAC+1
	DCA	FLAC+2
	DCA	FLAC+3
	IAC
	DCA I	TEM
	FINT
	FMUL	LOG2
	FPUT I	X1
	FGET I	TEM
	FSUB I	CON1
	FPUT I	TEM
	FMUL	LOG8
	FADD	LOG7
	FMUL I	TEM
	FADD	LOG6
	FMUL I	TEM
	FADD	LOG5
	FMUL I	TEM
	FADD	L4
	FMUL I	TEM
	FADD	L3
	FMUL I	TEM
	FADD	L2
	FMUL I	TEM
	FADD	L1
	FMUL I	TEM
	FADD I	X1
	FEXT
	JMP I	EXIT1
L1,	0000
	3777
	7742
L2,	7777
	4000
	4100
L3,	7777
	2517
	0307
L4,	7776
	4113
	7211

/	LOGARITHM CONSTANTS

LOG5,	7776
	2535
	3301
LOG6,	7775
	4746
	0771
LOG7,	7774
	2236
	4304
LOG8,	7771
	4544
	1735

TEM,	TEMP
LOG2,	0
	2613
	4414
FLAG1,	0




FNEG,	0
	JMS I	MINSKI
	CLA CMA
	JMP I	FNEG
/	FLOATING POINT SINE AND COSINE

	PAGE

FCOS,	FINT			/COS(X)=SIN(PI/2-X)
	FPUT	X
	FGET	PIOT
	FSUB	X
	FEXT
FSIN,	GETSGN
	SMA SZA CLA
	JMP	MOD
	GETSGN
	SMA CLA
	RETURN			/YES SIN(0)=0
	JMS I	MINSKI
	CMA			/NO: SIN(-X)=-SIN(X)
MOD,	DCA	T3

/	REDUCE X MODULO 2 PI

	FINT
	FDIV	TWOPI
	FPUT	XSQR
	FEXT
	JMS I	INTEGER
	FINT
	FNOR
	FPUT	X
	FGET	XSQR
	FSUB	X
	FMUL	TWOPI
	FPUT	X
	FSUB	PI		/X<PI?
	FEXT
	GETSGN
	SPA CLA
	JMP	PCHECK		/YES
	FINT			/NO, SIN(X-PI)=-SIN(X)
	FPUT	X
	FEXT
	TAD	T3		/INVERT THE SIGN
	CMA
	DCA	T3
PCHECK,	FINT			/X<PI/2?
	FGET	X
	FSUB	PIOT
	FEXT
	GETSGN
	SPA CLA
	JMP	PALG		/YES
	FINT			/NO
	FGET	PI		/SIN(X)=SIN(PI-X)
	FSUB	X
	FPUT	X
	FEXT
PALG,	FINT
	FGET	X
	FDIV	PIOT
	FPUT	X
	FMUL	X
	FPUT	XSQR
	FGET	C9
	FMUL	XSQR
	FADD	C7
	FMUL	XSQR
	FADD	C5
	FMUL	XSQR
	FADD	C3
	FMUL	XSQR
	FADD	PIOT
	FMUL	X
	FEXT
EXIT2,	ISZ	T3
	RETURN
	JMS I	MINSKI
	RETURN
/	CONSTANTS AND POINTERS



TWOPI,	0003
	3110
	3756			/(3755) - FOR 4-WORD
	3235

PI,	0002
	3110
	3756
	3235

PIOT,	0001			/USED BY SINE AND COSINE
	3110
	3756
	3235

X,	0000
	0000
	0000
	0000

XSQR,	0000
	0000
	0000
	0000

/	SINE CONSTANTS

C9,	7764
	2401
	7015
	1042
C7,	7771
	5464
	5514
	6150
C5,	7775
	2431
	5361
	4736
C3,	0000
	5325
	0414
	3167

/	END OF EXTENDED FUNCTIONS.
/	PAGE 1 - INPUT/OUTPUT ROUTINES FOR THE FOCAL
/	FLOATING POINT PACKAGE.


/	IN THE COMMENTS BELOW:
/	F = NUMBER OF DIGITS TO BE OUTPUT	=FISW
/	D = NUMBER OF DECIMAL PLACES		=DECP
/	E = DECIMAL EXPONENT			=BEXP
/	P = NUMBER OF PLACES REMAINING TO BE
/	    PRINTED BEFORE DECIMAL POINT

	PAGE

	DIGITS=	6		/NUMBER OF DECIMAL DIGITS OUT

TGO,	0
	DCA	SCOUNT		/SAVE MAX. NUMBER OF DIGITS AVAILABLE - *SET COUNTS*
	TAD	FISW
	RTL6
	AND	P77
	DCA	T1
	TAD	T1
	CIA			/NO, COMPUTE FIELD SIZES
	SNA
	TAD	MD
	DCA	FCOUNT
	TAD	FISW		/(JMP FPRNT) - FOR NO ROUNDING.
	SNA			/FLOATING OUTPUT?
	JMP	R6		/YES, ROUND OFF TO MAX. NO. PLACES
	AND	P77
	DCA	DECP
	TAD	FCOUNT
	TAD	DECP
	SPA			/ F-D > 0?
	JMP	.+5		/YES
	CLA CMA			/NO,
	TAD	T1
	DCA	DECP		/MAKE D = F-1
	CMA
	TAD	T3		/COMPARE DECIMAL EXPONENT
	SMA			/ F-D > E?
	CLA			/NO, ROUND OFF TO .F PLACES
	TAD	T1		/YES
	SPA			/ D+E < 0?	
	JMP	FPRNT-2		/YES, NO ROUNDING NEEDED, GO TO PRINT
	TAD	MD		/NO, ROUND TO D+E PLACES,
	SMA			/TO A MAXIMUM OF D PLACES
	CLA
R6,	TAD	RND2		/ *ROUND UP *
	DCA	T2		/SAVE NUMBER+1 OF PLACES TO ROUND TO.
	TAD I	BUFST
	TAD	T2		/SET UP BUFFER ADDRESS AT WHICH
	DCA	PLCE		/ROUNDING OFF SHOULD START
	TAD	T2
	CIA			/SET UP COUNT OF MAXIMUM NUMBER
	DCA	T2		/OF CARRIES ALLOWABLE
	TAD	K5		/LITTLE EXTRA ON FIRST DIGIT.
RET,	ISZ I	PLCE		/ADD 1 TO DIGIT AT CURRENT POSITION
	TAD I	PLCE
	TAD	OM12
	SPA CLA			/CARRY REQUIRED?
	JMP	FPRNT		/NO, GO TO OUTPUT
	DCA I	PLCE		/YES, MAKE CURRENT DIGIT ZERO
	ISZ	T2		/BEGINNING OF BUFFER REACHED?
	JMP	DECR		/NO, DECREMENT BUFFER ADDRESS AND REPEAT
	ISZ I	PLCE		/YES, SET MANTISSA TO 0.1
	ISZ	T3		/COMPENSATE BY INCREMENTING EXPONENT
	CLA
FPRNT,	TAD	FISW		/AUTO-INDEX REGISTER ALREADY SET. - *PRINT*
	SNA CLA			/ F = 0?
	JMP	FLOUT		/YES, OUTPUT AS FLOATING NUMBER
	TAD	FCOUNT
	TAD	T3
	SMA SZA			/ E > F?
	JMP	FLOUT-1		/YES, CONVERT TO E FORMAT
	TAD	DECP
	SMA			/ E < F-D?
	CLA			/NO, TAKE P = E
	CIA			/YES, TAKE P = F-D
	TAD	T3
	CIA
	DCA	T1		/SET UP MINUS P
BACK,	TAD	T3		/PRINT DD.DDD
	TAD	T1
	SNA CLA			/ P = E?
	JMP	DIG		/YES, PRINT DIGIT
	TAD	T1		/NO,
	IAC
	SPA CLA			/ P > 1?
	TAD	M20		/YES, TAKE SPACE (240-260); OTHERWISE ZERO
IN,	JMS	OUTA		/PRINT CHARACTER
	ISZ	T1		/P CHARACTERS PRINTED?
	JMP	BACK		/NO
	TAD	PER		/YES,
	PRINTC			/PRINT DECIMAL POINT
	JMP	BACK

DECR,	CMA			/BACKUP TO TOP OF BUFFER.
	TAD	PLCE
	DCA	PLCE
	JMP	RET
K5,	5
MD,	-DIGITS
RND2,	DIGITS+1
OM12,	-12
BUFST,	SADR
OPUT,	OUTDG
DECP,	0			/MODIFIABLE LOCATIONS
SCOUNT,	0
FCOUNT,	0

	PLCE=	.

OUTA,	0			/MODIFIED REGISTERS.
	JMS I	OPUT		/PRINT CHARACTER
	ISZ	FCOUNT		/F CHARACTERS PRINTED?
	JMP I	OUTA		/NO
	JMP I	TGO		/YES, NUMBER FINSHED

DIG,	CMA
	TAD	T3		/REDUCE E, BY 1
	DCA	T3
	ISZ	SCOUNT		/ARE ALL SIG. FIGS. USED?
	JMP	.+4		/NO
	CMA			/YES,
	DCA	SCOUNT		/RESET COUNT TO -1
	JMP	IN		/AND LEAVE C(AC) = 0
	TAD I	FLTXR		/TAKE NEXT DIGIT FROM BUFFER
	JMP	IN

/	DO FLOATING OUTPUT

	CLA			/IF OUTPUT TOO LARGE,
FLOUT,	JMS I	OPUT		/PRINT "0"
	TAD	PER
	PRINTC			/PRINT "."
	ISZ	TGO		/SECOND RETURN
	TAD I	FLTXR		/TAKE NEXT DIGIT FROM BUFFER
	JMS	OUTA		/PRINT IT
	ISZ	SCOUNT		/TEST FOR END OF INPUT
	JMP	.-3		/AND REPEAT
	CMA
	DCA	SCOUNT		/OUTPUT EXTRA ZEROS.
	JMP	.-5

ABSOLV,	0
	TAD	HORD
	DCA	SIGNF
	TAD	HORD
	SPA CLA
	JMS I	MINSKI
	JMP I	ABSOLV
/	DOUBLE PRECISION DECIMAL-BINARY
/	INPUT AND CONVERSION FOR + OR - XXX...

	PAGE

DECONV,	0
	DCA	LORD
	DCA	EXP		/ZERO THE EXPONENT AND
	DCA	HORD		/INITIALIZE FLOATING AC.
	DCA	OVER2
	DCA	DNUMBR
	DCA	SIGNF
	TAD	CHAR		/ALLOW KEYBOARD SIGN CHECKS.
	TAD	MPLUS
	SNA
	JMP	.+6		/+SIGN; GET NEXT
	TAD	M2		/CHECK - SIGN
	SZA CLA
	JMP	.+4
	CMA			/INIT SIGN CHECK TO POS.
	DCA	SIGNF
	JMS I	XINPUT		/GET NEXT
	TAD	CHAR		/A SPACE PERHAPS?
	TAD	MSPACE
	SNA CLA
	JMP	.-4
	JMS	DECON
	JMP I	DECONV
DECON,	0
	TAD	CHAR		/TEST LEAD CHARACTER FOR TERMINATOR
	TAD	MINE
	SNA CLA
	JMP I	DECON		/E
	TESTN
	JMP I	DECON		/.
	JMP	DTST		/OTHER
	TAD	SORTCN		/N
DSAVE,	DCA	DIGIT		/YES
	JMS	MULT10		/REMAIN MUST =0 SINCE OVERFLOW IS CHECKED
	ISZ	DNUMBR		/COUNT DIGITS
	SZA CLA
	ERROR2			/INPUT-OVERFLOW ERROR
	JMS I	XINPUT
	JMP	DECON+1		/CONTINUE

DTST,	TAD	CHAR		/ALLOW A-Z
	TAD	MINUSA
	SPA CLA
	JMP I	DECON
	TAD	CHAR
	TAD	MINUSZ
	SZA SMA CLA
	JMP I	DECON		/USE SIX BITS OF ASCII
	TAD	CHAR
	AND	P77
	JMP	DSAVE

MINE,	-"E			/(7532)- FOR AMPERSAND
MINUSZ,	-"Z
MPLUS,	-"+
MSPACE,	-" 
XINPUT,	INPUT
MULT10,	0			/ROUTINE TO MULTIPLY FLAC BY TEN (10)
	TAD	OVER2
	DCA	OVER1
	TAD	LORD		/DOUBLE PRECISION WORD
	DCA	AC1L		/BY TEN (DECIMAL)
	TAD	HORD		/REMAIN=REMAINDER
	DCA	AC1H
	DCA	REMAIN		/CLEAR OVERFLOW WORD
	JMS	MULT2		/CALL SUBROUTINE TO
	JMS	MULT2		/MULTIPLY BY TWO
	JMS	DUBLAD		/CALL DOUBLE ADD
	JMS	MULT2
	TAD	DIGIT		/ADD LAST DIGIT RECEIVED
	DCA	OVER1
	DCA	AC1L
	DCA	AC1H
	JMS	DUBLAD
	TAD	REMAIN		/EXIT WITH REMAINDER
	JMP I	MULT10		/IN AC

REMAIN,	0
DIGIT,	0			/STORAGE FOR DIGIT
DNUMBR,	0			/=NUMBER OF DIGITS

MULT2,	0			/MULTIPLY OVER2, LORD, HORD BY 2
	TAD	OVER2
	CLL RAL			/CARRY INSERT BIT IS IN LINK
	DCA	OVER2
	TAD	LORD
	RAL
	DCA	LORD
	TAD	HORD
	RAL
	DCA	HORD
	TAD	REMAIN
	RAL
	DCA	REMAIN
	JMP I	MULT2
DUBLAD,	0			/TRIPLE PRECISION ADDITION
	CLA CLL
	TAD	OVER2
	TAD	OVER1
	DCA	OVER2
	RAL
	TAD	LORD
	TAD	AC1L
	DCA	LORD
	RAL
	TAD	HORD
	TAD	AC1H
	DCA	HORD
	RAL
	TAD	REMAIN		/WITH OVERFLOW
	DCA	REMAIN
	JMP I	DUBLAD

DIV1,	0			/SHIFT OPERAND RIGHT
	CLA CLL			/TRIPLE PRECISION
	TAD	AC1H
	SPA
	CLL CML
	RAR
	DCA	AC1H
	TAD	AC1L
	RAR
	DCA	AC1L
	TAD	OVER1
	RAR
	DCA	OVER1
	ISZ	EX1
	JMP I	DIV1
	JMP I	DIV1
	PAGE

/	FLOATING OUTPUT CONVERSION ROUTINE

FLOUTP,	0
	TAD	PEQ
	PRINTC			/(CLA)- TO SUPPRESS "="
	TAD	HORD		/NUMBER>0??
	SMA CLA
	TAD	SMSP		/PRINT "-" OR A SPACE.
	TAD	SMIN
	PRINTC
	JMS I	ABSOL2
FGO2,	DCA	T3		/INITIALIZE DECIMAL EXPONENT
	TAD	EXP		/IS EXP 0 TO 4?
	SPA
	JMP	FGO3		/TOO LARGE: MULTIPLY BY 1/10
	SZA
	TAD	M4
	SPA SNA CLA
	JMP	FGO4
	FINT
	FMUL I	PPTEN
	FEXT
	IAC
	TAD	T3
	JMP	FGO2

FGO3,	FINT
	FMUL I TENPT
	FEXT
	CMA
	JMP	.-6
FGO4,	DCA I	DPT		/MULTIPLY BY TWO TO POSITION BIT0
	DCA I	REPT		/CLEAR OVERFLOW WORD
	TAD	SADR		/INIT BUFFER POINTER
	DCA	FLTXR
	TAD	EXP		/COMPUTE BITS IN 1ST DIGIT
	CLL CMA
	DCA	OUTDG		/TEMP COUNT
	TAD	DCOUNT		/SETUP COUNT OF TOTAL OUTPUT
	DCA	EXP
	JMS I	DOUBLE		/ROTATE OUT THE 1ST 4 BITS
	ISZ	OUTDG
	JMP	.-2
	TAD I	REPT		/TEST FOR 10-15, 0, 1-9
	SNA 
	JMP	FGO5		/IGNORE 1ST ZERO
	TAD	FM12
	SPA CLA
	JMP	.+7		/0-9
	IAC
	DCA I	FLTXR		/OUTPUT A 1
	ISZ	EXP		/COUNT THE DIGIT
	TAD	FM12		/CORRECT REMAINDER
	ISZ	T3		/BUMP DECIMAL EXPONENT
	NOP
	TAD I	REPT		/COMPUTE RESULTANT OR SECOND DIGIT 
	ISZ	T3
	NOP
	SKP
FGO5,	JMS I	M10PT		/IE. .672X10=6+.72.. ETC
	DCA I	FLTXR
	ISZ	EXP		/ALL DIGITS OUTPUT??
	JMP	.-3		/NO: CONTINUE
	TAD	SADR		/INIT BUFFER POINTER
	DCA	FLTXR
	TAD	DCOUNT
	JMS I	ROUND		/OUTPUT MANTISSA
	JMP I	FLOUTP		/FIXED POINT DONE
	TAD	CHRT		/PRINT "E"
	PRINTC
/	OUTPUT THE EXPONENT

	TAD	T3		/TAKE ABSOLUTE VALUE OF EXPONENT
	SPA
	CIA
	DCA	HORD		/SAVE + POWER 
	TAD	T3		/PRINT SIGN
	SMA CLA
	TAD	M2
	TAD	SMIN
	PRINTC
	TAD	HORD
	ISZ	EXP
	TAD	M144
	SMA
	JMP	.-3
	TAD	C144
	DCA	HORD		/SAVE TENS AND UNITS
	CMA			/OUTPUT HUNDREDS
	TAD	EXP
	SZA			/UNLESS ZERO
	JMS	OUTDG
	TAD	HORD		/PRINT TWO DIGITS
	JMS I	PRNTI
	JMP I	FLOUTP

PRNTI,	PRNT
CHRT,	"E			/E (0246) - FOR AMPERSAND
SMSP,	" -"-			/
PEQ,	"=
SMIN,	"-
M144,	-144			/-100
C144,	0144			/+100
M4,	-4
FM12,	-12
DCOUNT,	-DIGITS-1		/NUMBER OF DIGITS OUTPUT
PPTEN,	PTEN			/IEI
DPT,	DIGIT
REPT,	REMAIN			/OVERFLOW FROM INTEGER MULTIPLY
M10PT,	MULT10
SADR,	BUFFER-1
ROUND,	TGO			/ACTUAL OUTPUT ROUTINE
TENPT,	TEN
ABSOL2,	ABSOLV

OUTDG,	0			/OUTPUT ONE DIGIT
	TAD	C260
	PRINTC
	JMP I	OUTDG

/	USED BY 8K
/	FLOATING POINT INPUT

	PAGE

FLINTP,	0			/IF C(AC) = 0, USE CHAR
	SZA CLA			/IF C(AC) NON-ZERO, GET NEXT
	JMS I	XIN		/GET FIRST CHAR
	TAD	CHAR		/IGNORE LEADING SPACES
	TAD	M240
	SNA CLA
	JMP	.-4
	JMS I	DPCVPT		/READ FIRST DIGIT GROUP	
	TAD	CHAR		/AND SET "SIGNF"
	TAD	MPER
	SZA CLA			/ENDED BY PERIOD?
	JMP	FIGO1
	JMS I	XIN		/YES, READ 2AND GROUP
	DCA I	DPN
	JMS I	DCONP
	TAD I	DPN		/SAVE NUMBER OF DIGITS IN T3
	CMA IAC
FIGO1,	DCA	T3		/NO,
	TAD	P43
	DCA	EXP
	JMS I	RESOL5
	JMS I	INORM		/NORMALIZE FIRST, THEN
	FINT
	FPUT I	PT1		/SAVE NUMBER
	FEXT
	TAD	CHAR
	TAD	MINUSE
	SZA CLA			/"E" READ IN?
	JMP	ENDFI+3		/NO
	JMS I	XIN		/YES, READ 3RD DIGIT GROUP
	JMS I	DPCVPT		/I.E. CONVERT DECIMAL EXPONENT
	JMS I	RESOL5
	TAD	OVER2
	TAD	T3		/C(SEXP) PLACES TO RIGHT
	DCA	T3		/OF LAST DIGIT
/	COMPENSATE FOR DECIMAL EXPONENTS

ENDFI,	FINT			/RESTORE MANTISSA
	FGET I	PT1
	FEXT
	TAD	T3		/TEST DECIMAL EXPONENT
	SNA
	JMP I	FLINTP		/FINISHED
	SMA CLA
	JMP	FIGO4
	FINT			/. IS TO THE LEFT:
	FMUL	PTEN		/TIMES .1000
	FPUT I	PT1
	FEXT
	IAC
	JMP	.+6

FIGO4,	FINT			/. IS TO THE RIGHT:
	FMUL	TEN		/MULTIPLY BY 10
	FPUT I	PT1
	FEXT
	CMA
	TAD	T3
	DCA	T3
	JMP	ENDFI+3

TEN,	0004
	2400
	0000
	0000

PTEN,	7775
	3146
	3147			/(3146) - FOR 4-WORD
	3150

MINUSE,	-"E			/(7532) - FOR AMPERSAND

DPCVPT,	DECONV
DCONP,	DECON
RESOL5,	RESOLV
DPN,	DNUMBR
XIN,	INPUT
INORM,	DNORM
P43,	43

/	END OF FLOATING POINT INPUT

/	7 FREE

/	USED BY H.S. READER
	PAGE

/	FLOATING-POINT INTERPRETER FOR FOCAL.

FPNT,	0
	CLA CLL
	DCA	OVER2		/(NOP) - FOR 4-WORD
	DCA	OVER1		/(NOP) - FOR 4-WORD.
	TAD I	FPNT		/GET NEXT INSTRUCTION
	SNA
	JMP I	FPNT		/FAST EXIT
	DCA	JUMP
	TAD	JUMP
	AND	C200		/GET PAGE BIT
	SNA CLA			/PAGE ZERO?
	JMP	.+3		/YES
	TAD	P7600		/NO
	AND	FPNT		/C(FPNT)0-4 CONTAINS PAGE BITS
	DCA	ADDR
	TAD	P177		/GET 7 BIT ADDRESS
	AND	JUMP
	TAD	ADDR
	DCA	ADDR
	TAD	INDRCT		/INDIRECT BIT=1?
	AND	JUMP
	SNA CLA
	JMP	LOOP01		/NO-GO ON
	TAD I	ADDR		/YES, DEFER, W/O AUTO-INDEX
	DCA	ADDR
LOOP01,	ISZ	FPNT
	CMA
	TAD	ADDR
	DCA	FLTXR2
	TAD	JUMP		/GET COMMAND
	CLL RTL
	RTL
	AND	P17		/GET BITS 0-2, IE OPCODE
	SNA
	JMP	FLGT
	TAD	TABLE		/LOOKUP IN TABLE
	DCA	JUMP
	TAD I	JUMP
	SNA
	JMP	FLPT
	DCA	JUMP
	TAD	CEX1		/SAVE FLOATING ARGUMENT, UNLESS 'GET' OR 'PUT'
	DCA	FLTXR
	TAD	MFLT
	DCA	CNTR
	TAD I	FLTXR2
	DCA I	FLTXR
	ISZ	CNTR
	JMP	.-3
	JMP I	JUMP		/GO THERE
JUMP,	0

	ADDR=	EX1

INDRCT,	0400
TABLE,	ITABLE

FLPT,	TAD	CEXP		/EXP TO (ADDR)
	JMP	.+5

FLGT,	TAD	CEXP		/(ADDR) TO EXP
	DCA	FLTXR2
	CMA
	TAD	ADDR
	DCA	FLTXR		/SAVE 'FROM' ADDRESS
	TAD	MFLT		/3 OR 4 WORDS
	DCA	CNTR
	TAD I	FLTXR
	DCA I	FLTXR2
	ISZ	CNTR
	JMP	.-3
	JMP	FPNT+1

CEXP,	EXP-1
CEX1,	EX1-1


FLSU,	JMS I	OPMINS		/FSUB=2 - NEGATE THE OPERAND
FLAD,	JMS I	ALGN		/FLAD=1 - FIRST ALIGN EXPONENTS
	JMP	FPNT+1		/RETURN IF NO ALIGNMENT IS POSSIBLE
	JMS I	RAR2		/TRIPLE PRECISION ADDDITION
	JMS I	RAR1		/SINCE BITS ARE SHIFTED
	JMS I	TRAD		/RIGHT
NORF,	JMS I	NORM		/NORMALIZE THE RESULT
	JMP	FPNT+1		/HINT: USE 700X FOR FUNCTIONS.
/	INTERPRETIVE POWER

FLEX,	TAD	HORD		/ZERO?
	SZA CLA
	JMP	.+6
ZERO,	DCA	EXP		/YES
	DCA	HORD
	DCA	LORD
	DCA	OVER2
	JMP	FPNT+1

	PUSHF			/AC TO A + POWER
	FLAC
	PUSHF			/SETUP ARGUMENT (THE EXPONENT)
	EX1
	POPF
	FLAC
	JMS I	INTEGER		/ONLY POSITIVE, INTEGER  EXPONENTS
	SPA
	JMP	.+5		/(COULD DIVIDE)
	CMA
	DCA	JUMP		/TEMP STORAGE
	DCA	OVER1		/(NOP) - FOR 4-WORD
	TAD	HORD
	SZA CLA
	ERROR2			/TOO LARGE OR NEGATIVE EXPONENT
	PUSHF			/INITIALIZE TO ONE.
	FLTONE
	POPF
	FLAC
	POPF
	ITER1
	JMP	.+6
	PUSHF
	ITER1
	POPF
	EX1
	JMS I	MULT		/"MULT"
	ISZ	JUMP
	JMP	.-6
	JMP	FPNT+1
FLMY,	JMS I	MULT		/MULTIPLY
	JMP	FPNT+1


OPMINS,	MINUS2
MULT,	DMULT
NORM,	DNORM
ALGN,	ALIGN
RAR1,	DIV1
RAR2,	DIV2
TRAD,	DUBLAD

	ITABLE=	.-1

	FLAD
	FLSU
	FLDV
	FLMY
	FLEX
	0000
	NORF

ACMINS,	0			/ROUTINE TO  COMPLEMENT FLAC - VIA "MINSKI"
	CLA CLL
	TAD	OVER2		/TRIPLE PRECISION NEGATION
	CMA IAC			/OF FLOATING AC
	DCA	OVER2
	TAD	LORD
	CMA
	SZL
	CLL IAC
	DCA	LORD
	TAD	HORD
	CMA
	SZL
	CLL IAC
	DCA	HORD
	JMP I	ACMINS
ALIGN,	0			/SUBROUTINE TO ALIGN
	TAD	HORD		/BINARY POINTS
	SNA
	TAD	LORD		/IS MANTISSA ZERO?
	SNA CLA
	JMP	NOX1		/YES, RESULT=OPERAND
	TAD	AC1H		/NO, IS OPERAND ZERO?
	SNA
	TAD	AC1L
	SNA
	TAD	OVER1
	SNA CLA
	JMP I	ALIGN		/YES, EXIT.
	TAD	EX1
	CMA IAC
	TAD	EXP
	SNA			/ARE EXPONENTS EQUAL?
	JMP	ADONE		/YES
	DCA	ACMINS
	TAD	ACMINS
	SMA			/NO
	CIA			/NEGATE AND
	DCA	AMOUNT		/SAVE THE DIFFERENCE
	TAD	AMOUNT
	TAD	TEST2
	SPA CLA			/CAN THE EXPONENTS BE ALIGNED?
	JMP	NOX		/NO, USE LARGER OF THE TWO.
	TAD	ACMINS		/YES, SHIFT THE SMALLER
	SMA CLA
	JMP	ASHFT
	JMS	DIV2
	ISZ	AMOUNT
	JMP	.-2
	JMP	ADONE
ASHFT,	CMA	
	TAD	EX1
	DCA	EX1
	JMS I	TAG1
	ISZ	AMOUNT
	JMP	.-2
ADONE,	ISZ	ALIGN
	JMP I	ALIGN

NOX,	TAD	EX1		/MISSION IMPOSSIBLE!
	SMA CLA			/CHECK FOR SIGN DIFFERENCE
	JMP	NOX2
	TAD	EXP
	SMA CLA
	JMP I	ALIGN		/-+
	JMP	.+3		/--
NOX2,	TAD	EXP
	SMA CLA
	TAD	ACMINS		/TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG.
	SMA SZA CLA
	JMP I	ALIGN		/OK (+-)
NOX1,	TAD	EX1		/USE LARGER
	DCA	EXP
	TAD	AC1H
	DCA	HORD
	TAD	AC1L
	DCA	LORD
	TAD	OVER1
	DCA	OVER2
	JMP I	ALIGN

AMOUNT,	0
TAG1,	DIV1
/	LEAVE 12 BIT ANSWER IN AC UPON RETURN
/	LEAVE FLAC AS AN INTEGER,

FIX,	0			/VIA (INTEGER)
	JMS I	ABSOL
	TAD	EXP		/TEST FOR FRACTION
	SPA SNA CLA
	JMP	FIXM		/DOUBLE CHECK FOR MINUS ONE.
	IAC
	DCA	OVER1
	TAD	P27		/INIT ALIGNMENT
	DCA	EX1
	JMS	ALIGN		/DO THE ALIGNMENT TO AN INTEGER
TEST2,	0027			/ALREADY DONE; (43)-FOR 4-WORD
	ISZ	OVER2
	JMP	.+4
	ISZ	LORD
	SKP
	ISZ	HORD
	DCA	OVER2		/CLEAR THE FRACTION
	JMS I	RESOL
	TAD	LORD		/EXIT WITH LOW ORDER RESULT IN AC.
	JMP I	FIX

P27,	27
ABSOL,	ABSOLV
RESOL,	RESOLV

FIXM,	DCA	EXP		/CLEAR EXPONENT
	DCA	HORD
	DCA	LORD
	JMP	TEST2+6

DIV2,	0			/SHIFT FLAC RIGHT
	CLA CLL
	TAD	HORD
	SPA
	CML
	RAR
	DCA	HORD
	TAD	LORD
	RAR
	DCA	LORD
	TAD	OVER2
	RAR
	DCA	OVER2
	ISZ	EXP
	JMP I	DIV2
	JMP I	DIV2
	SPECIAL=.		/INPUT CHARACTERS

	337			/LEFT ARROW
	377			/RUBOUT
	"J&237			/L.F.
	375			/ALT MODE
	-1

/	(A+B+C)*(D+E+F)=A*D, A*E, B*D, B*E

DMULT,	0			/N- PRECISION MULTIPLY WITH
	IAC			/PRODUCT IN TRIPLE PRECISION
	TAD	EX1		/ADD EXPONENTS+1
	JMS	SIGN		/AND DETERMINE SIGN OF RESULT
	SPA CLA
	JMS	MINUS2
	DCA	DATUM-1		/INITIALIZE RESULT
	DCA	DATUM-2
	DCA	DATUM-3
	DCA	DATUM-4
	TAD	A		/A*D
	SAVE			/STORE IN MP2
	TAD	D		/SINGLE PRECISION MULTIPLY
	MULTY
	2			/ACCUMULATE STARTING IN #2 DATA WORD
	TAD	E		/A*E
	MULTY
	3
	TAD	B		/B*D
	SAVE
	TAD	D
	MULTY
	3
	TAD	E		/B*E
	MULTY
	4
DMULT4,	JMP	DMDONE		/(DCA DATUM-5)-FOR 4-WORD
	DCA	DATUM-6
	TAD	F		/A*F
	SAVE
	TAD	A
	MULTY
	4
	TAD	B		/B*F
	MULTY
	5
	TAD	C		/C*D
	SAVE
	TAD	D
	MULTY
	4
	TAD	E		/C*E
	MULTY
	5
	TAD F			/C*F
	MULTY
	6
DMDONE,	TAD	DATUM-1		/COPY RESULT
	DCA	HORD
	TAD	DATUM-2
	DCA	LORD
	TAD	DATUM-3
	DCA	OVER2
	JMS	MULDIV
	DCA	OVER2		/(NOP) - FOR 4-WORD
	JMP I	DMULT

	DATUM=	.+6		/INTERMEDIATE STORAGE

/	#6-LOW ORDER RESULT
/	#5
/	#4
/	#3
/	#2
/	#1-HIGH ORDER RESULT

	*DATUM-1

MULDIV,	0			/TERMINATE MULTIPLY AND DIVIDE.
	ISZ	SIGNF		/CORRECT FOR SIGN
	JMS I	MINSKI
	JMS I	NORMF		/SHIFT LEFT
	ISZ	OVER2		/ROUNDUP LAST BIT; (NOP) - FOR 4-WORD
	JMP I	MULDIV

FLDV,	TAD	AC1H		/4:DIVIDE
	SNA CLA
	ERROR2			/DIVISION BY ZERO
	TAD	EX1		/SUBTRACT EXPONENTS+1
	CMA IAC
	IAC
	JMS	SIGN		/SET UP SIGNS
	SMA CLA
	JMS	MINUS2		/NEGATE DIVISOR
	JMS I	DIVIDE		/DIVIDE
	JMS	MULDIV
	JMP I	.+1;	FPNT+1
/	THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE
/	FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO.
/	THE RESULT OF EITHER IS ZERO IF FLAC = 0.
/	RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO;
/	DIVISION BY ZERO IS CHECKED BEFORE THIS 
/	ROUTINE IS CALLED. 

/	THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE
/	EXPONENT. THE RETURNING AC CONTAINS THE SIGN OF 
/	THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE.


SIGN,	0			/TEST AND SAVE SIGN OF RESULT
	TAD	EXP		/COMPUTE NEW EXPONENT FOR MUL-DIV.
	DCA	EXP
	TAD	P4000		/LOAD 4000 TO XOR THE SIGN BITS
	AND	HORD
	TAD	AC1H
	SMA CLA			/RESULT MAY BE ZERO
	CMA
	DCA	SIGNF
	TAD	HORD
	SNA
	JMP I	REVIT		/ANSWER IS ZERO.
	SPA CLA			/TAKE ABSOLUTE VALUE OF FLAC
	JMS I	MINSKI
	TAD	AC1H
	SNA			/RESULT OF EITHER MAY BE ZERO
	JMP I	REVIT
	JMP I	SIGN

/	SIGN OF RESULT = SIGNF
/	+=-1
/	-=0

REVIT,	ZERO
NORMF,	DNORM
DIVIDE,	DUBDIV

	SAVE=	DCA I .;MP2
	MULTY=	JMS I .;MP4

	A=	FLAC+1
	B=	FLAC+2
	C=	FLAC+3
	D=	AC1H
	E=	AC1L
	F=	OVER1
MINUS2,	0			/NEGATE OPERAND
	CLA CLL			/TRIPLE PRECISION
	TAD	OVER1
	CMA IAC
	DCA	OVER1
	TAD	AC1L
	CMA
	SZL
	CLL IAC
	DCA	AC1L
	TAD	AC1H
	CMA
	SZL
	CLL IAC
	DCA	AC1H
	JMP I	MINUS2

RESOLV,	0
	TAD	SIGNF
	SPA CLA
	JMS I	MINSKI
	JMP I	RESOLV

	PAGE

MP4,	0			/SINGLE PRECISION, UNSIGNED MULTIPLY - "MULTY"
	SNA			/NO RESULT ADDED IF ZERO
	JMP I	MP4

/	FOR EAE INSERT THE FOLLOWING:

/	7203  3206  DCA	.+3
/	7204  1256  TAD	MP2
/	7205  7425  MQL MUY
/	7206  0000  0
/	7207  3253  DCA	MP5
/	7210  7501  MQA
/	7211  3255  DCA	MP3
/	7212  5227  JMP	.+15
	DCA	MP1		/12 BITS BY 12 BITS
	DCA	MP5
	TAD	THIR
	DCA	MP3
	CLL
MP6,	TAD	MP1
	RAR
	DCA	MP1
	TAD	MP5
	SNL
	JMP	.+3
	CLL
	TAD	MP2
	RAR
	DCA	MP5		/SAVE HIGH ORDER RESULT
	ISZ	MP3
	JMP	MP6
	TAD	MP1		/CORRECT LOW ORDER RESULT
	RAR
	DCA	MP3
	TAD I	MP4		/PICKUP SCALE FACTOR
	CIA
	TAD	DATUMA		/COMPUTE ADDRESS
	DCA	MP1		/TEMP
	TAD	MP3		/LOW ORDER PART
	CLL
	TAD I	MP1		/ACCUMULATE
	DCA I	MP1
	ISZ	MP1
	RAL
	TAD	MP5
	TAD I	MP1
	DCA I	MP1
	SNL
	JMP I	MP4		/NO CARRY
	ISZ	MP1
	ISZ I	MP1
	JMP I	MP4
	JMP	.-3		/CARRY AGAIN

DATUMA,	DATUM
MP5,	0			/PRODUCT
MP1,	0			/MULTIPLIER
MP3,	0
MP2,	0			/MULTIPLICAND
THIR,	-14			/12 BITS
MIF,	-27			/(-43) - FOR 4-WORD (=7735)
DUBDIV,	0			/2 OR 3  PRECISION DIVIDE
	DCA	MP4
	DCA	MP1
	TAD	MIF		/INIT BIT COUNTER
	DCA	MP3
	SKP
DV3,	JMS I	DOUBLE		/SHIFT FLAC LEFT
	CLL
	TAD	AC1L		/COMBINE ONE POSITION AND (4-WORD)
	TAD	LORD
	DCA	MP2		/SAVE RESULT
	RAL
	TAD	HORD		/ADD OVERFLOW
	TAD	AC1H
	SNL			/SKIP IF OVERFLOW
	JMP	.+4
	DCA	HORD		/UPDATE FLAC
	TAD	MP2
	DCA	LORD
	CLA			/CLEAR ACCUMULATOR
	TAD	MP1		/SAVE OVERFLOW BITS CIRCULARLY
	RAL
	DCA	MP1	
	TAD	MP4
	RAL
	DCA	MP4
	ISZ	MP3		/TEST FOR END OF DIVIDE
	JMP	DV3
	TAD	MP1		/LOAD RESULTS
	DCA	LORD
	TAD	MP4
	DCA	HORD
	JMP I	DUBDIV		/(NOP)
	RAL			/EXTRA FOR 4-WORD
	DCA	DNORM
	ISZ	MP3		/TEST FOR END OF DIVIDE
	JMP	DV3
	TAD	DNORM
	DCA	HORD
	TAD	MP4
	DCA	LORD
	TAD	MP1
	DCA	OVER2
	JMP I	DUBDIV
DNORM,	0			/SUBROUTINE TO NORMALIZE FLAC
	JMS I	ABSOL3
	JMS	TEST4
	TAD	HORD
	SNA			/IS MANTISSA=0?
	TAD	OVER2
	SNA
	TAD	LORD
	SNA CLA
	JMP	EXIT3		/YES
	TAD	HORD
	CLL RAL
	SPA CLA			/WILL SHIFT BE TOO FAR?
	JMP	.+6
	JMS I	DOUBLE
	CLL CMA
	TAD	EXP
	DCA	EXP
	JMP	.-10

	JMS I	RESOL3
	JMS	TEST4		/DON'T LEAVE 4000
	JMP I	DNORM

EXIT3,	DCA	EXP		/SET TO ZERO
	JMP I	DNORM		/RETURN

XRAR2,	DIV2

TEST4,	0
	TAD	HORD		/TEST FOR 4000
	SPA
	CIA
	SPA CLA
	JMS I	XRAR2		/SHIFT BACK
	JMP I	TEST4

ABSOL3,	ABSOLV
RESOL3,	RESOLV
	PAGE

/	FLOATING SQUARE ROOT FUNCTION

XSQRT,	FINT
	FPUT	FPAC1		/VALUE
	FEXT			/NEWTON'S METHOD IS USED
	GETSGN
	SPA CLA
	ERROR2			/NUMBER IS NEGATIVE=IMAGINARY ROOTS
	TAD	EXP		/LINK IS =0 FROM FINT
	SPA			/MATCH THE SIGN WITH LINK BIT
	CML
	RAR
	DCA	ITER1		/MAKE FIRST APPROXIMATION
	SZL			/TEST LSB OF EXP
	ISZ	ITER1
	NOP
	TAD	SQCON1
	DCA	ITER1+1
	DCA	ITER1+2
	DCA	ITER1+3
	TAD	FPAC1+1
	SNA
	TAD	FPAC1+2
	SNA CLA
	JMP	SQEND		/NUMBER=0
CLCU,	FINT
	FGET	FPAC1
	FDIV	ITER1
	FADD	ITER1
	FEXT
	CLA CMA
	TAD	EXP
	DCA	EXP
	TAD	EXP
	CMA IAC
	TAD	ITER1
	SZA CLA			/ARE EXPONENTS EQUAL?
	JMP	ROOTGO		/NO
	TAD	HORD		/ARE HIGH-ORDER MANTISSAS EQUAL?
	CMA IAC
	TAD	ITER1+1
	SZA CLA
	JMP	ROOTGO		/NO
	TAD	LORD
	CMA IAC	
	TAD	ITER1+2		/DO LOW-ORDER MANTISSAS AGREE
	SMA
	CMA IAC			/WITHIN ONE BIT?
	IAC
	SMA CLA
	RETURN
ROOTGO,	FINT
	FPUT	ITER1
	FEXT
	JMP	CLCU

SQEND,	DCA	EXP
	RETURN

SQCON1,	3015

	BUFFER=	.

ITER1,	0
	0
	0
	0

FPAC1,	0
	0
	0
	BUFFER+13		/ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION.

	ENPUNCH			/IN CASE BINARY WAS TURNED OFF BEFORE

	$			/THAT'S ALL FOLK!
