/23-BIT FLOATING PT INTERPRETER
/DEC-08-NFPPA-A	VERSION 1
/COPYRIGHT	 1972 BY DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASSACHUSETTS. 01754
/
/W.J. CLOGHER
/
/
/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	/(DON'T USE FPNEXT AS A TEM!! E.G. IN I/O
		/SINCE OS/8 BASIC MAY BE THERE INSTEAD!!!)

*FLPT-2600
/
/PARTS OF INTERPRETER DISPATCH ROUTINES
/
/TABLE FOR JUMPS-OP CODE 7
/
JMPI3,	JMP I	TABLE3
TABLE3,	FFSKP		/SKIP ON CONDITION OF FAC
	FFCDF		/CHANGE FLTG. DATA FIELD
	FFSW0		/FLOATING SWITCH 0
	FFSW1		/FLOATING SWITCH 1
	FFHLT		/FLOATING HALT-DISPLAY PC
	FPNEXT		/NOP-FOR FUTURE EXPANSION
	FPNEXT		/ "
	FPNEXT		/ "
/
/ROUTINE FOR DECODING SPECIAL FJMS'S-OP CODE 7
/
JSKP,	TAD	OPH	/GET EFF. ADDR.
	AND	P7	/MASK OFF BITS 9-11
	TAD	JMPI3	/MAKE A JUMP THROUGH TABLE
	DCA	.+1	/STORE IT
	0		/EXECUTE IT
P7,	7
/
/FLOATING SWITCH 1
/
FFSW1,	JMS I	CDFCRK	/MUST BE CURRENT DATA FIELD
	TAD	FFSB1	/CHANGE INTERPRETATION OF SUB, DIV
	DCA I	TSUBP	/SO THAT FAC IS SUBTRACTED
	TAD	FFDV1	/FROM OR DIVIDED INTO OPERAND
	DCA I	TDIVP
	JMP I	FPNXT	/DONE
FFSB1,	FFSUB1
FFDV1,	FFDIV1
TSUBP,	TSUB
TDIVP,	TDIV

*FLPT-2500
/
/THIS STUFF MUST BE HERE CAUSE OS/8 BASIC EXPECTS IT  
/TO BE HERE
/
/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE
/ALSO SHIFTS OPERAND ONE BIT TO THE LEFT.
/EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT
/CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND
/DATA FIELD SET PROPERLY FOR OPERAND.
/
MDSET,	0
	JMS I	ARGETK	/GET ARGUMENT
MD1,	JMS I	CDFCRK	/CHANGE TO DF OF PACKAGE
	CLA CLL CMA RAL	/SET SIGN CHECK TO -2
	DCA	TM
	TAD	OPH	/IS OPERAND NEGATIVE?
	SMA	CLA
	JMP	.+3	/NO
	JMS I	OPNEGP	/YES-NEGATE IT
	ISZ	TM	/BUMP SIGN CHECK
	TAD	OPL	/AND SHIFT OPERAND LEFT ONE BIT
	CLL	RAL
	DCA	OPL
	TAD	OPH
	RAL
	DCA	OPH
	DCA	AC1	/CLR. OVERFLOW WORF OF FAC
	TAD	ACH	/IS FAC NEGATIVE
	SMA	CLA
	JMP	LEV	/NO-GO ON
	JMS I	FFNEGK	/YES-NEGATE IT
	ISZ	TM	/BUMP SIGN CHECK
	NOP		/MAY SKIP
LEV,	TAD	OPX	/EXIT WITH OPERAND EXPONENT IN AC
	JMP I	MDSET

FFNEGK,	FFNEG
OPNEGP,	OPNEG
CDFCRK,	CDFCUR
ARGETK,	ARGET
/
/CONTINUATION OF FLOATING DIVIDE ROUTINE
/
FD1,	TAD	AC2	/NEGATE HI ORDER PRODUCT
	CLL CMA IAC
	TAD	ACH	/COMPARE WITH REMAINDER OF FIRST DIV.
	SNL		/WELL?
	JMP I	DVOPSP	/GREATER THAN REM.-ADJUST QUOT OF 1ST DIV.
	CLL		/OK-DO  (REM-(Q*OPL))/OPH
	DCA	ACH	/FIRST STORE ADJUSTED PRODUCT
	JMS I	DV24P	/DIVIDE BY OPH (HI ORDER OPERAND)
