/MODE "B" E.A.E. PATCHES TO FOCAL8
/ SYMBOLS:
EX1=	40	/ OPERAND:
AC1=	41	/"AC1H" IN FOCAL8 LISTING
AC1L=	42
OVER1=	43	/ GUARD WORD (MANTISSA #3)
EXP=	44	/ FLAC (FLOATING AC):
HORD=	45
LORD=	46
OVER2=	47
SIGNF=	50	/-1 FOR POSITIVE ANSWER
MINSKI=	51	/ POINTS TO "ACMINS"
ERROR2=	JMS I 166
DUBLAD=	5733
DIV1=	5754	/ SHIFTS OPERAND RIGHT
DIV2=	6757	/   "	 FLAC	 "
FPNT=	6400	/ INTERPRETER
ALIGN=	6623
TEST2=	6736	/ HOLDS OCTAL 27
SIGN=	7124
MINUS2=	7153
TEST4=	7366
/ E.A.E. STUFF:
SAM=	7457
SGT=	6006
SWAB=	7431	/ ALSO DOES AN MQL...
MUY=	7405
DVI=	7407
CAM=	7621
DLD=	7663
DST=	7445
DCM=	7575	/ DOUBLE-PREC. "CIA"
SHL=	7413
LSR=	7417	/ LOGICAL: 0 SHIFTED INTO AC(0)
ASR=	7415	/ SIGNED: AC(0) SHIFTED INTO AC(0)
/THESE PATCHES ARE INCOMPATIBLE WITH ANY SORT
/OF "4-WORD" (10 PLACE) OVERLAY.  THEY WILL WORK
/WITH EITHER 4-K OR 8-K ONE USER FOCAL8.
/THEIR USE WITH "QUAD" ETC. HAS NOT BEEN TESTED.
/A FIRST GUESS SUGGESTS THAT IT MIGHT WORK.
/CERTAIN PURELY LOCAL SUBROUTINES HAVE BEEN
/ELIMINATED.
/ PATCH FLOATING ADD TO CUT OUT RIGHT SHIFT
/ WHEN SIGNS OF FLAC & OPERAND DIFFER:
*6506
FLAD,	JMS I ALGN	/ALIGN EXPONENTS
	JMP FPNT+1	/NOT POSSIBLE
	CLA SWP		/MQ>=0 IF SIGNS AGREE
	SPA CLA		/SIGNS ALIKE
	JMP .+3		/OPPOSITE. SKIP SHIFTS.
	 JMS I RAR2	/ SHIFT FLAC RIGHT
	 JMS I RAR1	/ ..AND OPERAND
	JMS I TRAD	/DO ADDITION
NORF,	JMS I NORM
	JMP FPNT+1
*6567
NORM,	DNORM
ALGN,	ALIGN
RAR1,	DIV1
RAR2,	DIV2
TRAD,	DUBLAD
*6602
	NORF		/IN "ITABLE"
*ALIGN+5	/ MODIFY "ALIGN" ROUTINE:
	JMP NOX1
*ALIGN+15
	TAD EXP
	SWAB		/MQL & MODE "B"
	TAD EX1		/OPERAND
	SAM		/SUBTRACT EXP-EX1
	SNA		/ARE EXPONENTS EQUAL?
	JMP ADONE	/YES.
	SPA
	CIA		/BE SURE IT'S POSITIVE!
	MQL		/STORE
	MQA		/RETRIEVE
	CIA
	TAD TEST2	/ALIGNABLE?
	SPA CLA
	JMP NOX		/NO. USE THE LARGER NO.
	SGT
	JMP I BSHFT	/SHIFT FLAC
	JMP I ASHFT	/SHIFT OPERAND
BSHFT,	SHFLAC
ASHFT,	SHOPER
ADONE,	CLA STL RAR	/4000
	AND AC1		/SIGN OF OPERAND
	TAD HORD	/SUM POS. IF LIKE SIGNS;
	MQL		/NEG., IF SIGNS DIFFER.
	ISZ ALIGN	/SECOND RETURN
	JMP I ALIGN
NOX,	SGT
	JMP NOX1	/OPERAND IS THE GREATER
	JMP I ALIGN	/FLAC IS GREATER
NOX1,	DLD
	  EX1		/LOAD OPERAND
	DST
	  EXP		/INTO FLAC
	DLD
	  AC1L
	DST
	  LORD
	CAM
	JMP I ALIGN
/NEXT OCCUPIED LOCATION: 6724 ("FIX")
/ TRIPLE-PRECISION MULTIPLY:
*7004
DMULT,	0
	IAC
	TAD EX1		/EXPONENTS+1
	JMS SIGN
	SPA CLA		/IF NECESSARY,
	JMS MINUS2	/  NEGATE OPERAND
	TAD LORD
	SWAB		/MODE "B" THROUGHOUT
	MUY
	  AC1L		/LOW FLAC * LOW OPERAND
	MQL		/ONLY THE CARRY MATTERS
	TAD HORD	/HI FLAC * LO OPERAND
	SWP MUY
	  AC1L
	SWP		/GET PROD., LOW WORD
	DCA OVER2	/FLAC, MANTISSA #3
	SWP		/CARRY, IF ANY
	DCA WORD2	/STASH FOR A MINUTE
	TAD LORD
	MQL MUY
	  AC1		/LOW FLAC * HI OPERAND
	SWP		/PRODUCT INTO AC
	TAD OVER2	/ALSO A 3RD ORDER TERM
	DCA OVER2	/FINAL VALUE
	SZL		/NO ADDITIVE CARRY?
	ISZ WORD2	/AH, THERE WAS!
	TAD HORD	/HI FLAC * HI OPERAND
	SWP MUY
	  AC1
	SWP
	TAD WORD2
	DCA LORD	/WORD #2
	SWP
	SZL
	CLL IAC		/ADDITION CARRY, IF ANY
	DCA HORD	/WORD #1
	ISZ SIGNF	/"MULDIV", FORMERLY A SUBR.
	JMS I MINSKI	/SKIP IF + ANSWER WANTED
	JMS I NORMF	/NORMALIZE ANSWER
	CAM
	DCA OVER2
	JMP I DMULT
/ ROUTINE TO SHIFT OPERAND RIGHT
/ MQ CONTAINS THE SHIFT COUNT:
SHOPER,	CLA MQA
	DCA OKTR1
	SWP
	DCA OKTR2
	TAD OVER1	/LOWEST MANTISSA WD.
	SWAB		/MQL & MODE "B"
	TAD AC1L
	LSR		/SHIFT RIGHT, INSERTING 0'S
OKTR1,	  0
	SWP DST		/REVERSE ORDER, STORE
	  AC1L		/INTO AC1L AND OVER1
	CAM
	TAD AC1
	ASR		/IF NEG., INSERT 1'S
OKTR2,	  0
	DCA AC1
	SWP		/GET SHIFT-OUTS
	TAD AC1L
	DCA AC1L
	CLA CLL CMA	/-1
	TAD OKTR1
	TAD EX1
	DCA EX1		/CORRECT EXPONENT
	JMP I .+1
	ADONE		/BACK TO "ALIGN"
WORD2=	OKTR1
*7107	/ FIX UP "FLDV":
FLDV,	TAD AC1
	SNA CLA
DVOVER,	ERROR2		/DIVIDE OVERFLOW
	TAD EX1
	CIA		/NO OFFSET, IN THIS CASE
			/(WE PRE-SHIFT DIVISOR)
	JMS SIGN
	SPA CLA		/DIVISOR MUST BE POSITIVE
	JMS MINUS2	/NEGATE DIVISOR (ABS. VAL.)
	JMP I DIVIDE	/TO "DUBDIV", 7200
/"FPI()" FUNCTION, REPLACES FZ() IN TABLES.
/ *** WARNING: THE SINE FUNCTION MUST BE
/     RESIDENT IF YOU USE FPI(); ELSE THE
/     RESULT WILL BE GARBAGE.
/USED TO GET INTERNAL VALUES OF PI*(X).
/FASTER & SHOULD BE MORE ACCURATE THAN PRO-
/GRAMMED CALCULATIONS.
/N.B.:
/	FPI(1)/180 GIVES BETTER VALUES THAN
/	FPI(1/180).
FPI,	FINT		/FPI(X)=PI*X
	FMUL I PISTOL	/MULT. FLAC BY PI
	FEXT		/LEAVE INTERPRETER
	JMP I EFUN3I	/RETURN
*7147
NORMF,	DNORM
DIVIDE,	DUBDIV
PISTOL,	PI		/PI STORAGE LOCN.
EFUN3I=	136
FINT=	JMS I 7
FEXT=	0
PI=	5312
FIXMRI	FMUL=	4000
/FOCAL'S PI IS > VALUE GIVEN IN BOOKS;
/APPARENTLY WORKS BETTER IN THIS F.P.P.
*2172			/LIST OF (HASHED) NAMES
	"P^2+"I		/"PI" REPLACES 332 ("Z")
*401
	FPI		/ADDRESS, REPLACES 2725
/RESTORING THE 2 LOCATIONS ABOVE TO 332 AND
/2725 GETS RID OF "FPI()" & RE-ENABLES "FZ()".
/ LONG DIVISION, E.A.E., FOCAL8:
/ ADAPTED FROM EAE FPP ROUTINES PUBLISHED
/ BY DEC.  [W.J. CLOGHER, WHO QUOTES I. FLORES]
*7200
DUBDIV,	TAD OVER1	/SHIFT DIVISOR LEFT
	SWAB		/MQL & MODE "B"
	TAD AC1L	/MANTISSA #2 & #3, OPERAND
	SHL
	  1
	DCA V2		/"V" HOLDS DIVISOR
	TAD AC1		/MANTISSA #1, OPERAND
	RAL		/LINK INTO BIT 11
	DCA V1
/NOTE THAT THIS GIVES A 24-BIT DIVISOR, NOT 23.
/DIVIDE OVERFLOW--ASSUMING NORMALIZATION--SHOULD
/BE IMPOSSIBLE.  0 DIVISORS ARE TRAPPED IN "FLDV".
	DLD
	  HORD		/LOAD FLAC (BACKWARDS)
	SWP DVI
	  V1
	DST		/STORE QUOT. IN DVQUOT,
	  DVQUOT	/ REM. IN DVREM
DVLP,	CLA CLL
	MUY		/QUOTIENT IS STILL IN MQ
	  V2		/QUOT.*V2 / 4096
	DCM		/NEGATE, SEE IF IT'S
	TAD DVREM	/  GREATER THAN REMAINDER
	SZL		/YES, ADJUST 1ST DIVIDE.
	JMP DIVN2	/NO ADJUSTMENT NEEDED
/--------
DVOPS,	CIA
	DCA DVREM	/ADJUST REMAINDER
	TAD V1		/WATCH FOR OVERFLOW
	CLL CIA
	TAD DVREM
	SNL
	JMP DVOP1	/DON'T ADJUST QUOTIENT
	DCA DVREM	/YES, ADJUST
	CMA
	TAD DVQUOT	/DECREASE QUOTIENT
	DCA DVQUOT	/..BY 1
/ LONG DIVISION, CONTINUED:
DVOP1,	CLA CLL
	TAD DVREM	/REMAINDER
	SNA		/ZERO?
	CAM		/YES--ZERO EVERYTHING
	DVI		/NO, DIVIDE
	  V1		/..BY HI OPERAND
	SZL CLA
	JMP I OVERDV	/OVERFLOW
	DCM		/NEGATE. ADJUST HI QUOT.
	JMP DVLP1
/--------
DIVN2,	DVI		/DIVIDE BY HI OPERAND
	  V1
	SZL CLA
	JMP I OVERDV	/OVERFLOW
DVLP1,	TAD DVQUOT	/RETRIEVE QUOTIENT, 1ST DIV.
	SMA
	JMP POSQUO	/O.K. AS IT IS
NEGQUO,	LSR		/NEGATIVE.  SHIFT RIGHT.
	  1
	ISZ EXP		/PAY BACK EXP FOR OUR DEED
	NOP
POSQUO,	ISZ SIGNF	/POS. ANSWER WANTED?
	DCM		/NO.  NEGATE.
	SWP DST
	  HORD
	CLA CLL
	DCA OVER2
	JMP I .+1
	FPNT+1		/INTERPRETER
/NO FURTHER NORMALIZATION IS NEEDED.
OVERDV,	DVOVER	/PREV. PAGE
DVQUOT,	0	/"DAD" & "DST" WORK BACKWARDS
DVREM,	0
V2=	TEST4
/ ROUTINE TO SHIFT FLAC RIGHT
/ MQ CONTAINS THE SHIFT COUNT:
SHFLAC,	CLA MQA
	DCA FKTR1
	SWP
	DCA FKTR2
	TAD OVER2	/LOWEST MANTISSA WD.
	SWAB		/MQL & MODE "B"
	TAD LORD	/2ND MANTISSA WD.
	LSR
FKTR1,	  0
	SWP DST		/THAT INVERTED ORDER!
	  LORD		/INTO LORD AND OVER2
	CAM
	TAD HORD	/HIGH MANTISSA
	ASR
FKTR2,	  0
	DCA HORD
	SWP		/GET SHIFT-OUTS
	TAD LORD
	DCA LORD
	TAD FKTR1	/UPDATE EXP
	TAD EXP
	DCA EXP
	JMP I .+1
	ADONE		/BACK TO "ALIGN"
	ZBLOCK 4	/THESE LOCNS. ARE FREE
DNORM,	0		/ENTRY, "DNORM"
V1=	DNORM
/ SEVERAL E.A.E. VERSIONS OF "DNORM" WERE TRIED.
/ THERE WAS LITTLE IMPROVEMENT IN RUNNING TIME;
/ GENERALLY, POST-OPERATIVE NORMALIZATION DOES
/ NOT INVOLVE LARGE SHIFTS.
$$$$	PAS  11/74	$$$$