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

/FIVE WORD FLOATING POINT PACKAGE
	FIXMRI FADD=1000
	FIXMRI FSUB=2000
	FIXMRI FMPY=3000
	FIXMRI FDIV=4000
	FIXMRI FGET=5000
	FIXMRI FPUT=6000
	FNOR=	7000
	FEXT=	0000
	FSQ=	0001
	FSQRT=	0002
	EPRINT=	0003
	FPRINT=	0004	/FLOATING POINT WRITE
	FREAD=	0010	/READ
	FABS=	0011	/ABSOLUTE VALUE
	FNEG=	0016	/NEGATE FAC

*5
FLINPT,	FIPT
FLOUPT,	FOPT
FLPNT,	FPNT
	/*15 USED BY OUTPUT CONTROLLER
*40
ACSIGN,	0		/FLOATING PT ACCUMULATOR
ACEXP,	0
AC1,	0
AC2,	0
AC3,	0
AC4,	0
AC5,	0
OPSIGN,	0		/FLOATING PT OPERANAND
OPEXP,	0
OP1,	0
OP2,	0
OP3,	0
OP4,	0
OP5,	0
SWIT1,	7777		/IF=0, NO CR-LF AFTER OUTPUT
SWIT2,	7777		/IF=0, NO LF AFTER CR IN INPUT
CHAR,	0		/CONTAINS LAST CHAR READ
DSWIT,	0		/=0 IF NO CONVERSION TOOK PLACE
DIGNOP,	0		/NUMBER OF DIGITS O/P; 0=OP FLOATS
FFLAG,	0		/FLOATING FLAG=0 IF FLOP=0
OVER,	0		/OVERFLOW
	*200
START,	JMS I	7	/ENTER FLOATING PT MODE
	FREAD		/GET A NUMBER
	FPUT	FOO	/STORE IT IN A DUMB PLACE
	FREAD		/GET ANOTHER NUM
	FPUT	FOO1
	FGET	FOO1
	FADD	FOO
	FPUT	FOO2
	FGET	FOO
	FPRINT
	FGET	FOO1
	FPRINT
	FGET	FOO2
	FPRINT
	FEXT
	JMP	START

FOO,	0
	0
	0
	0
	0
FOO1,	0
	0
	0
	0
	0
FOO2,	0
	0
	0
	0
	0
*5463
FPSQRT,	0		/SQUARE ROOT FUNCT
	JMS I 7		/PUT INPUT INTO HERE
	FPUT I	HERE
	FEXT
	TAD	AC1
	SNA CLA
	JMP I	FPSQRT	/ZERO INPUT
	TAD	ACSIGN
	SPA CLA
	JMP I	ERROR5	/NEGATIVE INPUT
	TAD	ACEXP
	TAD	M200X	/REAL EXPONENT
	CLL
	SPA
	CML
	RAR
	TAD	CP200
	DCA	ACEXP	/ACEXP **0.5
	IAC RTL		/NICE POINT TO START ITERATION
	DCA	AC1
	DCA	ACSIGN
ROOT,	JMS I	7
	FPUT I	ITER
	FGET I	HERE
	FDIV I	ITER
	FADD I	ITER
	FEXT
	CLA CMA
	TAD	ACEXP
	DCA	ACEXP	/DIVIDE FAC BY 2
	TAD I	ITER
	AND	MASKZ
	CLL RTR
	RAR
	CIA
	TAD	ACEXP
	SZA CLA		/ITER=FAC WITHIN ONE BIT?
	JMP	ROOT
	TAD I	ITER
	AND	MASKY
	CIA
	TAD	AC1
	SZA CLA
	JMP	ROOT
	TAD	ITER
	DCA	15
	TAD I	15
	CIA
	TAD	AC2
	SZA CLA
	JMP	ROOT
	TAD I	15
	CIA
	TAD	AC3
	SZA CLA
	JMP	ROOT
	TAD I	15
	CIA
	TAD	AC4
	SZA CLA
	JMP	ROOT
	TAD I	15
	CIA
	TAD	AC5
	SMA
	CIA
	IAC
	SPA CLA
	JMP	ROOT
	JMP I	FPSQRT
HERE,	ICI
MASKZ,	3770
MASKY,	0007
ERROR5,	ERRORD
CP200,	200
M200X,	7600
ITER,	ITERX
*5600
FPNT,	0
P7600,	7600		/CLA
	JMP	.+3
FLOOP,	JMS I	FPNORM	/NORMALIZE FAC
	ISZ	FPNT	/GO ONTO NEXT OP
	TAD I	FPNT
	SNA		/OP CODE=0000?
	JMP I	FPNT	/UES, EXIT
	RTL		/NO. GET OP CODE (BITS 0-2)
	RTL		/INDIRECT ADDRESS BIT IN LINK
	AND	MASK1
	DCA	FGOTO
	TAD I	FPNT	/PAGE 0 MODE?
	AND	MASK2
	SNA CLA
	JMP	FPNT1	/YES
	TAD	FPNT	/NO, GET PAGE
	AND	P7600
FPNT1,	DCA	FADDR
	TAD I	FPNT	/ADD IN ADDRESS
	AND	MASK3
	TAD	FADDR
	DCA	FADDR
	SNL
	JMP	FPNT2
	TAD I	FADDR	/GO INDIRECT
	DCA	FADDR
FPNT2,	TAD	FGOTO	/GET OP CODE
	SNA		/SPECIAL OPS?
	JMP	FPNT4	/YES
	TAD	M6
	SMA CLA		/OP CODE 6 OR 7
	JMP	FPNT3	/YES. DO NOT PICK UP ARG
	TAD	MASK4
	AND I	FADDR
	DCA	OPSIGN	/GET SIGN
	TAD I	FADDR	/=0?
	SZA CLA
	CLA CMA
	DCA	FFLAG	/=0 IF OP =0
	TAD I	FADDR
	RTR		/GET EXPONENT
	RAR
	AND	MASK6
	DCA	OPEXP
	TAD I	FADDR
	AND	MASK1	/GET 4BIT HIGH MANTISSA
	DCA	OP1
	TAD	M4	/GET REST OF MANTISSA IN OP
	DCA	CONA
	TAD	ADDOP1
	DCA	HIGHWD
	ISZ	FADDR
	ISZ	HIGHWD
	TAD I	FADDR
	DCA I	HIGHWD
	ISZ	CONA
	JMP	.-5
FPNT3,	TAD	FGOTO
	TAD	TABLE
FPNT5,	DCA	JUMP2
	TAD I	JUMP2
	DCA	JUMP2
	TAD	FGOTO
	SZA CLA
	JMP I	JUMP2	/EXECUTE
	TAD	FPNT
	DCA	GOTO	/SAVE PSEUDO PC BECAUSE
	JMS I	JUMP2	/A JMS I 7 IN ROUTINE
	TAD	GOTO
	DCA	FPNT
	JMP	FLOOP+1
TABLE,	.
	FPADD
	FPSUB
	FPMPY
	FPDIV
	FPGET
	FPPUT
	FLOOP		/NORMALIZE
FPNT4,	TAD I	FPNT	/OP CODE 0
	AND	MASK5
	TAD	TABLE2
	JMP	FPNT5
TABLE2,	.
	FPSQ
	FPSQRT
	EWRITE
	FWRITE
MASK3,	177
MASK4,	4000
MASK5,	17
	FPREAD
	FPABS
JUMP2,	0
GOTO,	0
FADDR,	0
FGOTO,	0
	FPNEG
M6,	7772

HIGHWD,	0		/ASSEMBLES HIGH WORD
	TAD	ACEXP
	CLL RTL
	RAL
	TAD	ACSIGN
	TAD	AC1
	JMP I	HIGHWD
FPPUT,	JMS	HIGHWD	/GET HIGH WORD
	DCA I	FADDR
	TAD	M4
	DCA	CONA
	TAD	ADDAC1
	DCA	HIGHWD
	ISZ	FADDR
	ISZ	HIGHWD
	TAD I	HIGHWD
	DCA I	FADDR
	ISZ	CONA
	JMP	.-5
	JMP	FLOOP+1
FPNORM,	FNORM
ADDAC1,	AC1
ADDOP1,	OP1
M4,	7774
MASK6,	377
MASK1,	7
MASK2,	200
CONA,	0
	PAGE
AR1,	0		/SHIFT FAC RIGHT BY ONE
	TAD	ADAC1
	DCA	CONB
	TAD	M5
	DCA	CONC
	CLL
	TAD I	CONB
	RAR
	DCA I	CONB
	ISZ	CONB
	ISZ	CONC
	JMP	.-5
	RAR
	DCA	OVER	/OVERFLOW RIGHT
	JMP I	AR1
ACN,	0		/NEGATE FLAC
	TAD	ADDOP5
	DCA	OADD
	TAD	M5
	DCA	AR1
	CLL
ACN1,	TAD I	OADD
	CML CMA		/LINK ALTERED AT EVERY .+5
	SZL		/SO CML TO COMPENSATE
	CLL IAC		/INCREMENT OP5
	DCA I	OADD	/PLUS ANY CARRY OVER
	CMA
	TAD	OADD
	DCA	OADD
	ISZ	AR1
	JMP	ACN1
	JMP I	ACN
ADDOP5,	OP5
OADD,	0
	CLA CLL
	TAD	AC5
	TAD	OP5
	DCA	AC5
	RAL
	TAD	OP4
	TAD	AC4
	DCA	AC4
	RAL
	TAD	OP3
	TAD	AC3
	DCA	AC3
	RAL
	TAD	AC2
	TAD	OP2
	DCA	AC2
	RAL
	TAD	AC1
	TAD	OP1
	DCA	AC1
	JMP I	OADD
FPSUB,	TAD	C4000	/NEGATE OP MANTISSA
	TAD	OPSIGN
	DCA	OPSIGN
FPADD,	ISZ	FFLAG
	JMP	EOFAD	/ZERO NUMBER
	TAD	ACEXP
	CLL CIA
	TAD	OPEXP
	SZL		/POSITIVE DIFFERENCE
	JMP	BCKWDS
	DCA	OADD
ALGNLP,	TAD	M5	/SHIFT OPERAND RIGHT
	DCA	CONC
	TAD	ADOP1
	DCA	ACN
	CLL
	TAD I	ACN
	RAR
	DCA I	ACN
	ISZ	ACN
	ISZ	CONC
	JMP	.-5
	ISZ	OADD
	JMP	ALGNLP
SETSGN,	TAD	ACSIGN
	TAD	OPSIGN
	SPA CLA
	JMS	ACN	/SIGNS OF MANTISSA DIFFER
	JMS	OADD
	TAD	AC1
	SMA CLA
	JMP	EOFAD
	TAD	M7	/SO ACN WORKS ON AC1-5
	JMS	ACN	/TO GET MANTISSA POSITIVE
	TAD	OPSIGN
	DCA	ACSIGN
EOFAD,	DCA	OVER
	JMP I	FPLOOP
M7,	7771
FPLOOP,	FLOOP
C4000,	4000
BCKWDS,	CMA		/SHIFT FAC RIGHT
	DCA	OADD
	TAD	OPEXP
	DCA	ACEXP
	SKP
	JMS	AR1
	ISZ	OADD
	JMP	.-2
	JMP	SETSGN
ADAC1,	AC1
ADOP1,	OP1
M5,	7773
CONB,	0
CONC,	0
BUFFER,	0		/OUTPUT CHARACTER BUFFER
	0000		/PART OF BUFFER BORROWED FOR VARS
	0000
	0000
	0000
	0
ICI,	0
	0
	0
	0
	0
	0
ITERX,	0
	0
	0
	0
	0
	PAGE
FPMPY,	ISZ	FFLAG	/MULTIPLY
	JMP	MULCLR
	TAD	ACSIGN	/AC X OP
	TAD	OPSIGN
	DCA	ACSIGN
	TAD	ACEXP
	TAD	OPEXP
	TAD	M201
	DCA	ACEXP	/EXPONENTS MULTIPLIED
	TAD	AC1
	DCA	OPSIGN	/COPY FLAC INTO
	TAD	AC2	/OPSIGN+OPEXP+MPDV+FFLAG+AL1
	DCA	OPEXP	/TO UES AS MULTIPLIER CONTROL
	TAD	AC3
	DCA	MPDV
	TAD	AC4
	DCA	FFLAG
	TAD	AC5
	DCA	AL1
	TAD	M63
	DCA	COUNT	/TEMPORARY COUNTER
MPYLUP,	JMS I	ARM1	/SHIFT FLAC RIGHT
	TAD	OPSIGN	/SHIFT CONTROL FLAC RIGHT
	RAR		/LSB ENDS IN LINK
	DCA	OPSIGN
	TAD	OPEXP
	RAR
	DCA	OPEXP
	TAD	MPDV
	RAR
	DCA	MPDV
	TAD	FFLAG
	RAR
	DCA	FFLAG
	TAD	AL1
	RAR
	DCA	AL1
	SZL		/ADD IF BIT IN LINK
	JMS I	ADDO	/OP + AC = AC
	ISZ	COUNT
	JMP	MPYLUP
	DCA	OVER
	JMP I	AFLOOP
M201,	7577
M63,	7715
ADDO,	OADD
ARM1,	AR1
MULCLR,	DCA	ACEXP
	DCA	AC1
	DCA	AC2
	DCA	AC3
	DCA	AC4
	DCA	AC5
	DCA	OVER
	JMP I	AFLOOP
AFLOOP,	FLOOP
FPDIV,	ISZ	FFLAG	/DIVIDE
	JMP I	ERROR2	/DIVISION BY ZERO
	TAD	ACSIGN
	TAD	OPSIGN
	DCA	ACSIGN
	TAD	OPEXP
	CIA
	TAD	ACEXP
	TAD	C201
	DCA	ACEXP
	DCA	OPSIGN
	TAD	M63
	DCA	COUNT
DIVLP,	TAD	MASKA
	AND	OP1
	TAD	AC1
	SMA CLA		/AC, OP MUST HAVE DIFF. SIGNS
	JMS I	ACNEG
	JMS I	ADDO	/1 IN LINK IF REMAINDER POSITIVE
	TAD	OPSIGN	/TEMP FAC FOR RESULT
	RAL		/COND+FFLAG+MPDV+OPEXP+OPSIGN
	DCA	OPSIGN
	TAD	OPEXP
	RAL
	DCA	OPEXP
	TAD	MPDV
	RAL
	DCA	MPDV
	TAD	FFLAG
	RAL
	DCA	FFLAG
	TAD	COND
	RAL
	DCA	COND
	JMS	AL1	/SHIFT AC ONCE LEFT
	ISZ	COUNT
	JMP	DIVLP
	TAD	COND	/TRANSFER ANSWER TO FAC
	DCA	AC1
	TAD	FFLAG
	DCA	AC2
	TAD	MPDV
	DCA	AC3
	TAD	OPEXP
	DCA	AC4
	TAD	OPSIGN
	DCA	AC5
	JMP I	AFLOOP
MASKA,	4000
ACNEG,	ACN
C201,	201
ERROR2,	ERRORB
AL1,	0		/SHIFT FAC ONCE LEFT
	TAD	AC5
	CLL RAL
	DCA	AC5
	TAD	AC4
	RAL
	DCA	AC4
	TAD	AC3
	RAL
	DCA	AC3
	TAD	AC2
	RAL
	DCA	AC2
	TAD	AC1
	RAL
	DCA	AC1	/ANY OVERFLOW FILLS SPACE IN AC1
	JMP I	AL1
COUNT,	0
MPDV,	0
COND,	0
	PAGE
FNORM,	0
	TAD	AC1
	AND	MASKC
	SNA CLA		/3BITS PERMITTED
	JMP	NOTBIG	/3
	JMS I	SAR1	/DIVIDE FAC BY 2
	ISZ	ACEXP	/COMPENSATE EXP
	JMP	FNORM+1
NOTBIG,	TAD	OVER	/OVERFLOW RIGHT IN AR1?
	SNA CLA		/ROUNDING CORRECTION
	JMP	NOBUMP
	ISZ	AC5
	JMP	NOBUMP
	ISZ	AC4	/ONLY GETS HERE IF AC5 IS 7777
	JMP	NOBUMP
	ISZ	AC3
	JMP	NOBUMP
	ISZ	AC2
	JMP	NOBUMP
	ISZ	AC1
	DCA	OVER
	JMP	FNORM+1
	CLA CMA		/COMPENSATE EXP AFTER AL1
NOBUMP,	TAD	ACEXP
	SPA
	JMP	UNDERF	/EXP<0 NOT PERMITTED
	DCA	ACEXP
	TAD	MM3
	TAD	AC1
	SMA SZA CLA
	JMP	.+3	/3BITS IN AC1
	JMS I	SAL1
	JMP	NOBUMP-1
	TAD	ACEXP
	TAD	MIN377
	SPA SNA CLA
	JMP I	FNORM
	JMP	ERRORA	/OVERFLOW
MIN377,	7401
SAR1,	AR1
SAL1,	AL1
MASKC,	7770
MM3,	7775
UNDERF,	CLA
	DCA	ACSIGN
	DCA	ACEXP
	TAD	AC1
	SNA
	TAD	AC2
	SNA
	TAD	AC3
	SNA
	TAD	AC4
	SNA
	TAD	AC5
	SZA CLA
	JMP	ERRORC
	JMP I	FNORM	/ZERO NUMBER
FPNEG,	0
	TAD	ACSIGN
	TAD	CC4000
	DCA	ACSIGN
	JMP I	FPNEG
ERRORA,	TAD	CO	/EXP OVERFLOW
	JMS	PRINT
	JMP	ERRORX
ERRORB,	TAD	CD	/DIVIDE BY ZERO
	JMS	PRINT
	TAD	C0
	JMS	PRINT
	JMP	ERROR
ERRORC,	TAD	SWIT3	/EXP UNDERFLOW
	SNA CLA		/0=PASS EXP UNDERFLOW
	JMP	TOZERO
	TAD	CU
	JMS	PRINT
ERRORX,	TAD	CF
	JMS	PRINT
	JMP	ERROR
ERRORD,	TAD	CN	/NEGATIVE SQUARE ROOT
	JMS	PRINT
	TAD	CR
	JMS	PRINT
ERROR,	JMS	CRLF
	TAD	MASKC
	DCA	CRLF
	TAD	BELL
	JMS	PRINT
	ISZ	CRLF
	JMP	.-3
	HLT
TOZERO,	DCA	ACEXP	/SETS FAC TO ZERO
	DCA	AC1
	DCA	AC2
	DCA	AC3
	DCA	AC4
	DCA	AC5
	DCA	OVER
	JMP I	FNORM
SWIT3,	0		/0=PASS EXPONENT UNDERFLOW
CC4000,	4000
CN,	316
CR,	322
CO,	317
CU,	325
CF,	306
CD,	304
C0,	260
BELL,	207
CRLF,	0
	TAD	CRN
	JMS	PRINT
	TAD	LF
	JMS	PRINT
	JMP I	CRLF
CRN,	215
LF,	212
THERE,	ICI
PRINT,	0
	TSF
	JMP	.-1
	TLS
	CLA CLL
	JMP I	PRINT
	PAGE
/OUTPUT CONTROLLER WITH ROUNDING
FIX,	0
	TAD	DIGNOP	/=F. FLOATING OUTPUT?
	SZA
	JMP	.+4
	TAD	SAC
	IAC
	JMP	ROUND+1	/YES, ROUND OFF FOR SAC PLACES
	CIA		/-F
	TAD	SAC	/+D
	SPA		/F-D>0?
	JMP	.+5	/YES, OK
	CLA CMA		/NO
	TAD	DIGNOP	/FIX UP
	DCA	SAC	/PUT D=F-1
	CMA
	TAD	ACEXP	/E
	SMA		/(D+E) (NUMBER DIGITS TO BE OP)<F?
	CLA		/NO, ROUND FOR F DIGITS
	TAD	DIGNOP	/YES, ROUND FOR <F DIGITS
	SPA		/D+E<0?
	JMP	PRNT-1	/YES, JUST PRINT IT
	TAD	M17	/NO, ROUND TO D+E PALCES
	SMA		/TO A MAX OF 15 PLACES
	CLA
ROUND,	TAD	K20
	DCA	TEMP	/SAVE #+1 OF PLACES TO ROUND TO
	TAD	BUFST
	TAD	TEMP	/SET UP BUFFER ADDRESS WHERE
	DCA	FPABS	/ROUNDING SHOULD START
	TAD	TEMP
	CIA		/SET UP COUNT OF MAXIMUM
	DCA	TEMP	/NUMBER OF CARRIES AVAILABLE
	TAD	K4	/ADD 4+1 TO LEAST SIG DIGIT
RET,	ISZ I	FPABS	/ADD ONE TO CURRENT DIGIT
	TAD I	FPABS
	TAD	M10
	SPA CLA		/CARRY REQUIRED?
	JMP	PRNT	/NO, OUTPUT
	DCA I	FPABS	/YES, SET CURRENT DIGIT=0
	ISZ	TEMP	/START OF BUFFER REACHED?
	JMP	DECR	/NO ADD-1 TO ADDR AND REPEAT
	ISZ I	FPABS	/YES, SET MANTISSA TO 0.1000
	ISZ	ACEXP	/COMPENSATE EXP
	CLA
PRNT,	TAD	BUFST
	DCA	15	/SET AUTOINDEX REG
	TAD	DIGNOP
	SNA		/F=0?
	JMP	FLOP	/YES, OUTPUT AS FLOATING PT
	CIA		/NO,
	DCA	FPABS	/SET COUNT TO PRINT F PLACES
	TAD	FPABS
	TAD	ACEXP
	SMA SZA		/E>F?
	JMP	XXX	/YES, PRINT X S
	TAD	SAC
	SMA		/E<F-D?
	CLA		/NO, OVERRIDE D AAND USE P=E
	CIA		/YES, TAKE P=F-D
	TAD	ACEXP
	CIA
	DCA	TEMP	/COUNT FOR PRE POINT OUTPUT
	TAD	M17
	DCA	SCOUNT	/SET COUNT FOR MAX SIG FIGS
BACK,	TAD	ACEXP
	TAD	TEMP
	SNA CLA		/P=E?
	JMP	DIG	/YES, PRINT DIGIT
	TAD	TEMP	/NO
	IAC
	SPA CLA		/P>1?
	TAD	SPACE	/YES, TAKE SPACE OTHERWISE 0
IN,	JMS	OUT	/PRINT CHARACTER
	ISZ	TEMP	/P CHARS PRINTED?
	JMP	BACK	/NO
	TAD	POINT	/YES
	JMS I	OPUT	/PRINT DECIMAL POINT
	JMP	BACK
M17,	7761
M10,	7766
K20,	20
K4,	4
TEMP,	0
BUFST,	BUFFER-1
OPUT,	OUTDG
SPACE,	240-260
POINT,	256-260
CHX,	330-260
SAC,	0
SCOUNT,	0
DECR,	CMA
	TAD	FPABS
	DCA	FPABS
	JMP	RET
FLOP,	TAD	SAC	/SET COUNT TO PRINT
	CIA		/SAC DIGS AFTER POINT
	DCA	FPABS
	JMS I	OPUT	/PRINT 0
	TAD	POINT
	JMS I	OPUT	/PRINT DECIMAL PT
	ISZ	FIX	/INCREMENT RETURN ADDR
	TAD I	15	/TAKE NEXT DIGIT
	JMS	OUT	/AND PRINT IT
	JMP	.-2	/THEN REPEAT
OUT,	0
	JMS I	OPUT	/PRINT CHAR
	ISZ	FPABS	/ALL CHARS PRINTED?
	JMP I	OUT	/NO, RETURN
	JMP I	FIX	/YES, NUMBER FINISHED
XXX,	CLA
	TAD	CHX
	JMS	OUT	/PRINT X
	JMP	.-2	/AND REPEAT
DIG,	CMA
	TAD	ACEXP	/REDUCE E BY 1
	DCA	ACEXP
	ISZ	SCOUNT	/ALL SIG FIGS PRINTED?
	JMP	.+4	/NO
	CMA		/YES
	DCA	SCOUNT	/RESET COUNT TO -1
	JMP	IN	/PRINT ZEROS
	TAD I	15	/TAKE NEXT DIGIT
	JMP	IN
FPABS,	0
	CLA CLL
	DCA	ACSIGN
	JMP I	FPABS
	PAGE
DECONV,	0		/INPUT SUB ROUTINES
	DCA	OVER
	DCA	ACSIGN
	DCA	ACEXP
	DCA	AC1
	DCA	AC2
	DCA	AC3
	DCA	AC4
	DCA	AC5
	DCA	DNUMBR
	JMS	INPUT
	TAD	MPLUS	/TEST FOR PLUS SIGN
	SNA
	JMP	DECON
	TAD	DELMIN	/TEST MINUS
	SZA CLA
	JMP	.+4
	TAD	CBIT0
	DCA	ACSIGN	/SIGN SET
DECON,	JMS	INPUT
	CLA
	TAD	CHAR	/IS IT A DIGIT
	TAD	MIN9
	SMA
	JMP I	DECONV	/NO
	TAD	PLUS12
	SPA
	JMP I	DECONV	/NO
	DCA	DIGIT	/YES
	TAD	AC1
	AND	MASKB	/OVERFLOW?
	SZA
	JMP	DECON	/YES, IGNORE
	ISZ	DSWIT
	ISZ	DNUMBR	/INDEX NUMBER DIGITS
	JMS	MULT10
	TAD	DIGIT
	DCA	OP5
	DCA	OP4
	DCA	OP3
	DCA	OP2
	DCA	OP1
	JMS I	ADDOX
	JMP	DECON	/CONTINUE
MULT10,	0
	JMS I	MAL1
	TAD	AC5
	DCA	OP5
	TAD	AC4
	DCA	OP4
	TAD	AC3
	DCA	OP3
	TAD	AC2
	DCA	OP2
	TAD	AC1
	DCA	OP1
	JMS I	MAL1
	JMS I	MAL1
	JMS I	ADDOX
	JMP I	MULT10
MAL1,	AL1
ADDOX,	OADD
MPLUS,	-253
DELMIN,	7776
MIN9,	-272
PLUS12,	12
MASKB,	7770
DIGIT,	0
DNUMBR,	0		/NUMBER OF DIGITS
CBIT0,	4000
/INPUT A CHARACTER, IF CR TEST INPUT SWITCH
/TO SEE IF LF SHOULD BE TYPED
/IF RUBOUT, RESTART INPUT
INPUT,	0		/INPUT A CHAR
	CLA
	KSF
	JMP	.-1
	KRB
	DCA	CHAR
	TAD	CHAR
	JMS I	OUTPUT
	TAD	CHAR
	SNA
	JMP	INPUT+1	/IGNORE BLANKS
	TAD	MRBOUT
	SNA
	JMP I	RESTRT	/RUB - RESTART INPUT
	TAD	MINCR
	SZA CLA
	JMP	.+6
	TAD	SWIT2	/CR - FOLLOW WITH LF?
	SNA CLA
	JMP	.+3
	TAD	LNFD
	JMS I	OUTPUT
	TAD	CHAR
	JMP I	INPUT
LNFD,	212
OUTPUT,	PRINT
RESTRT,	FIPT+1
MRBOUT,	-377
MINCR,	377-215
FPGET,	CLA CMA
	TAD	MINSIX
	DCA	INPUT
	TAD	ADDOPS
	DCA	OUTDG
	TAD	ADDACS
	DCA	DIGIT
	TAD I	OUTDG
	DCA I	DIGIT
	ISZ	OUTDG
	ISZ	DIGIT
	ISZ	INPUT
	JMP	.-5
	JMP I	FLOOP1
MINSIX,	7772
ADDOPS,	OPSIGN
ADDACS,	ACSIGN
FLOOP1,	FLOOP+1
OUTDG,	0
	TAD	C260
	JMS I	OUTPUT
	JMP I	OUTDG
C260,	260
DIX,	2045
	0000
	0000
	0000
	0000
	PAGE
FOPT,	0		/FLOATING OUTPUT
	DCA I	SCAD	/SAVE C(AC)
	DCA	BEXP	/CLEAR DECIMAL EXP
	TAD	ACSIGN	/NUMBER POSITIVE?
	SPA CLA
	TAD	SMINUS
	TAD	SPLUS
	JMS I	WRITE	/PRINT + OR -
	TAD	BFRST
	DCA	15
	TAD	AC1
	SZA CLA		/MANTISSA ZERO
	JMP	FGO2
	DCA	ACEXP	/YES
	IAC
	DCA	BEXP	/SO BEXP=0 AFTER DIGIT 1=0 ROUTINE
	JMP	FGO4
FGO2,	TAD	ACEXP
	TAD	MASKIT	/REMOVE 200 EXCESS
	SMA SZA		/IF ACEXP<=0?
	JMP	FGO3	/NO, TOO LARGE
	TAD	C4
	SMA SZA CLA	/IS ACEXP> -4?
	JMP	FGO4	/0>=ACEXP> -4, SO OUTPUT
	JMS I	7
	FMPY I	TENPT
	FEXT
	CLA CMA		/ADJUST DECIMAL EXPONENT
	TAD	BEXP
	DCA	BEXP
	JMP	FGO2
FGO3,	JMS I	7
	FDIV I	TENPT
	FEXT
	ISZ	BEXP	/ADJUST DECIMAL EXPONENT
	JMP	FGO2
FGO4,	JMS I	MALF1	/MOVE FAC TO NORMALLY
	JMS I	MALF1	/OCCUPY 7 BITS OF AC1
	JMS I	MALF1	/ALLOWS FOR UNDERFLOWS
	JMS I	MALF1	/OVERFLOW USED FOR OUTPUT
	TAD	ACEXP
	TAD	MASKIT	/-200
	DCA	ACEXP
	TAD	ACEXP
	SMA CLA
	JMP	.+4
	JMS I	MAR1	/ADJUST FAC FOR ACEXP=0
	ISZ	ACEXP
	JMP	.-2
	JMS	GETDIG
	SNA		/IS INTEGER 0?
	JMP	FGO7	/YES, IGNORE
FGO6,	DCA I	15	/NB MULTIPLICATIONS GIVE DIGITS
	TAD	MIN17
	DCA	ACEXP	/USED AS COUNTER
FGO6A,	JMS	GETDIG
	DCA I	15
	ISZ	ACEXP	/16 DIGITS STORED?
	JMP	FGO6A	/NO
	TAD	BEXP	/YES
	DCA	ACEXP
	JMS I	FXAD
	JMP	QCRLF	/FIXED PT RETURN
	TAD	CHE	/FLOATING PT RETURN
	JMS I	WRITE	/PRINT E
	TAD	ACEXP	/CONVERT EXP AND OUTPUT
	SPA
	CMA IAC CML
	DCA	BEXP	/NOW POSITIVE
	TAD	SPLUS
	SZL
	TAD	SMINUS
	JMS I	WRITE	/OUTPUT SIGN
	DCA	GETDIG
	TAD	BEXP
	TAD	M12
	ISZ	GETDIG
	SMA
	JMP	.-3
	TAD	C12
	DCA	BEXP
	CMA
	TAD	GETDIG
	JMS I	OUTDIG
	TAD	BEXP
	JMS I	OUTDIG
QCRLF,	TAD	SWIT1	/PRINT CRLF?
	SZA CLA
	JMS I	LINE	/YES
	JMP I	FOPT	/NO, EXIT
FGO7,	CLA CMA		/IGNORE FIRST DIGIT
	TAD	BEXP	/ADJUST DECIMAL EXP
	DCA	BEXP
	CLA CMA		/ADJUST DIGIT COUNTER
	JMP	FGO6+1
GETDIG,	0
	JMS I	MULTEN	/MULTIPLY BY TEN
	TAD	AC1
	AND	MASKIT	/TO GET OVERFLOW=DIGIT 1
	DCA	FFLAG	/DIGIT 1
	TAD	FFLAG	/REMOVE INTEGER FROM AC1
	CIA
	TAD	AC1
	DCA	AC1
	TAD	FFLAG
	CLL RTL
	RTL
	RTL
	JMP I	GETDIG
BEXP,	0
MIN17,	7761
SPLUS,	253
SMINUS,	2
MALF1,	AL1
MAR1,	AR1
MULTEN,	MULT10
CHE,	305
MASKIT,	7600		/-200
TENPT,	DIX
C4,	4
LINE,	CRLF
WRITE,	PRINT
M12,	7766
C12,	12
SCAD,	SAC
FXAD,	FIX
BFRST,	BUFFER-1
OUTDIG,	OUTDG
	PAGE
FIPT,	0		/FLOATING PT INPUT
	CLA CMA		/INIT PERIOD SWITCH
	DCA	PRSW	/7777 = NO PERIOD
	DCA	DSWIT	/=1 IF CONVERSION TOOK PLACE
	JMS I	DPCVPT
	CLA
	TAD	CHAR
	TAD	MINPER
	SZA CLA		/PERIOD?
	JMP	FIG01	/NO
	TAD	PRSW	/PERIOD FOUND
	SNA CLA		/SECOND PERIOD?
	JMP	FIG02	/YES, TERMINATE
	DCA I	DPN	/NO - SET NUMB DIGITS=0
	DCA	PRSW	/SET PERIOD SWITCH TO 0
	JMP I	DPCSPT	/CONVERT REST OF STRING
FIG01,	TAD	PRSW	/PERIOD READ IN PREVIOUSLY?
	SNA CLA
FIG02,	TAD I	DPN	/YES, NUMB OF DIGITS IN SET
	CMA IAC		/NO
	DCA	SEXP	/-NUMB DECIMAL DIGITS
FIG03,	TAD	C263	/51 (10)=63(8) +EXCESS 200
	DCA	ACEXP
	JMS I	7
	FNOR
	FPUT I	SQIT	/HOLD FOR POSSIBLE E
	FEXT
	TAD	CHAR
	TAD	MINUSE
	SZA CLA		/"E" READ IN?
	JMP	ENDFI	/NO
	JMS I	DPCVPT	/YES - CONVRT DECIMAL EXP
	CLA CLL
	TAD	ACSIGN
	SMA CLA
	JMP	.+4
	TAD	AC5
	CIA
	DCA	AC5
	TAD	AC5	/ADD EXPONENT TO
	TAD	SEXP	/PREVIOUS EXPONENT
	DCA	SEXP
ENDFI,	JMS I	7
	FGET I	SQIT
	FEXT
	TAD	SEXP	/COMPNESATE FOR DECIMAL EXP
	SNA
	JMP I	FIPT
	SMA CLA
	JMP	FIG04	/POSITIVE EXP
	JMS I	7
	FDIV I	TEN
	FEXT
	ISZ	SEXP
	JMP	ENDFI+3
	JMP I	FIPT
FIG04,	JMS I	7
	FMPY I	TEN
	FEXT
	CLA CMA
	TAD	SEXP
	DCA	SEXP
	JMP	ENDFI+3
TEN,	DIX
MINUSE,	-305
C263,	263
MINPER,	-256
PRSW,	0
SEXP,	0		/CONTAINS DECIMAL EXP
DPCVPT,	DECONV
DPCSPT,	DECON
DPN,	DNUMBR
EWRITE,	0
	DCA	DIGNOP
	TAD	DECDIG
	JMS I	6
	JMP I	EWRITE
DECDIG,	17
FWRITE,	0
	DCA	OPDIG
	DCA	DIGNOP
	TAD	OPDEC
	JMS I	6
	JMP I	FWRITE
OPDIG,	6
OPDEC,	4
FPSQ,	0
	JMS I	7
	FPUT I	SQIT
	FMPY I	SQIT
	FEXT
	JMP I FPSQ
SQIT,	ICI
FPREAD,	0
	JMS I	5
	CLA CLL
	TAD	DSWIT
	SNA CLA
	JMP	.-4
	JMP I	FPREAD

	$