DVL1,	TAD	AC1	/GET QUOT. OF FIRST DIV.
	SMA		/IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT
	JMP	FD	/NO-ITS NORMALIZED-DONE
	CLL	RAR	/MUST SHIFT RIGHT 1
	DCA	ACH	/STORE IN FAC
	TAD	ACLO	/SHIFT LOW ORDER RIGHT
	RAR
	DCA	ACLO	/STORE BACK
	ISZ	ACX	/BUMP EXPONENT
	NOP
	TAD	ACH
FD,	DCA	ACH	/STORE HIGH ORDER RESULT
	JMP I	FDDONP	/GO LEAVE DIVIDE

FDDONP,	FDDON		/END OF FLTG. DIV. ROUTINE
DV24P,	DV24		/ROUTINE TO DO A 24X12BIT DIVIDE
DVOPSP,	DVOPS		/ROUTINE TO ADJUST QUOT OF FIRST DIV.
/
/CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV.
/DBAD1 IS ONLY EXECUTED ON DIVIDE OVERFLOW-OTHERWISE THE
/ROUTINE STARTS AT DVOP2
/
DBAD1,	DCA	ACX	/DIVIDE OVERFLO-ZERO ALL
DVOP2,	SNA		/IS IT ZERO?
	DCA	ACLO	/YES-MAKE WHOLE THING ZERO
	DCA	ACH
	JMS I	DV24P	/DIVIDE EXTENDED REM. BY HI DIVISOR
	TAD	ACLO	/NEGATE THE RESULT
	CLL CMA IAC
	DCA	ACLO
	SNL		/IF QUOT. IS NON-ZERO, SUBTRACT
	CMA		/ONE FROM HIGH ORDER QUOT.
	JMP	DVL1	/GO TO IT
*FLPT-1600

/
/FLOATING OUTPUT ROUTINE
/
FFOUT,	0
	CLA CLL CMA RAL	/MAKE A MINUS TWO
	DCA I	FFNGP	/AND STORE IN SIGN WORD
	DCA	KNT	/CLEAR COUNT WORD
	TAD	EFLG	/IS THIS E FORMAT?
	SZA	CLA	
	JMP	FFMT	/NO-F FORMAT
	TAD	K6	/YES-GET 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
	JMS I	FFNGP	/NEGATE #
	DCA I	FFNGP	/NEGATIVE-SET FLAG
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	SE	/# 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	SE	/STORE AS COUNTER
	JMP	.+3
	JMS I	FFDVP	/DIVIDE .5 BY TEN THAT # OF TIMES
	TEN
	ISZ	SE	/DONE?
	JMP	.-3	/NO-GO ON
	JMS I	FFADP	/YES-ADD IN ORIG.#-THIS IS ROUNDING
	TM3
	JMS	SE	/INSURE THAT IT IS IN RANGE
FOUT4,	TAD	ACX	/SHIFT MANTISSA ACCORDING TO EXP
	CMA	IAC	/0=1 LEFT; 1=NO SHIFT;2=1 RIGHT,...
	JMS I	ACSRPT	/SHIFT RIGHT (ACX+1) PLACES
	JMS I	AL1PT	/SHIFT LEFT 2 TO CORRECT
	JMS I	AL1PT	/(WE ARE LOSING BITS!!)
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
ACSRPT,	ACSR
AL1PT,	AL1
/
/ROUTINE TO GET FAC<1
/
SE,	0
SE1,	TAD	ACX
	SPA SNA CLA	/#>1?
	JMP I	SE	/NO-RETN.
	JMS I	FFDVP	/YES-DIV. BY TEN
	TEN
	CMA
	TAD	KNT	/REDUCE KNT BY 1
	DCA	KNT
	JMP	SE1
