From b8d7034829ad329633a655a2dccdcb7191f699dc Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Mon, 13 Mar 2017 22:13:52 -0700 Subject: [PATCH] Added BALANC/MOVDIR. Resolves #467. --- README.md | 1 + build/build.tcl | 5 + src/alan/balanc.179 | 1756 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 1762 insertions(+) create mode 100755 src/alan/balanc.179 diff --git a/README.md b/README.md index d8165b42..f219f8ff 100644 --- a/README.md +++ b/README.md @@ -110,6 +110,7 @@ A list of [known ITS machines](doc/machines.md). - ATSIGN DEVICE, load device drivers. - ATSIGN TARAKA, starts dragons. - ATSIGN TCP, TCP support. + - BALANC, MOVDIR, balances directories. - BDAY, happy birthday demon. - BINPRT, display information about binary executable file. - BITPRT, print JCL as bits. diff --git a/build/build.tcl b/build/build.tcl index 10484e77..bf2ede09 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -1403,6 +1403,11 @@ respond "*" ":move .temp.;maklap fasl,comlap;mk.fas 80\r" respond "*" ":move .temp.;phas1 fasl,comlap;ph.fas 86\r" respond "*" ":move .temp.;srctrn fasl,comlap;st.fas 20\r" +# balanc +respond "*" ":midas sys3;ts balanc_alan;balanc\r" +expect ":KILL" +respond "*" ":link sys3;ts movdir,sys3;ts balanc\r" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" respond "*" ":link kshack;ddt bin,.;@ ddt\r" diff --git a/src/alan/balanc.179 b/src/alan/balanc.179 new file mode 100755 index 00000000..25f19eaa --- /dev/null +++ b/src/alan/balanc.179 @@ -0,0 +1,1756 @@ +; -*- 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 + ; - => link to non-ex file with error +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): ,, +; 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,, +; -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.-, .err Bad entry at: start +.cnt.==-.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==:_-12 + +end go