File F1092.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/EAE EXTENDED FUNCTIONS-23 BIT

/1-31-72       R BEAN

/COPYRIGHT     1972 DIGITAL EQUIPMENT CORPORATION,MAYNARD, MASS. 01754

/DEC-8E-NEAEA-A    VERSION 1


	FIXMRI	FADD=1000
	FIXMRI	FSUB=2000
	FIXMRI	FMPY=3000
	FIXMRI	FDIV=4000
	FIXMRI	FGET=5000
	FIXMRI	FPUT=6000
	FEXT=0000;FNOR=7000


	EXP=44;HORD=45;LORD=46

FIXFLT=5500
	*FIXFLT

	/******FIX******
/ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO
/A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44)

FFIX,	0
	CLA
	TAD EXP 	/FETCH EXPONENT
	SZA SMA 	/IS NUMBER <1?
	 JMP .+3	/NO-CONTINUE ON
FTRPRT, CLA
	JMP FIXDNE+1	/YES-FIX IT TO 0
	TAD M13 	/SET BINARY POINT AT 11
	SNA		/PLACES TO RIGHT OF CURRENT POINT?
	 JMP FIXDNE	/NO-NUMBER IS ALREADY FIXED THEN.
	SMA		/YES-IS NUMBER TOO LARGE TO FIX?
	 JMP I OTRAPA	/YES-TAKE OVERFLOW TRAP
	DCA EXP 	/NO-SET SCALE COUNT
FIXLP,	CLL		/0 IN LINK
	TAD HORD	/GET HIGH MANTISSA
	SPA		/IS IT <0?
	 CML		/YES-PUT A 1 IN LINK
	RAR		/SCALE RIGHT
	DCA HORD	/SAVE
	ISZ EXP 	/DONE YET?
	 JMP FIXLP	/NO
FIXDNE, TAD HORD	/YES-ANSWER IN AC
	DCA EXP 	/RETURN WITH ANSWER IN 44
	JMP I FFIX	/RETURN

M13,	-13		/-11 DECIMAL
C13,	13		/11 DECIMAL
OTRAPA, FTRP1		/ADDRESS OF VECTOR FOR OVERFLOW TRAP

/******FLOAT******
/ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC

FFLOAT, 0
	TAD EXP
	DCA HORD	/PUT NUMBER IN HI MANTISSA
	DCA LORD	/CLEAR LOW MANTISSA
	TAD C13 	/11(10) INTO EXPONENT
	DCA EXP
	JMS I FNORL	/NORMALIZE
	JMP I FFLOAT	/RETURN
FNORL,	FFNOR		/LINK TO NORMALIZE ROUTINE
*5000

/******SINE******

SIN,	0
	JMS NHNDLE	/IF X<0,NEGATE X AND SET NFLAG
	JMS I FMPYL	/X*2/PI
	  TOVPI
	JMS FRACT	/SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FR
RACTIONAL PART IN FAC
	TAD NUM 	/GET INTEGER PART OF (2/PI)*X
	AND C3		/ISOLATE BITS 10,11
	TAD JMPI
	DCA .+1 	/MAKE JUMP TO ARGUMENT REDUCING ROUTINE
	JMP .		/AND ADJUST ARG ACCORDING TO QUADRANT OF X
JMPI,	JMP I .+1
	POLYSN		/X IN QUAD1,SIN(X)=SIN(X)
	QUAD2		/X IN QUAD2,SIN(X)=SIN(1-X)
	QUAD3		/X IN QUAD3,SIN(X)=SIN(-X)
	QUAD4		/X IN QUAD4,SIN(X)=SIN(X-1)

QUAD2,	JMS I FSUB1L	/1-X
	  ONE
	JMP POLYSN	/CALCULATE SIN(1-X)
QUAD3,	JMS I FNEGL	/-X
	JMP POLYSN	/CALCULATE SIN(-X)
QUAD4,	JMS I FSUBL	/X-1
	  ONE
POLYSN, JMS I FPUTL	/SAVE X
	  TEMP1
	JMS I FSQRL	/U=X**2
	JMS I FPUTL	/SAVE U
	  TEMP2
	JMS I FMPYL	/A7*U
	  SINA7
	JMS I FADDL	/A5+A7*U
	  SINA5
	JMS I FMPYL	/A5*U+A7*U**2
	  TEMP2
	JMS I FADDL	/A3+A5(U)+A7(U**2)
	  SINA3
	JMS I FMPYL	/A3(U)+A5(U**2)+A7(U**3)
	  TEMP2
	JMS I FADDL	/A1+A3(U)+A5(U**2)+A7(U**3)
	  SINA1
	JMS I FMPYL	/A1(X)+A3(X**3)+A5(X**5)+A7(X**7)
	  TEMP1
	JMS NCHK	/IF NFLAG IS SET,SET SIN(X)=-SIN(X)
	JMP I SIN	/FAC=SIN(X)


/******COSINE******
/USES SIN ROUTINE TO CALCULATE COS(X)

COS,	0
	JMS I FADDL	/COS(X)=SIN(PI/2+X)
	  PIOV2
	JMS SIN
	JMP I COS	/RETURN

FGETL,	FFGET
FADDL,	FFADD
FMPYL,	FFMPY
FPUTL,	FFPUT
FDIVL,	FFDIV
FSUB1L, FFSUB1
FNEGL,	FFNEG
FSUBL,	FFSUB
FSQRL,	FFSQ
FIXL,	FFIX
FLOATL, FFLOAT
FDIV1L, FFDIV1
C3,	3
TEMP1,	0
	0
	0
TEMP2,	0		/TWO TEMP STORAGE BLOCKS FOR FUNCTIONS
	0
	0
ONE,	1		/1
	2000
	0

/ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC
/ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS
/SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC

FRACT,	0
	JMS I FPUTL	/SAVE X
	  TEMP1
	JMS I FIXL	/INTEGER PORTION OF X
	TAD EXP
	DCA NUM 	/SAVE FIXED FORTION OF X
	JMS I FLOATL	/FAC=FLOAT(FIX(X))
	JMS I FSUB1L	/FAC=X-INT(X)=FRACTION (X)
	  TEMP1
	JMP I FRACT	/RETURN

/ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS
/SET TO 1

NHNDLE, 0
	TAD HORD	/FETCH HIGH ORDER MANTISSA
	SMA CLA 	/IS IT <0?
	 JMP NFLGST	/NO-CLEAR NFLAG
	JMS I FNEGL	/YES-NEGATE FAC
	IAC		/AND SET NFLAG
NFLGST, DCA NFLAG
	JMP I NHNDLE

/ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0

NCHK,	0		/LOC ALSO USED FOR TEMP STORAGE
	TAD NFLAG
	SZA CLA 	/IS NFLAG=0?
	 JMS I FNEGL	/NO-NEGATE FAC
	JMP I NCHK	/YES-RETURN

	NUM=NCHK

/******EXPONENTIAL******

EXPON,	0		/LOC USED FOR TEMP STORAGE BY SIN,ARCTAN
	JMS I FMPYL	/Y=XLOG2(E)
	  LOG2E
	JMS FRACT	/GET FRACTIONAL PART OF Y
	JMS I FMPYL	/(FRACTION(Y))*(LN2/2)
	  LN2OV2
	JMS I FPUTL	/SAVE Y
	  TEMP1
	JMS I FSQRL	/Y**2
	JMS I FADDL	/B1+Y**2
	  EXPB1
	JMS I FDIV1L	/A1/(B1+Y**2)
	  EXPA1
	JMS I FADDL	/A0+A1/(B1+Y**2)
	  EXPA0
	JMS I FSUBL	/A0-Y+A1/(B1+Y**2)
	  TEMP1
	JMS I FPUTL	/SAVE
	  TEMP2
	JMS I FGETL	/GET Y
	  TEMP1
	ISZ EXP 	/MULT. BY 2=2Y
	 NOP
	JMS I FDIVL	/2Y/(A0-Y+A1/(B1+Y**2))
	  TEMP2
	JMS I FADDL	/1+2Y/(AO-Y+A1/(B1+Y**2))
	  ONE
	JMS I FSQRL	/ 1+2Y/(A0-Y+A1/(B1+Y**2)) **2=EXP(Y)
	TAD NUM
	TAD EXP 	/EXP(X)=(2**N)(EXPY)
	DCA EXP
	JMP I EXPON	/FAC=EXPON(X)

	NFLAG=EXPON

/CONSTANT THAT WOULDN'T FIT ELSEWHERE
TOVPI,	0		/.6366198
	2427
	6302
	*SIN+200

/******ARC TANGENT******

ATAN,	0
	JMS I NHNDLL	/IF X<0,SET NFLAG AND NEGATE
	JMS I FPUTM	/SAVE X
	  TEMP1
	JMS I FSUBM	/X-1
	  ONE
	TAD HORD	/GET HI MANTISSA
	SPA CLA 	/WAS X>1?
	 JMP ARGPOL	/NO-CLEAR GT1FLG
	JMS I FGETM	/YES-ATAN(X)=PI/2-ATAN(1/X)
	  ONE
	JMS I FDIVM	/1/X
	  TEMP1
	JMS I FPUTM
	  TEMP1
	IAC		/SET GT1FLG
ARGPOL, DCA GT1FLG
	JMS I FGETM	/GET X OR 1/X
	  TEMP1
	JMS I FSQRM	/Y**2
	JMS I FPUTM	/SAVE
	  TEMP2
	JMS I FADDM	/Y**2+B3
	  ATANB3
	JMS I FDIV1M	/A3/(Y**2+B3)
	  ATANA3
	JMS I FADDM	/B2+A3/(Y**2+B3)
	  ATANB2
	JMS I FADDM	/Y**2+B2+A3/(Y**2+B3)
	  TEMP2
	JMS I FDIV1M	/A2/(Y**2+B2+A3/(Y**2+B3))
	  ATANA2
	JMS I FADDM	/B1+A2/(Y**2+B2+A3/(Y**2+B3))
	  ATANB1
	JMS I FADDM	/Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))
	  TEMP2
	JMS I FDIV1M	/A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
	  ATANA1
	JMS I FADDM	/B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))
	  ATANB0
	JMS I FMPYM	/ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))))
	  TEMP1
	TAD GT1FLG	/WAS X>1?
	SNA CLA
	 JMP NGT	/NO-TEST IF X<0?
	JMS I FSUB1M	/ATAN(X)=PI/2-ATAN(1/X)
	  PIOV2
NGT,	JMS I NCHKL	/IF NFLAG SET,NEGATE FAC
	JMP I ATAN	/FAC=ATAN(X)

NHNDLL, NHNDLE
NCHKL,	NCHK


/******NAPERIAN LOGARITHM******

	GTFLG=ATAN

LOG,	0
	TAD HORD
	SPA SNA 	/X<0 OR X=0?
	 JMP I ARTRAP	/YES-TAKE ILLEGAL ARGUMENT TRAP
	CLL RTL
	SNA		/NO-HORD=2000?
	 TAD EXP	/YES-EXP=1?
	CMA IAC
	IAC
	SNA
	TAD LORD	/YES-LORD=0?
	SZA CLA
	 JMP POLYNL	/NO-ARG IS LEGAL AND NOT 1
	DCA EXP
	DCA LORD
LTRPRT, DCA HORD
	JMP I LOG	/YES-LOG(1)=0
POLYNL, TAD EXP
	DCA GTFLG	/SAVE EXPONENT FOR LATER
	DCA EXP 	/ISOLATE MANTISSA IN FAC
	JMS I FPUTM	/SAVE F
	  TEMP1
	JMS I FADDM	/F+SQR(.5)
	  SQRP5
	JMS I FPUTM	/SAVE
	  TEMP2
	JMS I FGETM
	  TEMP1
	JMS I FSUBM	/F-SQR(.5)
	  SQRP5
	JMS I FDIVM	/Z=F+SQR(.5)/F-SQR(.5)
	  TEMP2
	JMS I FPUTM
	  TEMP1
	JMS I FSQRM	/Z**2
	JMS I FPUTM
	  TEMP2
	JMS I FMPYM	/C5(Z**2)
	  LOGC5
	JMS I FADDM	/C3+C5(Z**2)
	  LOGC3
	JMS I FMPYM	/C3(Z**2)+C5(Z**4)
	  TEMP2
	JMS I FADDM	/C1+C3(Z**2)+C5(Z**4)
	  LOGC1
	JMS I FMPYM	/C1(Z)+C3(Z**3)+C5(Z**5)
	  TEMP1
	JMS I FSUBM	/C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F)
	  ONEHAF
	JMS I FPUTM	/SAVE LOG2(F)
	  TEMP2
	TAD GTFLG	/I
	DCA EXP 	/SET UP FLOAT
	JMS I FLOATM
	JMS I FADDM	/I+LOG2(F)
	  TEMP2
	JMS I FMPYM	/ I+LOG2(F) *LOGE(2)=LOGE(X)
	  LN2
	JMP I LOG	/FAC=LN(X)

	GT1FLG=LOG
FPUTM,	FFPUT
FMPYM,	FFMPY
FADDM,	FFADD
FDIVM,	FFDIV
FDIV1M, FFDIV1
FSUBM,	FFSUB
FSUB1M, FFSUB1
FSQRM,	FFSQ
FLOATM, FFLOAT
FGETM,	FFGET
ARTRAP, FTRP3

/CONSTANTS USED BY VARIOUS FUNCTIONS

SINA1,	1		/1.5707949
	3110
	3747
SINA3,	0		/-.64592098
	5325
	1167
SINA5,	7775		/.07948766
	2426
	2466
SINA7,	7771		/-.004362476
	5610
	3164
PIOV2,	1		/1.5707963
	3110
	3756
LOG2E,	1		/1.442695
	2705
	2434
LN2OV2, 7777		/.34657359
	2613
	4415
EXPB1,	6		/60.090191
	3602
	7054
EXPA1,	12		/-601.80427
	5514
	3104
EXPA0,	4		/12.015017
	3001
	7301
ATANB0, 7776		/.17465544
	2626
	6157
ATANA1, 2		/3.7092563
	3553
	1071
ATANB1, 3		/6.762139
	3303
	670
ATANA2, 3		/-7.10676
	4344
	5267
ATANB2, 2		/3.3163354
	3241
	7554
ATANA3, 7777		/-.26476862
	5703
	4040
ATANB3, 1		/1.44863154
	2713
	3140
SQRP5,	0		/.7071068
	2650
	1170
LOGC1,	2		/2.8853913
	2705
	2440
LOGC3,	0		/.9614706
	3661
	566
LOGC5,	0		/.59897865
	2312
	5525
ONEHAF, 0		/.5
	2000
	0
LN2,	0		/.6931472
	2613
	4415

	FFSIN=SIN
	FFCOS=COS
	FFATN=ATAN
	FFLOG=LOG
	FFEXP=EXPON
/EAE FLOATING POINT INTERPRETER
/FOR PDP8/E WITH KE8-E EAE
/DEC-8E-NEAEA-A   VERSION 1
/COPYRIGHT	 1972 BY DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASSACHUSETTS. 01754
/
/W.J. CLOGHER
/
/DEFINITIONS OF EAE INSTRUCTIONS
SWAB=7431;SWBA=7447;SCA=7441;MUY=7405;DVI=7407;NMI=7411;SHL=7413
ASR=7415;LSR=7417;ACS=7403;SAM=7457;DAD=7443;DLD=7663;DST=7445
DPIC=7573;DCM=7575;DPSZ=7451;SWP=7521;CAM=7621
MQA=7501;MQL=7421;SGT=6006
/
/DEFINITION FOR ORIGIN OF PACKAGE
/
FLPT=7400
/
/PAGE ZERO LOCATIONS USED
/
*7
FPP,	FPT	/IF THIS IS MOVED, FIX LOC. K7
*40
AC0,	0
AC1,	0
AC2,	0
TM,	CDF 0	/ONLY NEEDED ONCE (FIRST CALL TO CDFCUR)
ACX,	0	/FLOATING ACCUMULATOR-EXPONENT
ACH,	0	/   "	       "     -HIGH ORDER MANTISSA
ACLO,	0	/   "	       "     -LOW ORDER MANTISSA
OPX,	0	/STORAGE FOR OPERAND
OPH,	0
OPL,	0
DSWIT,	0	/SWITCH SHOWING IF ANY INPUT CONV. WAS DONE
CHAR,	0	/LOCATION HOLDING TERMINATOR OF LAST INPUT.
SWIT1,	7777	/=0 IF NO LINE FEED AFTER CAR.RET. ON INPUT
SWIT2,	7777	/=0 IF NO CR/LF AFTER OUTPUT
/
/IF EFLG = 0, 6 IS DEPOSITED INTO DADP, AND 16 (8) INTO FLDW
/
EFLG,	0	/=0 IF E FORMAT OUT
FLDW,	0	/FIELD WIDTH ON OUTPUT
DADP,	0	/=# OF PLACES AFTER DEC. PT.
FPNXT,	FPNEXT
*FLPT-1600

/
/FLOATING OUTPUT ROUTINE
/
FFOUT,	0
	SWAB		/ALSO DOES MQL TO CLR. AC
	DCA	SGN	/CLEAR SIGN AND COUNT WORDS
	DCA	KNT
	TAD	EFLG	/IS THIS E FORMAT?
	SZA	CLA
	JMP	FFMT	/NO-F FORMAT
	CLL CML IAC RTL /YES-MAKE A 6
	DCA	DADP	/STORE AS # OF DIGITS AFT DEC PT
	TAD	K16	/SET FIELD WIDTH TO 14 ( DECIMAL)
	DCA	FLDW
FFMT,	JMS I	CDFCRB	/CHANGE TO FIELD OF PACKAGE
	TAD	KM7	/SET # OF SIGNF. DIGITS
	DCA I	DCNTP	/TO 6 (DON'T PRINT 7TH)
	TAD	ACH	/DETERMINE IF #=0
	SNA
	JMP	FOUT3	/YES-SKIP DOWN
	SMA	CLA	/NO-IS IT NEGATIVE?
	JMP	.+3	/POSITIVE
	ISZ	SGN	/NEGATIVE-SET FLAG
	JMS I	FFNGP	/AND NEGATE #
FOUT1,	TAD	ACX	/GET # INTO RANGE .1<=N<1
	SMA SZA CLA	/IS EXP. NEG.?
	JMP	FOUT2	/NO-GO ON
	JMS I	FFMPP	/YES-MAKE # GREATER THAN 1
	TEN		/BY MULTIPLYING BY TEN (DEC.)
	ISZ	KNT	/COUNT THE MULTIPLIES
	JMP	FOUT1	/SEE IF >1 YET
FOUT2,	JMS I	SEP	/# IS >1-MAKE IT LESS THAN 1
	JMS I	FFPUTP	/STORE IN A TEMPORARY
	TM3
	DCA	ACX	/SET FAC TO .5
	CLL CML RTR
	DCA	ACH
	DCA	ACLO
	TAD	EFLG	/IS THIS E FORMAT?
	SZA	CLA
	TAD	KNT	/NO-GET COUNT OF MULTIPLIES
	CMA	IAC	/NEGATE IT
	TAD	DADP	/AND ADD # OF DIGITS AFT. DC. PT.
	SMA		/MUST BE NEGATIVE
	CMA
	TAD	KK7	/LIMIT # OF DIVS TO 7
	SPA
	CLA
	TAD	KM7	/RESTORE
	DCA I	SEP	/STORE AS COUNTER
	JMP	.+3
	JMS I	FFDVP	/DIVIDE .5 BY TEN THAT # OF TIMES
	TEN
	ISZ I	SEP	/DONE?
	JMP	.-3	/NO-GO ON
	JMS I	FFADP	/YES-ADD IN ORIG.#-THIS IS ROUNDING
	TM3
	JMS I	SEP	/INSURE THAT IT IS IN RANGE
FOUT4,	TAD	ACX	/GET EXPONENT
	CMA	IAC	/USE AS COUNT FOR SHIFTING MANT.
	DCA	FOUT5
	DLD		/PICK UP MANTISSA
	ACH
	SWP	SHL	/PUT IN CORRECT ORDER
	1		/SHIFT LEFT 1(FOR 0 EXP.)
	LSR		/NOW SHIFT RIGHT ACCORD TO EXP.
FOUT5,	0
	DCA	ACH	/STORE BACK
	SWP
	DCA	ACLO
FOUT3,	TAD	KNT	/DONE-GET COUNT OF MULS.
	DCA	OPX	/PRESERVE IT
	TAD	EFLG	/IS THIS E FORMAT OUT?
	SZA	CLA
	JMP	NOTE	/NO
	DCA	KNT	/YES-ZERO COUNT
	TAD	KM7	/GET MINUS 7-FOR 2 SIGNS,PT,+EXP
	JMP	ADFW	/GO ADD FIELD WIDTH
NOTE,	TAD	KNT	/GET COUNT OF MULTIPLIES
	SMA		/IF NOT NEG-MAKE = -2
	CLA	CMA
	TAD	M1	/MINUS 1 FOR DEC.PT
ADFW,	TAD	FLDW	/GET THE FIELD WIDTH
	CMA	IAC	/NEGATE IT
	TAD	DADP	/ADD DIGITS AFTER DEC. PT
	SMA		/NEG?
	JMP I	PRNTXP	/NO-PRINT XS-NOT ENUFF ROOM
	DCA I	SEP	/STORE AS CNT OF SPACES
	JMP	.+3
	TAD	K240
	JMS I	OUTP	/PRINT A SPACE
	ISZ I	SEP	/DONE?
	JMP	.-3	/NO-GO ON
	TAD	SGN	/YES-GET SIGN
	CLL	RAL	/MAKE A ZERO OR 2
	TAD	K253	/FOR PLUS OR MINUS
	JMS I	OUTP	/PRINT SIGN
	TAD	KNT	/GET MUL COUNT
	SMA
	JMP I	PRZROP	/PRINT LEADING ZERO
	CMA	IAC
	JMS I	DGTYPP	/OUTPUT 'KNT' DIGITS
PRDCP,	TAD	DADP	/DON'T PRINT DEC. PT
	SNA	CLA	/IF DADP IS 0
	JMP I	GKNTP
	JMP I	PDPP
PRZROP, PRZRO
PDPP,	PDP
K16,	16
GKNTP,	GKNT
CDFCRB, CDFCUR
FLINK,	JMP I	FFOUT
PRNTXP, PRNTX
K253,	253
PRP,	PR
DCNTP,	DCNT
M1,	7777
KK7,	7
DGTYPP, DGTYP
OUTP,	OUT
K240,	240
KM7,	-7
FFADP,	FFADD
FFDVP,	FFDIV
FFPUTP, FFPUT
SEP,	SE
FFMPP,	FFMPY
FFNGP,	FFNEG
KNT,	0
SGN,	0
*FLPT-1400
PDP,	CLA CLL CMA RAL
	JMS	OUTDG	/PRINT DEC. PT.
GKNT,	TAD I	KNTP	/GET COUNT AGAIN
	SPA SNA CLA
	JMP	GD
	TAD I	KNTP	/GET COUNT
	CMA		/NEGATE
	DCA	DGTYP	/STORE AS COUNTER
	TAD	DADP
	CMA		/SAME FOR DADP
	DCA	SE
	JMP	PR	/GO ON
PZR,	JMS	OUTDG	/PRINT A ZERO
PR,	ISZ	DGTYP
	SKP
	JMP	PS
	ISZ	SE
	JMP	PZR
PS,	TAD I	KNTP
	CMA	IAC
GD,	TAD	DADP
	SMA	SZA
	JMS	DGTYP
	TAD	EFLG
	SZA	CLA
	JMP	DONEF	/DONE
	TAD	K305	/PRINT 'E'
	JMS	OUT
	TAD	OPX	/GET PRESERVED COUNT OF MULS
	SMA SZA CLA	/DETERMINE SIGN
	CLA IAC RAL	/MAKE A 2
	TAD	P253	/PRINT MINUS OR PLUS SIGN
	JMS	OUT
	TAD	OPX	/GET THE COUNT
	SPA
	CMA	IAC	/NEGATE IF NEGATIVE
	MQL	DVI	/DIVIDE BY ONE HUNDRED
	K144
	SWP		/QUOT TO AC, REM TO MQ
	JMS	OUTDG	/THIS IS FIRST DIG-PRINT IT
	DVI		/DIVIDE REM BY TEN
	K12
	SWP		/GET SECOND DIGIT
	JMS	OUTDG	/PRINT IT
	SWP
	JMS	OUTDG	/PRINT LAST
DONEF,	TAD	SWIT2	/SHOULD WE PRINT CR/LF?
	SNA	CLA
	JMP I	FLING	/NO
	TAD	K215
	JMS	OUT
	TAD	K212
	JMS	OUT
	JMP I	FLING
/
/ROUTINE TO GET FAC<1
/
SE,	0
SE1,	TAD	ACX
	SPA SNA CLA	/#>1?
	JMP I	SE	/NO-RETN.
	JMS I	FFDV	/YES-DIV. BY TEN
	TEN
	CMA
	TAD I	KNTP	/REDUCE KNT BY 1
	DCA I	KNTP
	JMP	SE1

/
/OUTPUT DIGITS OF FAC BY MULTIPLYING BY TEN
/THE HIGH ORDER OVERFLOW IS THE DIGIT

DGTYP,	0
	CMA	IAC
	DCA	SE	/STORE COUNT PASSED
	SWAB		/MODE B OF EAE
DT1,	TAD	ACLO	/GET LOW ORDER FAC
	MQL	MUY	/MUL BY TEN
	K12
	SWP		/NEW ACLO TO AC
	DCA	ACLO	/STORE IT BACK
	TAD	ACH	/GET ACH-SEND TO MQ, AND
	SWP	MUY	/HI ORD. OVERFLO OF MUY TO AC
	K12		/MULT BY TEN, OVRFLO IS ADDED
	ISZ	DCNT	/DONE ALL SIGNIF. DIGS.?
	JMP	.+3	/NO-GO ON
	CLA	CMA	/YES-PRINT ZEROS
	DCA	DCNT	/FROM NOW ON
	JMS	OUTDG	/PRINT DIGIT (HI ORD. OVRFLOW)
	SWP		/NEW ACH IS IN MQ
	DCA	ACH	/STORE IT
	ISZ	SE	/DONE REQUIRED?
	JMP	DT1	/NOPE
	JMP I	DGTYP	/YUP

PRNTX,	CLA
	TAD	FLDW	/GET FIELD WIDTH
	CMA		/MUST BE NEGATIVE
	DCA	SE	/USE AS COUNTER
PRNTX1, ISZ	SE	/DONE ALL?
	SKP		/NO-GO ON
	JMP	DONEF	/YES-RETN.
	TAD	K252
	JMS	OUT	/PRINT ASTERISK
	JMP	PRNTX1
K252,	252		/ASTERISK
PRZRO,	CLA		/CLR. GARBAGE
	JMS	OUTDG	/PRINT ZERO
	JMP I	PRDCPP	/PRINT DEC. PT. (MAYBE)
PRDCPP, PRDCP
/
/OUTPUT ROUTINE
/
OUT,	0
	TSF
	JMP	.-1
	TLS
	CLA	CLL	/USE AN 'AND..' INSTEAD???
	JMP I	OUT

/
/OUTPUT DIGIT
/
OUTDG,	0
	TAD	P260
	JMS	OUT
	JMP I	OUTDG	/RETN

KNTP,	KNT
K215,	215
K212,	212
TM3,	0
	0
	0
DCNT,	0	/COUNT OF SIGNF. DIGITS
K305,	305
P260,	260
FFDV,	FFDIV
P253,	253
FLING,	FLINK
K144,	144




/
/FLOATING POINT INPUT ROUTINE
/
*FLPT-1200
FFIN,	0
	CLA	CMA
	DCA	PRSW	/INITIALIZE PERIOD SWITCH TO -1
	CMA		/SET SIGN SWITCH TO -1
	DCA	SIGNF
	JMS I	CDFCRA	/CHANGE TO DF OF PACKAGE
	DCA	DSWIT	/ZERO CONVERSION SWITCH
DECONV, DCA	ACX	/ZERO OUT THE FAC!
	DCA	ACLO
	DCA	ACH
DECNV,	DCA	DNUMBR	/ZERO # OF DIGITS SINCE DEC. PT.
DECON,	JMS	GCHR	/GET A CHAR.FROM TTY.
	JMP	FFIN1	/TERMINATOR-
	ISZ	DSWIT	/DIGIT-BUMP CONVERSION SWITCH
	ISZ	DNUMBR	/BUMP # OF DIGITS
	DCA	TP1	/STORE IT IN FORM EASILY FLOATIBLE
	JMS I	FPP	/ENTER INTERPRETER
	FMPY	TEN	/MULTIPLY # BY TEN
	FPUT	AC0	/STORE IT AWAY
	FGET	TP	/GET NEW DIGIT
	FNOR		/FLOAT IT
	FADD	AC0	/ADD IT TO ACCUMULATED #
	FEXT		/DONE
	JMP	DECON	/GO ON
FFIN1,	ISZ	PRSW	/HAVE WE HAD A PERIOD YET?
	JMP	FIGO2	/YES-GO ON
	TAD	K2	/NO-IS THIS A PERIOD?
	SNA	CLA
	JMP	DECNV	/YES-ZERO DIG. COUNT AFTER DEC. PT.
			/AND GO CONVERT REST
	DCA	DNUMBR	/NO-TERMINATOR-ZERO COUNT OF
			/DIGITS AFTER DECIMAL POINT.
FIGO2,	CLA	MQL	/0 TO MQ FOR LATER MULTIPLY
	ISZ	SIGNF	/IS # NEGATIVE?(DID WE GET - SIGN?)
	JMS I	FFNEGP	/YES-NEGATE IT
	SWAB
	CMA		/RESET SIGN SWITCH FOR EXP.
	DCA	SIGNF
	TAD	CHAR	/NO-WAS THE TERMINATOR AN 'E'?
	TAD	KME
	SNA	CLA
GETE,	JMS	GCHR	/YES-GET A CHAR. OF EXPONENT
	JMP	EDON	/END OF EXPONENT
	MUY		/GOT DIGIT OF EXP-MULT ACCUMULATED
	K12		/EXPONENT BY TEN AND ADD DIGIT
	JMP	GETE	/CONTINUE
EDON,	ISZ	SIGNF	/WAS EXPONENT NEGATIVE?
	DCM		/YES-NEGATE IT
	CLA	CLL	/CLEAR AC AND LINK
	TAD	DNUMBR	/GET # TIMES TO DIV MANTISSA BY TEN
	SAM		/SUBTRACT FROM EXPONENT
	CLL
	SPA		/RESULT POSITIVE?
	CLL CMA CML IAC /NO-MAKE POS. AND SET LINK
	CMA		/NEGATE FOR COUNTER
	DCA	DNUMBR	/AND STORE
	RAL		/LINK=1-DIV;=0-MUL. # BY TEN
	TAD	MDV	/FORM CORRECT INSTRUCTION
	DCA	FINST	/AND STORE FOR EXECUTION
FCNT,	ISZ	DNUMBR	/DONE ALL OPERATIONS?
	JMP	FINST	/NO
	JMP I	FFIN	/YES-RETURN
FINST,	0		/NO- MUL OR DIV. MANTISSA
	TEN		/BY TEN
	JMP	FCNT	/GO ON
FFNEGP, FFNEG
PRSW,	0
DNUMBR, 0
SIGNF,	0
K2,	2
KME,	-305
MDV,	JMS I	.+1	/THESE 3 WDS. MUST BE IN THIS ORDER
	FFMPY
	FFDIV		/!!!!!!!!!!!!!!!!!

CDFCRA, CDFCUR
K12,	12
TP,	13
TP1,	0
	0
TEN,	4
	2400
	0
/ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT
/OR A TERMINATOR.
/RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT
/THIS ROUTINE MUST NOT MODIFY THE MQ!!
GCHR,	0
	JMS	INPUT	/GET A CHAR FROM TTY.
	TAD	CHAR	/PICK IT UP
	TAD	PLUS	/WAS IT PLUS SIGN?
	SNA
	JMP	DECON1	/YES-GET ANOTHER CHAR.
	TAD	MINUS	/NO WAS IT MINUS SIGN?
	SZA	CLA
	JMP	.+3
	DCA	SIGNF	/YES-FLIP SWITCH
DECON1, JMS	INPUT	/GET A CHAR.
	TAD	CHAR
	TAD	K7506	/SEE IF ITS A DIGIT
	CLL
	TAD	K12
	SZL		/DIGIT?
	ISZ	GCHR	/YES-RETN. TO CALL+2
	JMP I	GCHR	/NO-RETN. TO CALL+1
K7506,	7506
PLUS,	-253
MINUS,	253-255
/
/INPUT ROUTINE-CHECKS FOR RUBOUT AND CARRIAGE RETURN
/
INPUT,	0
	KSF
	JMP	.-1
	KCC
	TAD	P200	/FORCE CHANNEL 8
	KRS		/READ CHAR.
	DCA	CHAR	/STORE CHAR.
LP,	TAD	CHAR
	JMS I	OUTPP	/PRINT IT
	TAD	CHAR
	TAD	MRUBOT	/IS IT RUBOUT?
	SNA
	JMP	FFIN+1	/YES-RESTART INPUT
	TAD	MCR	/NO-IS IT CARRIAGE RETN.?
	SNA	CLA
	TAD	SWIT1	/YES-SHOULD WE ECHO LINE FEED?
	SNA	CLA
	JMP I	INPUT	/NO-GO BACK
	TAD	LFED	/YES-DO IT
	JMS I	OUTPP
	JMP I	INPUT	/RETURN
OUTPP,	OUT
LFED,	212
MCR,	377-215
MRUBOT, -377
P200,	200
/EAE FLOATING POINT INTERPRETER
*FLPT-1000
/
/FLOATING SUBTRACT-USES FLOATING ADD
/FSW1!!
FFSUB1, 0
	SNA		/WHICH MODE?
	TAD I	FFSUB1	/CALLED BY USER-GET ADDR. OF OP
	JMS I	ARGETL	/PICK UP ARGUMENT
	JMS I	CDFCRL
	JMS I	FFNEGA	/NEGATE FAC!
	TAD	FFSUB1
	JMP I	SUB0P
FFNEGA, FFNEG
SUB0P,	SUB0


/
/FLOATING DIVIDE
/FSWITCH=1
/THIS IS OP/FAC
/
FFDIV1, 0
	SNA		/WHICH MODE OF CALL?
	TAD I	FFDIV1	/CALLED BY USER-GET ADDR.
	JMS I	ARGETL	/(INTERP.)-GET OPRND.-ADDR. IN AC
	JMS I	CDFCRL	/CDF TO FIELD OF PACKAGE
	TAD	ACH	/SWAP FAC AND OPRND-OPH IN MQ!
	DCA	OPH	/STORE ACH IN OPH
	TAD	ACX	/GET EXP OF FAC
	SWP		/OPH TO AC, ACX TO MQ
	DCA	ACH	/STORE OPH IN ACH
	TAD	OPX	/STORE OPX IN ACX
	DCA	ACX
	TAD	OPL	/OPL TO MQ, ACX TO AC
	SWP
	DCA	OPX	/STORE ACX IN OPX
	TAD	ACLO
	DCA	OPL	/STORE ACLO IN OPL
	TAD	OPH	/OPH TO MQ FOR LATER
	SWP
	DCA	ACLO	/STORE OPL IN ACLO
	TAD	FFDIV1	/SET UP SO WE RETN TO
	DCA I	FFDP	/NORMAL DIVIDE ROUTINE
	TAD	FD1
	DCA I	MDSETP
	JMP I	MD1P	/GO ARRANGE OPERANDS

MD1P,	MD1
ARGETL, ARGET
CDFCRL, CDFCUR
MDSETP, MDSET
FFDP,	FFDIV
FD1,	FFD1


/
/FLOATING SQUARE ROOT
/USES MODIFIED HARDWARE ALGORITHM FOR BINARY SQUARE ROOTS
/REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES; P-409
/
FROOT,	0
	CLA CLL CML RTR /SET RESLT TO 2000,0000
	DCA	OPL
	DCA	OPH
	SWAB		/MODE B OF EAE-ALSO DOES MQL
	JMS I	CDFCRL	/CDF TO FIELD OF PACKAGE
	DCA	RBCNT	/CLR. SHIFT COUNTER
	TAD	KM22
	DCA	AC2	/SET COUNTER FOR 23 BITS OF RESULT
	TAD	ACX	/GET EXPONENT OF FAC
	ASR		/DIVIDE BY 2
	1
	DCA	ACX	/STORE IT BACK
	DPSZ		/INCREMENT EXP. IF ORIG. EXP
	ISZ	ACX	/WAS ODD
	NOP
	MQA		/DETERMINE WHETHER TO DO A
	CLL	RAL	/PRE-SHIFT FOR EVEN EXPONENTS.
	CML	RAL
	DCA	RKNT	/STORE BIT-0 OR 1 SHIFT CNT
	CLL CML RTR	/SET UP FIRST TRIAL BIT
	RTR
	DCA	AC1
	DCA	AC0	/STORE AWAY
	DCA	ACNT	/ZERO COUNTER
	DLD		/GET THE FAC
	ACH
	SWP		/GET IN RIGHT ORDER
	SNA		/IS IT ZERO? (HI ORD=0)
	JMP I	FROOT	/YES-ROOT = 0
	SPA		/NEGATIVE?
	DCM		/YES-TAKE ABSOL. VALUE
	SHL		/SHIFT # 1 BIT IF EXP WAS EVEN
RKNT,	0		/SO FIRST BIT PAIR IS 10 NOT 01
	TAD	K6000	/SUBTRACT 2000-KNOW FIRST BIT
	DPSZ		/IS 1(NORMALIZED)-DONE??
	JMP	LOP1	/NO-WE MUST LOOP
	JMP	DONE	/YES-AN EASY ONE!!!
LOOP,	DLD		/GET THE FAC
	ACH
	SHL		/SHIFT FAC APPROPRIATELY
	1
LOP1,	DST		/MUST STOR BACK IN CASE RESLT
	ACH		/BIT IS 0
	DLD		/GET TRIAL BIT
	AC0

	ASR		/SHIFT THE BIT APPROPRIATELY
ACNT,	0
	ISZ	ACNT	/SHIFT 1 MORE NEXT TIME
	DAD		/ADD IN RESULT SO FAR
	OPH
	DCM		/NEGATE IT
	ISZ	RBCNT	/BUMP COUNTER FOR RESLT BIT
	DAD		/DO THE SUBTRACT
	ACH
	SNL		/RESULT NEGATIVE?
	JMP	GON	/YES-NEXT RESULT BIT = 0

	DPSZ		/NO-DID WE GET A ZERO REMAINDER?
	JMP	NOTZRO	/NOPE
ZREM,	CMA		/YES-SET SO LOOKS LIKE WE'RE DONE
	DCA	AC2
NOTZRO, DST		/GOOD SUBTR.-MODIFY FAC
	ACH		/ITS NOT CHANGED BY BAD SUBTRACT
	CAM		/CLEAR EVERYTHING
	RTR
	ASR		/SHIFT RESLT BIT TO RIGHT PLACE
RBCNT,	0
	DAD		/ADD IT TO THE RESULT SO FAR
	OPH		/WE APPEND IT TO RIGHT OF LAST
	DST		/BIT
	OPH		/STORE IT BACK
GON,	ISZ	AC2	/DONE 23 BITS?
	JMP	LOOP	/NO-GO ON
DONE,	DLD		/YES-GET RESULT-ITS NORMALIZED
	OPH
	DCA	ACH	/STORE HIGH ORDER BACK
	SWP
	DCA	ACLO	/STORE LOW ORDER BACK
	JMP I	FROOT	/RETURN
KM22,	-26
K6000,	6000
/
/FLOATING HALT-DISPLAY FLOATING P.C.
/
FFHLT,	JMS I	CDFCRL	/MUST BE CURRENT DATA FLD.
	TAD I	FPP	/PICK UP THE P.C.
	HLT		/HALT
	CLA		/CLR. IT OUT
	JMP I	FPNXT	/GO ON
/
/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE
/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO
/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY.
/(IN THE LOW ORDER, NATCHERLY)
*FLPT-600
FFMPY,	0
	SNA		/WHICH MODE?
	TAD I	FFMPY	/CALLED BY USER-GET ADDRESS
	JMS	MDSET	/SET UP FOR MULT
	CLA	MUY	/MULTIPLY-LOW ORDER FAC STILL IN MQ
	OPH		/THIS IS PRODUCT OF LOW ORDERS
	MQL		/ZAP LOW ORDER RESULT-INSIGNIFICANT
	TAD	ACH	/GET LOW ORDER(!) OF FAC
	SWP	MUY	/TO MQ-HIGH ORD. RESLT OF LAST MPY
	OPL		/TO AC-WILL BE ADDED TO RESLT-THIS
	DST		/IS PRODUCT-LOW ORD FAC,HI ORD OP
	AC0		/STORE RESULT
	DLD		/HIGH ORDER FAC TO MQ, OPX TO AC
	ACLO
	TAD	ACX	/ADD FAC EXPONENT-GET SUM OF EXPS.
	DCA	ACX	/STORE RESULT
	MUY		/MUL. HIGH ORDER FAC BY LOW ORD OP.
	OPH		/HIGH ORDER FAC WAS IN MQ
	DAD		/ADD IN RESULT OF SECOND MULTIPLY
	AC0
	DCA	ACH	/STORE HIGH ORDER RESULT
	TAD	ACLO	/GET HIGH ORDER FAC
	SWP		/SEND IT TO MQ AND LOW ORD. RESULT
	DCA	AC0	/OF ADD TO AC-STORE IT
	RAL		/ROTATE CARRY TO AC
	DCA	ACLO	/STORE AWAY
	MUY		/NOW DO PRODUCT OF HIGH ORDERS
	OPL		/FAC HIGH IN MQ, OP HIGH IN OPL
	DAD		/ADD IN THE ACCUMULATED #
	ACH
	SNA		/ZERO?
	JMP	RTZRO	/YES-GO ZERO EXPONENT
	NMI		/NO-NORMALIZE (1 SHIFT AT MOST!)
	DCA	ACH	/STORE HIGH ORDER RESULT
	CLA	SCA	/GET STEP CNTR-DID WE NEED A SHIFT?
	SNA	CLA
	JMP	SNCK	/NO-JUST CHECK SIGN
	CLA	CMA	/YES-MUST DECREASE EXP. BY 1
	TAD	ACX
RTZRO,	DCA	ACX	/STORE BACK

	TAD	AC0
	SPA	CLA	/IS HIGH ORDER OF OVERFLO WD. 1?
	DPIC		/YES-ADD 1 TO LOW ORDER-STILL IN MQ
SNCK,	ISZ	MSIGN	/RESULT NEGATIVE?
	JMP	MPOS	/NO-GO ON
	TAD	ACH	/YES-GET HIGH ORDER BACK
	DCM		/LOW ORDER STILL IN MQ-NEGATE
	DCA	ACH	/STORE HIGH ORDER BACK
MPOS,	SWP		/LOW ORDER TO AC
	DCA	ACLO	/STORE AWAY
	ISZ	FFMPY	/BUMP RETURN
	JMP I	FFMPY	/RETIRN
MSIGN,	0
ARGETK, ARGET
CDFCRK, CDFCUR
DVOFL,	FTRP2

/
/ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE
/
MDSET,	0
	JMS I	ARGETK	/GET OPERAND (ADDR. IN AC)
	JMS I	CDFCRK	/CHANGE TO DATA FIELD OF PACKAGE
MD1,	CLA CLL CMA RAL /MAKE A MINUS TWO
	DCA	MSIGN	/AND STORE IN MSIGN.
	TAD	OPL	/GET LOW ORDER MANTISSA OF OP.
	SWP		/GET INTO RIGHT ORDER ( OPH IN MQ)
	SMA		/NEGATIVE?
	JMP	.+3	/NO
	DCM		/YES-NEGATE IT
	ISZ	MSIGN	/BUMP SIGN COUNTER
	SHL		/SHIFT OPRND LEFT 1 TO AVOID OVRFLO
	1
	DST		/STORE BACK-OPH CONTAINS LOW ORDER
	OPH		/	    OPL CONTAINS HIGH ORDER
	DLD		/GET THE MANTISSA OF THE FAC
	ACH
	SWP		/MAKE IT CORRECT ORDER
	SMA		/NEGATIVE?
	JMP	FPOS	/NO
	DCM		/YES-NEGATE IT
	ISZ	MSIGN	/BUMP SIGN COUNTER (MAY SKIP)
	NOP
FPOS,	DST		/STORE BACK-ACH CONTAINS LOW ORDER
	ACH		/	    ACLO CONTAINS HIGH ORDER
	JMP I	MDSET	/RETURN



/
/FLOATING DIVIDE
/
FFDIV,	0
	SNA		/WHICH MODE?
	TAD I	FFDIV	/CALLED BY USER-GET ARG. ADDRESS
	JMS	MDSET	/GET ARG. AND SET UP SIGNS
FFD1,	DVI		/DIVIDE-ACH AND ACLO IN AC,MQ
	OPL		/THIS IS HI (!) ORDER DIVISOR
	DST		/QUOT TO AC0,REM TO AC1
	AC0
	SZL	CLA	/DIVIDE ERROR?
	JMP I	DVOFL	/YES-HANDLE IT
	TAD	OPX	/DO EXPONENT CALCULATION
	CMA	IAC	/EXP. OF FAC - EXP. OF OP
	TAD	ACX
	DCA	ACX
	DPSZ		/IS QUOT = 0?
	SKP		/NO-GO ON
	DCA	ACX	/YES-ZERO EXPONENT
DVLP,	MUY		/NO-THIS IS Q*OPL*2**-12
	OPH
	DCM		/NEGATE IT
	TAD	AC1	/SEE IF GREATER THAN REMAINDER
	SNL
	JMP I	DVOPSP	/YES-ADJUST FIRST DIVIDE
	DVI		/NO-DO Q*OPL*2**-12/OPH
	OPL
	SZL	CLA	/DIV ERROR?
	JMP I	DVOFL	/YES
DVLP1,	TAD	AC0	/NO-GET QUOT OF FIRST DIV.
	SMA		/NEGATIVE?
	JMP	.+5	/NO-REMEMBER-QUOT OF 2ND DIV. IN MQ
	LSR		/YES-MUST SHIFT IT RIGHT 1
	1
	ISZ	ACX	/ADJUST EXPONENT
	NOP
	ISZ	MSIGN	/SHOULD SIGN BE MINUS?
	SKP		/NO
	DCM		/YES-DO IT
DBAD1,	DCA	ACH	/STORE IT BACK
	SWP
	DCA	ACLO
	ISZ	FFDIV
	JMP I	FFDIV	/BUMP RETN. AND RETN.

DVOPSP, DVOPS
DBAD,	CAM
	DCA	ACX	/ZERO EXPONENT
	JMP	DBAD1	/GO ZERO MANTISSA
/FLOATING ADDITION-IN ORDER NOT TO LOSE BITS, WE DO NOT
/SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-ONLY SHIFTS DONE
/ARE TO ALIGN EXPONENTS.
/
*FLPT-400
FFADD,	0
	SNA		/WHICH MODE OF CALLING
	TAD I	FFADD	/CALLED DIRECTLY BY USER
	JMS I	ARGETP	/PICK UP ARGUMENTS
FAD1,	JMS I	CDFCRP	/CHANGE TO CURRENT DATA FIELD
	TAD	OPX	/PICK UP EXPONENT OF OPERAND
	MQL		/SEND IT TO MQ FOR SUBTRACT
	TAD	ACX	/GET EXPONENT OF FAC
	SAM		/SUBTRACT-RESULT IN AC
	SPA		/NEGATIVE RESULT?
	CMA	IAC	/YES-MAKE IT POSITIVE
	DCA	CNT	/STORE IT AS A SHIFT COUNT
	TAD	CNT	/COUNT TOO BIG?(CAN'T BE ALIGNED)
	TAD	M27
	SPA SNA CLA
	CMA		/NO-OK
	DCA	AC0	/YES-MAKE IT A LOAD OF LARGEST #
	DLD		/GET ADDRESSES TO SEE WHO'S SHIFTED
	ADDRS
	SGT		/WHICH EXP GREATER(GT FLG SET
			/BY SUBTR. OF EXPS.)
	SWP		/OPERAND'S-SHIFT THE FAC
	DCA	SHFBG	/STORE ADDRESS OF WHO GETS SHIFTED
	SWP		/GET ADDRESS OF OTHER (0 TO MQ)
	DCA	DADR	/THIS ONE JUST GETS ADDED
	TAD	ACX	/GET FAC EXP.INTO AC
	SGT		/WHICH EXPONENT WAS GREATER?
	DCA	OPX	/FAC'S-STORE FINAL EXP. IN OPX
	DLD		/GET THE LARGER # TO AC,MQ
DADR,	0
	SWP		/PUT IN THE RIGHT ORDER
	ISZ	AC0	/COULD EXPONENTS BE ALIGNED?
	JMP	LOD	/NO-JUST LEAVE LARGER IN AC,MQ
	DST		/YES-STORE THIS TEMPORARILY
	AC0		/(IF ONLY FAC STORAGE WAS REVERSED)
	DLD		/GET THE SMALLER #
SHFBG,	0
	SWP		/PUT IT IN RIGHT ORDER
	ASR		/DO THE ALIGNMENT SHIFT
CNT,	0
	DAD		/ADD THE LARGER #
	AC0
	DST		/STORE RESULT
	AC0
	SZL		/OVERFLOW?(L NOT = SIGN BIT)
	CMA		/NOTE-WE DIDN'T SHIFT BOTH RIGHT 1
	SMA	CLA
	JMP	NOOV	/NOPE
	CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN
	AND	ACH
	TAD	OPH
	SMA	CLA	/SIGNS ALIKE?
	JMP	OVRFLO	/YES-OVERFLOW
NOOV,	TAD	AC1	/NO-GET HIGH ORDER RESULT BACK
	TAD	K4000	/CHECK FOR 4000 0000 MANTISSA
	DPSZ		/IT WILL BE SET TO 0 BY NMI
	JMP	.+3	/OK-RESTORE NUMBER
	CLL CML RTR	/GOT A 4000 0000-SET TO 6000 0000
	JMP	DOIT	/AND INCREMENT EXPONENT
	TAD	K4000	/RESTORE NUMBER
LOD,	NMI		/NORMALIZE (LOW ORDER STILL IN MQ)
	DCA	ACH	/STORE FINAL RESULT
	SCA		/GET SHIFT COUNTER(# OF NMI SHIFTS)
	CMA		/NEGATE IT
ADON,	IAC
	TAD	OPX	/AND ADJUST FINAL EXPONENT
	DCA	ACX
	SWP		/GET AND STORE LOW ORDER
	DCA	ACLO
	ISZ	FFADD	/BUMP RETURN PAST ADDRESS
	JMP I	FFADD	/RETURN
OVRFLO, TAD	AC1	/OVERFLOW-GET HIGH ORDER RESLT BACK
	ASR		/SHIFT IT RIGHT 1
	1
DOIT,	TAD	K4000	/REVERSE SIGN BIT
	DCA	ACH	/AND STORE
	JMP	ADON	/DONE
K4000,	4000
M27,	-27
ARGETP, ARGET
/FLOATING SUBTRACT-USES FLOATING ADD
/FSW0!!
FFSUB,	0
	SNA		/WHICH MODE?
	TAD I	FFSUB	/CALLED BY USER-GET ADDRESS OF OP.
	JMS I	ARGETP
	TAD	OPL	/OPH IS IN MQ!
	SWP		/PUT IT IN RIGHT ORDER
	DCM		/NEGATE IT
	DCA	OPH	/STORE BACK
	MQA
	DCA	OPL
	TAD	FFSUB	/GO TO ADD
SUB0,	DCA	FFADD
	JMP	FAD1
DVOVR,	FTRP2
/
/FLOATING NEGATE--NEGATE FLOATING AC
/
FFNEG,	0
	SWAB		/MUST BE MODE B
	DLD		/GET MANTISSA
	ACH
	SWP		/CORRECT ORDER PLEASE!
	DCM		/NEGATE IT
	DCA	ACH	/RESTORE
	SWP		/SEND 0 TO MQ
	DCA	ACLO
	JMP I	FFNEG

CDFCRP, CDFCUR

/
/CONTINUATION OF DIVIDE ROUTINE
/WE ARE ADJUSTING THE RESULT OF THE
/FIRST DIVIDE.
/
DVOPS,	CMA	IAC
	DCA	AC1	/ADJUST REMAINDER
	TAD	OPL	/WATCH FOR OVERFLOW
	CLL CMA IAC
	TAD	AC1
	SNL
	JMP	DVOP1	/DON'T ADJUST QUOT.
	DCA	AC1
	CMA
	TAD	AC0
	DCA	AC0	/REDUCE QUOT BY 1
DVOP1,	CLA	CLL
	TAD	AC1	/GET REMAINDER
	SNA		/ZERO?
	CAM		/YES-ZERO EVERYTHING
	DVI		/NO
	OPL
	SZL	CLA	/DIV. OVERFLOW?
	JMP I	DVOVR	/YES
	DCM		/NO-ADJUST HI QUOT (MAYBE)
	JMP I	DVLP1P	/GO BACK
DVLP1P, DVLP1
ADDRS,	OPH
	ACH
/
/ROUTINE TO CALL EXTENDED FUNCTIONS
/THIS IS EXTENSION OF OP CODE 0
/
*FLPT-200
FCALL,	SWP		/FCALL-GET FUNCTION #(ALSO 0 TO MQ)
	TAD	JMSI2	/MAKE A JMS THROUGH TABLE
	DCA	DCOD1	/STORE IT
	JMS	CDFCUR	/D. F. MUST BE FIELD OF FLT PT PKG.
K7,	TAD I	FPP	/GET FLTG. P.C.
	DCA	FT1	/SAVE IT
	TAD I	DFCDFP	/SAVE FLTG DATA AND INST. FIELD
	DCA	FT2
	TAD I	FPNXT
	DCA	FT3
DCOD1,	0		/CALL THE SUBR.
	CAM		/CLEAR AC AND MQ.
	JMS	CDFCUR	/IN CASE USER CHANGED DATA FLD.
	TAD	FT3	/RESTORE DF,IF, AND FLTG. PC
	DCA I	FPNXT
	TAD	FT2
	DCA I	DFCDFP
	TAD	FT1
FJUMP1, MQA		/EFF ADDR IN MQ FOR JMP(0 IF FCALL)
	DCA I	FPP
	JMP I	FPNXT
FJUMP,	JMS	CDFCUR	/D.F. MUST BE CURRENT
	JMP	FJUMP1	/GO DO IT
DFCDFP, DFCDF
TDIVP,	TDIV
JMSI2,	JMS I	TABLE2-1
TABLE2, FFSQ		/SQUARE
	FROOT		/SQUARE ROOT
	FFSIN		/SIN
	FFCOS		/COS
	FFATN		/ATN
	FFEXP		/EXP
	FFLOG		/LOG
	FFNEG		/NEGATE FAC
	FFIN		/INPUT
	FFOUT		/OUTPUT
	FFIX		/FIX
	FFLOAT		/FLOAT
	DCOD1		/NOP
	DCOD1		/NOP
	DCOD1		/NOP
/
/ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FLD SET TO EITHER
/FLOATING DATA FIELD OR FLOATING INSTRUCTION FIELD.
/ADDRESS OF OPERAND IS IN THE AC ON ENTRY.
/ON RETURN, THE AC IS CLEAR, AND THE MQ CONTAINS THE
/HIGH ORDER MANTISSA WD. OF THE OPERAND.
/
ARGET,	0
	DCA	ADR1	/STORE ADDRESS PASSED
	TAD I	ADR1	/PICK UP EXPONENT OF OPERAND
	DCA	OPX	/STORE
	ISZ	ADR1	/MOVE POINTER TO HI ORDER MANTISSA
	SWAB		/MUST BE MODE B OF EAE
	DLD
ADR1,	0		/PICK UP MANTISSA
	DCA	OPL	/LOW ORDER IN AC-STORE
	MQA		/HIGH ORDER IN MQ
	DCA	OPH	/STORE
	JMP I	ARGET	/RETURN

/
/ROUTINE TO NORMALIZE THE FAC
/
FFNOR,	0
	JMS	CDFCUR	/CHANGE D.F. TO FIELD OF PACKAGE
	SWAB		/FORCE MODE B
	DLD		/PICK UP MANTISSA
	ACH
	SWP		/PUT IT IN CORRECT ORDER
	NMI		/NORMALIZE IT
	SNA		/IS THE # ZERO?
	DCA	ACX	/YES-INSURE ZERO EXPONENT
	DCA	ACH	/STORE HIGH ORDER BACK
	SWP		/STORE LOW ORDER BACK
	DCA	ACLO
	CLA	SCA	/STEP COUNTER TO AC
	CMA	IAC	/NEGATE IT
	TAD	ACX	/AND ADJUST EXPONENT
	DCA	ACX
	JMP I	FFNOR	/RETURN
/
/FLOATING GET
/
FFGET,	0
	SNA		/WHICH MODE?
	TAD I	FFGET	/CALLED BY USER-GET ADDR. OF OP.
	JMS	ARGET	/PICK UP OPERAND
	TAD	OPX	/STORE OPERAND IN FAC
	DCA	ACX
	TAD	OPL
	DCA	ACLO
	SWP		/OPH IS IN MQ
	DCA	ACH
	ISZ	FFGET	/BUMP RETURN
	JMP I	FFGET	/RETURN

/
/FLOATING PUT
/
FFPUT,	0
	SNA		/DETERMINE MODE
	TAD I	FFPUT	/USER-GET ADDR.
	DCA	TM1	/STORE ADDRESS TO PUT FAC
	TAD	ACX	/GET FAC EXPONENT
	DCA I	TM1	/STORE IT
	ISZ	TM1	/CAN'T DO 'DLD;ACH' FOR DATA FIELD
	TAD	ACH	/WON'T BE RIGHT
	SWAB		/EAE MODE B (ALSO DOES MQL!)
	TAD	ACLO
	DST		/D.F. SET BY INTERP. ELSE-CURRENT
TM1,	0
	CAM		/CLEAR AC AND MQ
	ISZ	FFPUT	/BUMP RETURN
	JMP I	FFPUT	/RETURN

/TABLE FOR JUMPS
/
JMPI3,	JMP I	TABLE3
TABLE3, FFSKP		/SKIP ON COND. OF FAC
	FFCDF		/CHANGE FLTG. D.F.
	FFSW0		/FSWITCH 0
	FFSW1		/FSWITCH 1
	FFHLT		/FLOATING HALT-DISPLAY P.C.
	FPNEXT		/NOP-FOR FUTURE EXPANSION
	FPNEXT		/NOP
	FPNEXT		/NOP
/ROUTINE FOR DECODING SPECIAL FJMS'S
/
JSKP,	MQA		/EFFECTIVE ADDR TO AC
	AND	K7	/MASK OFF IMPORTANT BITS
	TAD	JMPI3	/K7 MUST HAVE BITS 9-11=1,4-8=0
	DCA	.+1	/DO A JUMP THROUGH TABLE

/
/CHANGE TO DATA FIELD OF FLTG. PT. PKG.
/AFTER FIRST TIME THRU, SUBR. LOOKS LIKE:
/	CDFCUR, 0
/		CDF	N	/WHERE N IS FIELD OF PKG.
/		JMP I	CDFCUR
/		(NEXT 5 LOCS. FREE FOR TEM. STORAGE)
/
CDFCUR, 0		/USED AS TEM BY JSKP ROUTINE(ABOVE)
CCUR1,	RIF		/READ INST. FIELD.
CCUR2,	TAD	TM	/MAKE A CDF TO THIS FIELD
FT1,	DCA	CCUR1	/STORE IT, MODIFYING SUBR.
FT2,	TAD	JMPIC	/PICK UP THE RETURN JUMP.
FT3,	DCA	CCUR2	/STORE IT-MODIFYING SUBR.
	JMP	CCUR1	/GO CHANGE THE FIELD
JMPIC,	JMP I	CDFCUR

/
/FLOATING SWITCH 1
/
FFSW1,	JMS	CDFCUR	/MUST BE CURRENT DATA FIELD
	TAD	FFSB1	/CHANGE INTERPRETATION OF SUB,DIV
	DCA I	TSUBP
	TAD	FFDV1
	DCA I	TDIVP
	JMP I	FPNXT	/DONE
FFSB1,	FFSUB1
TSUBP,	TSUB
FFDV1,	FFDIV1
/
/BEGINNING OF INTERPRETER
/
*FLPT
FPT,	0
L7600,	7600		/CLA
	RDF		/READ DATA FLD-THIS WILL BE INITIAL
	TAD	KCDF0	/FLOATING DATA AND INSTR. FIELD
	DCA	FPNEXT	/STORE CDF TO FLTG. IF AT FPNEXT
FFSW0,	TAD	FFSB0	/SET FLOATING SWITCH TO 0
	DCA	TSUB	/SUBTR. AND DIV. WORK AS NORMAL
	TAD	FFDV0
	DCA	TDIV
	TAD	FPNEXT
SFDF,	DCA	DFCDF
FPNEXT, 0		/CHANGE TO FLOATING INST. FIELD
	SWAB		/GO TO MODE B OF THE EAE
	TAD I	FPT	/GET FLOATING POINT INSTRUCTION
	MQL		/SEND IT TO MQ
	MQA		/GET IT BACK
	AND	K177	/PICK OFF ADDRESS PORTION
	DCA	OPH	/STORE IT
	MQA		/GET INSTR. BACK
	AND	K200	/CURRENT PAGE?
	CMA	IAC	/IF SO WE ADJUST ADDRESS
K200,	AND	FPT	/IF NOT AC WILL BE ZERO
	ISZ	FPT	/MOVE FLTG. PC. TO NEXT INSTR.
	TAD	OPH	/NOW HAVE ADDR. IN AC
	DCA	OPH	/THIS IS FINAL (UNLESS INDIRECT)
	SHL		/MOVE OP CODE OF INSTR. TO
	3		/BITS 9-11 OF THE AC
	TAD	JMSI	/MAKE AN INDIRECT JMS THROUGH TABLE
	DCA	DCOD	/STORE IT
	MQA		/GET INST TO AC-HIGH ORDER AC
	SMA	CLA	/BIT IS NOW INDIRECT BIT OF INST.
	JMP	GTAD	/NOT INDIRECT REF-GO ON
	TAD	OPH	/INDIRECT-SEE IF  AUTO INDEX REG.
	AND	K7770
	TAD	K7770
	SNA	CLA	/WELL-IS IT?
	CLL CML IAC RAL /YES-BUMP ADDR. BY THREE
	TAD I	OPH
	DCA I	OPH	/AND STORE IT BACK
	TAD I	OPH	/GET FINAL ADDRESS.
DFCDF,	0		/CHANGE TO FLTG D. F.-ITS INDIRECT
	SKP		/ALL DONE
GTAD,	TAD	OPH	/CALL SUBRS. WITH ADR. OF OP IN AC
DCOD,	0		/BECOMES JMS I TABLE WITH DATA
			/FLD SET TO FLTG. DF OR IF
FNRM,	JMS I	FFNORP	/NORMALIZE FAC(SUBR. CALLS SKIP THIS)
	JMP	FPNEXT	/GO GET NEXT INSTR.
K177,	177
/TABLE FOR DECODING OP CODES
JMSI,	JMS I	TABLE
TABLE,	FFJMP		/FLOATING JMP OP CODE 0
	FFADD		/FLOATING ADD OP CODE 1
TSUB,	FFSUB		/   "	  SUBTRACT "  2
TMPY,	FFMPY		/   "	  MULTIPLY "  3
TDIV,	FFDIV		/   "	  DIVIDE   "  4
	FFGET		/   "	  GET	   "  5
	FFPUT		/   "	  PUT	   "  6
	FFJMS		/   "	  JMS	   "  7

FCALLP, FCALL
FJUMPP, FJUMP
KCDF0,	CDF	0
K7770,	7770
/
/FLOATING JUMP-CHECK FOR FCALL OR FISZ
/
FFJMP,	0
	SWP		/ADDR IN AC TO MQ, INST IN MQ TO AC
	SNA		/IS IT FEXT?
	JMP	EXIT	/YES-LEAVE INTERPRETER
	CLL	RAL	/NO- INDIRECT AND PAGE BITS ZERO?
	SPA SZL CLA
	JMP I	FJUMPP	/NO-IT IS FJUMP-EFF. ADDR. IS IN MQ
	MQA		/YES-GET INSTR (=ADDR. SINCE PG 0)
	AND	K160	/CHECK BITS 5-7 ANY ON=FISZ
	SNA	CLA
	JMP I	FCALLP	/NONE ON-ITS A FUNCTION CALL
FFISZ,	ISZ I	OPH	/FISZ-ISZ PAGE 0 ADDR.(DF=FLTG.I.F.)
	JMP	FPNEXT	/NO SKIP-RETURN
FISZ1,	ISZ	FPT	/SKIP-BUMP FLOATING PC BY 1
	JMP	FPNEXT	/RETN.

/LEAVE INTERPRETER
EXIT,	IAC	RAL	/MAKE A CDF CIF TO FLTG. INSTR. FLD
	TAD	FPNEXT
	DCA	.+1	/STORE IT
	0
	SWBA		/MODE A OF EAE FOR EXIT.
	JMP I	FPT	/GO BACK TO USER

/
/FLOATING JMS-IF BITS 3-11=0 = NORMALIZE FAC (FNOR)
/		 BITS 3-4 =0 = DECODE FURTHER BY BITS 9-11
/		      9-11=0 = SKIP ON COND. OF FAC
/			  =1 = FCDF (BITS 6-8=NEW FLTG DF.)
/			  =2 = FSW0
/			  =3 = FSW1
/			  =4-7 = ??
/
FFJMS,	0
	SWP		/EFF. ADDR. OF JMS IN AC TO MQ
	SNA		/INST. TO AC-IS IT NORMALIZE?
	JMP	FNRM	/YES-GO DO IT
	CLL	RAL	/NO-ARE INDIRECT AND PAGE BITS 0?
	SMA SNL CLA
	JMP I	JSKPP	/YES-DECODE FURTHER BY BITS 9-11
	TAD	FPT	/NO-ITS A FJMS-GET FLTG. P.C.
	SWP		/SEND TO MQ-E.A. TO AC
	DCA	FPT	/PUT E.A. OF FJMS INTO FLTG. P.C.
	TAD	FPNEXT
	DCA	.+1
IFCDF,	0		/CHANGE TO FLOATING INSTR. FIELD
	MQA		/GET CURRENT FLTG. P.C.
	DCA I	FPT	/STORE IN 1ST WD. OF SUBR. FOR RETN
	JMP	FISZ1	/GO BUMP FLTG. P.C. AND EXEC. SUBR.
JSKPP,	JSKP	/ROUTINE TO DECODE INST. BY BITS 9-11

FFDV0,	FFDIV
FFSB0,	FFSUB

/ROUTINE TO DO FLOATING SKIPS ON CONDITION OF FAC
/THE E.A. OF INST. IS IN MQ-TO THIS WE 'OR' 7600 TO
/MAKE THE PROPER SKIP PLUS A CLA--SENSING IS REVERSED
/TO FACILITATE DECODING
FFSKP,	TAD	L7600	/GET BITS TO MAKE PROPER SKIPW/CLA
	MQA		/'OR' IN THE INST.
	DCA	.+2	/STORE FOR SKIP DECODING
	TAD	ACH	/GET HIGH ORDER MANTISSA FOR CHECK
	0		/EXECUTE THE SKIP
	ISZ	FPT	/NO SKIP=SKIP-BUMP PC (REV. SENSE)
	JMP	FPNEXT	/GO GET NEXT
/
/ROUTINE TO HANDLE AN FCDF--BITS 6-8 ARE THE NEW DATA FIELD
/
FFCDF,	TAD	KCDF0	/GET A BLANK CDF
	MQA		/'OR' THE DATA FIELD BITS INTO IT
	JMP	SFDF	/STORE AS NEW FLTG. DATA FIELD
FFNORP, FFNOR
K160,	160	/REPLACE WITH INST:BITS 5-7=1,8-11=0
/
/FLOATING SQUARE
/
	*FPT+164
FFSQ,	0
	JMS I	TMPY	/CALL MULTIPLY TO MUL.
	ACX		/FAC BY ITSELF
	JMP I	FFSQ	/DONE


/
/FLOATING TRAPS TO USER
/
*FPT+170
FTRP1,	JMP I	FTRAP1
FTRP2,	JMP I	FTRAP2
FTRP3,	JMP I	FTRAP3
FTRP4,	JMP I	FTRAP4
FTRAP1, FTRPRT		/OVERFLOW
FTRAP2, DBAD		/DIV. ERR -
FTRAP3, LTRPRT		/ILLEGAL FUNCT. ARG.
FTRAP4, DCOD1+1 	/UNDERFLOW
	$END$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search