file system 12/2/70
pbs.=3 /physical block spacing (must be >2)
ffb.=12 /first free tape block
dirl.=4 /directory length
dir1.=6 /address of directory 1
dir2.=773 /address of directory 2
cbl.=6000-cbf /character buffer length
0/ jmp in /load new file system, save directory
1/ jmp ini /initialize entire tape
2/ jmp file /normal entry point
3/ jmp nme /rename tape
4/ cbf /address of character buffer
5/ cbl /maximum length of buffer
6/ jmp invk /invoke file system
7/ text .12/2/70. /date of assembly
12/
/constants used in first page before file system read in
const1, dirlxi dir1
const2, dirlxi i dir2
const3, 607600
const4, lai
e21=e23+2 /text / 2_/
invk, clf 7
stf 1
jmp file 1
file, clf 7
iam
law cbf
dac tyin
lio 0 /([ffb-dirl-1]xi 1
law 400
ivk 16 /read file system
jmp trr /tape error while reading directory
szf i 1
jdp bdmp
jmp rdir
swd, jdp wdy
rdir, lio const1 /dirlxi dir1
law 6000
ivk 16
jmp trr
rdir1, lio const2 /dirlxi i dir2
law ntb
ivk 16
jmp trr
law (dirlxi dir2
dap rdir1 /setup for directory swap
dzm wpm /turn on software write permit
law e21 / 2_
jdp chd /check directory 2
jmp bdir /bad directory
jdp dswp /look at dir 1
law e20 / 1_
jdp chd /check dir 1
jmp bdir
jdp dcom /compare 2 good directories
jmp dok /both ok and the same
idx wpm /turn off write permit
law e22 /directories don't match
jdp txp
jmp dok
bdir, jdp dswp
law e23 / 1 and 2_
jdp chd
idx wpm /turn off write permit
dok, skp i
jdp dswp
law 600
xor dok
dap dok
jmp . 1
law rst
dap .-2
jmp cr
txp, 0
dap txy
txy, lio
idx .-1
lac const3
rcl 6s
sad const4 /lai
jmp i txp
sad . 2
jmp txy
swp
tyo
lia
jmp txy 2
trr, law m1
jdp txp
dsm
m1, text /tape error while reading directory_/
repeat ifp .-400,[
printx /
data on first page exceeds space provided
/]
>>35<<
dcom, 0 /skip on bad comparison
lxr (1-dirlx400
lac i ntb dirlx400-1
sas i 6000 dirlx400-1
jmp dbad
SXX>
jmp .-4
jmp i dcom
dbad, idx dcom
jdp dbad
jmp i dcom
dswp, 0
lxr (1-dirlx400
lac i ntb dirlx400-1
lio i 6000 dirlx400-1
dio i ntb dirlx400-1
dac i 6000 dirlx400-1
SXX>
jmp .-5
jmp i dswp
tbl, 660000 fil /command table - 4000 bit indicates no args needed
304000 name /print name of tape
650000 edi
610000 app
220000 sav
204000 tap0 /0F
014000 tap1 /1F
024000 tap2 /2F
034000 tap3 /3F
240000 uns
440000 mer
640000 del
670000 go
430000 loa
510000 ren
470000 pri
230000 tex
274000 swd /swap directories
674000 goa
454000 ctn /certainly loc 0
630000 ecm /edit and assemble m
450000 ecn /edit and assemble n
634000 ctm /certainly loc 2
654000 et /go to et
624000 ddt
474000 pr1 /print directory
264000 won /turn write permit on
tble,
bdmp, 0
law cbf
dac tyin
clc
dac cbf
jmp i bdmp
u wdy, 0
lac wpm
wtd, szf i
sza
jmp i wdy /don't even try to write if permit is off
law (add
jdp chd
jmp wda
lio (10 /directory ok
law 6000
jdp tpe /read name
lxr (-ffb
wdy3, lac i ffb dbt
sad i 6000 ffb
jmp wdy2
jdp bdmp /dump character buffer
law e24 /anomalous tape
jmp rst1
wdy2, SXX=
jmp wdy3
law dir2
jdp dirb
law dir1
jdp dirb
clc
jdp tpe
cla
dap wtd
jmp i wdy
dirb, 0
lio (dirlxi
dap rd1
A+II
lac (add ntb
jdp tpe
lxr (-3
rd1, law .
XMAI
cmi
CXA
sal 8s
add (6000
jdp tpe
SXX>
jmp rd1
jdp dcom
jmp i dirb
jdp bdmp /dump character buffer
law e25 /hardware failure
jmp rst1
WDA= IDX WPM ?TURN OFF WRITE PERMIT
CR= LEM
T"= CLI>>05<<cmi>>05<<cla>>05<<clf 7
dap er7
dap cd
law 600
dap merg /set to normal,nonmerge mode
aam
lac tyin
TAAM
jmp cl
t0, cli>>05<<cmi
tyo
jdp bdmp
ZXAP
t2, law i 1
A+XX>P
jmp t0 /backup to beginning of line
t3, tyi
dio i cbf
szs 30
jmp t4
lai
sad (75 /backspace
jmp t2
sad (40 /_
jmp t0
sad (77 /cr
jmp t6
t4, SXXA
sas (cbl-1
jmp t3
q, law cr
jda txp
742172 add
t6, cla>>05<<cma
dac i cbf 1 /set end of buffer marker
cl, law 1
dac af
jsp ll
stf 6 /,
stf 5 /cr
dzm as /space
lxr (tbl-tble-1
cl1, SXX=|
jmp q
lio (770000
lac van
A^IP|
jmp cr
xor i tble
A^IP
jmp cl1
lac i tble
ral 8s
rpf
A~II
law 2
A^I=
jmp cl1
. law 3777
and i tble
dap . 1
jmp .
>>32<<
/read symbol and terminator
/name in van, value in pnu, flag 1 if not a number
/skip 0, 1, 2 times if terminator is comma, c.r., space
ll, dap ell
clf 1
lxr (-4
dzm i pnu
SXX>
jmp .-2
law van
dap lp1
stf 6
ti, aam
lio tyin
idx tyin
TIIAP
clf 6
szf 6
jmp ti
lxr (-2
sad i tit 2
jmp lle
SXX>
jmp .-3
TAX
lp1, lac
cli
rcl 6s
sza
jmp .-2
rcl 6s
sza
jmp tia
X>>05<<II
rcr 6s
sni i
jmp .-2
aam
dac lp1
law 20
X~AP|
ZX
law 10
XMA|>
stf 1
lac pnu
TXI
rir 3s
rcl 3s
dac pnu
jmp ti
tia, lac lp1
sas (lac van 3
idx lp1
dzm van 3
jmp lp1
tit, 0 /2
77 /1
33 /0
lle, CXX
aam
ell, jmp
p
/read file names and search directory
/skip if end with cr, no skip if comma
/return pointer to last directory block in AC, XR
/F2 on to construct new blocks if name not found
gef, 0
dzm sga
clf 6
clf 5
lac ntb
dac sfp
gea, jsp ll
jmp gel /,
jmp gel /cr
jmp gen-1 /space
gel, stf 6
TXA
dac sx
lxr (ntb
gen, law 777
and sfp
skp 5
jmp guc
sza i
jmp gun /name not found
lxr sfp
jdp ttx
law ntb
X+AXI
lac i 0
dac sfp
lac van
sza i
jmp gou /no name typed
dio sga
sas i 1
jmp gen
lac van 1
sas i 2
jmp gen
lac van 2
sas i 3
jmp gen
skp 6 /name found
jmp got
lac i 4 /more names to type
sma
jmp gea-1
er1, jdp car /"no subfile" error
law e1
jdp txp
jdp prn
jmp cd
r gun, TXXA
dap gua
jdp gfa
lac sfp
gua, dac
sas ntb
jmp . 4
law ntb
XMAA
dac ntb
dzm i 0
lac van
sza i
jmp gos
dac i 1
lac van 1
dac i 2
lac van 2
dac i 3
TXXA
dac sga
skp i 6
jmp gub
lac (add
dac i 4
jmp got
gub, stf 5
law 4
A+XA
dap guc
jdp gfa
jmp gea
guc, dac
add (ntb
TAAX
jmp gua 1
er3, jdp car
lxr (van-1
jdp prn
law e3
jdp txp
jmp cd
gos, lac (add
xct guc
law i 1
adm pdp
sad (dac pdl-1
jmp erg 1
TXXA
jdp flh
gou, lxr sga
TXXP|
jmp erg
got, lac gef
add sx
dap . 2
TXXA
jmp
w
/get a directory block, demands F2 on
/return it in sfp, XR
/set across = -0, down = 0
gfa, 0
skp i 2
jmp er3
lac ntb 1
sza i
jmp er2
dac sfp
add (ntb
TAAX
lio i 0
dio ntb 1
pdp, dac pdl
idx .-1
sad (dac pdl 37
jmp pce /push down list full
clc
dac i 0
dzm i 4
jmp i gfa
pce, law e32
jdp txp
jmp cd
er2, jdp car /"directory full" error
law e2
jdp txp
cd, skp i
jmp rem
jdp bdmp
law i 1
adm pdp
sad (dac pdl-1
jmp rst
dap . 1
lac
jdp flh
jmp cd 2
/delete all blocks of a file_.initial block number or zero in ac
/anthing negative or low half = 0 ends it. xr saved
uch, 0
sma
jmp i uch
and (777
TAAIP|
jmp i uch
X.IX
lac i dbt
dzm i dbt
TIX
jmp uch 1
rst, law pdl
dap pdp
rsp, lxr (ntb 2
rsa, lac i 4
TAAI|P
jmp rsj
TAAM
and (lac
TA=|
jmp rsb
rsd, lac i 4
jdp uch
clc
dac i 4
lac ntb 1
dac i 0
law ntb
XMAA
dac ntb 1
rsb, law 5
A+XAX
sas (ntb 1000
jmp rsa
skp 3
jmp q
jmp cr
rsj, TXXA
jdp flh
jmp rsp
flh, 0
dac fla
TAX
lac i 4
ral 1
spa
jmp i flh
flz, lxr fla
fli, lac i 4
spq
jmp flb
add (ntb 4
dap . 1
lac
and (lac
sza
jmp flb
law ntb
lio i 4
A+IX
lio i 0
sni i
jmp .-3
jmp fli
,
flb, lac (lac
ior i 4
dac i 4
lio i 0
dzm i 0
dio fle
TIIM|
jmp i flh
law ntb
dac svl
XMAA
sad ntb
jmp fp5
dac flf
lxr (-776
lio (5
flg, sad i ntb 1000
jmp fp0
sad i ntb 1004
jmp fp4
X+IX>=
jmp flg
jmp fp1
fp0, law ntb 1000
skp i
fp4, law ntb 1004
A+XAX
dac svl
lac fle
dac i 0
fp1, law ntb
add flf
sas fla
jmp flz
jmp i flh
fp5, dio ntb
jmp i flh
l e1, text /no subfile of _/
e2, text /directory full_/
e3, text / not found_/
e4=e6+5 /text/field _/
e5, text / not assigned_/
e6, text /can't assign field _/
e7, text /illegal field number_/
e8, text / has subfiles_/
e11, text /tape error _/
e12, text /tape full_/
e13, text /anomalous directory_/
e14, text /anomalous text _/
e15, text /no write permit, type an "r" to try again
_/
e20, text / 1_/
e22, text /directories do not match - both are ok_/
e23, text / 1 and 2_/
e24, text /anomalous tape_/
e25, text /hardware failure_/
e26, text /write not allowed_/
e27, text /drum error_/
e30, text /tape _/
e31, text / busy
_/
e32, text /push down capacity exceeded
_/
/format of directory entries
/word 0_. pointer to next block on this level
/word 1_. 1st three chars of name
/word 2_. 2nd three
/word 3_. 3rd three
/word 4_. pointer to value
/ bit 0 => value is a file_,otherwise, list of subfiles
/ if bit 0 = 1 then the format of word 4 is the same as the
/ format of a tape block word
/ntb contains pointer to directory
/ntb+1 contains free directory block list
/ntb+2 to ntb+777 contain 146 directory blocks
/format of tape block entries in directory
/each word has bit 0 = 1
/the right half of each word is a pointer to the next tape block
/bits 2-8 of each word indicate the number of all-zero blocks to be
/placed before the next block
/a right half that is all 0 indicates that this is the last block of
/a file that is nonzero. All zero blocks may follow.
/dbt to dbt 777 contains 1000 tape block words
/the file system and the directories occupy tape blocks 0-11 and
/773-777. These blocks are chained together starting at word 0.
/The tape name is encoded in the zero block field (bits 2-8) of
/dbt to dbt 11
gnu, 0
jsp ll
skp i
stf 2
lac pnu
skp i 1
jmp i gnu
erg, jdp car
stf 3
jmp cd
/check field number in af
/F2 on . want to write on it, assign if necessary
/skip if pseudo field
tf, 0
law i 40
lio af
A^IA>
jmp er7
sub (27
sma
jmp er7
law 40
A^IAP
jmp i tf
idx tf
law flexo tf
arq
sza
jmp i tf
skp i 2 /not assigned
jmp er5
law flexo af
arq
jmp er6
jmp i tf
(
,
/read file name from typewriter, going to read file
/put initial tape block in bkp and AC
/point ucp and drd at value word
/skip if end with comma, no skip if c.r.
gtf, 0
jdp gef
idx gtf
law 4
X+AA
dap ucp
dap drd
lac i 4
dac bkp
spa
jmp i gtf
jdp car
er8, jdp prn /"has subfiles" error
law e8
jmp ex
er5, xct er7
jmp era
jdp car /"field n not assigned"
law e4
jdp txp
lac af
jdp ocp
law e5
ex, jdp txp
jmp cd
er6, jdp car /"can't assign field n"
law e6
jdp txp
lac af
jdp ocp
jmp cd
ocp, 0
lio (law
rcl 3s
sni
jmp .-2
sza
opa, sni
lio . 3
tyo
cli
rcl 620
sza
jmp opa
jmp i ocp
b, 0
20400
1
del, jdp gef
skp i
stf 2
jdp flh
skp i 2
jmp del
jmp wre
ren, jdp gef
skp i
jmp q
dac reu
lac i 1
dac sve
lac i 4
dac rsi
law 600
dap cd
dac i 1
dzm i 4
stf 2
jdp gef
jmp er4
TXA
dac snx
flt, lxr snx
lac i 4
spq
jmp flu
add (ntb
jdp flh
jmp flt
flu, jdp uch
lac rsi
dac i 4
lac reu
jdp flh
jmp wre
er4, stf 3
rem, lxr reu
lac sve
dac i 1
lac rsi
dac i 4
jmp cd 2
>>16<<
go, jdp gnu
sza
dac af
skp 2
jmp goa
jdp gnu
dac as
skp i 2
jmp erg
goa, clf 2
jdp tf
nop
gob, jdp rew
lio af
rir 6s
law 7777
and as
add (i-2
dap gol 1
dap gol 3
sad (i gol 2
jmp gol1
gol, lac (dcc
dac .
ZA
jmp .
gol1, lac (dcc
dac gol 2
ZA
jmp gol 2
ddt, jdp rew
dsm
rew, 0
jdp wdy
clc>>05<<cli>>05<<cmi
tyo
jdp tpe
law 16
szs i 60
mta 204
ZIXA
lpf
mta
jmp i rew
1 mer, cla
dap merg /set to merge mode
uns, jdp gtf
jmp una
jdp gnu
szf i 2
jmp erg
sza
dac af
una, cla 2
jdp dro
jmp rst
er7, skp i
jmp era
law e7 /"illegal field number"
jmp ex
era, jdp car /"anomalous text"
law e14
jmp ex
won, law (add /rewind and turn write permit on
jdp chd
jmp . 2
dzm wpm /turn write permit back on
clc
jdp tpe /rewind
jmp rst
tap0, law 16
jmp tapn
tap1, law 116
jmp tapn
tap2, law 216
jmp tapn
tap3, law 316
tapn, dac drum
lio q 2 /downshift
tyo
jdp wdy
law 16
mta 204
lac drum
mta 306
jmp ntap
lac (ivk 16
dac 0
ZXIA
lpf
jmp 0
ntap, law e30
jdp txp
lac drum
sar 6s
jdp ocp
law e31
jmp rst1
>>34<< drum, 0
dcc
skp i
jmp i drum
law e27
jmp drer /drum error
tpe, 0
dac tpe1
dio tpe2
and (-7777
lio wpm
TIIP /skip if write permit on
sas (add /skip if trying to write
jmp tpa
law e26
drer, jdp txp
jmp fps
fpt, law e15
jdp txp
tyi
law char rr
A~IP
jmp fps
tpa, jdp tpb
sad (6
jmp fpt
jdp tpb
dac ter
law e11
jdp txp
lac ter
jdp ocp
fps, idx wpm
jmp cd
tpb, 0
lac tpe1
lio tpe2
ivk 16
jmp i tpb
jmp i tpe
z edi, law 61
ed0, dac fld1
ed1, law 2
ed2, dac fld2
lac (and 400
dac b
jdp eet
lac fld1
dac af
lac fld2
ed3, dac as
jmp gob
et, law 61
dac af
jmp et1
ecm, law 62
jmp ed0
ecn, law 62
dac fld1
cla
jmp ed2
ctm, law 62
dac af
et1, law 2
jmp ed3
ctn, law 62
dac af
cla
jmp ed3
app, jdp afp
jmp apr
tex, lac (and 400
dac b
apr, jdp eet
jmp rst
fil, stf 2
jdp gtf
skp i
jmp erg
clf 2
jdp afp
stf 2
law i 400
add b
dac hig
lac (and
jmp sav3
eet, 0 /read text files beginning at drum address in b
law 6400
dap eea
dap eeb
. eec, jdp gtf /read file name from typewriter
jmp eek
eea, dac . /save initial block
idx eea
jmp eec
eek, xct eea
eeb, lac .
dac bkp /initial block
idx eeb
sub eea
sad (lac-dac 2
jmp eel /no more files
law i 7777
and b
ral 6s
dac af
law 7777
and b
jdp dro
lac 6377
sad (131313
jmp eep
add b
sub (and 400
dac sb
sub afn
sub ofs
lia
law 400
spi
A+IA>
jmp ant
add (5777
dap . 1
lac
sad (131313
jmp een
ant, law e14 /"anomalous text" error
jdp txp
lac eeb
sub (lac 6400
jdp ocp
jdp car
eep, lac ofs
add afn
skp i
een, lac sb /next drum address
dac b
jmp eeb
eel, lio (20372
mta 1
law b
lio (2
jdp drum
jmp i eet
4
/check that text on drum is in good form, put end+1 in b
afp, 0
law 2
dac af
law 600
dap er7
jdp tf
hlt
law 372
mta
law b
lio (20001
jdp drum
afs, law i 1
add b
dac drum /save pointer to 131313 word of text
ral 6s
and (17
sub af
sza i
jmp afr
spa
jmp era
idx af
jdp tf
hlt
jmp afs
afr, law 7777
and drum /load pointer to 131313 word of text
mta
lac af
rar 6s
SAI
law tf
jdp drum
lac tf
sas (131313
jmp era
jmp i afp
/read file and put on drum
/initial tape block in bkp, initial field in af
/initial drum address in AC
/after return, afn+ofs = next drum address and field
/splits fields properly -- F6 . split transfer
/F5 . zero blocks being written on drum
dro, 0
dac ofs
clf 2
xct merg /skip if merge operation
stf 2
jdp tf
jmp er7
dro1, clf 6
lio af
rir 6s
dio afn
lac (177777
lio bkp
A^IAP|
jmp i dro
and (777
dac blk /block to be read
lac (177000
clf 5
A^IAP
stf 5
law 7777
and ofs
sad ofs
jmp drp
dac ofs
drr, idx af
lac (i
adm afn
jdp tf
jmp er7
skp 6
jmp sp2 /finishing a split transfer
drp, szf 5
jmp drp2
lio blk
law 7777
A^II
law 6000
jdp tpe /read a block
jmp drp1
drp2, law i 1000
adm bkp
lxr (-400
dzm i 6400
SXX=
jmp .-2
drp1, law 377
add ofs
and (-7777
sza
jmp sp1 /overlaps fields
merg, skp i 600
jmp nmerg /no merge-this is normal mode
lac ofs
mta
law 400
ior afn
lia
law 6400
jdp drum /read current block from drum
lxr (-400
lac i 7000
xor i 6400
dac i 6400 /xor new and old field
SXX=
jmp .-4
nmerg, lac afn
add ofs
mta
lio (400
law 6000
sp4, jdp drum /write on field
drs, law 400
skp i 6
adm ofs
drt, lxr blk
lac i dbt
szf i 5 /still working on current pointer
dac bkp /next block number
jmp dro1
sp1, lac (i /need to split the drum transfer
sub ofs
lia>>05<<stf 6
lac afn
add ofs
mta
law 6000
jdp drum /low part
A+II
dio sp3
law i 7400
adm ofs
jmp drr /go to next field
sp2, lio afn
mta 1
lio sp3
law 6400
AMIA
swp
jmp sp4 /do second part
>>17<<
pri, jdp gef
skp i
stf 2
lxr i 4
jmp prh
pr1, szf i 6
stf 2 /print top level
lxr ntb /print all
prh, TXX>
jmp erp
jdp crp
law c0
jdp txp
prm, TXX|=
jmp prp
jdp ttx
law ntb
X+AX
lac (dac pdl
sub pdp
dac nid
sza i 2
jmp prv
stf 6
jmp prw
prv, jdp crp
lac nid
ZIP
tyo
SAA>
jmp .-2
jdp prn
prw, lac i 4
sma
jmp phi
jdp prz
pru, swp
adm bck
lxr i 0
jmp prm
phi, lac i 0
xct pdp
idx pdp
sad (dac pdl 37
jmp pce
lxr i 4
jmp prm
erp, TXXA
jdp prz
lai
jdp ocp
jmp rst
prz, 0
cli
and (777
sza i
jmp i prz
add (dbt
dap . 2
SII
lac
jmp prz 2
z
prp, law i 1
adm pdp
dap . 1
lxr
sas (dac pdl-1
jmp prm
jdp crp
jdp car
law i 1000-ffb
TAX
lio i dbt 1000
sni
SAA
SXX=
jmp .-4
dac sve /free blocks
szs i 10
jdp ocp
law c1
szs i 10
jdp txp
law i 1
CAX
lxr i ntb
SAA
TXXP
jmp .-3
dac rsi /free directory entries
mul (3
lac sve
AMI>= /print if less than 1/6 of directory blocks free
law 60
AMI>= /or less than 10 blocks free
jmp rst
lac rsi
jdp ocp
law c2
szs i 10
rst1, jdp txp
jmp rst
c0, text /
file blocks
_/
c1, text / free blocks
_/
c2, text / free directory entries
_/
crp, 0
lac bck
TA|M
jmp crq
lio (5736
tyo
sir 6s
skp 6
tyo
lac bck
a jdp ocp
lio (55
skp 6
tyo
crq, clc 6
dac bck
jdp car
jmp i crp
bck, -0
d
dri, 0
dac ofs
dzm fb /current tape position
dzm dir /current tape direction
dzm eflg /use to determine if tape is full
dre, dzm t
drl, law 400
dap afn
adm ofs
dip afn
sub hig
spa
jmp drg
drn, skp 2
skp 4
jmp drn2
jmp drh
drn1, law rst1
dac dri /tape full
drn2, lac t
ior (add
xct drd
law e12 /tape full message
jmp i dri
drh, stf 4
drg, law 7777
and ofs
mta
lio afn
law 6000
jdp drum
lac t
sad (177000
jmp drk
law i 400
TAX
sas i 6400
jmp drk /block is nonzero
SXX=
jmp .-3
law 1000
adm t /block is all zero
jmp drl
nxtblk, 0
next, lac fb
rar 8s
xor dir
and (1
ior (776
sub fb
sma
sad fb
isp dir /always skips
TAAX|
jmp next
dac fb
jmp i nxtblk
j
drk, skp i 4
jmp tbp
law 377
lio b
A^IA=
dio 6377
tbp, lxr fb
tbp1, lio i dbt /load tape block descriptor block
TII=|
jmp tbp2
jdp nxtblk /get next block, block ptr left in A,X
sas (777
jmp tbp1
lio eflg
TIIP|
jmp drn1
dzm eflg
jmp tbp1
tbp2, lac (add
A+XIA
ior t
drd, dac
and (777
add (dbt
dap drd
idx eflg /have found free block on this pass
law 7777
A^II
lac (add 6000
jdp tpe
repeat pbs,jdp nxtblk /skip pbs blocks
jmp dre
>>76<<
sav, law 1
dac as
dac tem1
stf 2
jdp gtf
jmp sav1
clf 2
jdp gnu
dac af
dac as
dac tem1
szf 2
jmp sav1
jdp gnu
dac as
szf i 2
jmp erg
sav1, clf 2
sav2, jdp tf
nop
lac af
sad as
jmp . 3
idx af
jmp sav2
lio as
lac tem1
AMII
SAA
rar 6s
rir 6s
AMII
dio hig
sub (i 400
sav3, dac drum
law i 7777
ucp, ior
jdp uch
lac drum
wre-1, jdp dri
wre, law 600
dap wtd
jmp rst
g
loa, law 1
dac fld1
dzm fld2
jdp gtf
jmp loa1
clf 2
jdp gnu
dac fld1
dac af
szf 2
jmp loa1
jdp gnu
dac as
dac fld2
szf i 2
jmp erg
loa1, cla
jdp dro
lac fld1
dac af
lac fld2
dac as
jmp goa
name, lxr (-10.
nam1, law 77
lio i dbt 10.
ril 9s
tyo
A^II
A~IP|
jmp . 3
SXX=
jmp nam1
jmp rst
f
repeat if2,[
printo [ffb-4]x400-.
printx /
/]
3000/
ntb, ntb 1000/ /directory blogks (146x5 words + 2 word header)
dbt, dbt 1000/ /tape blocks
5000/ /program area 2 5000-5377
car, 0
cli>>05<<cmi
tyo
jmp i car
prn, 0
law 1
dap . 1
lio i
law i 3
dac t
prr, ril 6s
law 77
szs 10
jmp rst
A^IA|=
jmp i prn
tyo
isp t
jmp prr
idx prn 3
sas (lio i 4
jmp prn 3
jmp i prn
g
/check directory thoroughly
chd, 0
dap erb1 /error printout
law pdl 1
dap chf
lac ntb
dac pdl
ZX
chv6, lac i dbt
ior (200000
spa
sad i dbt
jmp erb
dac i dbt
chv, and (777
TAXP
jmp chv6
chv3, law i 1
adm chf
aam
lac chf
mrk, TAXP|
jmp chu
jdp ttx
lac i ntb
chf, dac .
ior (200000
sad i ntb
jmp erb
dac i ntb
idx chf
sad (dac pdl 37
jmp erb
lac i ntb+4
spa
jmp chv
sza
jmp mrk
erb, jdp car
law e13
jdp txp
erb1, law .
jdp txp
jdp bdmp /dump character buffer
idx wpm
jmp i chd
chu, lac (dac pdl
sas chf
jmp chv3
lac ntb+1
chw, TAXP|
jmp chx
jdp ttx
lac i ntb
ior (200000
sad i ntb
jmp erb
dac i ntb
and (-200000
jmp chw
chx, lxr (-776
chx+1, lac i ntb+1000
and (-200000
sad i ntb+1000
jmp erb
dac i ntb+1000
law 5
A+XXP
jmp chx+1
lxr (-1000
chy, lac i dbt 1000
sza i
jmp .+6
and (-200000
sza
sad i dbt+1000
jmp erb
dac i dbt+1000
SXXP
jmp chy
idx chd
jmp i chd
ttx, 0 /check that XR points to a directory block
law i 2
A+XA>P
jmp erb
mul (1
div . 1
5
law 1000
XMA>
sni i
jmp erb
jmp i ttx
constants
repeat ifp [.-5400],[printx /
data in program area 2 exceeds 400 words
/]
repeat if2,[printo 5400-.
printx /
/]
n 5400/ /variables
pdl, .+40/
af, 0
as, 0
sfp, 0
sx, 0
sga, 0
snx, 0
fla, 0
fle, 0
svl, 0
flf, 0
t, 0
bkp, 0
reu, 0
sve, 0
rsi, 0
ter, 0
sb, 0
ofs, 0
afn, 0
blk, 0
sp3, 0
nid, 0
hig, 0
bnl, 0
eflg, 0
dir, 0
fb, 0
tpe1, 0
tpe2, 0
fld1, 0
fld2, 0
wpm, 0
tem1, 0
van, van 4/
pnu, 0
tyin, 0 /pointer to character buffer
cbf, 0 /character buffer
6000/ /tape-drum buffer
6000/ /second directory buffer 6000-7777
6400/ /merge buffer 6400-6777
7400/ /character buffer 7400-7777
d /initialization
6000/
jmp in /replace file system
/here to initialize entire tape
ini, iam
clf 7
law m69
jdp txp
lxr (-1000
dzm i dbt 1000
SXX=
jmp .-2
jdp dirset
cli>>05<<cmi
law 2
dac ntb 1
ink, TAAX
sad (1000
jmp inj
law 5
X+AA
dac i ntb
dio i ntb 4
jmp ink
inj, dzm ntb 773
dzm ntb
inj1, law (774000
jdp chd
hlt /bad directory, don't write it
lio (dirlxi i dir2
lac (add ntb
ivk 16
hlt
lio (ffbxi
inj2, lac (hlt
dac 1
dac 3
lac ([ffb-dirl-1]xi 1
dac 0
dzm txp
dzm chd
lac (add
ivk 16
hlt
clc
ivk 16
hlt
dsm
m69, text /type tape name
_/
dirset, 0
lac (add
lxr (-ffb
ini1, SAA
cli
szf i 1
tyi
swp
sad (77
stf 1
swp
ril 9s
and (400777
A>>05<<IA
lio i dbt ffb
szf 6
cli
sni i
hlt
dac i dbt ffb /save out directory space
SXX=
jmp ini1
cli>>05<<cmi
tyo
law dir2-ffb
adm dbt ffb-1
lxr (-dirl-1
lio i dir2 dirl dbt 1
szf 6
cli
TIIP
jmp foob
SXX=
jmp .-6
fooc, lac dbt ffb-1
and (400777
lxr (-dirl-1
food, SAA
lio i dir2 dirl dbt 1
szf 6
cli
sni i
hlt
dac i dir2 dirl dbt 1
SXX=
jmp food /save secondary directory space
lac (add
dac i dir2 dirl dbt
jmp i dirset
r foob, law m70
jdp txp
tyi
ZI
lxr (-5
lac i dbt 1000
sza
SII /count blocks needed
SXX=
jmp .-4
cmi
lxr (-773
lac i dbt 773
sza i
SII
SXX=
jmp .-4
TII>P
jmp foob1 /not enough free blocks
law 773
dac n /block currently being moved
go1, lxr n
lac i dbt
sza i
jmp index /index n
lac (add
A+XI
lxr (dbt ffb
lac i
and (400777
A~IP|
jmp found /found block pointing to n
SXXA
sas (dbt 1000
jmp .-6
lxr (ntb 6 /look in directory blocks
go2, lac i /load value pointer
and (400777
A~IP|
jmp found /found pointer to block to be moved
law 5
A+XXA
sas (ntb 1004
jmp go2
hlt /not in directory blocks e.ther
found, /XR points to pointer to be redirected
TXI
lxr (dbt
lac i /find free block
sza i
jmp found2 /found free block
SXXA
sas (773 dbt
jmp .-5
hlt /no free block this can't happen
found2,
X.IX /X contains pointer to block to be redirected
law 777
A^II
cma
y and i /I contains pointer to free block
A>>05<<IA
dac i /redirect block
law 777
A^IA /A contains pointer to free block
dac acs
lxr n
lac i dbt
dzm i dbt
lxr acs
dac i dbt /move pointer from block to freed block
law 7400
lio n
ivk 16
hlt /read block
lio acs
lac (add 7400
ivk 16 /move block
hlt
index, idx n
sas (1000
jmp go1
jmp fooc
m70, text /tape blocks must be moved, type a character to continue
_/
foob1, law m71
jdp txp
dsm
m71, text /there are insufficient free blocks to move data
_/
n, 0
acs, 0
0 in, clf 7
iam
lio (dirlxi dir1
law ntb
ivk 16
hlt /read old directory
lac erb
dac erbs
lac (jmp i chd
dac erb /catch illegal directory returns
jdp chd
jmp fix /directory is no good by new standard
lac erbs
dac erb
lio (i 777
lac (add 5000
ivk 16
hlt
lio (ffbxi-dirlxi
jmp inj2
fix, law m69
jdp txp
lio ([dirlxi] dir1
law ntb
ivk 16
hlt
jdp dirset
lac erbs
dac erb
jmp inj1
erbs, 0
nme, clf 7
iam
stf 6
law ntb
lio (dirlxi dir1
ivk 16
hlt
law m69
jdp txp
jdp dirset
jmp inj1 /write file system and directory
constants
start 0
4