/CONSTANTS AND POINTERS
OUTDGP,	OUTDG
K16,	16
CDFCRB,	CDFCUR
FLINK,	JMP I	FFOUT
PRNTXP,	PRNTX
PRZROP,	PRZRO
DGTYPP,	DGTYP
DCNTP,	DCNT
M1,	7777
KK7,	7
KM20,	-20
KM7,	-7
FFADP,	FFADD
FFDVP,	FFDIV
FFPUTP,	FFPUT
FFMPP,	FFMPY
FFNGP,	FFNEG
KNT,	0
K6,	6
/CONTINUATION OF OUTPUT MAINLINE
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
	DCA I	FFDVP	/STORE WHILE WE CHECK DADP
	TAD	DADP	/GET DIGITS AFTER DEC. PT
	SNA		/DID HE SAY NO DEC. PLACES?
	CMA		/YES-TAKE AWAY 1 SINCE NO DEC. PT.
	TAD I	FFDVP	/ADD IN REST
	SMA		/NEG?
	JMP I	PRNTXP	/NO-PRINT XS-NOT ENUFF ROOM
	DCA	SE	/STORE AS CNT OF SPACES
	JMP	.+3
	TAD	KM20
	JMS I	OUTDGP	/PRINT A SPACE
	ISZ	SE	/DONE?
	JMP	.-3	/NO-GO ON
	CLA CLL CMA RTL	/MAKE A MINUS 3
	TAD I	FFNGP	/YES-GET SIGN(=-2 OR 0)
	JMS I	OUTDGP	/FOR PLUS OR MINUS-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	/CHECK DADP FOR 0
	SNA	CLA	/DON'T PRINT '.' IF DADP=0
