                                                                                                                                                                >>40<<0>>14<<21  31   
5511 
>>40<<>>40<<>>40<<>>40<<  j
j  
9996   13  >>14<<>>14<<>>14<<>>14<<>>14<<        k
>>40<<  	nnny        31   0>>40<<>>40<<>>40<<>>37<< >>37<<>>40<<>>40<<>>40<<>>37<< 
>>40<<>>40<<>>40<<>>40<< 12'"   "~        	NNNY >>14<<>>12<<^
> >>14<<>>14<<>>14<<>>14<<>>14<<        ~"   >>20<<>>40<<>>40<<>>40<<>>37<<   "~    >>60<<>>60<<         ~"   >>20<<>>40<<>>40<<>>40<<>>37<<   "~  	JJJ	 
>>>
 
'>>14<<>>20<<
 SNNNY 	JJJ	 
'>>14<<>>20<<
                                         



?FLIP, 16 JULY 64, J. Johnson
/ TWO WORD EIGHT-TWENTYEIGHT FLOATING POINT INTERPRETER AND SUBROUTINE PACKAGE
/ ENTRANCE>>40<<.
/	efm 2	,enter floating mode
/	 >>40<<
/	operations to be performed in floating mode
/	 >>40<<
/	lfm	/leave floating mode

xsy efm lfm
dss udf ovf

/CALLING SEQUENCES
efm'	0	/enter floating mode
	dap r
	lac r
efm1,	jmp interp+1

lfm'	0	/leave floating mode
	dap r
	lac lfm
r,	jmp 0

blk


/INTERPRETER

interp,ac,	0
	dap pc
loop,	lac i pc
	dac instr
	idx pc
	lac instr
