github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-04-30 05:35:36 +00:00
Code Issues Releases Wiki Activity
Files
7c877e3cbce5bb52335fde8724877ec3491463b5
PDP-10.its/src/alan/balanc.179
Eric Swenson b8d7034829 Added BALANC/MOVDIR. Resolves #467.
2017-03-14 07:07:41 -07:00

1757 lines
34 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
; -*- Midas -*-
title BALANCE - Balance directories.
a=:1
b=:2
c=:3
d=:4
e=:5
t=:6
tt=:7
x=:10
y=:11
z=:12
nam==:13
dev=:13
fn1=:14
fn2=:15
dir=:16
p=:17
ch==:0,,-1
chttyi==:1
chttyo==:2
chwall==:3
chdiri==:4
cherri==:5
chdski==:6
chdsko==:7
call=:pushj p,
return=:popj p,
save==:push p,
rest==:pop p,
flose=:.lose %lsfil
slose=:.lose %lssys
pause=:.break 16,100000
tyi=:.iot chttyi,
tyo=:.iot chttyo,
quit=:call .
$quit: trne %frdbg
pause
.logout 1,
define syscall name,args
.call [setz ? sixbit /name/ ? args(400000)]
termin
define conc foo,bar
foo!bar!termin
popj3: aos (p)
popj2: aos (p)
popj1: aos (p)
cpopj: return
%fl==:1,,525252
%fr==:0,,525252
%frdbg==:400000 ; Being debugged
%frwin==:200000
%frwal==:100000 ; Wall paper on
%frshh==:040000 ; TTY off
%frfn1==:020000 ; Translate FN1's
%frfn2==:010000 ; Translate FN2's
%freap==:004000 ; Copy reap bits
%frnbk==:002000 ; Don't do BACKUP LIST and BACKUP;TAPE hack
%frupd==:001000 ; Don't start any new FN1's on Y directory
%frdds==:000400 ; Directory redisplay needed
%frnds==:000200 ; Note redisplay needed
%frds==:%frdds\%frnds ; Some kind of redisplay needed
%frclr==:000100 ; Clear screen at next page break
%frnew==:000040 ; Only offer to move greatest numbered files
%frmov==:000020 ; Assume moving X -> Y
%fryes==:000010 ; Do default action without questions
; Ideas and Notes:
;
; Include a -complete- directory listing somewhere?
; (Including directory allocations etc.)
; What about .TAPEn directories?
; Offer to create a link and then write the target of the link?
datime"$$out==:1 ; printing dates and times
.insrt dsk:syseng;datime >
rfn"$$rfn==:1 ; reading filenames
rfn"$$switch==:1 ; hack switches
rfn"$$pfn==:1 ; printing filenames
.insrt dsk:syseng;rfn >
format"$$time==:1 ; Call DATIME for:
format"datime==:datime"twdasc ; ~Q
format"time==:datime"timasc ; ~:Q
format"date==:datime"datasc ; ~@Q
format"erri==:cherri ; ~E
format"$$pfn==:1 ; Call RFN for:
format"pfn==:rfn"pfn ; ~F
format"$$utab==:1 ; Track HPOS
.insrt dsk:syseng;format >
outstr: trnn %frwal
jrst outst1
save a
save b
syscall siot,[movei chwall ? a ? b]
slose
rest b
rest a
outst1: trne %frshh
return
syscall siot,[movei chttyo ? a ? b]
slose
return
.scalar hpos
define format &string&,args
call [
call $format
.zzz.==-1
irp arg,,[args]
save arg
.zzz.==.irpcnt
termin
hrroi a,[ascii string]
movei b,.length string
movni c,.zzz.+1
move d,hpos
jrst format"format]
termin
$forma: save a
save b
save c
save d
save [.+2]
jrst @-5(p)
movem d,hpos
rest d
rest c
rest b
rest a
rest (p)
return
; If it looks like an instruction, then it can't randomly clobber ACs.
terpri=:call .
skipn hpos
return
trne %frshh
jrst terpr1
tyo [^M]
tyo [^J]
terpr1: setzm hpos
trnn %frwall
return
.iot chwall,[^M]
.iot chwall,[^J]
return
page=:call .
trne %frshh
jrst page1
trze %frclr
jrst page2
tyo [^P]
tyo ["A]
tyo [^M]
tyo [^J]
jrst page1
page2: tyo [^P]
tyo ["C]
page1: trnn %frwal
return
.iot chwall,[^M]
.iot chwall,[^J]
skipe hpos
jrst terpr1
return
ttyoff=:call .
terpri
tro %frshh
return
ttyon=:call .
terpri
trz %frshh
return
psixtp==:cpopj
rsixtp: caie a,", ; comma terminates filespecs
cain a,"/ ; slash introduces a switch
aos (p)
return
switch: caie a,"u
cain a,"U
jrst [ tro %frupd ? trz %frmov ? return ]
caie a,"m
cain a,"M
jrst [ tro %frmov ? trz %frupd ? return ]
cain a,">
jrst [ tro %frnew ? return ]
caie a,"d
cain a,"D
jrst [ tro %frdbg ? trz %frwin ? return ]
cain a,"!
jrst [ tro %frwin ? return ]
cain a,"$
jrst [ tro %freap ? return ]
caie a,"b
cain a,"B
jrst [ tro %frnbk ? return ]
format "~&Unknown switch: ~C",a
syscall lose,[movei 0 ? movei cpopj]
slose
lpdl==:100.
.vector pdl(lpdl)
.scalar mname ; Name of this machine
usrvar: sixbit /OPTION/ ? tlo %opint\%opopc
sixbit /MASK/ ? move [%pirlt\%pipdl]
irps var,,[
option:
xuname:
xjname:
sname:
hsname:]
.scalar var ? sixbit /var/ ? movem var
termin
lusrvar==:.-usrvar
go: move p,[-lpdl,,pdl-1]
movei 0,%frclr ; Initial flags
setzm hpos
setzm xlist
setzm ylist
movei t,rltime
move tt,[%rlfls\%rlset,,t]
.realt tt,
.open chttyi,[.uai,,'tty ? setz ? setz]
slose
.open chttyo,[%tjdis\.uao,,'tty ? setz ? setz]
slose
syscall ttyset,[movei chttyi ; Nobody echos or interrupts
[%tgact*<010101,,010101>]
[%tgact*<010101,,010101>]]
slose
move tt,[-lusrvar,,usrvar]
syscall usrvar,[movei %jself ? tt]
slose
syscall sstatu,[repeat 6,[ ? movem mname]]
slose
move tt,xuname
camn tt,[sixbit /ALAN/] ; camn tt,hsname ?
tro %frwin\%freap
move tt,xjname
camn tt,[sixbit /UPDATE/]
tro %frupd
camn tt,[sixbit /MOVDIR/]
tro %frmov
lcmd==:100.
.vector cmd(lcmd) ; Command string
lbkhack==:6 ; Read on and weep...
.vector xnames(4+lbkhack) ; filenames
.vector ynames(4+lbkhack)
move t,option
tlnn t,%opcmd
jrst [ format "~&Use JCL."
quit ]
setzm cmd
move tt,[cmd,,cmd+1]
blt tt,cmd+lcmd-2
setom cmd+lcmd-1
.break 12,[..rjcl,,cmd]
move tt,mname
movem tt,xnames+0
movem tt,ynames+0
movsi tt,(sixbit /*/)
movem tt,xnames+1
movem tt,xnames+2
move tt,sname
movem tt,xnames+3
move d,[440700,,cmd]
movei b,xnames
call rfn"rfn
move tt,[xnames+1,,ynames+1]
blt tt,ynames+3
movei b,ynames
cain a,",
call rfn"rfn
move t,mname
movsi tt,(sixbit /DSK/)
camn tt,xnames+0
movem t,xnames+0
camn tt,ynames+0
movem t,ynames+0
movsi tt,(sixbit /*/)
camn tt,xnames+1
jrst [ camn tt,ynames+1
jrst cmdck2
jrst badcmd ]
camn tt,ynames+1
jrst badcmd
tro %frfn1
cmdck2: camn tt,xnames+2
jrst [ camn tt,ynames+2
jrst cmdok
jrst badcmd ]
camn tt,ynames+2
jrst badcmd
tro %frfn2
jrst cmdok
badcmd: format "~2&Can't mix wildcards like this:~
~2& ~F vs. ~F~2&",[[[xnames]],[[ynames]]]
quit
cmdok:
.insrt dsk:syseng;fsdefs >
lmfd==:2000 ; Size of the MFD
lufd==:2000 ; Size of a UFD
nfiles==:lufd/lunblk ; More than the maximum number of files on
; a directory.
ndirs==:2 ; Two directories
; Format of a file description:
f.nam==:0 ; File names, must be first for the
f.dev==:0 ; convenience of various routines.
f.fn1==:1
f.fn2==:2
f.dir==:3
f.vers==:4 ; Version number or -1
f.rndm==:5 ; UNLINK, UNDUMP, UNREAP, UNPACK
f.date==:6 ; Creation date and time
f.ref==:7 ; Reference date
f.len==:10 ; Length in words or 0
f.auth==:11 ; Author in SIXBIT or 0
f.lnam==:12 ; Link target names
f.ldev==:12 ; (Same as f.dev)
f.lfn1==:13
f.lfn2==:14
f.ldir==:15
f.nxn1==:16 ; Next FN1 in directory
f.nxn2==:17 ; Next FN2 in directory
f.nxvr==:20 ; Next (smaller) version in directory
f.pair==:21 ; Buddy in other directory
f.id==:22 ; Creation date of target of contents
; 0 => not computed yet
; -<n> => link to non-ex file with error <n>
f.act==:23 ; Action to perform with this file or 0
f.size==:24 ; Size of a file description.
ldescrs==:f.size*nfiles*ndirs ; Allocate enough of 'em
.vector descrs(ldescrs)
.scalar fdescr ; Free pointer into DESCRS
movei tt,descrs
movem tt,fdescr
.scalar xdir,ydir
movei d,xnames
call dodir
movem c,xdir
movei d,ynames
call dodir
movem c,ydir
bkxtape==:4+0
bkytape==:4+1
bkxlist==:4+2
bkylist==:4+3
bkxpack==:4+4
bkypack==:4+5
lbkhack==:6
irp xy,,[x,x,x,y,y,y]yx,,[y,y,y,x,x,x]taplis,,[tape,list,pack,tape,list,pack]
move t,xy!names+0
move tt,[sixbit /TAPLIS/]
movem tt,xy!names+bk!xy!taplis
call sixsuf
movem t,yx!names+bk!xy!taplis
termin
move tt,xnames+0
camn tt,ynames+0
tro %frnbk ; Don't do hack on same machine...
move a,xdir
move b,ydir
movei d,xnames
movei e,ynames
call pairup
move a,ydir
move b,xdir
movei d,ynames
movei e,xnames
call pairup
.open chwall,[.uao,,'dsk ? sixbit /wall/ ? sixbit />/]
slose
ttyoff
tro %frwal
format "~&~F vs. ~F~&Flags: ",[[[xnames]],[[ynames]]]
trne %frdbg
format "Debugging, "
trne %frupd
format "Update Mode, "
trne %frmov
format "Move Mode, "
trnn %frupd\%frmov
format "Balance Mode, "
trne %frwin
format "Winner, "
trne %frnew
format "Newest Only, "
trne %freap
format "Reap Bits, "
trne %frnbk
format "No "
format "Backup Hack"
ttyon
skipn b,ydir
jrst loop3
loop1: move y,f.fn1(b)
trne %frfn1
came y,1(d)
skipa
move y,1(e)
move x,xdir
call findn1
move c,x
movem c,xlist
movem b,ylist
tro %frdds
move a,b
loop2: movei d,ynames
movei e,xnames
call proces
jrst loop22
skipe a,f.nxn2(a)
jrst loop2
skipn a,c
jrst loop29
loop21: movei d,xnames
movei e,ynames
call proces
jrst loop27
skipe a,f.nxn2(a)
jrst loop21
jrst loop29
loop22: movsi t,unigfl
iorm t,f.rndm(a)
skipe a,f.nxn2(a)
jrst loop22
skipn a,c
jrst loop29
loop27: movsi t,unigfl
iorm t,f.rndm(a)
skipe a,f.nxn2(a)
jrst loop27
loop29: skipe b,f.nxn1(b)
jrst loop1
loop3: trnn %frupd
loop4: skipn b,xdir
jrst loop7
loop5: move a,b
setzm ylist
movem b,xlist
tro %frdds
loop6: movei d,xnames
movei e,ynames
trne %frmov
tro %fryes
call proces
jrst loop69
trz %fryes
skipe a,f.nxn2(a)
jrst loop6
loop69: trz %fryes
skipe b,f.nxn1(b)
jrst loop5
loop7: setzm ylist
setzm xlist
move t,[format "Start working"
]
call yornp
.value
trz %frwal
.close chwall,
format "~2&Working..."
movei d,xnames
movei e,ynames
skipe c,xdir
call work1
movei d,ynames
movei e,xnames
skipe c,ydir
call work1
format "~2&Finished."
quit
work1: move b,c
work2: move a,b
work3: skipe t,f.act(a)
call (t)
skipe a,f.nxvr(a)
jrst work3
skipe b,f.nxn2(b)
jrst work2
skipe c,f.nxn1(c)
jrst work1
return
.scalar xlist,ylist ; Directory to display
.scalar note ; Note
; CALL REDISP: Redisplay if needed.
redisp: save a
trzn %frdds
jrst rdisp1
page
move a,xlist
call lstfn1
move a,ylist
call lstfn1
terpri
rdisp1: trze %frnds
skipn note
jrst rdisp2
terpri
xct note
terpri
rdisp2: rest a
return
; Action codes:
nxtfn1==:1 ; Next FN1
nxtfn2==:2 ; Next FN2
nxtvrs==:3 ; Next version
nxtopt==:4 ; Next option
flink=:format "Link"
alink: movei tt,link
movem tt,f.act(a)
movei t,nxtvrs
return
fcopy=:format "Copy"
acopy: movei tt,copy
movem tt,f.act(a)
movei t,nxtvrs
return
irpw line,,[
-2,,["N ? 177]
format "Nothing"
format "Do nothing. Advance to next option or file"
[ movei t,nxtopt ? return ]
-1,,["F]
format "New File"
format "Skip to next file"
[ movei t,nxtvrs ? return ]
-1,,["T]
format "New Type"
format "Skip to next type of file"
[ movei t,nxtfn2 ? return ]
-1,,["G]
format "New Group"
format "Skip to next group of files"
[ movei t,nxtfn1 ? return ]
-1,,["*]
format "**NOTE**"
format "Make a note of this entry for later"
popj1
]
conc $usl,\.irpcnt,==:line
.usl.==.irpcnt
termin
nusual==:.usl.+1
define usual
repeat nusual, conc $usl,\.rpcnt
termin
; CALL AMOVE: Consider moving a file or link.
; A (a/v): File description of source
; B (a/v): Filename block of target
; D (a/v): First translation filename block
; E (a/v): Second translation filename block
; T (val): Action code
; Clobbers DEV, DIR, FN1, FN2
amove: move tt,f.rndm(a)
tlne tt,unlink ; File or link?
jrst amove1 ; There are more options with a link...
trne %fryes
jrst acopy
call redisp
move t,[format "Copy ~F ",[a]]
move tt,[-lqmove,,qmove]
jrst choose
linkbx=:format "Link ~F to ~F ",[b,x]
copyab=:format "Copy ~F into ~F ",[a,b]
qmove: -3,,["C ? "Y ? 40]
fcopy
copyab
acopy
usual
lqmove==:.-qmove
amove1: trne %fryes
jrst alink
call redisp
save b
movei b,f.lnam(a)
call trans
rest b
move x,a
call ident ; Check out target of link
came t,[-%enapk] ; Unless problem was offline pack
jumpl t,amove2 ; There are less options with a null link...
movei x,nam
move t,[format "Copy link or data ~F ",[a]]
move tt,[-lqmov1,,qmov1]
jrst choose
qmov1: -2,,["L ? 40]
flink
linkbx
alink
-1,,["C]
fcopy
copyab
acopy
usual
lqmov1==:.-qmov1
amove2: movei x,nam
move t,[format "Copy null link ~F ",[a]]
move tt,[-lqmov2,,qmov2]
jrst choose
qmov2: -3,,["L ? "Y ? 40]
flink
linkbx
alink
usual
lqmov2==:.-qmov2
; CALL PROCES: Process a file description
; Fails to skip if the user wants the next FN1 group
; A (a/v): File description
; D (arg): First translation filename block
; E (arg): Second translation filename block
proces: save a
save b
save c
movei b,f.nam(a)
call matchp
jrst procex
movsi t,unigfl ; Don't process a file twice
tdne t,f.rndm(a) ; (Non-standard use of UNIGFL...)
jrst procex
iorm t,f.rndm(a)
movei c,procnp
skipn b,f.pair(a)
jrst procdo
came a,f.pair(b)
.lose
tdne t,f.rndm(b)
.lose
iorm t,f.rndm(b)
movei c,procvr
skipl f.vers(a)
jrst procdo
movsi tt,unlink
movei c,procbd
tdne tt,f.rndm(a) ; If both files are links
tdnn tt,f.rndm(b) ; that point to the "same" place,
jrst procdo ; then don't complain.
movei b,f.lnam(a)
call trans
move b,f.pair(a)
camn dev,f.ldev(b)
came dir,f.ldir(b)
jrst procdo
camn fn1,f.lfn1(b)
came fn2,f.lfn2(b)
jrst procdo
jrst procex
procdo: call (c) ; Routine returns action code in T
caie t,nxtfn1
procex: aos -3(p)
trz %frnds ; Invalidate any note
setzm note
rest c
rest b
rest a
return
.scalar tnames(4) ; Temporary filename block
; Process file(s) with no buddy
procnp: setoi c, ; Loop back to version -1 (forever)
prcnp1: movei b,f.nam(a)
call trans
movem dev,tnames+0
movem fn1,tnames+1
movem fn2,tnames+2
movem dir,tnames+3
movei b,tnames
call amove
caie t,nxtfn1
cain t,nxtfn2
return
trnn %frnew
skipn a,f.nxvr(a)
return
caml c,f.vers(a)
return
jrst prcnp1
; Process unversioned buddies:
procbd: call samep
jrst prcbd1
movei t,nxtfn2
return
prcbd1: skipg x,f.id(a)
jrst prcbd2
skipg y,f.id(b)
jrst xnew ; Only X entry has data
;; Both entries have data, but it differs.
camg x,y
jrst ynew ; Y data is newer
jrst xnew ; X data is newer
prcbd2: skipl y,f.id(b)
jrst ynew ; Only Y entry has data
;; Both entries are null links, but they have different targets
move tt,f.date(a)
camge tt,f.date(b)
jrst ynew ; Y link is newer
jrst xnew ; X link is newer
; X file looks newest
xnew: call amove
caie t,nxtopt
return
exch a,b
exch d,e
jrst amove
; Y file looks newest
ynew: exch a,b
exch d,e
call amove
caie t,nxtopt
return
ynew1: exch a,b
exch d,e
jrst amove
; Process two series of versioned files
procvr: call forkp
jrst prcvr1
move t,[
format "**NOTE** These files look like they have forked!"
]
movem t,note
tro %frnds ; Set up a note
prcvr1: move t,f.vers(a)
camle t,f.vers(b)
jrst prcvrx ; X files are more recent
camge t,f.vers(b)
jrst prcvry ; Y files are more recent
jrst procbd ; Versions match, simple case
prcvry: exch a,b
exch d,e
prcvrx: move c,f.vers(b) ; Loop back to newest version in other
jrst prcnp1 ; directory
; CALL FORKP: Check two series of versioned files for possible forking
; A (a/v): First description list
; B (a/v): Second description list
forkp: save a
save b
forkl: skipge t,f.vers(a)
.lose
skipge f.vers(b)
.lose
camge t,f.vers(b)
jrst forkal
camle t,f.vers(b)
jrst forkag
call diffp ; Same version numbers
jrst nofork
jrst isfork ; but definitely different data
; A has greater version number
forkag: call oldp
jrst forkla
jrst isfork ; but is definitely older
; A has smaller version number
forkal: call newp
jrst forklb
jrst isfork ; but is definitely newer
forkla: skipn a,f.nxvr(a) ; Step A
jrst nofork
jrst forkl
forklb: skipn b,f.nxvr(b) ; Step B
jrst nofork
jrst forkl
isfork: aos -2(p)
nofork: rest b
rest a
return
lbuffer==:2000
.vector buffer(lbuffer)
; CALL COPY: Copy data from directory to directory
; CALL LINK: Copy a link from directory to directory
; A (a/v): Source file description
; D (a/v): First translation filename block
; E (a/v): Second filename translation block
; Clobbers DEV, DIR, FN1, FN2
copy: save b
movei b,f.nam(a)
call trans
syscall open,[[%donrf\.bii,,chdski] ? moves t
0(b) ? 1(b) ? 2(b) ? 3(b)]
jrst [ cain t,%enapk
jrst copypk
syscall lose,[movei %lsfil(t) ? movei .-1]
slose ]
syscall open,[[.bio,,chdsko]
dev
[sixbit /_BLNC_/]
[sixbit /OUTPUT/]
dir]
flose
copylp: move t,[-lbuffer,,buffer]
.iot chdski,t
hrloi tt,-1-buffer(t)
eqvi tt,buffer
.iot chdsko,tt
jumpge t,copylp
syscall filblk,[movei chdski
repeat 3, movem x
movem y
movem z]
flose
syscall rauth,[movei chdski ? movem t]
flose
.close chdski,
syscall sauth,[movei chdsko ? t]
flose
syscall sfdate,[movei chdsko ? y]
flose
hllz z,z
syscall srdate,[movei chdsko ? z]
flose
tlne x,unreap
trnn %freap
jrst copyex
syscall sreapb,[movei chdsko ? movei 1]
flose
copyex: syscall renmwo,[movei chdsko ? fn1 ? fn2]
flose
.close chdsko,
rest b
return
copypk: move tt,f.dev(a)
movem tt,f.ldev(a)
move tt,[sixbit /BACKUP/]
movem tt,f.ldir(a)
move tt,[sixbit /PACK/]
movem tt,f.lfn1(a)
ldb t,[unpkn f.rndm(a)]
call numsix
movem x,f.lfn2(a)
jrst linkpk
link: save b
move tt,f.rndm(a)
tlnn tt,unlink
.lose
movei b,f.nam(a)
call trans
linkpk: save dev ; -3(P)
save fn1 ; -2(P)
save fn2 ; -1(P)
save dir ; -0(P)
movei b,f.lnam(a)
call trans
came dev,-3(p)
.lose
syscall mlink,[move -3(p) ? move -2(p) ? move -1(p) ? move -0(p)
fn1 ? fn2 ? dir]
flose
syscall open,[[%donlk\.bii,,chdsko]
move -3(p) ? move -2(p) ? move -1(p) ? move -0(p)]
flose
syscall sauth,[movei chdsko ? f.auth(a)]
jfcl ; MLDEV has this bug...
syscall sfdate,[movei chdsko ? f.date(a)]
jfcl
syscall srdate,[movei chdsko ? f.ref(a)]
jfcl
.close chdsko,
sub p,[4,,4]
rest b
return
; CALL SAMEP: Compare the identities of two files.
; CALL DIFFP: Compare the identities of two files.
; CALL NEWP: Compare the identities of two files.
; CALL OLDP: Compare the identities of two files.
; Skips if A's data seems to be {the same as, different from, newer than,
; older than} B's data.
; Sets F.ID and F.LEN in both descriptions
; A (a/v): File description
; B (a/v): File description
samep: call idcomp
return
return
aos (p)
return
diffp: call idcomp
return
aos (p)
return
aos (p)
return
newp: call idcomp
return
return
return
aos (p)
return
oldp: call idcomp
return
aos (p)
return
return
; 0: A ? B
; 1: A < B
; 2: A = B
; 3: A > B
idcomp: move x,b
call ident
move x,a
call ident
jumpl t,cpopj ; Error code: no data
skipge f.id(b)
return ; Error code: no data
camge t,f.id(b)
jrst popj1 ; A < B
camle t,f.id(b)
jrst popj3 ; A > B
camn tt,f.len(b)
jrst popj2 ; A = B
return ; Dates match, but lengths dont?
; CALL IDENT: Get the identity of a file. Set F.ID and F.LEN.
; X (a/v): File description
; T (val): F.ID(X)
; TT (val): F.LEN(X)
ident: move tt,f.len(x)
skipe t,f.id(x)
return
move tt,f.rndm(x)
tlne tt,unlink
jrst ident1
move t,f.date(x)
ident9: tlz t,600000 ; Can these ever get set? Be certain...
skipn t
movei t,1 ; 0/0/0 0:0:0.0 => 0/0/0 0:0:0.5
ident8: movem t,f.id(x)
move tt,f.len(x)
return
ident1: syscall open,[[%donrf\.bii,,chdski] ? moves t
f.ldev(x) ? f.lfn1(x) ? f.lfn2(x) ? f.ldir(x)]
jrst [ movn t,t ? jrst ident8 ]
syscall fillen,[movei chdski ? movem f.len(x)]
slose
syscall rfdate,[movei chdski ? movem t]
slose
.close chdski,
jrst ident9
; CALL PAIRUP: Pair up entries from two directories.
; A (a/v): First directory
; B (a/v): Second directory
; D (a/v): First translation filename block
; E (a/v): Second translation filename block
; Clobbers: DEV, DIR, FN1, FN2
pairup: jumpe a,cpopj
save a
save b ; -2(P): Second directory
save c
pairl1: save f.nxn1(a) ; -0(P): Remainder of first directory
pairl2: skipe f.pair(a)
jrst pairnx
movei b,f.nam(a)
call matchp
jrst pairnx
call trans
move c,-2(p)
call find
jumpe c,pairnx
skipe f.pair(c)
jrst pairnx
movem a,f.pair(c)
movem c,f.pair(a)
pairnx: skipe a,f.nxn2(a)
jrst pairl2
rest a
jumpn a,pairl1
rest c
rest b
rest a
return
; CALL MATCHP: Skip if description matches pattern
; B (a/v): Filename block
; D (a/v): Pattern filename block
matchp: move tt,1(b)
trne %frfn1
camn tt,1(d)
skipa tt,2(b)
return
trne %frfn2
camn tt,2(d)
aos (p)
return
.vector ufd(lufd)
.vector mfd(lmfd)
; CALL DODIR: Read in and process a directory.
; C (val): linked list of descriptions
; D (a/v): pattern filename block
dodir: save a
save b
save e
move c,[.bii,,chdiri]
movei a,ufdblk
.call open
call nsdrck
move tt,[-lufd,,ufd]
.iot chdiri,tt
movei a,mfdblk
.call open
flose (e)
move tt,[-lmfd,,mfd]
.iot chdiri,tt
syscall rfname,[movei chdiri ? movem t]
flose
.close chdiri,
camn t,[sixbit /DSK/]
move t,mname
movem t,0(d) ; Set translated device name
move t,ufd+udname
movem t,3(d)
move a,ufd+udnamp
movei a,ufd(a) ; A: current UFD name block
push p,[0] ; (P): directory
jrst dodir1
dodir2: move tt,unrndm(a)
skipe unfn1(a)
tlne tt,unigfl
jrst dodir3
call mkdesc
movei e,(p)
call insert
dodir3: addi a,lunblk
dodir1: caige a,ufd+lufd
jrst dodir2
rest c
rest e
rest b
rest a
return
; CALL INSERT: Insert file description in a directory.
; B (arg): description
; E (arg): pointer to cell containing directory
insert: save a
insrt0: skipn a,(e)
jrst insrt1 ; End of dir, insert here
move x,f.fn1(a)
move y,f.fn1(b)
camn x,y
jrst insrt2 ; Found matching FN1
call sixtst
jrst insrt1 ; This entry is larger, insert here
movei e,f.nxn1(a) ; This entry is smaller, keep looking
jrst insrt0
insrt1: movem a,f.nxn1(b)
insrtx: movem b,(e)
rest a
return
insrt2: move y,f.nxn1(a)
movem y,f.nxn1(b)
skipl y,f.vers(b)
jrst insrt4 ; Inserting numeric FN2
insrt9: move x,f.fn2(a)
move y,f.fn2(b)
camn x,y
.lose ; FN2 shouldn't also match
call sixtst
jrst insrt3 ; This entry is larger, insert here
movei e,f.nxn2(a)
skipe a,(e) ; Check for end of dir
jrst insrt9
insrt3: movem a,f.nxn2(b)
jrst insrtx
insrt4: skipge x,f.vers(a)
jrst insrt3 ; This entry not numeric, insert here
move tt,f.nxn2(a)
movem tt,f.nxn2(b)
insrt6: camn x,y
.lose ; Can't be same version number
camg x,y
jrst insrt5 ; This entry is smaller, insert here
movei e,f.nxvr(a)
skipn a,(e) ; Check for end of dir
jrst insrt5
skipge x,f.vers(a)
.lose ; Better have a version
jrst insrt6
insrt5: movem a,f.nxvr(b)
jrst insrtx
; CALL FIND: Find a given file in a directory
; C (arg): Head of directory
; DEV (a/v): Device
; DIR (a/v): Directory
; FN1 (a/v): First name
; FN2 (a/v): Second name
; C (val): Found file description, or zero if none found
find: jumpe c,cpopj
came dev,f.dev(c)
.lose ; Device better match
came dir,f.dir(c)
.lose ; Directory better match too
find1: camn fn1,f.fn1(c)
jrst find2 ; FN1 matches, do FN2
skipn c,f.nxn1(c)
return ; No matches found.
jrst find1
find2: move x,fn2
call sixnum ; See if FN2 is numeric
jrst find4 ; Nope, just search for FN2
find3: skipge f.vers(c) ; Yup, find first numeric name
skipn c,f.nxn2(c)
return
jrst find3
find4: came fn2,f.fn2(c)
skipn c,f.nxn2(c)
return
jrst find4
; CALL FINDN1: Find files with matching first names
; X (arg): Head of directory to search
; Y (a/v): FN1 to look for
; X (val): Matching files
findn1: jumpe x,cpopj
fndn11: came y,f.fn1(x)
skipn x,f.nxn1(x)
return
jrst fndn11
; CALL TRANS: Translate a name from one directory to another
; B (a/v): Filename block to translate
; D (a/v): Translation input filename block
; E (a/v): Translation output filename block
; DEV (val): Translated device
; DIR (val): Translated directory
; FN1 (val): Translated first name
; FN2 (val): Translated second name
trans: move dev,0(b)
move dir,3(b)
move fn1,1(b)
move fn2,2(b)
came dev,0(d)
.lose ; Device better match
move dev,0(e)
came dir,3(d) ; Check directory
jrst trans1 ; Different directory
move dir,3(e) ; Translate directory and possibly other names
trne %frfn1 ; If translating FN1's,
came fn1,1(d) ; and this is a match,
skipa
move fn1,1(e) ; translate FN1
trne %frfn2
came fn2,2(d)
skipa
move fn2,2(e) ; Same for FN2
trans1: trne %frnbk
return ; Suppressing backup hack
call trans2
call trans3
call trans4
return
trans2: came fn1,[sixbit /BACKUP/] ; *;BACKUP LIST ?
return
camn fn2,bkxlist(d)
jrst [ move fn2,bkxlist(e)
return ]
camn fn2,bkylist(d)
move fn2,bkylist(e)
return
trans3: came dir,[sixbit /BACKUP/] ; BACKUP;TAPE * ?
return
camn fn1,bkxtape(d)
jrst [ move fn1,bkxtape(e)
return ]
camn fn1,bkytape(d)
move fn1,bkytape(e)
return
trans4: came dir,[sixbit /BACKUP/] ; BACKUP;PACK * ?
return
camn fn1,bkxpack(d)
jrst [ move fn1,bkxpack(e)
return ]
camn fn1,bkypack(d)
move fn1,bkypack(e)
return
; CALL MKDESC: Make a file description.
; A (a/v): pointer to UFD name block
; B (val): file description
; D (a/v): filename block containing correct device
mkdesc: move b,fdescr
movei tt,f.size
addb tt,fdescr
caile tt,descrs+ldescrs
.lose ; No free space!
hrlzi tt,0(b)
hrri tt,1(b)
setzm tt,0(b) ; Zero out the new description
blt tt,f.size-1(b)
move tt,0(d)
movem tt,f.dev(b)
movem tt,f.ldev(b)
move tt,ufd+udname
movem tt,f.dir(b)
move tt,unfn1(a)
movem tt,f.fn1(b)
move tt,unfn2(a)
movem tt,f.fn2(b)
move tt,unrndm(a)
tlne tt,unigfl
.lose
movem tt,f.rndm(b)
move tt,undate(a)
movem tt,f.date(b)
hllz tt,unref(a)
movem tt,f.ref(b)
call rdauth
movem x,f.auth(b)
call rdlen
movem x,f.len(b)
call rdlink
movem x,f.ldir(b)
movem y,f.lfn1(b)
movem z,f.lfn2(b)
move x,f.fn2(b)
call sixnum
setoi x,
movem x,f.vers(b)
return
; CALL PFILE: Print the description of a file.
; A (a/v): file description
pfile: move t,f.rndm(a)
tlne t,unlink
jrst pfile1
terpri
ldb tt,[unpkn t]
format "~2T~D ",tt
pnames==:format "~6T~S ~13T~S ",[f.fn1(a),f.fn2(a)]
pnames
format "~21T~6<~D~> ",f.len(a)
tlnn t,undump
format "~39T!"
tlne t,unreap
format "~40T$"
jrst pfile2
pfile1: format "~& L "
pnames
format "~21T~S;~S ~S",[f.ldir(a),f.lfn1(a),f.lfn2(a)]
pfile2: format " ~43T~Q (~@Q)",[f.date(a),f.ref(a)]
skipn t,f.auth(a)
return
came t,f.dir(a)
format " ~S",t
return
; CALL LSTFN1: List a group of files with the same first name
; A (a/v): First description in group.
lstfn1: jumpe a,cpopj
format "~&~S:~S;",[f.dev(a),f.dir(a)]
save a
save b
move b,a
lstn10: move a,b
lstn11: call pfile
skipe a,f.nxvr(a)
jrst lstn11
skipe b,f.nxn2(b)
jrst lstn10
rest b
rest a
return
; CALL LSTDIR: List a directory.
; C (a/v): First description in directory.
lstdir: jumpe c,cpopj
format "~&~S:~S;",[f.dev(c),f.dir(c)]
save a
save b
save c
lstdr3: move b,c
lstdr2: move a,b
lstdr1: call pfile
skipe a,f.nxvr(a)
jrst lstdr1
skipe b,f.nxn2(b)
jrst lstdr2
skipe c,f.nxn1(c)
jrst lstdr3
rest c
rest b
rest a
return
; CALL SIXNUM: Convert SIXBIT to a version number.
; Skips if SIXBIT is numeric
; X (arg): A word of SIXBIT
; X (val): Version number (if skip)
sixnum: move tt,x
setzi x,
sixnm1: setzi t,
lshc t,6
cail t,'0
caile t,'9
return
jumpn x,sixnm2
cain t,'0
jumpn tt,cpopj ; First, but not last, char is "0"
sixnm2: imuli x,10.
addi x,-'0(t)
jumpn tt,sixnm1
aos (p)
return
; CALL NUMSIX: Convert a version number (mod 1000000.) to SIXBIT
; T (arg): Version number
; X (val): SIXBIT
numsix: setzi x,
idiv t,[1000000.]
skipge t,tt
add t,[1000000.]
numsx1: idivi t,10.
movei tt,'0(tt)
lshc tt,-6
jumpn t,numsx1
return
; CALL SIXSUF: Append SIXBIT suffux
; T (a/v): Word of SIXBIT
; TT (arg): Suffix (will be truncated if too long)
sixsuf: save t
jumpe t,sixsf2
sixsf1: lsh t,6
lsh tt,-6
jumpn t,sixsf1
sixsf2: rest t
ior t,tt
return
; CALL SIXTST: Skip if first arg is smaller under filename order.
; X (arg): First arg (SIXBIT)
; Y (arg): Second arg (SIXBIT)
sixtst: save x ; -1(P): first arg
save y ; -0(P): second arg
call sixnum
jrst sixts1
exch x,(p) ; -0(P): first arg as number
call sixnum
jrst sixts2 ; First is number, second isn't
camle x,(p) ; Both are numbers, compare numerically
sixts2: aos -2(p)
sub p,[2,,2]
return
sixts1: move x,(p)
call sixnum
jrst sixts3 ; Neither is a number
sub p,[2,,2] ; Second is number, first isn't
return
sixts3: rest y ; Alphabetical order
rest x
tlc x,400000
tlc y,400000
camge x,y
aos (p)
return
; CALL RDLEN: Compute length of a file.
; A (a/v): pointer to UFD name block
; X (val): length in words
; Unfortunately nobody respects the byte size and length-in-bytes
; information, otherwise this would be the place to compute it. Perhaps
; there needs to be a way to SET the byte size and length information to
; make that stuff really usable?
rdlen: setzi x,
move t,unrndm(a)
tlne t,unlink
return ; Links are of length 0
ldb t,[undscp t]
ifn ufdbyt-6, .err UFDBYT changed!
idivi t,6
addi t,ufd+uddesc
hrl t,sixbps(tt) ; T: descriptor BP
jrst rdlen1
rdlen2: add x,tt ; Take next TT blocks
rdlen1: ildb tt,t ; TT: next desc byte
jumpe tt,rdlen3 ; No more
caig tt,udtkmx
jrst rdlen2
caige tt,udwph
aoja x,rdlen1 ; Skip some, then take 1
cain tt,udwph
jrst rdlen1 ; Ignore placeholder
repeat nxlbyt, ibp t ; Load address, then take 1
aoja x,rdlen1
rdlen3: imuli x,2000
ldb t,[unwrdc unrndm(a)]
jumpe t,cpopj ; No padding in last block
addi x,(t)
subi x,2000
return
; CALL RDLINK: Compute the target of a link.
; A (a/v): pointer to UFD name block
; X (val): DIR of link
; Y (val): FN1 of link
; Z (val): FN2 of link
rdlink: save c
setzb x,y
setzi z,
move t,unrndm(a)
tlnn t,unlink
jrst popcj ; Return zeros if not link
ldb t,[undscp t]
ifn ufdbyt-6, .err UFDBYT changed!
idivi t,6
addi t,ufd+uddesc
hrl t,sixbps(tt) ; T: descriptor BP
move c,[440600,,x] ; C: names BP
jrst rdlnk1
rdlnk2: cain tt,';
jrst [ tlz c,770000 ? jrst rdlnk1 ]
cain tt,':
ildb tt,t
idpb tt,c
rdlnk1: ildb tt,t
jumpn tt,rdlnk2
popcj: rest c
return
; CALL RDAUTH: Read the author of a file
; A (a/v): pointer to UFD name block
; X (val): SIXBIT name of author
rdauth: ldb t,[unauth unref(a)]
sub t,mfd+mdnuds
setzi x, ; Return 0 if no author known
jumpge t,cpopj
lsh t,1
move x,mfd+lmfd(t)
return
; .CALL OPEN: Open a file
; A (a/v): pointer to UFD name block
; C (a/v): <mode bits>,,<channel>
; D (a/v): directory filename block
; E (val): error code
open: setz ? sixbit /OPEN/
moves e
move c
move 0(d)
move unfn1(a)
move unfn2(a)
setz 3(d)
; CALL NSDRCK: Consider creating a non-existent directory.
; Assumes the previous instruction was .CALL OPEN
nsdrck: trne %frwin
caie e,%ensdr
jrst nsdrer
move t,[format "Create directory ~S on ~S",[3(d),0(d)]]
call yornp
jrst nsdrer
save a
movei a,newblk
.call open
caie e,%ensfl
.lose
rest a
rest tt
jrst -2(tt)
nsdrer: rest tt
syscall lose,[movei %lsfil(e) ? movei -2(tt)]
slose
; CALL YORNP: Ask the user a Y or N question.
; Skips if the answer is Y.
; T (arg): Instruction to XCT to pose the question.
yornp: move tt,[-lqyornp,,qyornp]
; CALL CHOOSE: Offer the user a bunch of choices.
; T (arg): Instruction to XCT to pose the question
; TT (arg): Aobjn to a choice table
; -4n,,[
; -k(1),,[c(1,1) ? ... ? c(1,k(1))]
; format "Short Echo",a
; format "Long Description for Help",[a,b,c,x,y,z]
; 0,,<routine>
; -k(2),,[c(2,1) ? ... ? c(2,k(2))]
; etc. ]
; Routine can skip to cause the choice to happen again.
choose: push p,t ; -2(P): question poser
push p,tt ; -1(P): choice table
push p,x ; -0(P): old X
chose1: terpri
move x,-0(p)
xct -2(p)
move t,-1(p)
move tt,(t)
move x,(tt)
format " (~A",asctab(x)
jrst chose4
chose2: move tt,(t)
move x,(tt)
format ", ~A",asctab(x)
chose4: repeat 3, aobjn t,.+2 ? .lose
aobjn t,chose2
format ") ? "
tyi x
caie x,%txtop+"H
cain x,"?
jrst chose7
cain x,^L
jrst chse14
andi x,177
cail x,"a
caile x,"z
skipa
subi x,"a-"A
move t,-1(p)
chose5: move tt,(t)
came x,(tt)
aobjn tt,.-1
jumpl tt,chose6
repeat 3, aobjn t,.+2 ? .lose
aobjn t,chose5
format "~A?",asctab(x)
tyo [^G] ; Don't feep on my wallpaper
jrst chose1
chose6: move x,-0(p)
xct 1(t)
call @3(t)
jrst chse61
jrst chose1
chse61: sub p,[3,,3]
return
chse14: tro %frds\%frclr
call redisp
jrst chose1
chose7: format "Help"
move t,-1(p)
chose8: move tt,(t)
move x,(tt)
format "~&~A",asctab(x)
jrst chose9
chse81: move x,(tt)
format ", ~A",asctab(x)
chose9: aobjn tt,chse81
format "~15T"
move x,-0(p)
xct 2(t)
format "."
repeat 3, aobjn t,.+2 ? .lose
aobjn t,chose8
jrst chose1
qyornp: -2,,["Y ? 40]
format "Yes"
xct -2(p) ; Total kludge
[ aos -4(p) ? return ] ; Worse kludge
-2,,["N ? 177]
format "No"
format "Don't"
cpopj
lqyornp==:.-qyornp
tsint:
loc 42
-ltsint,,tsint
loc tsint
p
%pirlt ? 0 ? %pirlt ? 0 ? rltint
ltsint==:.-tsint
dismis: setz ? sixbit /DISMIS/
setz p
disint: .call dismis
slose
rltime==:10.*60. ; Every 10 seconds give the ML device a kick.
rltint==:disint
define maktab start=.loc.,stop=.loc.,body
ifn .loc.-<start>, .err Bad entry at: start
.cnt.==<stop>-.loc.+1
repeat .cnt.,[
body
.loc.==.loc.+1]
termin
asctab: .loc.==0
maktab 0,^F,[440700,,[<"^>_29.+<.loc.+"@>_22.]]
maktab ^G,,[440700,,[asciz "Bell"]]
maktab ^H,,[440700,,[asciz "Backspace"]]
maktab ^I,,[440700,,[asciz "Tab"]]
maktab ^J,,[440700,,[asciz "Linefeed"]]
maktab ^K,,[440700,,[asciz "^K"]]
maktab ^L,,[440700,,[asciz "^L"]]
maktab ^M,,[440700,,[asciz "Return"]]
maktab ^N,32,[440700,,[<"^>_29.+<.loc.+"@>_22.]]
maktab 33,,[440700,,[asciz "Altmode"]]
maktab ,37,[440700,,[<"^>_29.+<.loc.+"@>_22.]]
maktab 40,,[440700,,[asciz "Space"]]
maktab ,"a-1,[440700,,[<.loc.>_29.]]
maktab "a,"z,[440700,,[<.loc.-"a+"A>_29.]]
maktab ,176,[440700,,[<.loc.>_29.]]
maktab 177,,[440700,,[asciz "Rubout"]]
ifn .loc.-200, .err ASCTAB wrong length.
ufdblk: offset -.
unfn1:: sixbit /.FILE./
unfn2:: sixbit /(DIR)/
offset 0
mfdblk: offset -.
unfn1:: sixbit /M.F.D./
unfn2:: sixbit /(FILE)/
offset 0
newblk: offset -.
unfn1:: sixbit /..NEW./
unfn2:: sixbit /(UDIR)/
offset 0
sixbps: 440600 ? 360600 ? 300600 ? 220600 ? 140600 ? 060600
cnstnts:
constants
variables
patch::
pat: block 100.
epatch: -1 ; Make memory exist, end of patch area
ffaddr:
ffpage==:<ffaddr+1777>_-12
end go
Reference in New Issue View Git Blame Copy Permalink