/fortran subr. package - tape 1 ---------------
/24 nov 65
/version 003
/errors_.
/illegal op.code 140000 is used for error halts
/the addr. part indicates the type of error
/push continue twice to get past the halt
/140001 = mul div switches not on - program will not run until switches are on
/140002 = paper tape parity error - put char. in TW, push continue twice
/140003 = illegal format, nogo
/140004 = no c/r at end of format (paper tape input)
/140005 = non digit char. in i or f input, go on - invalid char. used anyway
/140006 = ------- not used ---------------------------
/140007 = overflow - i input - go on and overflowed value used anyway
/140010 = printer error status bit on - go on and status is rechecked
/140011 = do index .> | 131071| ,go on - index invalid
/140012 = flt. no. too large to convert to fixed pt., go on - trash for fixed pt. no.
/140013 = not enough room in array storage, compiler error or array ig's used as decal inserts
/140014 = too many subsc. or out of range, go on - invalid subsc. used anyway
/140015 = out of bounds of array, go on - invalid subsc. used anyway
/140016 = recursive subsc. - not allowed
/140017 = exponent underflow, no go
/140020 = exponent overflow, no go
/140021 = sqrtf has a negative argument - go on, argument made positive
/140022 = logf or log10f argument .< 0 no go
/addr. 7777 is used for various debug. switches
/bit 0 on = type overbar at start of every format check
/bit 1 on = output number even if "f" or "i" field overflows
/addr. 7775 and 7776 are used for escape char. in the format routines
/if the input char. is the same as the char. in either address, for f, i, a, or x,
/the input for the field is terminated and the next format specification is checked
/normally c(7775) = tab, and c(7776) = carriage return
xsy cal lap dpy srb iot
xsy rcb cnv esm lsm cbs msm
xsy mwc mrc mcb rck cac eem lem
xsy procedure [
xsy mcs chn mec dao iso isd
xsy asd aso asc dsc isb bac
xsy bpc bio bjm dal
xsy goto < .< > .> ^
xsy sin cos atn sqrt ln log exp exp10 |=
xsy if then else clear set for stepu stepd
xsy until while do <=
xsy .>>04<< .=
xsy mus dis
xsy / x float unflt
x dig beg lv6 op2 rs1 cmt
jda fsy
flexo imp
lac 2 lst end
/ dig beg lv6 op2 rs1
jda fsy
flexo idv
lac 2
fde lst
hlt end
dss flc fdc fsb fad fmp fdv
dss idv imp float unflt
dss fbd sof
/the following is used only during initialization of the array area and
/is cleared and overlapped by the arrays
/>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<>>05<<
typ4, 0
dap typ4exit
law i 4. => ct
lio typ4
ril 6s
jmp .+2
typ4loop, lio typ4
cla
rcl 3s
dio typ4
sza i
law 20
jda swap
jsp typ
isp ct
jmp typ4loop
typ4exit, jmp 0
clear, sub (1
dap exit
law 1 /check for mul div switches on
mul (77
div (77
jmp .+3
sad (1
jmp .+3
oct 140001 /halt - switches are not on
jmp .-7
lac cpbinst /change "jda arf" to "cpb" intext /
dac i exit
law 36
dac 7775
lio /.77
dio 7776
jsp typ
lac arf
sza i
jmp exit-1
final - arf => arf
tpo
text /arrays /
lac arf
jda typ4
cli
jsp typ
lac final
jda typ4
lio (77
jsp typ
lac arf
lio final
jmp back
cpbinst, oct 730445
/^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
/the above is all overlapped by the arrays
final, loc .-1
arf' 0
jmp clear
back, jda clearmem
lac final
dac i arf
cla cli clf 7
exit, jmp 0
blk
errfmt' lac 7777
ral 1s
spa
jmp tryit
lio (flexo -
xct unit
isp w1m
jmp .-3
jmp nxtlist
tryit, idx w1
szf 4
jmp iout
jmp fout
digit, 0
dap exit
lac digit
sub (dec 10
sma
oct 140005 /non-digit halt
lac digit
exit, jmp 0
blk
/interchange AC and IO
swap,swf' 0
dap exit
lac swap
rcr 9s
rcr 9s
exit, jmp 0
blk
/get a char. from the typewriter
typin, dap exit
cla cli clf 1
szf i 1
jmp .-1
clf 1
tyi
dio swap
lac swap
sad 7776
jmp exit
sad 7775
jmp exit
idx exit
lac swap
exit, jmp 0
blk
leav, idx return
jsp eol
rtf'return,list, jmp 0
ti, jsp typin
tif'sv1, 0
dap return
lac tif
lio ti
jmp in
typ' dap .+10
dio swap
cks
ril 2s
spi i
jmp .-3
lio swap
tyo
jmp 0
to, jsp typ
tof'sv2, 0
dap return
lio to
lac tof
jmp out
/Following is the input/output routine with format decoding.
/enter at "in" for input devices with the address of the format in the AC
/and a word to be executed by an "xct" intext / in the IO_ which will cause
/a 6 bit input char/ to be in the AC following the "xct" intext /
/the input routine called by the "xct" instr/, must have two returns_,
/a normal return to the word following the "xct" intext / is made if the
/input 6 bit char/ matches the contents of 7775 or 7776, a skip return
/(or return +1) is made if the input char. does not match 7775 or 7776.
/enter at "out" for output devices with the address of the format in the AC
/and a word to be executed by an "xct" intext / in the IO_ which will cause
/a 6 bit output char/ from the IO to be output.
inf'in, stf 3
jmp in2
out, clf 3
in2, dac fmtadr
dio unit
clf 6
dzm rpt
lac fmtadr
dac format
getlist, lac i list /check for end of input/output list
sad (760000
stf 6 /flag 6 on indicates that the end of list is present
dzm word
lac 7777 /debug.
sma
jmp pst
lio (flexo .
jsp typ
pst, lio i format /check for type of format specification
cla
rcl 6s
sad (flexo x
jmp xfld
sad (flexo h
jmp hfld
sad (flexo /
jmp slash
sad (76
jmp eofmt
szf 6
jmp xfld
sad (flexo f
jmp ffld
sad (flexo i
jmp ifld
sad (flexo a
jmp afld
sad (flexo c
jmp pcc
sza
jmp illfmt /illegal format
lac i format /must be repeat
cma
dac rpt
idxfmt, idx format
jmp getlist
nxtlist, idx list
isp rpt
jmp getlist
dzm rpt
jmp idxfmt
illfmt, oct 140003 /halt - unrecognized format specification
jmp .-1
eofmt, szf 6
jmp leav
jsp eol
jmp getlist-3
blk
pcc, cla /format spec. "c" is for printer paper advance control
rcl 6s
dac caf
jmp idxfmt
ldblks, 0
dap exit
a37, cli
xct unit
isp ldblks
jmp a37
exit, jmp 0
blk
setws, dap exit
cla
rcl 6s
dac w1
cma
dac w1m
cla
rcl 6s
dac w2
exit, jmp 0
blk
udf' oct 140017 /halt - exp. underflow
caf' 0 /printer carriage advance control digit
format, 0
fmtadr, 0
unit, 0
ovf' oct 140020 /halt - exp. overflow
rpt, 0
afld, jsp setws
szf i 3
jmp ao
a1, xct unit
jmp strit-1
rcr 6s
lac word
rcl 6s
dac word
isp w1m
jmp a1
lac word
strit, xct i list
jmp nxtlist
ao, xct i list
dac word
law 3
sub w1
sza i
jmp a3
sma
jmp a4
jda ldblks
law i 3. => w1m
a3, lio word
cla
rcl 6s
dio word
jda swap
xct unit
isp w1m
jmp a3
jmp nxtlist
a4, cma
dac w2
lio word
ril 6s
isp w2
jmp .-2
jmp a3+1
blk
hfld, law 7777
and i format
cma
dac w1m
szf 3
jmp hi
h1, idx format
law i 3. => w2
lac i format
dac temp
h2, cla
lio temp
rcl 6s
dio temp
jda swap
xct unit
isp w1m
jmp .+2
jmp idxfmt
isp w2
jmp h2
jmp h1
hi, law i 3. => w2 /"h" input directly replaces the "h" field in the format
idx format
dzm word
h5, xct unit
nop
rcr 6s
lac word
rcl 6s
dac word
isp w1m
jmp .+2
jmp h6
isp w2
jmp h5
lac word
dac i format
jmp hi
h6, lac word
dac i format
h7, isp w2
jmp .+2
jmp idxfmt
lac i format
rcl 6s
ior (76
dac i format
jmp h7
blk
slash, jsp eol
jmp idxfmt /"/" in a format causes an end of line
eol, dap exit
lio (77
szf 3
jmp isinp
xct unit
exit, jmp 0
isinp, lac unit
sas tif-1
jmp papr
jsp typ
jmp exit
papr, xct unit
nop
sad 7776
jmp exit
sad 7775
jmp exit
oct 140004 /no c/r or tab at end of line (paper tape input)
jmp exit
blk
ifld, jsp setws
clf 4
szf i 3
jmp iout
iin, xct unit
jmp i7
sad (20
cla
sas (flexo -
jmp .+3
stf 4
jmp i6
dac temp
jda digit
law i 10. => ct /mul previous value by 10 and add new value
dzm fwrd /and check for overflow
clo
i5, fwrd + word => fwrd
isp ct
jmp i5
fwrd + temp => word
szo
oct 140007 /overflow value > | 131071|
i6, isp w1m
jmp iin
i7, lac word
szf 4
cma
jmp strit
iout, lac w1
ral 6s
jda sof
xct i list
jda float /float the value in the accumulator
dac fwrd
dio fwrd+1
stf 4
getrid, law fwrd
jda fbd
jmp nxtlist
blk
output' jsp .+1
dap exit
szf i 4
jmp oput
jda swap
sad (73
jmp nxtlist
jda swap
oput, xct unit
exit, jmp 0
blk
fout, clf 4
noi 1
add w1
sub w2
sal 6s
ior w2
jda sof
efm 2
xct i list
dac fwrd
lfm
jmp getrid
blk
xfld, jsp setws
szf 3
jmp xin
lac w1m
jda ldblks
jmp idxfmt
xin, xct unit
jmp idxfmt
isp w1m
jmp xin
jmp idxfmt
blk
"10.0", oct 240000
oct 10000
fwrd, 0
0
ffld, jsp setws
szf i 3
jmp fout
dzm ct
dzm fwrd
dzm fwrd+1
clf 5
clf 4
gdigt, xct unit
jmp setfract
sas (flexo -
jmp .+3
stf 4
jmp nxtdig
sad (..20
cla
sad (73
jmp decpt
jda digit
jda float /float the integer digit in the accumulator
dac ftemp
dio ftemp+1
idx ct
efm 2
lac fwrd
mul "10.0"
add ftemp
dac fwrd
lfm
nxtdig, isp w1m
jmp gdigt
setfract, lac w2
szf 5
lac ct /dec.pt. overrides format spec.
sza i
jmp nopt
cma
dac ct
efm 2 /flt.pt. number is still in flt.accumulator
div "10.0"
hlt
isp ct
jmp .-3
strval, szf 4
cma
xct i list /store the flt. word
lfm
jmp nxtlist
decpt, dzm ct
stf 5
jmp nxtdig
nopt, efm 2
jmp strval
blk
stp.
z
/fortran subroutine package - tape 2 -------------------------------
/display the sense lights in the prog. flags and halt
dff' dap exit
clf 7
law 1
sad f1f
stf 1
sad f2f
stf 2
sad f3f
stf 3
sad f4f
stf 4
sad f5f
stf 5
sad f6f
stf 6
cla cli hlt
exit, jmp 0
f1f' 0
f2f' 0
f3f' 0
f4f' 0
f5f' 0
f6f' 0
blk
/do handling subr.
/do loops may count up or down by any increment
/if a do loop is satisfied the index, upon exit, contains the same value
dof'ctaddr,word, 0 /"word" used in format routine
dap exit
clo
xct i exit
dac doit
idx exit
law i 1
add ctaddr
dac lmaddr
lac i ctaddr
spa
jmp some
lac (oct 650500 /sma sza i
lio = oct 650200 /spa i
jmp more
some, lac (oct 650200 /spa i
lio (oct 650500 /sma sza i
more, dac check
dio check2
lac i doit
add i ctaddr
dac i doit
szo
oct 140011 /do index .> | 131071|
ok, sub i lmaddr
szo
jmp over
check,w1, 0 /"w1" used in format routine
jmp loopagain
around, lac i doit /restore index for exit
sub i ctaddr
dac i doit
exit, jmp 0
loopagain, idx ctaddr
jmp i ctaddr
over, lac i doit
add i lmaddr
check2,w2_0 0 /"w2" used in format routine
jmp loopagain
jmp around
doit,w1m_0 0 /w1m used in format routine
lmaddr,temp, 0 /temp " " " "
blk
/fixed to floating conversion for fortran arith. statement
/from fortran stmnt a = i-j/k
/fortran output i-j/k
/ jda xf
/ dac a
xf'ct, 0 /"ct" used in format routine
dap exit
lac i exit
dac store
lac xf
jda float /float the value in the accumulator
dac i store
idx store
dio i store
idx exit
exit, jmp 0
/floating to fixed conversion for fortran arith.
/from fortran stmnt i = a+b
/fortran output efm 2
/ a+b
/ jsp ff
/ dac i
ff' dap exitff
jsp fdc /store flt. AC
loc store
law store
jda unflt
oct 140012 /flt. no. too large to convert to fix.pt.
xct i exitff
idx exitff
exitff, jmp 0
store,ftemp, 0
0 /"ftemp" used in format routine
blk
/array handling subroutines
/i1f defines 1 word (integer) arrays
/i2f defines 2 word (floating) arrays
/subsc. values begin with 1 instead of 0
/no recursive subsc.
clearmem,ptr, 0
dap r
dio endchk
loop, dzm i ptr
idx ptr
and (7777
sas endchk
jmp loop
r, jmp 0
endchk, 0
blk
i2f' dap exit
cla
jmp setrealflag
i1f' dap exit
law 600
setrealflag, dap realflag /usk for integer, nop for real
noi 1 + exit . swap /make call to array subr. a usk
poi 640600 =>| swap
exit| .ptr
idx exit
idx ptr
ptr| .ptr /now points to num of dim in subscript storage
lac i ptr
dap arraynameptr
ral 5s
and (37
dac nod
cma
dac count
1 => length
muloop, idx ptr
xct i ptr
ACxlength=>length
isp count
jmp muloop /fall out pointing to nth dim
length
realflag, skp 0
sal 1s /double the length for real arrays
AC+nod=>spaceneeded
arf => listptr /look thru array storage
lookloop, listptr|
sma
jmp look
in, AC^poi 377777=>listptr
sad final
oct 140013 /no room
jmp lookloop
look, sub listptr
sub spaceneeded
sma
jmp enough
listptr|
jmp in
enough, listptr+nod
xct realflag
ior (400000 /mark real arrays with sign bit a 1
arraynameptr, dac 0 /set up name register
listptr| =>oldptr
lac listptr
add spaceneeded
ior (400000
dac i listptr
and (377777
sad oldptr
jmp past /new array exactly fills old space
dac ct /this was oldptr =>| (AC) in old version
lac oldptr
dac i ct
past, poi 400000-nod=>count /set up for backwards isp
1=>partialprod
prodloop, isp count
exit, jmp 0
idx listptr
xct i ptr
ACxpartialprod=>partialprod=>| listptr /store products of dimensions
law i 1.+ptr=>ptr
jmp prodloop
ptr, 0
nod, 0 /no. of dimensions
count, 0
spaceneeded, 0
listptr, 0
oldptr, 0
partialprod,length, 0
blk
test, 0
nos, 0
csn, 0
io, 0
ssc' jda .+1 /this order is executed
ac, 0
AC.ret1.ret2
idx ret2 /set the return addresses
dio io /save io
AC-2
a, AC.b
b, lac 0
sas locssc
jmp a /find entry in subscript area
idx b
xct b
dip operation
dap sscptr /set op and ptr to subscript values
dzm csn
sscptr| . arrayname
ral 5s
AC^poi 37 => nos /set no. of subsc.
arrayname, lac 0
AC . operation . dimptr
jda swap /save mode bit in IO sign
cla
spi i
law 600
dap efmflag /set efmflag according to mode
lac (oct 332400
rcl 1s
dac scale
loop, idx sscptr
noi 1 + dimptr . dimptr
idx csn
sad nos
jmp lastssc
sscptr|
sad locssc
jmp recurse
sscptr, xct 0 /get subscript value (skipped if recursive)
sub (1
dimptr, mul 0 /mul by dimension value
sza /too many subsc. or out of range if not zero (spa?)
oct 140014
scl 9s
scl 8s
scale, 0 /shift left 1 (mul by 2) if real array
AC+operation.operation
jmp loop
lastssc, sscptr|
sad locssc
jmp recurse
xct sscptr /this instruction skipped if recursive
sub (1
lio i dimptr
spi
jmp c
mul i dimptr /do final mul if dimlist is not exhausted
scl 9s
scl 8s
c, xct scale
AC+operation.operation
AC^poi 7777=>test /set up operand address
d, dimptr|
spa
jmp e
noi 1+dimptr.dimptr
jmp d /step past unused dimensions
e, (AC^poi 7777)-test
sma sza i
oct 140015 /bounds check
ac
lio io
efmflag, skp 0
efm 2
operation, 0
ret1, jmp 0
ret2, jmp 0
recurse, oct 140016 /recursive subsc.
locssc, loc ssc
blk
fin.
e
xsy imp idv tpo
idv' 0
dap exit
xct i exit
dac temp
idx exit
lac idv
scr 9s
scr 8s
div temp
jmp exit
dac temp
idx exit
lac temp
exit, jmp 0
blk
imp'ct3, 0
dap exit
xct i exit
dac temp
idx exit
lac imp
mul temp
scl 9s
scl 8s
exit, jmp 0
blk
dss typ
tpo' dap exit
next, lac i exit
dac temp
idx exit
law i 3
dac ct3
loop, cla
lio temp
rcl 6s
dio temp
sad (13
exit, jmp 0
rcr 9s
rcr 9s
jsp typ
isp ct3
jmp loop
jmp next
temp, 0
blk
fin.
>>12<<