/pdp-1 fortran part 4
/dss flc fdc fad fsb fmp fdv
/dss bad jps
final=7000
sct=7001
tem=7002
stmnt=7003
tp=7005
dfg=7006
cct=7007
fg1=7010
nct=7011
rp2=7012
fv=7014
fcn=7077
ilist=7244
dolist=7411
buffer=7543
/output a char.
/entry_. lio char.
/ jda output
supres, 0
a, 0
output, 0
dap eput
dio feed
law 77
and feed
dac a /char. to be output
law 1
sas fg1
jmp rausit
dzm fg1
lac jps-1
sza i
jmp nojp
sas stmnt
jmp dif
lac jps-2
sad stmnt+1
jmp nojp
dif, law 36
jda parity
lac (flexo jmp
jda d
cla
jda parity
law 2223
jda d
lac jps-1
jda d
lac jps-2
jda d
law 77
jda parity
l nojp, dzm jps-1
dzm jps-2
lac stmnt
sza i
jmp c
law 2223
jda d
lac stmnt
jda d
lac stmnt+1
jda d
law 33
jda d
c, szf 4
jmp .+3 /flag 4 on for decal insert
law 36
jda parity
rausit, lac a
jda parity
lio feed
lac output
eput, jmp 0 /return
e, 0
d, 0
dap g
law i 3
dac e
f, cla
lio d
rcl 6s
dio d
sza
jda parity
isp e
jmp f
g, jmp 0
parity, 0
dap h
law 1
sad supres
jmp h /if "supres" is set there is to be no normal output
law 77
and parity
szs i 30
jmp .+5
sas del+13 /if sw.3 is on suppress redundant carriage returns
jmp .+3
sad lstc
jmp h
dac lstc
dap pab
ior (673000
dac paa
law 2525
paa, 0
pab, law 0
spi i
ior (200
rcr 9s
_ rcr 9s
jsp ppago
h, jmp 0
lstc, 0
>>14<<
/feed blank tape
feed, 0
dap exit
cli
jsp ppago
isp feed
jmp .-2
exit, jmp 0
0
ppago, dap exit
dio ppago-1
cks
ril 4s
spi i
jmp .-3
lio ppago-1
ppa
exit, jmp 0
del, 77
77
77
77
77
77
777720 /[ left bracket
777722 /] right bracket
777723 /+ plus
777744 /= equals
777704 /x multiply
77 / carriage return
77
77
57 /( left paren.
55 /) right paren.
54 /- minus
33 /, comma
73 /. dec.point
21 // divide
/check for a delimiter
delim, 0
dap exit
law i 20.
dac stemp
law del
dac tem
b, lac delim
sad i tem
jmp c
idx tem
isp stemp
jmp b
jmp exit
c, idx exit
exit, jmp 0 /returns to +1 if a delimiter
s
/buffer in paper tape
sw, 0
buf, dap exit
lac sw
sza i
jmp fillit
idx wh
sad endb
jmp fillit
pick, lac i wh
exit, jmp 0
b, .+40./
endb, endb
wh, 0
fillit, law b
dac wh
dac sw
a, rpa
dio i wh
lac i wh
sza i
jmp a /ignore blank tape
sad (13
jmp aa
rar 7s /check for delete (level 7 punched)
spa
jmp a /ignore tape with 7th level punched
lac i wh
ior (671000
dac .+2
law 2525
0
sma
jmp parng
bb, idx wh
sas endb
jmp a
aa, law b
dac wh
jmp pick
/parity error found
/type out "fpe" and stop program (no go)
parng, law fpe
jda ttext
cla>>05<<cma>>05<<cli>>05<<stf 7
jmp .-1
fpe, text /
fpe
/
-
/punch out a number with no leading zeros
numb, 0
dap b-1
clf 6
law i 6.
dac stemp
a, cla
lio numb
rcl 3s
dio numb
sza i
jmp b
dac tem
stf 6
lio tem
jda output
c, isp stemp
jmp a
jmp 0
b, szf 6
jmp d
law i 1
sas stemp
jmp c
d, lio (20
jmp c-1
/type c/r
typcr, dap .+3
lio del+13 /c/r
tyo
jmp 0
/check for 3 numeric char.
number, 0
dap b
law i 3
dac stemp
a, cla
lio number
rcl 6s
dio number
jda digit
jmp b
isp stemp
jmp a
idx b
b, jmp 0 /returns to +1 if a number
>>76<<
/check for digit in right 6 bits of AC (00 is a digit)
digit, 0
dap exit
lac digit
sad (20
jmp a
sub (10.
spa
a, idx exit
exit, jmp 0 /returns to +1 if a digit
/check for a fixed point variable name
fixed, 0
dap b+1
law i 3
dac stemp
a, cla
lio fixed
rcl 6s
dio fixed
sza i
jmp c /ignore spaces
sad (flexo i
jmp b
sad (flexo j
jmp b
sad (flexo k
jmp b
sad (flexo l
jmp b
sad (flexo m
jmp b
sad (flexo n
jmp b
jda digit /if a digit name of variable is illegal
jmp b+1
law 46.
jmp bad /name begins with digit
b, idx .+1
jmp 0
c, isp stemp
jmp a
jmp b+1 /if word is zero make a normal return
/
stemp, 0
/floating constants
fltcon, dap exit
law i 1 /backup rp2 to first digits
add rp2
dac rp2
lac i rp2
jda number
jmp .+2
jmp fltcon+1
idx rp2
dac addr /save addr. of first digits
dzm w1
dzm w1+1
dzm w2
dzm w2+1
jsp convert
dac w1
dio w1+1
idx addr /skip over dec. pt.
jsp convert
dac w2
dio w2+1
lac cntr
cma
dac cntr
jsp flc
d1
frlp, jsp fmp
d10
jsp fdc
ftemp
isp cntr
jmp frlp
jsp flc
w2
jsp fdv
ftemp
jsp fad
w1
jsp fdc
w1
lac word2 /check for e, as in a=12.34e6
sza i
jmp eno
lky, lio d1+1 /force a dummy exp. into flt.pt. zero
lac w1
sza i
dio w1+1
law fcn
dac tempo
lac fcn-1
dac cntr
search, lac w1
sad i tempo
jmp fnd
idx tempo
idxsrch, idx tempo
t sad nct
jmp .+3
isp cntr
jmp se>>60<<rch
/not on list, add it
isp cct
jmp strit
law 12. /error 12 = too many flt. const.
jmp bad
fnd, lac tempo
dac addr
idx tempo
lac i tempo
sas w1+1
jmp idxsrch
jmp onlist
strit, lac nct
dac addr
lac w1
dac i nct
idx nct
lac w1+1
dac i nct
idx nct
onlist, law 14
dac i rp2
idx rp2
law fcn-1
sub addr
cma
add (1
sar 1s /divide by 2
dac i rp2
step, idx rp2
lac i rp2
sad (73 /dec. pt.
jmp .+3
jda number
jmp .+3
dzm i rp2
jmp step
lac rp2
exit, jmp 0
addr, 0
cntr, 0
tempo, 0
0
c3, 0
tp2, 0
save, 0
0
w1, 0
0
w2, 0
0
ftemp, 0
0
d1, 200000
002000
d10, 240000
010000
out, lac tempo+1
sad (flexo e
dzm word2
lac save
lio save+1
exit2, jmp 0
convert, dap exit2
law i 1
dac word2
dzm save
dzm save+1
dzm cntr
back, lac i addr
dac store
law i 3
dac c3
octloop, cla
lio store
rcl 6s
dio store
dac tempo+1
jda digit
jmp out
lac tempo+1
sza i
jmp nxtdig
sad (20
cla
cli
jda float
17.
dac tempo
dio tempo+1
lac save
sza
jmp useit
lac save+1
sza
jmp useit
lac tempo
dac save
lac tempo+1
dac save+1
jmp idxit
useit, jsp flc
save
jsp fmp
d10
jsp fad
tempo
jsp fdc
save
idxit, idx cntr
sub (10.
sma>>05<<sza
jmp e42
w nxtdig, isp c3
jmp octloop
idx addr
jmp back
e42, law 42. /error 42 = over 10 digits
jmp bad
eno, dzm scratch
law i 0
dac ftemp
law i 1
sad c3
jmp .+4
lac store
dac i addr
jmp eny
dzm i addr
idx addr
lac i addr
sas del+20 /-
jmp .+4
dzm ftemp
dzm i addr
idx addr
eny, law i 3
dac c3
lac i addr
dac store
en1, cla
lio store
rcl 6s
dio store
sza i
jmp enx
sad (20
cla
dac ftemp+1
jda digit
jmp enn /no more digits
lac scratch
sal 2s
add scratch
sal 1s
add ftemp+1
dac scratch
enx, isp c3
jmp en1
idx addr
jmp eny
enn, lac scratch
sza i
jmp lky
cma
dac scratch
en2, jsp flc
w1
lac ftemp
sma
jmp dit
jsp fmp
d10
jmp en3
dit, jsp fdv
d10
en3, jsp fdc
w1
isp scratch
jmp en2
jmp lky
>>12<<
/entry_. ,sign,34,sign number in AC-IO
/ jda float
/ ..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
float,flt, 0
dap exit
lac i exit
dac ea
idx exit
dio ap
lac flt
spa
error 6 /halt - negative number - compiler error
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 ea
scr 8s
lac flt
exit, jmp 0
ea, 0
ap, 0
-
setit, dap .+5
law i 3
dac tp
lac i define
dac store1
jmp 0
scratch, 0
scratch1, 0
store, 0
store1, 0
word2, 0
strw2, 0
lpx, 0
fvc, 0
fvn, 0
ict, 0
inxt, 0
define, 0
dap return
dzm scratch1
law scratch
dac store
jsp setit
law i 2
dac lpx
reset, dzm i store
law i 3
dac word2
jsp nxtc /get a char.
rcr 6s
lac i store
rcl 6s
dac i store
isp word2
jmp reset+3
idx store
isp lpx
jmp reset
jsp nxtc /6 char. are packed
law 33. /error 33 = var. name too long
jmp bad
nxtc, dap extc
lac store1
dzm feed
lio (1
sad del+16
dio feed /temp. flag to indicate subsc. var.
a0, cla
lio store1
rcl 6s
dio store1
sza
jmp valid
isp tp
jmp a0
idx define
jsp setit
jmp nxtc+1
valid, dac strw2
jda delim
jmp .+2
jmp .+3
lac strw2
extc, jmp 0
law i 3
dac rp2
dac tp
law 77
and scratch
sza
jmp a
lac scratch
rar 6s
dac scratch
isp tp
jmp .-10
a, law i 7777 /mask = 770000
and scratch1
sza
jmp b
lac scratch1
ral 6s
dac scratch1
isp rp2
jmp a
b, law i 6
dac tp
law i 7777 /mask = 770000
and scratch
lio scratch1
sza
jmp c
lac scratch
rcl 6s
dac scratch
dio scratch1
isp tp
jmp b+2
c, lac scratch /does name end in f
lio scratch1
jmp .+2
b2, lac rp2
rcr 6s
dac rp2
and (770000
sza i
jmp b2
sas (flexo f
jmp c2
law 36. /error 36 = var. name ends with f
jmp bad
/look up on ilist
c2, lac (1
q dac define
lac scratch
jda fixed
dzm define
/if name being defined is flt.pt. "define" is zero, if fixed pt. "define" contains 1 (one)
law ilist
dac word2
lac ilist-1
dac tp
r9, lac scratch
sad i word2
jmp fnd
idx word2
d, idx word2
sad inxt
jmp .+3
isp tp
jmp r9
/not on ilist, is it on fv
law fv
dac word2
lac fv-1
dac tp
l1, lac scratch
sad i word2
jmp l4
idx word2
l2, idx word2
sad fvn
jmp .+3
isp tp
jmp l1
/not on ilist or fv
law 1
sad feed
jmp adf /add to fv
isp ict /add to ilist
jmp .+3
law 34. /error 34 = too many unsubsc. var.
jmp bad
lac scratch
dac i inxt
idx inxt
lac scratch1
dac i inxt
idx inxt
jmp return
fnd, idx word2
lac i word2
sas scratch1
jmp d
law 1
sas feed
return, jmp 0
law 37. /error 37 = subsc. var. found on ilist
jmp bad
l4, idx word2
g lac i word2
sas scratch1
jmp l2
law 1 /is on fv
sad feed
jmp return
law 38. /undimensioned var. found with subsc.
jmp bad
adf, sad dfg
jmp .+3
law 39. /subsc. var. has not been dimensioned
jmp bad
isp fvc
jmp .+3
law 40. /too many dimensioned var.
jmp bad
lac scratch
dac i fvn
idx fvn
lac scratch1
dac i fvn
idx fvn
jmp return
>>16<<
punch, jda output
/dec. output
typflg, 0
bindec, 0
dap exit
law 1
lio (730003
sas typflg
lio punch
dio it
lac (100000.
dac t1
law dtb
dac ptr
lac bindec
sza i
jmp zero
jmp .+2
aa, lac i ptr
scr 9s
scr 8s
div t1
hlt
dac i ptr
idx ptr
dio i ptr
lac t1
sad (10.
jmp cc
scr 9s
scr 8s
div (10.
hlt
dac t1
jmp aa
cc, law dtb-1 /skip leading zeros and output
dac ptr
dd, idx ptr
lac i ptr
sza i
jmp dd
ee, lac i ptr
sza i
z, law 20
rcr 9s
rcr 9s
xct it
idx ptr
sas tbc
jmp ee
exit, jmp 0
zero, lio z
xct it
jmp exit
ptr, 0
t1, 0
it, 0
dtb, .+7/
tbc, .-1
d
/type out 3 alphas from the AC
message, 0
dap a
lac (730003
dac crash
lac message
jda alpha
lac punch
dac crash
a, jmp 0
/punch out 3 alphas from the AC
alpha, 0
dap c
law i 3
dac sct
lac alpha
and (777700
sas (777700
jmp .+6
lac alpha
cma
ral 6s
ior (740072
dac alpha
d, cla
lio alpha
rcl 6s
dio alpha
sza i
jmp crash+1
sad (13
jmp c
sad (76
jmp crash+1
rcr 9s
rcr 9s
crash, jda output
isp sct
jmp d
c, jmp 0
z
/punch out text packed with text / /
/entry_. law text
/ jda ptext
ptext, 0
dap a
c, lac i ptext
dac tem
law i 3
dac sct
b, cla
lio tem
rcl 6s
dio tem
sad (13
a, jmp 0
rcr 9s
rcr 9s
d, jda output
isp sct
jmp b
idx ptext
jmp c
/type out text
ttext, 0
dap e
lac (730003
dac d
lac ttext
jda ptext
lac punch
dac d
e, jmp 0
txt, dap exit
law i 400.
jda feed
law gomsg
jda ptext
exit, jmp 0
gomsg, text /
/dss xf ff dff cff dof f1f f2f f3f f4f f5f f6f arf i1f i2f
/dss rdf wrf tif tof fdf eff prf eof
mainprog, lac laf
jda arf
/
v