loop1,	ral 5s
	and(37
	add xctable
	dap .+2
	lac ac
	xct 0
fxx,	dap b
b,	jsp 0
instr,	0
	jmp c
normal,	xct instr
c,	dac ac
	jmp loop
fskip,	law 100
	and instr
	sza i
	jmp sk1
	lac a
	sza i
	jmp sk1+2
sk1,	lac sa
	and (400000
	ior a
	ior ap
sk2,	xct instr
	jmp c
	jmp .+4
skip,	lac ac
	xct instr
	jmp c
	dac ac
	idx pc
	jmp loop
jump,	lac instr
d,	dap pc
	ral 5s
	sma
	jmp loop
	lac i pc
	jmp d
execute,	lac i instr
	dac instr
	jmp loop1
wdvd,	idx pc
	law fdv
	jmp fxx
operate,	lac instr
	and (1000
	sas (1000	/test for cma
	jmp .+4
	lac sa
	cma	/complements flt.AC
	dac sa
	lac instr
	and (200
	sad (200	/tests for cla
	jsp fcl	/floating clear
	lac instr
	and (766577	/eliminates cla and cma which have been done
	dac instr
	jmp normal
call,	lac instr
perform,	law i 1
	add pc
	dap g
	lac ac
g,	jmp 0
pc'	0
xctable,	loc .+1
	hlt		/00
	jmp normal	/02 and
	jmp normal	/04 ior
	jmp normal 	/06 xor
	jmp execute	/10 xct
	hlt		/12
	hlt		/14
	jmp call	/16 cal
	law flc	/20 lac
	jmp normal	/22 lio
	law fdc	/24 dac
	jmp normal	/26 dap
	jmp normal	/30 dip
	jmp normal 	/32 dio
	jmp normal	/34 dzm
	hlt		/36
	law fad	/40 add
	law fsb	/42 sub
	jmp normal	/44 idx
	jmp skip	/46 isp
	jmp skip 	/50 sad
	jmp skip	/52 sas
	law fmp	/54 mus
	jmp wdvd	/56 dis
	jmp jump	/60 jmp
	jmp perform	/62 jsp
	jmp fskip	/64 skp
	jmp normal	/66 sft
	jmp normal	/70 law
	jmp normal	/72 iot
	hlt		/74
	jmp operate	/76 opr
fcl,	dap exit
	dzm a
	dzm ap
	dzm sa
	dzm ea	/floating clear
exit,	jmp 0
blk
/8-28 ARITHMETIC ROUTINES
a'	0	/floating ac, mantissa
ap'	0	/continuation of mantissa
sa'	0	/sign
ea'	0	/exponent
y,	0	/floating ac, operand mantissa
yp,	0	/continuation of operand mantissa
sy,	0	/operand sign
ey,	0	/operand exponent
temp,	0
temp1,	0
begin,	0
	dap r
	dzm q
	lac i begin
	usk
b,	lac i q
	dap q
	ral 5s
	spa
	jmp b	/if deferred, then loop
	idx begin
r,	jmp 0
q,	0
return,	lac a
	jmp i begin
blk
flc'	jda begin		/floating lac
	lac i q
	dac sa		/sign
	and(377777
	dac a	/fractional part
	idx q
	lac i q
	and(1777
	ral 7s
	dac ap		/rest of fractional part
	lac i q
	sar 6s
	sar 4s
	dac ea
	jmp return	/exponent
fdc'	jda begin
	clo
	law 100
	add ap
	sar 7s
	sal 7s
	dac ap
	szo i
	jmp fdc1
	dzm ap
	idx a
	sma
	jmp fdc1
	rar 1s
	dac a
	idx ea
fdc1,	lac ea
	spa
	cma
	scr 7s
	sza i
	jmp fdc2
	lac ea
	spa
	jmp underflow
	jmp overflow
fdc2,	lac sa
	and (400000
	ior a
	dac i q
	idx q
	lac ap
	lio ea
	ral 1s
	rcr 8s
	dac i q
	jmp return
loady,	0		/floating lac of operand
	dap r
	lac loady
	jda begin
	lac i q
	dac sy
	and(377777
	dac y
	idx q
	lac i q
	and(1777
	ral 7s
	dac yp
	lac i q
	sar 6s
	sar 4s
	dac ey
	lac y
	sza
	jmp .+3
	lac yp
	sza
	idx r	/index return if not zero operand
r,	jmp 0
fsb'	jda loady
	jmp return	/floating subtract
	lac sy
	cma
	dac sy
	jmp fad1
fad'	jda loady
	jmp return	/floating add
fad1,	lac ea
	sub ey
	sza i
	jmp fad2	/exponents equal
	spa
	jmp fad6		/ea shift
	sub(11
	dac temp	/ey shift
	sma
	cla
	add shtble	/table start loc
	dap .+4
	lac y
	lio yp
	ril 1s
	xct 0
	dac y
	cla
	rcr 1s
	dio yp
	lac temp
	sma sza
	jmp fad1+6
fad2,	lac sa	/exponents equal
	xor sy
	spa
	jmp fad3	/signs differ
	clo
	lac ap
	add yp
	dac ap
	cla
	szo
	law 1	/overflow of extension
	add a
	add y
	dac a
	szo i
	jmp norm	/done
	sza
	jmp .+3
	lac(777777
	dac a
	law 1
	add ea
	dac ea
	lac a
	lio ap
	ril 1s
	rcr 1s
	and(377777
	dac a
	cla
	rcr 1s
	dio ap
	szo i
	jmp norm	/done
fad3y,	jmp overflow
fad3,	lac a			/signs differ
	sub y
	dac a
	sza i
	jmp fad4		/zero
	spa
	jmp fad5		/minus
	lac ap
	sub yp
	dac ap	/plus
	sma
	jmp norm		/done
fad3a,	add (200000	/add 400000 without ovflow
	add (200000
	dac ap
	law i 1
	add a
	dac a
	jmp norm		/done
fad4,	lac ap
	sub yp
	dac ap
	sza i
	dzm sa
	sma
	jmp norm		/done
	cma
	dac ap
	lac sa
	cma
fad5y,	dac sa
	jmp norm	/done
fad5,	cma
	dac a
	lac sa
	cma
	dac sa
	lac yp
	sub ap
	jmp fad3a-3
fad6,	cma
	sub(11
	dac temp	/ea shift
	sma
	cla
	add shtble
	dap .+4
	lac a
	lio ap
	ril 1s
	xct 0
	dac a
	cla
	rcr 1s
	dio ap
	lac ey
	dac ea
	lac temp
	sma sza
	jmp fad6+1
	jmp fad2
shtble,	loc shtble+11
	scr 1s
	scr 2s
	scr 3s
	scr 4s
	scr 5s
	scr 6s
	scr 7s
	scr 8s
	scr 9s
norm,	lac a			/normalize
	sza i
	jmp norm2
	lio ap
	ril 1s
norm1, 	rcl 1s
	sma i
	jmp norm3
	dac temp
	law i 1
	add ea
	dac ea
	lac temp
	jmp norm1
norm2,	lac ap
	sza i
	jmp fmp-2
	law i 21
	add ea
	dac ea
	lac ap
	lio a
	jmp norm1-1
norm3,	rcr 1s
	dac a
	cla
	rcr 1s
	dio ap
	jmp return
	dzm ea
	jmp return
fmp'	jda loady		/floating multiply
	nop
	clo
	lac ea
	add ey
	dac ea
	szo
	jmp fmp1		/multiply overflow
	lac a
	mpy y
	dac temp1
	cla
	rcr 1s
	dio temp
	lac a
	mpy yp
	add temp
	and (377777
	dac temp
	lac temp1
	dac a
	szo
	idx a
	lac y
	mpy ap
	add temp
	and(377777
	dac ap
	szo
	idx a
	lac sa
	xor sy
	jmp fad5y
fmp1,	sma
	jmp overflow
underflow,	lac pc
	jmp udf
overflow,	lac pc
	jmp ovf
fdv'	jda loady		/floating divide
	jmp fdv5
	cli
	lac(200000
	dvd y
	jmp fdv3
fdv1,	dac y
	clo
	dio temp
	lac yp
	mpy y
	cma
	add temp
	mpy y
fdv2,	dac temp
	spa
	jmp fdv4
	add temp
	and(377777
	dac yp
	szo
	idx y
	law 1
	add ea
	sub ey
	jmp fmp+5
fdv3,	lac y
	sas(200000
	jmp overflow
	lac(377776
	lio(377776
	jmp fdv1
fdv4,	law i 1
	add y
	dac y
	lac temp
	add(200000
	jmp fdv2
fdv5,	law i 1
	add pc
	jmp interp+1
blk
fin.
                >>13<<>>53<<                                	




/fdb - >>40<<FLOATING >>40<<DECIMAL TO >>40<<BINARY
/entrance>>40<<.	jsp fdb
/	return>>40<<, AC-IO contains number in 8-28 format
/After 9 significant digits of input, accuracy remains the same.
/Any non-decimal character except "-" and "." will terminate
/  the number and will be stored in the system symbol "lc".
/User must supply system symbol "input" .
/Fdb will "xct input" assuming this will result with the
/  right six bits of IO containing one character of the number
/  to be converted.

dss ea sa input float

fdb'	dap return
	dzm sign
	jsp grab	/gets integer and converts to octal
	lac save
	dac integer
	lac save+1
	dac integer+1	/stores integer part
	lac lc
	s>>40<<s (73
	jmp leave	/decimal point?
	jsp grab
	lac cntr	/yes, get fractional part and convert
	cma
	dac cntr
	efm 2
	lac one
	dac temp
loop1,	lac temp
	idx ea
	idx ea	/4 x temp
	add temp
	idx ea
	dac temp	/+ temp] x 2 >>20<< temp
	isp cntr
	jmp loop1
	lac save
	dvd temp
	hlt
	add integer
	dac integer
	lfm
leave,	lac sign
	sza
	lac (400000
	ior integer
	dac sa
	lio integer+1
return,	jmp 0
grab,	dap exitcvrt
	dzm temp+1
	dzm save
	dzm save+1
	dzm cntr
char,	xct input
	dio lc
	lac lc
	sza i
	jmp exitcvrt	/space delimits
	sas (flexo   -	/minus sign?
	jmp .+3
	dac sign
	jmp char	/yes
	sas (flexo   0	/zero?
	jmp .+3
	dzm lc
	jmp convert	/yes
	sub (dec 10
	sma
	jmp exitcvrt	/not a decimal diget
convert,	lac lc
	jda float	/float to 8-28 format
	dac temp
	dio temp+1
	efm 2
	lac save
	sza i
	jmp .+5
	idx ea
	idx ea
	add save	/[4 x save] + save
	idx ea
	add temp
	dac save	/] + tem
	lfm
	idx cntr
	jmp char
exitcvrt,	jmp 0
one,	200000
	002000
integer,	0
	0
save,	0
	0
temp,	0
	0
cntr,	0
lc'	0
blk
fin.




                >>13<<>>52<<                                



/fbd - >>40<<FOATING >>40<<BINARY TO >>40<<DECIMAL
/entrance>>40<<.	law A   (address of 8-28 number to be converted.)
/	jda fbd
/	return>>40<<, number has been converted and output
/	if number excedds format (determined by sof i ) a jsp to errfmt occurs
/	user must supply system symbol "output".
/	fbd will "xct output" with character to be output
/	in right 6 bits of IO.

xsy adr set
dss a ap ea sa output errfmt
fbd'	0
	dap returm
	law position+2
	dap position+1
	law storage
	dac adr
	dzm pcntr
	lac foi
	dac icntr
	idx icntr
	lac fof
	dac fcntr
	efm 2
	lac i fbd
	lio sa
	dio sign
	dzm sa
	dac save
	jsp seperate
	dac integer
	cma
	add save
	dac fraction
loop1,	idx adr
	lac integer
	dac save	/converts integer to decimal
	dvd ten
	hlt
	dac integer
	jsp seperate
	dac integer
	mpy ten
	cma
	add save
	jsp unflt
	lac integer
	sza i
	jmp here
	isp icntr
	jmp loop1
	jsp errfmt
	efm 2
	law i 1
	dac icntr
	jmp loop1
here,	lio adr
	dio bottom
	dio save+1
	law storage
	dap adr	/save+1 is starting (at bottom 
	idx pcntr
	cla
	dac integer	/of array) address of converted no. array.
loop2,	lfm
	lac fcntr
	sza
	jmp .+3
	efm 2
	jmp here1-3
	law i 1
	add adr
	dac adr
	efm 2
	lac fraction
	sub integer
	mpy ten
	dac fraction
	jsp seperate
	dac integer
	jsp unflt
	isp fcntr
	jmp loop2
	lac fraction
	sub integer
	sub half
here1,	lfm
	lac pcntr
	cma
	dac pcntr
	law i 10
	dac icmntr
p ition,	lac i bottom
	jmp.+1
	sad(20
	jmp loop4
	sad storage
	jmp loop4
	law .-2
	dap position+1
	isp icntr
	jmp loop4
	lac bottom
	dac eight
round1,	sad adr
	jmp remainder
	jsp set
	lac i bottom
	sad storage
	jmp .-3
	sad(20
	jmp .+3
	sub(5
	spa
	jmp zero-2
	sza
	jmp zero-3
	lac bottom
	sad adr
	jmp .+3
	jsp set
	lac i bottom
	sza i
	jmp .-6
	jmp zero-3
	lac fraction
	sza
	jsp round
	lac eight
	dac bottom
zero,	jsp set
	lac i bottom
	sad storage
	jmp .+3
	lio(20
	dio i bottom
	lac bottom
	sas adr
	jmp zero
typeout,	lac sign
	spa i
	jmp type0-3
	ior i fbd
	dac i fbd
	idx save+1
	law i 1
	add pcntr
	dac pcntr
	law 54
	dac i save+1
	lac fos
	sza
	jmp type2
type0,	law i storage
	add save+1
	add foi
	sza i
	jmp type2
	dac icntr
	cli
type1,	xct output
	isp icntr
	jmp type1
	jmp type2
type,	law i 1
	add save+1
	dac save+1
type2,	lio i save+1
	xct output
	isp pcntr
	jmp type
return,	jmp 0
loop4,	jsp set
	sas adr
	jmp position
	dac eight
remainder,	lac sa
	spa i
	jsp round
	jmp typeout
round,	dap exit
	lac eight
	dac bottom
loop5,	lac i bottom
	sad storage
	jmp here3+1
	add(1
	sas(21
	jmp here2
	law 1
	dac i bottom
	jmp exit
herd2,	sas(12
	jmp .-3
	law 20
	dac i bottom
	lac bottom
	sad save+1
here3,	jmp .+3
	idx bottom
	jmp loop5
	idx save+1
	law i 1
	add pcntr
	dac pcntr
	law 1
	dac i save+1
exit,	jmp 0
set,	dap back
	law i 1
	add bottom
	dac bottom
back,	jm1
exit,	jmp 0
set,	dap back
	law i 1
	add bottom
	dac bottom
back,	jmp 0
eight,	0
bottom,	0
blk
seperate,	dap exit	/routine to seperate
	law i 21
	add ea
	spa i
	jmp exit+1
	dac cntr
	dac back
	lio ap
	ril 1s
loop1,	lac a
	scr 1s
	dac a
	isp cntr
	jmp loop1
	cla
	rcr 1s
	dio ap
	law i 21
	add ea
	spa
	dzm ap
	lio ap
	ril 1s
loop2,	lac a
	scl 1s
	dac a
	isp back
	jmp loop2
	cla
	rcr 1s
	dio ap
	efm 2
exit,	jmp 0
	l>>60<<w i 42
	add ea
	jmp loop1-4
blk
unflt,	dap exit	/routine to unfloat 8-28 format
	law i 21
	add ea
	sza i
	jmp pack
	dac cntr
loop,	lac a
	scr 1s
	dac a
	isp cntr
	jmp loop
pack,	lac a
	sza i
	lac = 20
	dac i adr
	idx pcntr
	efm 2
exit,	jmp 0
blk
	lve dec 38
storage,	000073
	lve dec 39
half,	200000
	0
icntr,	0
fcntr,	0
cntr,	0
sign,	0
integer,	0
	0
fraction,	0
	0
adr,	0
save,	0
	0
ten,	240000
	010000
pcntr,	0
back,	0




/sof - >>40<<SET >>40<<OUTPUT >>40<<FORMAT
/	entrance>>40<<.	lac=[XXYYZZ] where>>40<<.
/			XX = 0 --Leading spaces
/			XX |= 0 --No leading spaces
/			YY =  Number of characters of field width to include the sign,
/			      whether it is typed or not.
/			ZZ =  Number of characters for fractional part of number.
/	jda sof
/	return

sof'	0
	dap return
	lio sof
	cla
	rcl 6s
	dac fos
	cla
	rcl 6s
	cma
	dac foi
	cla
	rcl 6s
	sza
	cma
	dac fof
return,	jmp 0
fos'	0	/sign output status
foi'	0	/integer output status
fof'	0	/fractional output status
blk
fin.




                >>13<<9                                




/floating point sin-cos subroutine
/14 August 64, J. Johnson
/entrance>>40<<.	efm 2
/	sinf a (cosf a)  ,sinf-cosf are i.g. i s and 
/		  ,results in lac a>>40<<, jsp sinf (cosf).
/	return, result is left in floating accumulator (FLAC)
/Floating mode is assumed in control upon entrance and 
/returns in control upon exit.
/no error halts
xsy sinf cosf
dss sa
cosf'	dap out
	efm 2
	add c1
	lio sa
	spi i
	sub 2pi
	jmp makeplus
sinf'	dap out
	efm 2
makeplus,	lio sa
	spi
	add 2pi
	sub pi
	lio sa
	spi i
	jmp quad34
quad12,	cli
	dio sa
	sub c1
	lio sa
	spi i
	lio c3
	dio sa
	add c1
	jmp findx
quad34,	sub c1
	lio sa
	spi
	cli
	dio sa
	sub c1
findx,	mpy 2opi
	dac x
	mpy x
	dac xsq
series,	mpy c9
	add c7
	mpy xsq
	add c5
	mpy xsq
	add c3
	mpy xsq
	add c1
	mpy x
out,	jmp 0
x,	0
	0
xsq,	0
	0
pi,	311037
	005324
2opi,	242763
	000035
2pi,	311037
	007324
c1,	311037
	003324
c3,	645273
	001405
c5,	243150
	771275
c7,	631114
	761431
c9,	236657
	746727
blk
fin.

                >>13<<>>53<<                                




/floating point arcsin-arcos subroutine
/14 August 64, J. Johnson
/entrance>>40<<.	efm 2
/	asinf a (or acosf a) , where a is the number for which
/			,asinf or acosf is desired.
/	return, results in the floating accumulator (FLAC)
/	asinf and acosf are i.g. i s and result in lac a
	jsp asinf or acosf.
/	no error halts
xsy asinf acosf sqrtf
dss sa sqrtf
asinf'	dap sxit
	jsp acosf
	lio sa
	spi
	jmp .+3
	lio a1
	jmp .+2
	cli
	dio sa
	add pio2
sxit,	jmp 0
acosf'	dap cxit
	efm 2
	lio sa
	dio sign	/correct sign of f(x)
	dzm sa
	dac x		/force x to be positive
	lio a1
	dio sa	/sign of x is made minus to form 1-x
	add one
	jsp sqrtf
	dac rt	/square root of 1-x
	lac x
	mpy a7
	add a6
	mpy x
	add a5
	mpy x
	add a4
	mpy x
	add a3
	mpy x
	add a2
	mpy x
	add a1
	mpy x
	add a0
	mpy rt
	lio sign
	spi i
	jmp .+3
	lio a1
	dio sa
	lio sign
	spi
	add pi
cxit,	jmp 0
sign,	0
x,	0
	0
rt,	0
	0
one,	200000
	002000
a0,	311037
	003323
a1,	733577
	773116
a2,	266165
	770354
a3,	715407
	766222
a4,	375041
	765702
a5,	613770
	765454
a6,	332441
	761053
a7,	645364
	754537
pi,	311037
	005324
pio2,	311037
	003324
blk 
fin.
                >>13<<>>40<<                                




/atanf routine
/entrance>>40<<.	efm 2
/	atanf a	,where a is tan 0.  Atanf results in lac a
	/		,jsp atanf and a will be loaded in the floating accumulator.
/	return	,0 in radians (0 - 180 ) is in flac.
/floating mode is assumed upon entrance and returns that way.
dss a sa
xsy atanf

atanf'	dap exit
	law exit+1
	dap dmp
	efm 2
	dac t
	dzm j
	dzm j+1
	spa
	idx dmp	/initializes
loop,	dzm sa
	sub s2	/| t| -.414214
	sma i sza i
	jmp eqt	/| t| >>40<<<.414214
	lac one
	sub t	/| t| >.414214 and must be reduced
	sza
	jmp .+3
	lac pio4
	jmp exit	/t=1 and 0=45
	dac temp
	lac one
	add j	/idx j counter
	lio a
	ril 2s
	spi
	lac one
	dac j	/set j=1 if j=3
	lac one
	add t
	dvd temp
	hlt
	dac t
	jmp loop	/45 added to 0 in hopes | tan 0 i | >>40<<<.414214
eqt,	lac t
	mpy t
	dac ts	/txt
	add d3
	dac temp
	lac pio4
	mpy j
	dac j	/j now contains the j(45) to be 
	lac e2
	dvd temp
	hlt	/added or sub from 0 i to get 0
	add d2
	add ts
	dac temp
	lac e1
	dvd temp
	hlt
	add d1
	mpy ts
	add one
	mpy t
dmp,	xct 0
	spa
	add pi
exit,	jmp 0
	add j
	sub j
pio4,	311037
	001325
pi,	311037
	005325
e2,	726417
	774175
e1,	625656
	000663
d3,	317373
	002653
d2,	206336
	005723
d1,	777263
	763105
s2,	324047
	775146
one,	200000
	002000
temp,	0
	0
ts,	0
	0
t,	0
	0
j,	0
	0
blk
fin.
                >>13<<v                                




/ln, log - FLOATING LOGARITHM ROUTINES, Natural and Common
/	entrance>>40<<.	logf a (or log10f a)  ,where a is a number >0.
/	return, result is in flac.
/logf and log10f are i.g.'s that result in lac a
	jsp logf (or log10f)
/floating mode is assumed on entrance and is in control upon return.
/	if no. was negative or zero, the routine jmps to errlgf
/	with the pc of the instruction being interpreted in the ac

dss float ea pc errlgf
xsy logf log10f

logf'	dap return
	jsp work
	jmp return
work,	dap exit
	lac ea
	sub = 1
	jda float
	dac char
	dio char+1
	dzm ea
	idx ea
	efm 2
	dac x
	sma sza
	jmp .+3
	lac pc
	jmp errlgf
	add k1
	dac save
	lac x	/X +>>05<<>>56<<2
	sub k1
	dvd save
	hlt	/(X- >>05<<>>56<<2)/(X + >>05<<>>56<<2)
	dac x
	mpy x
	dac save
	mpy c7
	add c5
	mpy save
	add c3
	mpy save
	add c1
	mpy x
	add k2
	add char	/log(base 2) x
	mpy k3	/log (base e) X	=	(log[base e] 2)>>40<< (log [base 2 ]X)
exit,	jmp 0
log10f'	dap return
	jsp work
	mpy k4	/log (base 10) X = (log [base 10] e)>>40<< (log [base e] X)
return,	jmp 0
x,	0
	0
save,	0
	0
c1,	270524
	004730	/2.8853900727
c3,	366161
	000231	/ .9618007623
c5,	223466
	000100	/ .5765843421
c7,	336256
	775132	/ .4342597513
k1,	265011
	..003631	/>>05<<>>56<<2 = 1.4142135624
k2>>40<<0	200000
	0		/ .5000000000
k3,	261344
	000277	/log (base e) 2 = .693147186
k4,	336267
	775305	/log (base 10) e = .4342944819
char,	0
	0
blk
fin.





                >>13<<>>16<<                                




/expf - FLOATING EXPONENTIAL ROUTINE      16 Dec. 1964
/entrance>>40<<.	efm 2
/	expf a	,a is the power to which e will be raised
/		,expf is an i.g. which results in a floating
/		,lac and jsp expf
/		return	(e to the a power is in flac)


xsy expf
dss sa

expf'	dap exit
	dap return
	lac sa
	spa i
	jmp .+4
	dzm sa
	law exit+1
	dap exit
	efm 2
	dac x
	mpy a6
	add a5
	mpy x
	add a4
	mpy x
	add a3
	mpy x
	add a2
	mpy x
	add a1
	mpy x
	add one
	dac x
	mpy x
	dac x
	mpy x
exit,	jmp 0
	dac x
	lac one
	dvd x
	hlt
return,	jmp 0

one,	200000
	002000
a1,	377777
	772475
a2,	200017
	767634
a3,	251647
	757764
a4,	263712
	747226
a5,	266152
	734200
a6,	271303
	726535
x,	0
	0
	blk

fin.




                >>13<<>>15<<                                



/floating point square root subroutine
/13 August 64, J. Johnson
/	entrance>>40<<.	sqrtf a  ,sqrtf is an i.g. and results
/			in lac a>>40<<, jsp sqrtf.
/	return, results in floating accumulator (FLAC)
/Floating mode is assumed in control upon entrance and returns
/in control upon exit.
/If a negative number is encountered, a jda to errsqt occurs.
/If the user desires corrective action the ac will contain the
/program counter of the instruction being interpreted, however
/a direct return to the sqrt will cma the number and proceed
xsy sqrtf
dss a sa ea pc errsqt
sqrtf'	dap srxit
	law i 2
	dac cntr
	lac a
	sza
	jmp .+3
	efm 2
	jmp srxit
	lac sa
	spa i
	jmp .+6
	lac pc
	jda errsqt
	lac sa
	cma
	dac sa
	efm 2
	jsp divby2
	dac save	/enters floating mode
	dac fxsi
	jmp fsr2	/forms X = X/2
fsr1,	lac save
	dvd fxsi
	hlt
	add fxsih
	dac save2
	sub fxsi
	lio a
	sil 1s
	dio a
	sza i
	jmp fsr2+3
	lac save2
	dac fxsi
fsr2, 	jsp divby2
	dac fxsih	/forms X /2
	jmp fsr1	/starts new iteration
	isp cntr
	jmp fsr2-2
	lac fxsi
srxit,	jmp 0
divby2,	dap return
	law i 1
	add ea
	dac ea
	efm 2
return,	jmp 0
fxsi,	0
	0
fxsih,	0
	0
save,	0
	0
save2,	0
	0
cntr,	0
blk
fin.
                >>13<<j                                




/routine to float numbers found in flac
float'	0
	dap exit
	dap exit2
	cli
	law i 21
	dac exponent
	lac float
	spa i
	jmp .+5
	cma
	dac float
	law exit+1
	dap exit
	sza i
	jmp exit
loop2,	lac float
	ral 1s
	spa
	jmp .+4
	dac float
	idx exponent
	jmp loop2
	rar 1s
	dac float
	lac exponent
	cma
	scr 8s
	lac float
exit,	jmp 0
	ior = 400000
exit2,	jmp 0
exponent>>40<<0	0
blk
fin.




                >>13<<>>56<<                                
/flt--subroutine to float fixed point numbers
/entry>>40<<.	,sign,34,sign number in AC-IO
/	jda flt
/	..K	/binary scale factor, i.e., b17 would be  dec 17 or oct 21
/	,return - 8/28 flt.pt. number in AC-IO

/subroutine does not use the flt.pt. package (flip)

/exponent(8/28) = scale factor- no.shifts to normalize  b17-15shifts=exp.2

flt'	0
	dap exit
	lac i exit
	dac ea
	idx exit
	dio ap
	lac flt
	dac sa
	spa i
	jmp .+6
	cma	/number must be made positive
	dac flt
	lac ap
	cma
	dac ap
	law i 1
	and ap
	dac ap
	cla
	sas flt
	jmp .+3
	sad ap	/zero number
	jmp zero
	lio ap
loop,	lac flt
	rcl 1s
	spa
	jmp .+6
	dac flt
	law i 1
	add ea
	dac ea
	jmp loop
	rcr 1s
	dac flt
	jmp .+2
zero,	lio ap
	lac sa
	and=400000
	ior flt
	dac flt
	lac ea
	scr 8s
	lac flt
exit,	jmp 0
blk
fin.
                >>13<<0                                




/UNFLT--ROUTINE TO UNFLOAT (8-28 FORMAT) BINARY NUMBERS
/ENTRANCE>>40<<.
/	law (address of first word of binary number)
/	jda unflt
/	,error return     no. too big or too small to un-float
/	,norm. return     sign,34,sign number in AC-IO, b17

unflt'	0
	dap exit
	law 1
	add unflt
	dac ap
	lac i unflt
	dac sa
	and = 377777
	dac a
	lac i ap
	cli
	scr 6s
	scr 4s
	spa
	jmp negative
positive,	sub=21
	sza i
	jmp sign
	sma
	jmp error
right,	dac ea
	lac a
	scr 1s
	dac a
	isp ea
	jmp .-4
	jmp sign
negative,	dac ea
	add = 21
	spa
	jmp error
	lac ea
	jmp positive
sign,	lac sa
	spa i
	jmp exit-5	/positive
	lac a
	cma
	dac a	/negative
	rcl 9s
	rcl 9s
	cma
	rcl 9s
	rcl 9s
	idx exit
	rcr 1s
	lac sa
	rcl 1s
	lac a
exit,	jmp 0
error,	lac i unflt
	lio i ap
	jmp exit
blk
fin.
                >>13<<>>40<<                                
/feed flex routine for fortran package

dss pcf

fdf'	0
	dap exit
	kac fdf	/force minus
	sma
	cma
	dac fdf
a,	cla
	jda pcf
	isp fdf
	jmp a
exit,	jmp 0

blk fin.
                >>13<<>>12<<                                
/clear fortran sense lights 1 thru 6

dss f1f f2f f3f f4f f5f f6f

cff'	dap exit
	dzm f1f
	dzm f2f
	dzm f3f
	dzm f4f
	dzm f5f
	dzm f6f
exit,	jmp 0
	blk
fin.
                >>13<<t                                
/parity check subr. for rdf and wrf
/entry>>40<<.	char.in AC
/	jda paf
/	return - char.in AC with odd parity

paf'	0
	dap exit
	lac paf
	dap b
	ior = 673000
	dac a
	law 2525
a,	0
b,	law 0
	spi i
	ior = 200
exit,	jmp 0
blk
fin.
                >>13<<                                
/paper tape output routine for fortran subr. package

dss swf inf rtf paf

wrf'	0
	dap rtf
	lac wrf
	lio punchlink
	jmp inf+2

punchlink,unch one char. from AC
	dap exit
	cks
	ril 4s
	spi i
	jmp .-3
	lio pcf
	ppa
exit,	jmp 0
blk
fin.
                >>13<<q                                
/read paper tape routine for fortran programs
/called by "read flex" statement

dss rtf inf paf
rdf'temp,	0
	dap rtf
	lac rdf
	lio readlink
	jmp inf

readlink,	jsp rdp
rdp,	dap exit
	lac switch
	spa
	jmp rpait
	sza
	jmp readit
	rrb
rpait,	rpa
readit,	cks
	ril 1s
	spi i
	jmp readit	/wait for reader buffer ready
	rrb
	rcl 9s
	rcl 9s
rcvr,	dac temp
	sza i
	jmp rpait
	rar 7s
	spa
	jmp rpait
	lac temp
	sad (13
	jmp etp
	jda paf
	sas temp
	jmp parerr
	and (77
	dac temp
	lio temp
	sad 7776
	jmp norpa
	sad 7775
	jmp norpa
	rpa
	idx exit
	law 1
	dac switch
	lac temp
exit>>40<<0	jmp 0

norpa>>40<<0	law i 1
	jmp exit-2

parerr,	lio temp
	oct 140002
	lat	/get replacement char. from Test Word switches
	jmp rcvr
switch,	0
etp,	dzm switch
eof'	jmp .	/stop code was read
blk
fin.
                >>13<<6                                

/printer routine for fortran subr. package

dss rtf swf inf caf

prf'	0
	dap rtf
	lac prf
	lio prtlink
	jmp inf+2

prtlink,	jda prt
/general subroutine for DEC type 644 printer

/all concise char. handled properly
/prints char. from right 6 bits of IO
/forms advance control in "caf" in subr. package
/"caf" is reset to single line spacing after every print operation.
/forms advance =
/0 = 1 line
/1 = 2 lines
/2 = 3 lines
/3 = 6 lines
/4 = 11 lines
/5 = 22 lines
/6 = 33 lines  (half page)
/7 = top of next page
/8 or greater = print with no paper advance (overprint)

/characters after 120th are lost
/at start of main routine give a cpb' command to clear the buffer.
/entry>>40<<.	lio char	/char. in IO
/	jda prt	/transparent to AC-IO

xsy lpb1 cpb pri pas
lpb1=720045
cpb=720445
pri=720645
pas=720745

prt,	0
	dap exit
	dio char
	law 77
	and char
	add adrtbl
	dac x1
	xct i x1
output,	jda addchar
out,	lio char
	lac prt
exit,	jmp 0


upper,	law i 0
	dac case
	jmp out
lower,	dzm case
	jmp out


addchar,	0	/char. in AC
	dap exit2
	jsp sync
	idx cct
	sub (dec 120
	sma sza
	jmp exit2	/over 120 char.
	lac addchar
	lio case
	spi i
	rar 6s	/if case is minus - upper case concise code
	jda swf
lpbhere,	lpb1 i
exit2,	jmp 0
	blk



table,	law 4040	/00  space
	law 0132	/01  1 "
	law 0212	/02  2  i
	law 0313	/03  3 ~
	law 0414	/04  4 >>04<<
	law 0515	/05  5 >>05<<
	law 0616	/06  6 >>06<<
	law 0717	/07  7 <
	law 1034	/10  8 >
	law 1135	/11  9 ^
x1,	0	/12  unused
	law 5252	/13 stop code prints as |S
x2,	0	/14
x3,	0	/15
x4,	0	/16
x5,	0	/17
	law 2036	/20  0 >>20<<
	law 2137	/21  / ?
	law 2222	/22  s
	law 2323	/23  t
	law 2424	/24  u
	law 2525	/24  v
	law 2626	/26  w
	law 2727	/27  x
	law 3030	/30  y
	law 3131	/31  z
x6,	0	/32
	law 3353	/33  , =
	jmp out	/34  red
	jmp out	/35  black
	jmp tab	/36  tab
cct,	..	/37
	jmp "ns>>40<< >>40<< "	/40  >>40<<  >>40<<
	law 4141	/41  j
	law 4242	/42  k
	law 4343	/43  l
	law 4444	/44  m
	law 4545	/45  n
	law 4646	/46  o
	law 4747	/47  p
	law 5050	/50  q
	law 5151	/51  r
case,	0
adrtbl,	loc table
	law 5474	/54  - +
	law 5575	/55  ) ]
	jmp "ns>>56<< | "	/56  >>56<<  |
	law 5777	/57  ( [
char,	0	/60
	law 6161	/61  a
	law 6262	/62  b
	law 6363	/63  c
	law 6464	/64  d
	law 6565	/65  e
	law 6666	/66  f
	law 6767	/67  g
	law 7070	/7                                 
            wer shift
	law 7372	/73  . x
	jmp upper	/74  upper shift
	jmp backspace  /75
	..	/76
	jmp print	/77  carriage return


tab,	law i 15. + cct
	spa
	jmp tabit
	law i 30. + cct
	spa
	jmp tabit
	law i 45. + cct
	spa
	jmp tabit
	law i 60. + cct
	spa
	jmp tabit
	law i 75. + cct
	spa
	jp tabit
	law i 90. + cct
	spa
	jmp tabit
	law i 105. + cct
	spa
	jmp tabit
	law i 115. + cct
	spa
	jmp tabit
	law 4040	/space
	jmp output
tabit,	jda spcbfr	/used to be   add=..1   before this jda ????
	jmp out
	blk


/print and space - release to main prog.
print,	law i 8.	/if "caf" is > 7 then print with no paper advance
	add caf
	sma
	jmp prtpri
	lio caf
	jsp sync
	pas
	dzm caf
	dzm cct
	jmp out
prtpri,	jsp prtnosp
	jmp .-4



"ns>>40<< >>40<< ",	law 0060	/>>40<< >>40<<
	jmp ahead
"ns>>56<< | ",	law 5676
ahead,	jda nospc
	jmp out
blk

nospc,	0
	dap eee
	lac nospc	/print the non-spacing char.
	jda addchar
	lac cct
	cma
	dac x3
	idx x3
	jsp prtnosp	/print
	lac x3
	jda spcbfr	/space up to correct place on line
eee,	jmp 0
blk

/print and suppress spacing
prtnosp,	dap exit3
	jsp sync
	pri
	dzm cct
exit3,	jmp 0
blk

backspace,	law 1
	sub cct
	dac x4
	sma sza
	jmp out
	jsp prtnosp
	lac x4	/space up to correct place on line
	jda spcbfr
	jmp out


/insert spaces into printer buffer
spcbfr,	0
	dap exit
	lac spcbfr
	sma
	jmp exit
	law 4040
	jda addchar
	isp spcbfr
	jmp .-3
exit,	jmp 0
blk

sync,	dap exit
	lac cct
	sza
	jmp exit
	dio tab-2	/save IO
	jmp .+2
	oct 140010	/halt - printer error status bit on
status,	cks
	ril 9s
	spi
	jmp status-1	/halt the prog.
	rir 1s
	spi i
	jmp status
	lio tab-2	/restore IO
exit,	jmp 0
blk
fin.
                >>13<<n                                
errsqt'	0
	dap exit
	lac errsqt
	oct 140021
exit,	jmp 0
	blk
fin.
                >>13<<y                                
/end flex routine for fortran package
/punches 10 blank lines, stop code, 150 blank lines of trailer

dss fdf pcf

eff'	dap exit
	law i 10.
	jda fdf
	law 13
	jda pcf
	law i 150.
	jda fdf
exit,	jmp 0

blk fin.
                >>13<<>>76<<                                
errlgf'	oct 140022
	jmp errlgf	/no go
fin.
                >>13<<>>16<<                                                                                    