/*************************************
/FALL THROUGH PAGE BOUNDARY!!!
/'SNA CLA' MUST BE LAST LOC. ON PAGE!!!
/(CURSE YOU B.C.)
/*************************************
*FLPT-1400
/*******FALL THROUGH PAGE BOUNDARY TO HERE*******
	JMP	GKNT	/MUST BE FIRST LOC. OF PAGE!!*******
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	SEP
	JMP	PR	/GO ON
PZR,	JMS	OUTDG	/PRINT A ZERO
PR,	ISZ	DGTYP
	SKP
	JMP	PS
	ISZ	SEP
	JMP	PZR
PS,	TAD I	KNTP
	CMA	IAC
GD,	TAD	DADP
	SMA	SZA
	JMS	DGTYP
	CLA
	TAD	EFLG
	SZA	CLA
	JMP	DONEF	/DONE
	JMS	OUT
	305		/PRINT 'E'
	TAD	OPX	/GET PRESERVED COUNT OF MULS
	SMA SZA CLA	/DETERMINE SIGN
	CLA CLL CML RTL	/MAKE A 2
	JMS	OUT
	253		/PRINT MINUS OR PLUS SIGN
	TAD	KM144	/SET TO DIV BY 100
	DCA	OPH
	CLA CLL CMA RAL	/SET LOOP COUNTER
	DCA	DGTYP
	TAD	OPX	/GET THE COUNT
	SPA
	CMA	IAC	/NEGATE IF NEGATIVE
LOOP,	DCA	ACLO	/STORE FOR DIV. ROUTINE
	DCA	ACH	/HI ORD. MUST BE ZERO
	CLL		/PREVENT DIVIDE OVERFLOW!!
	JMS I	DV24PT	/DIVIDE BY 100
	TAD	ACLO	/GET THE QUOTIENT
	JMS	OUTDG	/OUTPUT HUNDREDS PLACE
	TAD	KM12	/NOW DIV. BY 10
	DCA	OPH
	TAD	ACH	/DIV. REM. BY 10
	ISZ	DGTYP	/DONE?
	JMP	LOOP	/NO-GO DO CALCULATE , PRINT TENS PLACE
	JMS	OUTDG	/YES-REM(ONES PLACE)IS IN AC-PRINTIT
DONEF,	TAD	SWIT2	/SHOULD WE PRINT CR/LF?
	SNA	CLA
	JMP I	FLING	/NO
	JMS	OUT
	215
	JMS	OUT
	212
	JMP I	FLING
/
/OUTPUT DIGITS OF FAC BY MULTIPLYING BY TEN
/THE HIGH ORDER OVERFLOW IS THE DIGIT
DGTYP,	0
	CMA	IAC
	DCA	SEP	/STORE COUNT PASSED
DT1,	TAD	ACH	/GET FAC AND STORE FOR LATER
	DCA	OPH
	TAD	ACLO
	DCA	OPL
	JMS I	AL1PP	/SHIFT FAC LEFT 1 = FAC*2
	RAL		/OVERFLOW TO TM3
	DCA	TM3
	JMS I	AL1PP	/SHIFT LEFT AGAIN = FAC*4
	TAD	TM3	/SHIFT OUT OVERFLOW
	RAL
	DCA	TM3
	DCA	AC2	/MUST BE 0 FOR OADD
	JMS I	OADDP	/ADD ORIG FAC = FAC*5
	RAL		/ADD OVERFLOW TO TM3
	TAD	TM3
	DCA	TM3
	JMS I	AL1PP	/SHIFT FAC 1 LEFT = FAC*10!!
	TAD	TM3	/OVERFLOW IN TM3 IS FIRST DIGIT
	RAL
	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)
	ISZ	SEP	/DONE REQUIRED?
	JMP	DT1	/NOPE
	JMP I	DGTYP	/YUP
KM144,	-144
KM12,	-12
DV24PT,	DV24
DCNT,	0	/COUNT OF SIGNF. DIGITS
AL1PP,	AL1
OADDP,	OADD
FLING,	FLINK
PRDCPP,	PRDCP
/NEEDED FOR OS/8 BASIC
*FLPT-1234
/
/OUTPUT ROUTINE
/
OUT,	0
	TAD I	OUT	/GET THE CHAR.
	TSF
	JMP	.-1
	TLS
	CLA	CLL	/USE AN 'AND..' INSTEAD???
	JMP I	OUT

/
/OUTPUT DIGIT
/
OUTDG,	0
	JMS	OUT
	260
	JMP I	OUTDG	/RETN

KNTP,	KNT
TM3,	0
	0
SEP,	0
PRNTX,	CLA
	TAD	FLDW	/GET FIELD WIDTH
	CMA		/MUST BE NEGATIVE
	DCA	SEP	/USE AS COUNTER
PRNTX1,	ISZ	SEP	/DONE ALL?
	SKP		/NO-GO ON
	JMP	DONEF	/YES-RETN.
	JMS	OUT	/PRINT ASTERISK
	252		/ASTERISK
	JMP	PRNTX1
/
/PRINT A LEADING ZERO
/
PRZRO,	CLA
	JMS	OUTDG
	JMP I	PRDCPP

/
/FLOATING POINT INPUT ROUTINE
/
*FLPT-1200
FFIN,	0
	CLA	CMA
	DCA I	FDVPT	/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
P200,	200
	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-# IS STORED IN
	JMS I	FPP	/FORM EASILY FLOATIBLE-ENTER INTERP.
	FMPY	TEN	/MULTIPLY # BY TEN
	FPUT I	TM3PT	/STORE IT AWAY
	FGET	TP	/GET NEW DIGIT
	FNOR		/FLOAT IT
	FADD I	TM3PT	/ADD IT TO ACCUMULATED #
	FEXT		/DONE
	JMP	DECON	/GO ON
FFIN1,	ISZ I	FDVPT	/HAVE WE HAD A PERIOD YET?
	JMP	FIGO2	/YES-GO ON
	ISZ	TP1	/NO-IS THIS A PERIOD?
	ISZ	TP1
	SKP	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,	ISZ	SIGNF	/IS # NEGATIVE?(DID WE GET - SIGN?)
	JMS I	FFNEGP	/YES-NEGATE IT
	CLA	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
	TAD	TM	/GOT DIG. OF EXP-STORED IN TP1
	CLL	RTL	/MULT. ACCUMULATED EXP BY 10
	TAD	TM
	CLL	RAL
	TAD	TP1	/ADD DIGIT
	JMP	GETE	/CONTINUE
EDON,	TAD	TM	/GET EXPONENT
	ISZ	SIGNF	/WAS EXPONENT NEGATIVE?
	CMA	IAC	/YES-NEGATE IT
	CMA	IAC	/AND CALC. DNUMBR - EXPON.
	TAD	DNUMBR	/GET # TIMES TO DIV MANTISSA BY TEN
	CLL CMA IAC
	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	SIGNF	/AND STORE FOR EXECUTION
FCNT,	ISZ	DNUMBR	/DONE ALL OPERATIONS?
	JMP	SIGNF	/NO
	JMP I	FFIN	/YES-RETURN
SIGNF,	0		/NO- MUL OR DIV. MANTISSA
	TEN		/BY TEN
	JMP	FCNT	/GO ON
FFNEGP,	FFNEG
TM3PT,	TM3
DNUMBR,	0
KME,	-305
MDV,	JMS I	.+1	/THESE 3 WDS. MUST BE IN THIS ORDER
	FFMPY
FDVPT,	FFDIV		/!!!!!!!!!!!!!!!!!

CDFCRA,	CDFCUR
KK12,	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
	DCA	TM	/STORE ACCUMULATED EXPONENT (MAYBE)
	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	KK12
	DCA	TP1	/STORE FOR LATER
	SZL		/DIGIT?
	ISZ	GCHR	/YES-RETN. TO CALL+2
	JMP I	GCHR	/NO-RETN. TO CALL+1
K7506,	7506
/
/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
	DCA	TMIN	/STORE IT AGAIN
	JMS I	OUTPP	/PRINT IT
TMIN,	0
	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?
	SZA	CLA
	JMS I	OUTPP	/YES-DO IT
	212		/LINE FEED
	JMP I	INPUT	/RETURN
OUTPP,	OUT
MCR,	377-215
MRUBOT,	-377
PLUS,	-253
MINUS,	253-255

*FLPT-1000
/
/INVERSE FLOATING SUBTRACT-USES FLOATING ADD
/!!FSW1!!-THIS IS OP-FAC
/
FFSUB1,	0
	SNA		/WHICH MODE?
	TAD I	FFSUB1	/CALLED BY USER-GET ADDR. OF OP.
	JMS I	ARGETL	/GO PICK UP OPERAND
	JMS I	FFNEGA	/NEGATE FAC
	TAD	FFSUB1	/AND GO ADD
	JMP I	SUB0P
FFNEGA,	FFNEG
SUB0P,	SUB0
KM22,	-26
/
/INVERSE 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	/PICK UP OPERAND
	TAD	ACLO	/SWAP THE FAC AND OPERAND
	DCA	OPL	/THERE IS A POINTER TO OPL
	TAD I	AC2	/IN AC2 LEFT FROM ARGET SUBR.
	DCA	ACLO
	TAD	ACX	/MIGHT AS WELL SUBTRACT THE
	CLL CMA IAC	/EXPONENTS HERE (SAVES A WORD)
	TAD	OPX	/THEN ZERO OPX SO WILL NOT
	DCA	ACX	/MESS UP WHEN ITS DONE AGAIN
	DCA	OPX	/LATER (SEE DIV. ROUTINE)
	TAD	ACH
	DCA	AC2	/NOW SWAP HIGH ORDER MANTISSAS
	TAD	OPH
	DCA	ACH
	TAD	AC2
	DCA	OPH
	JMS I	CDFCRL	/CHANGE DF TO CURRENT
	TAD	FFDIV1	/NOW KLUDGE UP SUBROUTINE LINKAGE
	DCA I	FFDP
	TAD	KFD1
	DCA I	MDSETP
	JMP I	MD1P	/GO SET UP AND DIVIDE

MD1P,	MD1
ARGETL,	ARGET
CDFCRL,	CDFCUR
MDSETP,	MDSET
FFDP,	FFDIV
KFD1,	FFD1
AN1=FFSUB1
AN2=FFDIV1
/FLOATING SQUARE ROOT
/USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS
/REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409
/
FROOT,	0
	CLA CLL CML RTR	/SET RESULT TO 2000;0000
	DCA	AN1
	DCA	AN2
	JMS I	CDFCRL	/CHANGE TO DATA FIELD OF PACKAGE
	TAD	KM22	/SET COUNTER FOR DEVELOPING 22 BITS OF ERESULT
	DCA	AC2	/ALREADY HAVE 1
	TAD	ACH
	SNA
	JMP I	FROOT	/ZERO FAC-NORMALIZED!-RETN. SAME
	SPA	CLA
	JMS I	FFNEGA	/TAKE ROOT OF ABSOL VALUE
	TAD	ACX	/GET EXPONENT OF FAC
	SPA		/IF NEGATIVE-MUST PROPAGATE SIGN
	CML
	RAR		/DIVIDE EXP. BY 2
	DCA	ACX	/STORE IT BACK
	SZL		/INCREMENT EXP. IF ORIGINAL EXP 
	ISZ	ACX	/WAS ODD
	NOP
	SNL		/DO A PRE-SHIFT FOR EVEN EXPONENTS
	JMS I	AL1K	/SO FIRST BIT PAIR IS 10 NOT 01
	CLA CLL CMA RAL	/SET COUNTER FOR DETECTING A
	DCA	ZCNT	/ZERO REMAINDER
	CLA CLL CML RTR	/SET UP POSITION OF TRIAL BIT
	RTR		/FOR FIRST PASS THRU LOOP
	DCA	OPH
	DCA	OPL
	TAD	K6000	/GET A FAST FIRST BIT-WE KNOW 
	TAD	ACH	/THIS WILL WORK SINCE # IS NORMALIZED
	DCA	ACH	/IF # IS A POWER OF TWO, AND A PERFECT
	TAD	ACH	/SQUARE-WE ARE DONE HERE!
	SNA		/WELL IS IT?
	TAD	ACLO	/COULD BE-CHECK LOW ORDER
	SNA	CLA
	JMP	DONE	/WHOOPPEE-WE WIN BIG.
	JMP	LOP01	/NOPE-LOOP DON'T SHIFT FIRST TIME
SLOOP,	TAD	OPH	/SHIFT TRIAL BIT 1 PLACE
	CLL	RAR	/TO THE RIGHT
	DCA	OPH	/AND STORE BACK
	TAD	OPL
	RAR
	DCA	OPL
	JMS I	AL1K	/SHIFT FAC LEFT 1 PLACE
LOP01,	TAD	OPL	/ADD TRIAL BIT TO`ANSWER
	TAD	AN2	/SO FAR
	CLL CMA IAC	/NEGATE IT
	TAD	ACLO	/AND ADD TO FAC (REMAINDER SO FAR)
	SNA		/IS RESULT ZERO?
	ISZ	ZCNT	/YES-INCREMENT COUNTER
	DCA	TM	/STORE RESULT IN TEMPORARY

	CML	RAL	/ADD CARRY TO HIGH ORDER FOR SUBTRACT
	TAD	OPH	/ADD TRIAL BIT
	TAD	AN1	/ADD RESULT SO FAR (HI ORDER)
	CLL CMA IAC	/AND SUBTRACT FROM HI ORDER FAC
	TAD	ACH
	SNL		/RESULT NEGATIVE?
	JMP	GON	/YES-NEXT RESULT BIT IS 0
	SZA		/NO-IS HI ORDER RESULT=0?
	JMP	LOP02	/NO-GO ON
	ISZ	ZCNT	/YES-WAS LOW ORDER =0?
	JMP	.+3	/NO-GO ON
	CMA		/YES-REM.=0-SET COUNTER SO
	DCA	AC2	/LOOKS LIKE WE'RE DONE
LOP02,	DCA	ACH	/STORE HIGH ORDER REM. IN FAC
	TAD	TM	/STORE LO ORDER REM. IN FAC
	DCA	ACLO
	TAD	OPL	/TRIAL BIT SHIFTED LEFT 1 IS
	CLL	RAL	/RESULT BIT-ADD IT TO ROOT DEVELOPED
	TAD	AN2	/SO FAR
	DCA	AN2
	TAD	OPH
	RAL
	TAD	AN1
	DCA	AN1
GON,	CLA CLL CMA RAL	/RESET COUNTER FOR ZERO REM.
	DCA	ZCNT	
	ISZ	AC2	/DONE ALL 23 RESULT BITS?
	JMP	SLOOP	/NO-GO ON
DONE,	TAD	AN1	/YES-STORE ANSWER IN FAC
	DCA	ACH	/ITS NORMALIZED ALREADY
	TAD	AN2
	DCA	ACLO
	JMP I	FROOT	/AND RETURN

K6000,	6000
ZCNT,	0
AL1K,	AL1
PAUSE