          
/pdp-1 fortran part 5
/8-28 arithmetic routines
/from j.johnson's flip

/dss bad

fcl,	dap exit
	dzm a
	dzm ap
	dzm sa
	dzm ea
exit,	jmp 0

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
	skp i
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



























                
-                                
flc,	jda begin		/floating lac
	lac i q
	dac sa		/sign
	and (377777
	dac a	/fractional part
	idx q
	law 1777
	and i q
	ral 7s
	dac ap		/rest of fractional part
	lac i q
	sar 6s
	sar 4s
	dac ea
	jmp return	/exponent
fdc,	jda begin
	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
	jsp 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
	szo
	error 2	/halt - overflow set
	lac loady
	jda begin
	lac i q
	dac sy
	and (377777
	dac y
	idx q






                
>>52<<                                	law 1777
	and i q
	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>>05<<sza
	jmp fad1+6
fad2,	lac sa	/exponents equal
	xor sy
	spa
	jmp fad3	/signs differ
	lac ap
	add yp
	dac ap
	cla
	szo
	law 1	/overflow of extension
	add a
	add y
	dac a
	szo i






                
>>53<<                                	jmp norm	/done
	sma			/overflow
	jmp .+6
	lac y
	sas (377777
	jmp .+3
	law i 0
	dac a
	idx ea
	lac a
	lio ap
	ril 1s
	rcr 1s
	and (377777
	dac a
	cla
	rcr 1s
	dio ap
	szo i
	jmp norm	/done
	spa
	jmp fmp1+2
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
	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






                
>>75<<                                	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,	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






                
4                                	jmp return
	jsp fcl
	jmp return
fmp,	jda loady		/floating multiply
	jmp .-3		/0, clear flac
	lac ea
	add ey
	dac ea
	szo
	jmp fmp1		/multiply overflow
	lac a
	mul y
	dac temp1
	cla
	rcr 1s
	dio temp
	lac a
	mul yp
	add temp
	and (377777
	dac temp
	lac temp1
	dac a
	szo
	idx a
	lac y
	mul ap
	add temp
	and (377777
	dac ap
	szo
	idx a
	lac sa
	xor sy
	jmp fad5y
fmp1,overflow,underflow,	law 43.	/exp error
	jmp bad
fdv,	jda loady		/floating divide
	jmp fdv5
	cli
	lac (200000
	div y
	jmp fdv3
fdv1,	dac y
	clo
	dio temp
	lac yp
	mul y
	cma
	add temp
	mul y
fdv2,	dac temp
	spa
	jmp fdv4
	add temp
	and (377777
	dac yp
	szo
	idx y
	law 1






                
>>76<<                                	add ea
	sub ey
	jmp fmp+4
fdv3,	lac y
	sas (200000
	jmp fad3y
	lac (377776
	lio (377776
	jmp fdv1
fdv4,	law i 1
	add y
	dac y
	lac temp
	add (200000
	jmp fdv2
fdv5,	error 4	/divide by zero
	jmp return

constants
variables
start beg













































                
t                                                                                                                                                                      
        >>37<<
