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