TITLE DIRED -- DIRECTORY "EDITOR" -- PDL 4/27/76 ;===================================================================== ; date version RECORD OF CHANGES ;===================================================================== ; 4/24/76 (168) Addition of SREAPB, CREAPB. Expansion of AUTHOR. ; 4/26/76 (169) Convert to .CALL OPEN etc. ; 5/5/76 (170) QUOTA and ALLOC. ; 8/2/76 (174) ALLOCS keyed on PACK not DRIVE, for ITS 1021 et seq. - MB ; 8/15/76 (175) SIOT used to print files, better rubout hacking ; 8/24/76 (176) Cretinous --More-- hackery ; 9/10/76 (177) Number-only matching with # ; 10/8/76 (178) Switch INFO and ORDER files to conform to newest ideology .MLLIT=1 ; acs A=1 B=2 C=3 D=4 E=5 F=6 G=7 H=10 I=11 J=12 K=13 L=14 ; only for super-temp uses under these names M=15 ; only for super-temp uses ALT=14 ; copy from DIR, use to hack world, then copy back SAFE=15 ; 0 - SORRY, -1 - SAFE, 1 - super-SAFE DIR=16 ; aobjn pointer to dir vector P=17 ; PDL pointer ; channels TYIC==1 ; tty input TYOC==2 ; tty output XFIC==3 ; xfile input IC==4 ; general input OC==5 ERR==6 SCR==7 ; script file channel ; file block offsets DEV==0 ; device NM1==1 ; name1 NM2==2 ; name2 SNM==3 ; sname MK1==4 ; name1 star mask MK2==5 ; name2 star mask MN1==6 ; name1 number mask MN2==7 ; name2 number mask ; flags %MATCH==400000 ; means not a match %FOUND==200000 ; means already looked at %FLUSH==100000 ; means file should go away ; safety macros QSAFE==JUMPL SAFE, QSUPER==JUMPG SAFE, QSORRY==JUMPE SAFE, NSAFE==JUMPGE SAFE, NSORRY==JUMPN SAFE, NSUPER==JUMPLE SAFE, DEFINE FATAL STR/ .VALUE [ASCIZ /:!STR! /] TERMIN ; file system definitions .INSRT SYSTEM;FSDEFS > ; VARIABLES PDL: BLOCK 101. ; PDL BUFFER: BLOCK 2000 0 DIRBUF: BLOCK 2000 ; directory lives here DIRVCT: BLOCK 200. ; directory vector lives here MFDFRM: 0 ; where we got MFD from MFDBUF: BLOCK 2000. MFDVCT: BLOCK 500. MFDCNT: 0 ; cptr to mfd entries COMMND: BLOCK 20 COMPTR: 0 MESSAG: SIXBIT /DSK DIRED MESSAG.INFO./ HLPFIL: SIXBIT /DSK DIRED INFO .INFO./ LSTERR: 0 ; common open style error spot STARS: SIXBIT / / STAR: SIXBIT /* * / -1 ? -1 FYESNO: 0 ; 0 - tty, 1 - yes, -1 - no AUTFLG: 0 FILER: PUSHJ P,LFPRNT TESTER: CAMG C,(ALT) SSAFE: -1 ; saved safety mode (for interrupts) XFLAG: 0 ; >0 XFILEing SCRFLG: 0 ; -1 script output SCROPN: 0 ; -1 script channel open QUIREA: 0 ; -1 keep quiet (REAL quiet flag) QUIFLG: 0 ; -1 keep quiet CHKFLG: 0 ; -1 --> do checksumming CHKSUM: 0 ; store checksum here FLUSH: 0 ; -1 ==> files have been flushed MESSED: 0 ; -1 ==> message has been printed TERM: 0 ; terminator of command FUNC: 0 ; command being executed OLDM: 0 ; file ptr at start of command NAUTHO: 0 ; new author for AUTHOR command ; active directory INDEV: SIXBIT /DSK .FILE.(DIR) / ; current output directory OUTDEV: SIXBIT /DSK .FILE.(DIR) .LPTR./ ; temporary directory for FIND command TMPDEV: SIXBIT /DSK .FILE.(DIR) / ; current file pointed at in active directory FILE: SIXBIT /DSK/ SIXBIT /_EDIT_/ SIXBIT /> / 0 ; first file name arg FONE: SIXBIT /DSK / ; dev SIXBIT /_EDIT_/ ; nm1 SIXBIT /> / ; nm2 0 ; snm 0 ; mk1 -- mask for name1 0 ; mk2 -- mask for name2 ; second file name arg FTWO: BLOCK 6 ; temporaries for building real args in loop commands TONE: BLOCK 4 TTWO: BLOCK 4 ; generally useful temporary file block TEMP: SIXBIT /DSK / SIXBIT /_DIRED/ SIXBIT /> / 0 0 0 ; script file SCRFIL: SIXBIT /DSK / SIXBIT /WALLP / SIXBIT /> / RNMLNK: BLOCK 6 ; block for normal rename or link 0 ; block for rename while open 0 OC 0 0 TYPACC: 0 TYPBYT: 440700,,BUFFER TYPDFL: -5 ;==================================================================== ; START UP CODE ;==================================================================== START: MOVE P,[-100.,,PDL+1] ; open ttys .CALL [SETZ SIXBIT "OPEN" [TYIC] [SIXBIT "TTY"] [SIXBIT "DIRED"] [SIXBIT "INTTY"] SETZB LSTERR] FATAL CAN'T OPEN IN TTY .CALL [SETZ SIXBIT "OPEN" [1,,TYOC] [SIXBIT "TTY"] [SIXBIT "DIRED"] [SIXBIT "OUTTTY"] SETZB LSTERR] FATAL CAN'T OPEN OUT TTY ; decide whether we are a display .CALL [SETZ 'CNSGET [TYOC] MOVEM ; vsize MOVEM ; hsize MOVEM ; tctyp MOVEM ; ttycom MOVEM TTYOPT' SETZB LSTERR] FATAL CANT GET CONSOLE TYPE MOVE A,TTYOPT PUSHJ P,SLOW TLNN A,%TOERS PUSHJ P,QUICK ; nope, use short file typeout ; setup rubout hackery MOVE [PUSHJ P,RUBECH] TLNE A,%TOERS MOVE [PUSHJ P,RUBFLS] MOVEM XCTRUB' ; set up TTY interrupt for ^G and ^S .CALL [SETZ 'TTYGET MOVEI TYIC MOVEM A MOVEM B SETZB LSTERR] FATAL CANT GET CONSOLE TYPE MOVE 0,[SIXBIT / !!!!!/] ; make only ^G and ^S interrupt ANDCAM 0,A MOVE 0,[SIXBIT / !!!!!/] ANDCAM 0,B .CALL [SETZ 'TTYSET MOVEI TYIC A B SETZB LSTERR] FATAL CANT SET CONSOLE TYPE ; enable cretinous moreage .CALL [SETZ 'TTYGET MOVEI TYOC MOVEM A MOVEM B MOVEM C SETZB LSTERR] FATAL CANT GET CONSOLE TYPE TLZ C,%TSMOR .CALL [SETZ 'TTYSET MOVEI TYOC A B C SETZB LSTERR] FATAL CANT SET CONSOLE TYPE .SUSET [.SMASK,,[1]] .SUSET [.SMSK2,,[<1_TYIC>#<1_TYOC>]] ; initialize default sname hackery .SUSET [.RSNAM,,A] MOVEM A,FILE+SNM MOVEM A,FONE+SNM MOVEM A,INDEV+SNM ; print herald message and message file, if any ; ** Actually, no one ever put anything in that file, so I have placed ; ** its perpetual contents in a string here. - CSTACY, 9/12/84 IFN 0,[ HERALD: OASC [ASCIZ /DIRED./] OSIX [.FNAM2] OASCR [0] SKIPE MESSED JRST CRLOOP MOVEI A,MESSAG PUSHJ P,PRFILE JFCL ] OASC [ASCIZ / This is new dired. No warranty is expressed or implied. Type ? for command list, ? for each command. /] SETOM MESSED SETOB SAFE,SSAFE ; normal mode is somewhat safe PUSHJ P,ACTUP JRST FILOOP ; sname is not a directory ;==================================================================== ; MAIN LOOP ;==================================================================== QQLOOP: OASC [ASCIZ /Flushed/] CRLOOP: OASCR [0] ; here on normal loop FILOOP: MOVE A,QUIREA ; remove effect of ^V or ^W MOVEM A,QUIFLG PUSHJ P,GC ; garbage collect dir vector JUMPGE DIR,FONFIL HRRZ A,(DIR) ; save pointer to file we were at CAMN A,OLDM JRST LOOP ; here we have new file, must decide whether to print it SKIPGE QUIFLG JRST MAKFIL ; dont print name, in quiet mode OASCR [0] XCT FILER ; here to make new FILE MAKFIL: PUSHJ P,TYPSET MOVE A,INDEV MOVEM A,FILE+DEV MOVE A,(DIR) MOVE 0,(A) MOVEM 0,FILE+NM1 MOVE 0,1(A) MOVEM 0,FILE+NM2 MOVE A,INDEV+SNM MOVEM A,FILE+SNM HRRZ (DIR) MOVEM OLDM ; here print part of file if in auto mode SKIPE AUTFLG PUSHJ P,TYPER ; in auto mode JRST LOOP ; set up FONE with default of FILE FONFIL: MOVE A,FONE+NM1 CAMN A,[SIXBIT /.FILE./] JRST LOOP ; unless FONE is a directory MOVE A,[FONE,,FILE] PUSHJ P,FMOVER ; print prompt LOOP: SETZ K, OASCI "@ PUSHJ P,READ ; read a command line PUSHJ P,GETSYL ; parse out the actual command MOVEM B,FUNC ; save it away for future reference MOVEM A,TERM ;==================================================================== ; COMMAND DISPATCH ;==================================================================== SKIPN A,B ; null command == NEXT JRST DISNXT PUSHJ P,LOOKUP JRST DISPCH ; got a match OASCR [ASCIZ /HUH?/] ; unrecognized command JRST LOOP ; normal dispatch DISPCH: PUSHJ P,@1(A) JFCL ; don't care at this level JRST FILOOP ; special dispatch for null command -- move to next object DISNXT: XCT NEXTER JFCL JRST FILOOP ;==================================================================== ; COMMAND LOOKUP ;==================================================================== LOOKUP: PUSH P,B MOVEI B,COMTAB COMLUP: CAMN A,(B) JRST LUKWIN ADDI B,2 CAIGE B,COMEND JRST COMLUP AOSA -1(P) LUKWIN: MOVE A,B POP P,B POPJ P, DEFINE COM DIS,NMS IRP NM,,[NMS] SIXBIT /!NM!/ DIS TERMIN TERMIN ;==================================================================== ; COMMAND TABLE ;==================================================================== COMTAB: COM ACT,[A,ACT] COM ALLOC,[ALLOC,ALLOCA] COM ANSWER,[ANSWER] COM AUTHOR,[AUTHOR,AUTH,SAUTH,SAUTHO] COM AUTO,[AUTO] COM DOBACK,[^,BACK,U,UP] COM BOTTER,[BOTTOM,END] COM CHECK,[CHECK,CHECKS,CHKSUM,CHK] COM COPY,[B,BACKUP,COPY] COM COPYD,[BACKC,BC,COPYC,CD,COPYD,BD] COM CDUMPB,[CDUMPB,UNDUMP,CDMPBT] COM CREAPB,[CREAP,CREAPB,UNPROT] COM CTYPER,[T] COM DELETE,[D,DEL,DELETE] COM DIRECT,[DIR] COM ERASE,[ER,ERASE] COM FIND,[FIND] COM MFD,[MFD] COM HELP,[?,HELP] COM JUMPER,[J,JUMP,GO] COM KEEP,[KEEP] COM LINK,[LINK] COM LISTF,[L,LF,LISTF] COM MOVER,[M,MOVE] COM DONEXT,[NEXT] COM PRINT,[P,PR,PRINT] COM QUICK,[QUICK] COM QUIET,[QUIET,SILENT] COM QUIT,[Q,QUIT] COM QUOTA,[QUOTA] COM SDUMPB,[SDUMPB,DUMPED,SDMPBT] COM SREAPB,[SREAP,SREAPB,PROTEC] COM REAP,[REAP] COM RENAME,[R,RENAME] COM SAFETY,[SAFE] COM SAVE,[SAVE,S] COM SAVED,[SAVEC,SC,SAVED,SD] COM SCRIPT,[SCRIPT,WALBEG] COM SCREND,[SCREND,WALEND] COM SHOW,[SHOW] COM SLOW,[SLOW] COM SORRY,[SORRY] COM STATUS,[STATUS] COM SUPER,[SAFE!,SUPER] COM TOPPER,[TOP,BEGIN,BEGINN] COM TRAVEL,[TR,TRAVEL] COM TYPER,[TYPE] COM UNALLO,[UNALLO] COM VALRET,[K,VALRET] COM VECTOR,[V,VECTOR] COM WHO,[WHO] COM XFILE,[X,XF,XFILE] COMEND=. ;==================================================================== ; HELP ;==================================================================== QHELP: ASCIZ / HELP Print help message for a given command, or if no argument, print .INFO.;DIRED INFO./ QHELP HELP: PUSH P,A PUSH P,B LDB A,COMPTR CAIN A,^M JRST HELPF PUSHJ P,GETSYL MOVE A,B PUSHJ P,LOOKUP SKIPA JRST NOHELP ; command exists MOVE A,1(A) SKIPN A,-1(A) JRST NOHELP ; print help message OASCR (A) JRST POPBAJ HELPF: MOVEI A,HLPFIL PUSHJ P,PRFILE NOHELP: OASCR [ASCIZ /NO HELP AVAILABLE./] POPBAJ: POP P,B POPAJ: POP P,A POPJ P, ;==================================================================== ; QUICK and SLOW ;==================================================================== QQUICK: ASCIZ / QUICK Print short file-names instead of LISTF type lines./ QQUICK QUICK: MOVE 0,[PUSHJ P,LFQUIK] MOVEM 0,FILER POPJ P, QSLOW: ASCIZ / SLOW Print LISTF lines instead of just names: normal mode on display consoles./ QSLOW SLOW: MOVE 0,[PUSHJ P,LFPRNT] MOVEM 0,FILER POPJ P, ;==================================================================== ; QUIET ;==================================================================== QQUIET: ASCIZ / QUIET Toggle files-found printing on commands like ERASE./ QQUIET QUIET: SETCMB A,QUIREA ; changes REAL quiet flag PUSHJ P,ONOFF POPJ P, ;==================================================================== ; CHECK ;==================================================================== QCHECK: ASCIZ / CHECK Toggle state of checksumming. Normal mode is no checksum./ QCHECK CHECK: SETCMB A,CHKFLG PUSHJ P,ONOFF POPJ P, ;==================================================================== ; QUIT and VALRET ;==================================================================== QQUIT: ASCIZ / QUIT Kill the DIRED./ QQUIT QUIT: .CLOSE SCR, .BREAK 16,160000 POPJ P, QVALRE: ASCIZ / VALRET Valret the string to DIRED's superior./ QVALRE VALRET: PUSH P,A PUSH P,B MOVE B,[440700,,BUFFER] VALOOP: ILDB A,COMPTR CAIE A,^Q JRST VALRE1 ; here for quoted hackery ILDB A,COMPTR IDPB A,B JRST VALOOP VALRE1: IDPB A,B JUMPN A,VALOOP .VALUE BUFFER JRST POPBAJ ;==================================================================== ; ACTIVATE ;==================================================================== ; special entry to do JCL line activation ACTUP: PUSH P,A PUSH P,B .SUSET [.ROPTIO,,A] TLNN A,40000 ; OPTCMD JRST ACT1 .BREAK 12,[5,,COMMND] ; get command from superior SETO B, SKIPN COMMND JRST ACT1 ; no argument MOVE [440700,,COMMND] ; got arg, so parse it MOVEM COMPTR SETZ B, JRST ACT1 QQACT: ASCIZ / ACT , Reads in a directory and sets up an optional output directory. Only if a directory is active are "*" file names legal./ QQACT ; normal activation entry point ACT: PUSH P,A PUSH P,B SETZ B, ; parse -- directory to activate ACT1: MOVE A,[INDEV,,FONE] ; default is current active dir PUSHJ P,FMOVER PUSHJ P,SCNAM1 ; directory to activate ; funny names allowed only if device is not DSK: HLLZ A,FONE CAMN A,[SIXBIT /DIR/] JRST ACT2 ; if not dir:, no ridiculous device MOVE A,[SIXBIT /.FILE./] MOVEM A,FONE+1 MOVE A,[SIXBIT /(DIR)/] MOVEM A,FONE+2 ; parse -- backup directory (if any) ACT2: MOVE A,[FONE,,FTWO] ; default is the given indev PUSHJ P,FMOVER PUSHJ P,SCNAM2 ; directory for backup ; read the directory PUSHJ P,GETDIR JRST GETLOS ; no such directory ; create dir vector PUSHJ P,PRSDIR MOVE DIR,ALT SETZM OLDM ; check for dir: HLRZ A,FONE ; fix up DIR: in input CAIN A,'DIR SKIPA A,[SIXBIT "DSK"] ; repairs ravages of dir: MOVE A,FONE MOVEM A,FONE MOVEM A,INDEV MOVE A,FONE+SNM MOVEM A,INDEV+SNM HLRZ A,FTWO ; fix up DIR: in output CAIN A,'DIR SKIPA A,[SIXBIT "DSK"] ; repairs ravages of dir: MOVE A,FTWO MOVEM A,OUTDEV MOVE A,FTWO+SNM MOVEM A,OUTDEV+SNM ; here to get right mfd if neccessary MOVE A,INDEV CAMN A,MFDFRM ; got this mfd already? JRST ACTXIT CAME A,[SIXBIT /DM/] CAMN A,[SIXBIT /AI/] JRST ACTMFD CAME A,[SIXBIT /ML/] CAMN A,[SIXBIT /MC/] JRST ACTMFD CAME A,[SIXBIT /DSK/] JRST ACTXIT ; read in needed MFD ACTMFD: MOVEM A,MFDFRM PUSHJ P,RDMFD JFCL ; if can't, don't let it bother ACTXIT: JRST POPBAJ ; here when GETDIR lost, tell loser GETLOS: JUMPL B,ACTXIT OASC [ASCIZ /ACTIVATE of /] MOVEI A,FONE PUSHJ P,OERRF JRST ACTXIT ;==================================================================== ; READ IN and PARSE directories ;==================================================================== ; routine to read in a directory GETDIR: .CALL [SETZ SIXBIT "OPEN" [6,,IC] FONE FONE+NM1 FONE+NM2 FONE+SNM SETZB LSTERR] POPJ P, ; too bad SETZB DIR,OLDM MOVE A,[-2000,,DIRBUF] .IOT IC,A ; get it in one iot .CLOSE IC, AOS (P) POPJ P, ; build the pointer list to files in active directory PRSDIR: PUSH P,A PUSH P,B SETZM DIRVCT MOVE B,[DIRVCT,,DIRVCT+1] BLT B,DIRVCT+199. MOVE ALT,[-200.,,DIRVCT] MOVE B,DIRBUF+UDNAMP ; offset of name area ADDI B,DIRBUF-LUNBLK ; start of dirbuf NXTNAM: ADDI B,LUNBLK CAIL B,DIRBUF+2000 JRST GETXIT ; end of directory SKIPN (B) JRST NXTNAM MOVEM B,(ALT) AOBJN ALT,NXTNAM GETXIT: HLRE A,ALT MOVNS A SUBI A,200. HRL ALT,A HRRI ALT,DIRVCT XCT ATOPPER JRST POPBAJ ;==================================================================== ; MFD ;==================================================================== QMFD: ASCIZ / MFD Read in copy of MFD, including only those which match at least one of the arguments given. If none are given, just read in the whole MFD. The result is printed./ QMFD MFD: PUSHJ P,GETMFD POPJ P, ; lose, couldn't get it SETZM DIR ; print dirs gotten JUMPGE A,MFDNON PUSH P,B PUSH P,C PUSH P,D HLRE B,A MOVMS B MOVEI D,5 CAILE B,40. ADDI D,5 CAILE B,80. ADDI D,5 CAILE B,120. ADDI D,5 CAILE B,160. ADDI D,5 ; here we print the MFD OASCR [0] MOVE C,A MOVE B,A MFDP1: SKIPN (A) JRST MFDP2 OSIX (A) OASCI ^I ADD A,D AOBJP C,MFDPX JRST MFDP1 MFDP2: OASCR [0] AOS B MOVE A,B JRST MFDP1 MFDPX: OASCR [0] POP P,D POP P,C POP P,B POPJ P, MFDNON: OASCR [ASCIZ / No directories match./] POPJ P, ;==================================================================== ; READ IN and PARSE the M.F.D. ;==================================================================== ; read in the M.F.D. RDMFD: .CALL [SETZ SIXBIT /OPEN/ [6,,IC] MFDFRM [SIXBIT /M.F.D./] [SIXBIT /(FILE)/] SETZB LSTERR] POPJ P, ; here read in however you can MOVE A,[-2000,,MFDBUF] .IOT IC,A .CLOSE IC, AOS (P) POPJ P, ; parse the M.F.D. -- make a sorted vector GETMFD: PUSH P,B PUSH P,C PUSH P,D SETZM MFDCNT SETZM MFDVCT MOVE A,[MFDVCT,,MFDVCT+1] BLT A,MFDVCT+499. MOVEM P,PSAVE' MOVEI C,1(P) MFDLU1: PUSHJ P,GETSYL JUMPE B,GETMF1 MOVE A,B PUSH P,A PUSHJ P,NMPARS ANDM A,(P) PUSH P,A SUB C,[1,,0] JRST MFDLU1 ; read in mfd GETMF1: PUSHJ P,RDMFD JRST MFDLOS ; set for loop through MFD MOVE A,MFDBUF+1 ADDI A,MFDBUF MOVEI B,MFDVCT PUSH P,C ; pointer to snames MFDLUP: MOVE C,(P) SKIPN (A) JRST MFDNXT JUMPGE C,MFDWIN MFDTST: MOVE 0,(A) AND 0,1(C) CAMN 0,(C) JRST MFDWIN AOS C AOBJN C,MFDTST JRST MFDNXT MFDWIN: MOVE 0,(A) MOVEM 0,(B) AOBJP B,.+1 MFDNXT: ADDI A,2 CAIGE A,MFDBUF+1777 JRST MFDLUP HLRZS B MOVNS B HRLS B HRRI B,MFDVCT MOVE A,B MOVEM A,MFDCNT POP P,C ; now sort stupid thing SRTLUP: MOVE C,(A) MOVE D,A SRTLU1: CAMG C,(D) JRST SRTNXT EXCH C,(D) MOVEM C,(A) SRTNXT: AOBJN D,SRTLU1 AOBJN A,SRTLUP MOVE A,MFDCNT MOVE P,PSAVE AOS -3(P) MFDXIT: POP P,D POP P,C POP P,B POPJ P, ; couldn't open MFD MFDLOS: OASC [ASCIZ /OPEN OF M.F.D. /] PUSHJ P,OERR MOVE P,PSAVE JRST MFDXIT ;==================================================================== ; FIND ;==================================================================== ; WARNING -- THIS IS NOT LIKE TS FIND!!! SHOULD BE, BUT ISN'T YET QFIND: ASCIZ / FIND , Reads in files to search for, and searches entire M.F.D. for them, printing out results as they occur. The optional first argument enables the user to specify an alternate device (for example, DIR:ONLY LINKS) that will be used instead of DSK:.FILE. (DIR) to get the directories to search. The remaining arguments on the command line may be any number of directory names, with *'s allowed, which will be the directories to search. This is the same as for the MFD command./ QFIND FIND: PUSH P,A PUSH P,B ; read argument (what types of DIR or DSK) PUSH P,COMPTR PUSHJ P,GETSYL POP P,COMPTR CAIN A,'; JRST FNDGET ; he's skipping device argument MOVE A,[INDEV,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 HLRZ A,FONE CAIN A,'DIR JRST FNDMOV ; if DIR: device, use his file names MOVE 0,FONE+NM1 CAME 0,[SIXBIT /.FILE./] JRST FNDFIL MOVE 0,FONE+NM2 CAME 0,[SIXBIT /(DIR) /] JRST FNDBAD FNDMOV: MOVE A,[FONE,,TMPDEV] PUSHJ P,FMOVER ; read in mfd if neccessary LDB 0,COMPTR CAIE 0,^M JUMPN 0,FNDGET SKIPE D,MFDCNT JRST FNDFIL FNDGET: PUSHJ P,GETMFD JRST FINDX1 ; couldn't read mfd MOVE D,A ; aobjn ptr to mfd entries ; read in names to search for FNDFIL: MOVEM P,PSAVE' HRRZI B,1(P) FNDARG: OASC [ASCIZ /FILE=/] PUSHJ P,READ MOVE A,[[0?0?0?0?],,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 ; typed anything? -- device is ignored SKIPE FONE+SNM JRST FNDPSH SKIPN FONE+NM1 SKIPE FONE+NM2 SKIPA JRST FNDMFD FNDPSH: PUSH P,FONE+SNM ; sname, if any PUSH P,FONE+NM1 ; name1 PUSH P,FONE+NM2 ; name2 PUSH P,FONE+MK1 PUSH P,FONE+MK2 SUB B,[1,,0] JRST FNDARG ; read in MFD, for open-ended search FNDMFD: SETZ F, MOVE C,B FINDLP: MOVE B,C MOVE A,[TMPDEV,,FONE] PUSHJ P,FMOVER MOVE 0,(D) MOVEM 0,FONE+SNM PUSHJ P,GETDIR JRST FNDLOS PUSHJ P,PRSDIR SETZ E, MOVE DIR,ALT JUMPGE DIR,FINEX1 SETZM OLDM ; set up matching FINDL1: MOVE 0,1(B) MOVEM 0,FONE+NM1 MOVE 0,2(B) MOVEM 0,FONE+NM2 MOVE 0,3(B) MOVEM 0,FONE+MK1 MOVE 0,4(B) MOVEM 0,FONE+MK2 PUSHJ P,MORE SKIPA SETO E, FINEXT: ADDI B,4 AOBJN B,FINDL1 ; here print matches JUMPE E,FINEX1 OSIX FONE+SNM OASCR [ASCIZ /;/] FINPRT: PUSHJ P,SEARCH JRST FINEX1 AOS F ; count of files found MOVE A,(ALT) PUSHJ P,LFPRNT JRST FINPRT FINEX1: AOBJN D,FINDLP OASC [ASCIZ /Found /] ODEC F OASCR [ASCIZ / /] FINDXT: SETZM DIR MOVE P,PSAVE' FINDX1: JRST POPBAJ FNDBAD: OASCR [ASCIZ /BAD ARG TO FIND./] JRST FINDX1 FNDLOS: OASC [ASCIZ /FIND OPEN of /] MOVEI A,FONE PUSHJ P,OERRF JRST FINDXT ;==================================================================== ; DELETE ;==================================================================== QDELET: ASCIZ / DELETE Delete all files matching argument from active directory, (default current file) or single file if none active./ QDELET DELETE: NSAFE DELET1 OASC [ASCIZ /Delete?/] PUSHJ P,YESNO POPJ P, ; he copped out DELET1: PUSH P,A PUSH P,B MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 MOVE A,[FONE,,TONE] PUSHJ P,FMOVER PUSHJ P,MCHECK JRST DELARG ; nothing active but he said * JRST DELONE ; not in this directory ; did he say D * *? SKIPN FONE+MK1 SKIPE FONE+MK2 JRST DELMRK ; here if said "* *" OASCI 11 MOVEI A,INDEV PUSHJ P,ODIR OASC [ASCIZ / -- DELETE all remaining files?/] PUSHJ P,YESNO JRST DELXIT ; chickened out ; mark matches DELMRK: PUSHJ P,MARK JRST DELNON ; no matches ; loop through marked files DELLUP: PUSHJ P,SEARCH JRST DELXIT ; no more to find MOVE A,(ALT) ; dont try it if any funny bits on MOVE 0,UNRNDM(A) TLNE 0,UNCDEL+UNMARK+UNWRIT JRST DELLUP ; set up the deletion block MOVE 0,FONE MOVEM 0,TONE MOVE 0,(A) MOVEM 0,TONE+NM1 MOVE 0,1(A) MOVEM 0,TONE+NM2 MOVE 0,FONE+SNM MOVEM 0,TONE+SNM ; do the delete PUSHJ P,DELETR JRST DELLUP ; delete lost for some reason ; print the name of the victim MOVE A,(ALT) SKIPL QUIFLG XCT FILER PUSHJ P,COMPAC JRST DELLUP ; here to delete outside active directory or when none active DELONE: PUSHJ P,DELETR JRST DELXIT ; lost OASC [ASCIZ / /] ; print name of victim MOVEI A,FONE SKIPL QUIFLG PUSHJ P,ONAMES OASCR [0] DELXIT: JRST POPBAJ DELARG: OASCR STRACT ; no active dir? JRST DELXIT DELNON: OASCR STRNON ; no matches JRST DELXIT ;==================================================================== ; single file delete ;==================================================================== ; single file delete -- utility used by DELETE and anyone else ; who deletes, like COPY, RENAME, and LINK sometimes ; file block TONE contains th file to delete DELETR: PUSH P,A ; if in super mode, pester him about it NSUPER DELET2 ; if not in super mode, skip this OASC [ASCIZ / DELETE /] MOVEI A,TONE PUSHJ P,OFILE OASC "? PUSHJ P,YESNO JRST DELDON ; answer was no DELET2: .CALL [SETZ ; actually do the delete 'DELETE TONE TONE+NM1 TONE+NM2 TONE+SNM SETZB LSTERR] JRST DELLOS AOS -1(P) DELDON: JRST POPAJ ; delete failed, complain DELLOS: MOVEI A,TONE OASC [ASCIZ /DELETE of /] PUSHJ P,OERRF JRST POPAJ ;==================================================================== ; PRINT ERROR MESSAGE ;==================================================================== ; print error resulting from failing .CALL ; ones associated with a file, call OERRF ; ones that are just random, call OERR OERRF: PUSHJ P,OFILE OERR: PUSH P,A PUSH P,B OASC [ASCIZ / failed: /] SKIPN LSTERR JRST OERRC ; error in call, most likely? MOVE B,LSTERR JRST COERR OERRC: .SUSET [.RBCHN,,A] .CALL [SETZ 'STATUS A SETZM B] JRST ERRLUP MOVSS B ANDI B,77 COERR: .CALL [SETZ SIXBIT "OPEN" MOVEI ERR [SIXBIT "ERR"] MOVEI 4 SETZ B] JRST POPBAJ ERRLUP: .IOT ERR,A CAIGE A,40 JRST ERRXIT PUSHJ P,IOTA JRST ERRLUP ERRXIT: .CLOSE ERR, OASCR [ASCIZ /./] JRST POPBAJ ;==================================================================== ; PRINT FILE, DIRECTORY NAMES ;==================================================================== ; call with pointer to file block in A ODIR: OSIX (A) OASCI ": OSIX 3(A) OASCI "; POPJ P, OFILE: PUSHJ P,ODIR ONAMES: OSIX 1(A) OASCI " OSIX 2(A) POPJ P, ;==================================================================== ; JUMP ;==================================================================== QJUMP: ASCIZ / JUMP Make the current file the file given./ QJUMP JUMPER: JUMPGE DIR,[POPJ P,] PUSH P,A PUSH P,B MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 PUSHJ P,MARK JRST JMPXIT ; no match? PUSHJ P,SEARCH JRST JMPXIT ; nothing there? MOVE DIR,ALT JMPXIT: JRST POPBAJ ;==================================================================== ; VECTOR ;==================================================================== QVECTO: ASCIZ / VECTOR Print all filenames in active directory matching argument, or all files if no argument./ QVECTO VECTOR: JUMPGE DIR,[POPJ P,] PUSH P,A PUSH P,B MOVE A,[STARS,,FONE] PUSHJ P,FMOVER PUSHJ P,SCQUT1 PUSHJ P,MARK JRST VCTXIT VCTLUP: PUSHJ P,SEARCH JRST VCTXIT MOVE A,(ALT) XCT FILER JRST VCTLUP VCTXIT: JRST POPBAJ ;==================================================================== ; SHOW ;==================================================================== ; I DON'T THINK THIS REALLY WORKS AS ADVERTISED???? QSHOW: ASCIZ / SHOW , Print names of all files matching first argument, with all matching second marked. If only one argument given, print active files with matching files marked./ QSHOW SHOW: PUSH P,A MOVE A,[STARS,,FONE] PUSHJ P,FMOVER PUSHJ P,SCQUT1 LDB A,COMPTR CAIE A,^M JRST SHWTWO MOVE A,[FONE,,FTWO] PUSHJ P,FMOVET MOVE A,[STARS,,FONE] PUSHJ P,FMOVET JRST SHWMSK SHWTWO: MOVE A,[FONE,,FTWO] PUSHJ P,FMOVER PUSHJ P,SCNAM2 ; hack first arg -- mark all matches SHWMSK: PUSHJ P,MARK JRST SHWXIT ; now mark matches of second arg MOVE A,[FTWO,,FONE] PUSHJ P,FMOVER MOVE A,FTWO+MK1 MOVEM A,FONE+MK1 MOVE A,FTWO+MK2 MOVEM A,FONE+MK2 ; PUSHJ P,IERASE ; now print results XCT TOPPER JUMPGE DIR,SHWXIT SHWLUP: MOVE A,(DIR) JUMPL A,.+3 OASCI " JRST .+2 OASCI "> XCT FILER XCT NEXTER JRST SHWLUP SHWXIT: JRST POPAJ ;==================================================================== ; KEEP ;==================================================================== QKEEP: ASCIZ / KEEP ERASE all files from active directory other than those which match argument./ QKEEP KEEP: JUMPGE DIR,[POPJ P,] PUSH P,A PUSH P,B MOVE A,[STARS,,FONE] PUSHJ P,FMOVER PUSHJ P,SCQUT1 PUSHJ P,MARK JRST KEPXIT KEPERS: PUSHJ P,NSEARC JRST KEPXIT MOVE A,(ALT) SKIPL QUIFLG XCT FILER PUSHJ P,COMPAC JRST KEPERS ; restore acs and exit KEPXIT: JRST POPBAJ IFE 1,[ IKEEP: PUSH P,A PUSH P,B PUSHJ P,PSHDIR PUSHJ P,IERASE ; now do slow popdir PUSH P,DIR PUSHJ P,TOP MOVE ALT,DIR HRRI ALT,DIRTMP SETOM FLUSH IKEPLU: MOVE 0,(ALT) SKIPL (DIR) TLO 0,%MATCH MOVEM 0,(DIR) AOBJN ALT,.+1 AOBJN DIR,IKEPLU POP P,DIR ; restore acs and exit JRST POPBAJ ] ;==================================================================== ; ERASE ;==================================================================== QERASE: ASCIZ / ERASE Remove from in-core list of active directory all files which match argument. If no argument, remove current file./ QERASE ERASE: JUMPGE DIR,[POPJ P,] PUSH P,A PUSH P,B MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 PUSHJ P,MARK JRST ERSXIT ERSLUP: PUSHJ P,SEARCH JRST ERSXIT MOVE A,(ALT) ; actually do the erase SKIPL QUIFLG XCT FILER PUSHJ P,COMPAC JRST ERSLUP ERSXIT: JRST POPBAJ IFE 1,[ IERASE: PUSH P,A PUSH P,B PUSHJ P,MARK JRST IERSXI IERSLU: PUSHJ P,SEARCH JRST IERSXI SETOM FLUSH HRLZI 0,%MATCH IORM 0,(ALT) JRST IERSLU IERSXI: JRST POPBAJ ] ;==================================================================== ; GC the directory vector ;==================================================================== GC: SKIPN FLUSH ; nobody has flushed anythin POPJ P, ; something to gc away .SUSET [.SPICLR,,[0]] PUSH P,A PUSH P,B PUSH P,C ; someone actually clobbered a file SETZM FLUSH MOVE ALT,DIR PUSHJ P,ATOP HRRZ B,ALT HRRZ C,OLDM ; flush the ones clobbered GC1: MOVE A,(ALT) SETZM (ALT) TLNE A,%FLUSH JRST GCNXT HRRZM A,(B) AOBJN B,.+1 GCNXT: AOBJN ALT,GC1 ; reconstruct the vector HLRZ A,B MOVNS A HRL ALT,A HRRI ALT,DIRVCT JUMPL ALT,.+3 SETZ ALT, JRST GCXIT ; get back right DIR XCT ATOPPER GCFIND: XCT TESTER JRST GCXIT XCT ANEXTE JRST GCFIND XCT ATOPPER GCXIT: MOVE DIR,ALT POP P,C POP P,B POP P,A .SUSET [.SPICLR,,[-1]] POPJ P, ; here to compact directory by one file's worth COMPAC: HRLZI 0,%FLUSH IORM 0,(ALT) SETZM @(ALT) ; first word of name area SETOM FLUSH POPJ P, ;==================================================================== ; WHO ;==================================================================== QWHO: ASCIZ / WHO Do LISTF TTY:./ QWHO WHO: PUSH P,A PUSH P,INDEV HRLZI 0,'TTY MOVEM 0,INDEV MOVEI A,INDEV PUSHJ P,PRFILE JFCL OASCR [0] POP P,INDEV JRST POPAJ ;==================================================================== ; LISTF ;==================================================================== QLISTF: ASCIZ / LISTF Print directory of DEV:SNM;./ QLISTF LISTF: PUSH P,A MOVE A,[INDEV,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 HLRZ A,FONE CAIN A,'DIR JRST LFDO ; try to win if he types LISTF DSK or LISTF SYSENG (IE: no ; or :) MOVE A,[SIXBIT /.FILE./] CAMN A,FONE+NM1 JRST LFDO EXCH A,FONE+NM1 ; gave a nm1 ==> assume sname for now PUSH P,FONE+SNM MOVEM A,FONE+SNM MOVEI A,FONE PUSHJ P,PRFILE SKIPA ; not sname? JRST LFXIT1 MOVE A,FONE+SNM ; try device... POP P,FONE+SNM MOVEM A,FONE ; normal listf with ; or : given LFDO: MOVEI A,FONE PUSHJ P,PRFILE JRST LFERR ; nope OASCR [0] LFXIT: JRST POPAJ LFXIT1: POP P,FONE+SNM JRST LFXIT LFERR: OASC [ASCIZ /LISTF of /] MOVEI A,FONE PUSHJ P,OERRF JRST LFXIT ;==================================================================== ; XFILE ;==================================================================== QXFILE: ASCIZ / XFILE Execute a file, default the current file./ QXFILE XFILE: PUSH P,A MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 MOVE A,XFLAG CAIL A,8 ; max iopushage JRST XFMAX SKIPE A .IOPUS XFIC, ; if already xfiling, push .CALL [SETZ SIXBIT "OPEN" MOVEI XFIC FONE FONE+NM1 FONE+NM2 FONE+SNM SETZB LSTERR] JRST XFIERR AOS XFLAG XFIXIT: JRST POPAJ XFMAX: .IOPDL .CLOSE XFIC, SETZM XFLAG OASCR [ASCIZ /Too many nested XFILEs. All are terminated./] JRST XFIXIT XFIERR: OASC [ASCIZ /OPEN of /] MOVEI A,FONE PUSHJ P,OERRF JRST XFIXIT ;==================================================================== ; SCRIPT ;==================================================================== QSCRIP: ASCIZ / SCRIPT Script output to a file, default WALLP >./ QSCRIP SCRIPT: PUSH P,A MOVE A,[SCRFIL,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 .CALL [SETZ SIXBIT "OPEN" [1,,SCR] FONE FONE+NM1 FONE+NM2 FONE+SNM SETZB LSTERR] JRST PRIERR SETOM SCRFLG SETOM SCROPN JRST POPAJ ;==================================================================== ; SCREND ;==================================================================== QSCREN: ASCIZ / SCREND Close the currently open script file./ QSCREN SCREND: .CLOSE SCR, SETZM SCROPN SETZM SCRFLG POPJ P, ;==================================================================== ; PRINT ;==================================================================== QPRINT: ASCIZ / PRINT Print a file, default the current file./ QPRINT PRINT: PUSH P,A MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 MOVEI A,FONE PUSHJ P,PRFIL1 JRST PRIERR OASCR [0] PRIXIT: JRST POPAJ PRIERR: OASC [ASCIZ /OPEN of /] MOVEI A,FONE PUSHJ P,OERRF JRST PRIXIT ; here to print without clobbering ref date PRFIL1: PUSH P,A PUSH P,B PUSH P,C PUSH P,D MOVEI B,12 ; block input, don't clobber ref date JRST PRFCOM ; open without munging ref date ; here to print, don't care about ref date PRFILE: PUSH P,A PUSH P,B PUSH P,C PUSH P,D MOVEI B,2 ; block input PRFCOM: .CALL [SETZ SIXBIT "OPEN" 4000,,B ; open mode MOVEI IC (A) 1(A) 2(A) 3(A) SETZB LSTERR] JRST PREXIT PRLOOP: MOVE A,[-2000,,BUFFER] .IOT IC,A MOVEI C,<5*2000> JUMPGE A,PROUT .CLOSE IC, HRRZ D,A SUBI D,BUFFER IMULI D,5 ; max in this buffer MOVEI B,-2(A) CAIGE B,BUFFER-1 MOVEI B,BUFFER ; beginning of buffer MOVE C,B SUBI C,BUFFER IMULI C,5 HRLI B,440700 PRCTRL: ILDB 0,B CAIE 0,^C CAIN 0,^L SKIPA JUMPN 0,PRAOS JRST PROUT PRAOS: CAME C,D AOJA C,PRCTRL PROUT: PUSH P,C MOVE B,[440700,,BUFFER] .CALL [SETZ SIXBIT /SIOT/ MOVEI TYOC B C SETZB LSTERR] JRST [POP P,C JRST PREXIT] SKIPN SCRFLG ; here if scripting JRST PROUT1 MOVE B,[440700,,BUFFER] MOVE C,(P) .CALL [SETZ SIXBIT /SIOT/ MOVEI SCR B C SETZB LSTERR] JRST [POP P,C JRST PREXIT] PROUT1: POP P,C JUMPG A,PRLOOP AOS -4(P) PREXIT: POP P,D POP P,C JRST POPBAJ ;==================================================================== ; SDUMPB and CDUMPB ;==================================================================== QSDUMP: ASCIZ / SDUMPB Set the "Dumped" bit of all matching files. This bit being set is indicated by the absence of "!" next to the date on the LISTF line for a file./ QSDUMP SDUMPB: PUSH P,A MOVEI A,1 HRRM DUMPC MOVE A,[TLO UNDUMP] MOVEM A,DUMPI JRST DUMPB QCDUMP: ASCIZ / CDUMPB Clear the "Dumped" bit of all matching files. This bit being off is indicated by the presence of "!" next to the date on the LISTF line for a file. Files whose "Dumped" bit is zero will be dumped at the next incremental dump./ QCDUMP CDUMPB: PUSH P,A HLLZS DUMPC MOVE A,[TLZ UNDUMP] MOVEM A,DUMPI JRST DUMPB DUMPB: PUSH P,B MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 MOVE A,[FONE,,TONE] PUSHJ P,FMOVER PUSHJ P,MCHECK JRST DMPARG JRST DMPONE ; mark matches PUSHJ P,MARK JRST DMPNON DMPLUP: PUSHJ P,SEARCH JRST DMPXIT MOVE A,(ALT) ; dont try it if any funny bits on MOVE 0,UNRNDM(A) TLNE 0,UNCDEL+UNMARK+UNWRIT+UNLINK JRST DMPLUP MOVE 0,FONE MOVEM 0,TONE MOVE 0,(A) MOVEM 0,TONE+NM1 MOVE 0,1(A) MOVEM 0,TONE+NM2 MOVE 0,FONE+SNM MOVEM 0,TONE+SNM PUSHJ P,XDUMPB JRST DMPLUP MOVE UNRNDM(A) DUMPI: TLO UNDUMP ; fix up my copy of file block MOVEM UNRNDM(A) SKIPL QUIFLG XCT FILER JRST DMPLUP DMPONE: PUSHJ P,XDUMPB JRST DMPXIT OASC [ASCIZ / /] MOVEI A,FONE SKIPL QUIFLG PUSHJ P,ONAMES OASCR [0] DMPXIT: JRST POPBAJ DMPARG: OASCR STRACT JRST DMPXIT DMPNON: OASCR STRNON JRST DMPXIT ; single file reap bit hackery XDUMPB: PUSH P,A MOVEI A,TONE .CALL OPEN JRST DMPLOS .CALL DODUMP JRST DMPLOS AOS -1(P) DMPDON: .CLOSE IC, JRST POPAJ DODUMP: SETZ SIXBIT /SDMPBT/ MOVEI IC DUMPC: MOVEI 0 SETZB LSTERR ; reap bit set failed, complain DMPLOS: OASC [ASCIZ /.CALL SDMPBT of /] MOVEI A,TONE PUSHJ P,OERRF JRST DMPDON QREAP: ASCIZ / REAP Set reference date of files to 0. This means they will be reaped the next time a GFR is done./ QREAP REAP: PUSH P,A MOVE A,[SIXBIT /SRDATE/] MOVEM A,REAPS MOVEI A,0 HRRM A,REAPC MOVE A,[HRRZS UNREF(A)] MOVEM A,REAPI JRST REAPB ;==================================================================== ; SREAPB and CREAPB ;==================================================================== QSREAP: ASCIZ / SREAPB Set the "Do not reap" bit of matching files. This bit being set is indicated in the LISTF line for a file by the presence of a "$" to the left of the creation date. Files whose "Reap" bit is set will not be reaped by the Gr*m F*le R**per./ QSREAP SREAPB: PUSH P,A MOVE A,[SIXBIT /SREAPB/] MOVEM A,REAPS MOVEI A,1 HRRM A,REAPC MOVE A,[TLO UNREAP] MOVEM A,REAPI JRST REAPB QCREAP: ASCIZ / CREAPB Clear the "Do not reap" bit of matching files. This bit being cleared is indicated in the LISTF line for a file by the absence of a "$" to the left of the creation date./ QCREAP CREAPB: PUSH P,A MOVE A,[SIXBIT /SREAPB/] MOVEM A,REAPS MOVEI A,0 HRRM A,REAPC MOVE A,[TLZ UNREAP] MOVEM A,REAPI REAPB: PUSH P,B MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 MOVE A,[FONE,,TONE] PUSHJ P,FMOVER PUSHJ P,MCHECK JRST REPARG JRST REPONE ; mark matches PUSHJ P,MARK JRST REPNON REPLUP: PUSHJ P,SEARCH JRST REPXIT MOVE A,(ALT) ; dont try it if any funny bits on MOVE 0,UNRNDM(A) TLNE 0,UNCDEL+UNMARK+UNWRIT+UNLINK JRST REPLUP MOVE 0,FONE MOVEM 0,TONE MOVE 0,(A) MOVEM 0,TONE+NM1 MOVE 0,1(A) MOVEM 0,TONE+NM2 MOVE 0,FONE+SNM MOVEM 0,TONE+SNM PUSHJ P,XREAPB JRST REPLUP MOVE UNRNDM(A) REAPI: TLO UNREAP ; fix up my copy of file block MOVEM UNRNDM(A) SKIPL QUIFLG XCT FILER JRST REPLUP REPONE: PUSHJ P,XREAPB JRST REPXIT OASC [ASCIZ / /] MOVEI A,FONE SKIPL QUIFLG PUSHJ P,ONAMES OASCR [0] REPXIT: JRST POPBAJ REPARG: OASCR STRACT JRST REPXIT REPNON: OASCR STRNON JRST REPXIT ; single file reap bit hackery XREAPB: PUSH P,A MOVEI A,TONE .CALL OPEN JRST REPLOS .CALL DOREAP JRST REPLOS AOS -1(P) REPDON: .CLOSE IC, JRST POPAJ DOREAP: SETZ REAPS: SIXBIT /SREAPB/ MOVEI IC REAPC: SETZI 0 ; reap bit set failed, complain REPLOS: OASC [ASCIZ /.CALL /] OSIX [SIXBIT /SREAPB/] OASC [ASCIZ / of /] MOVEI A,TONE PUSHJ P,OERRF JRST REPDON ;==================================================================== ; OPEN a file ;==================================================================== ; open file pointed to in ac A in block mode without munging ref date. ; this is used by all routines that just want a file open ; for setting and clearing bits, etc. OPEN: SETZ SIXBIT "OPEN" [12,,IC] (A) 1(A) 2(A) 3(A) SETZB LSTERR ;==================================================================== ; QUOTA and ALLOC ;==================================================================== RDIRSZ: SETZ 'DIRSIZ MOVEI IC MOVEM DQUOTA MOVEM DALLOC SETZB LSTERR SDIRSZ: SETZ 'DIRSIZ MOVEI IC DQUOTA' ; set from dquota: quota,,xxx DALLOC' ; set from dalloc: drive,,alloc SETZB LSTERR ; read quota/alloc cruft. really could get it from our copy of ; directory, but some day we won't have that part of it. QAREAD: PUSHJ P,GETDSK ; get disk data if haven't yet POPJ P, .CALL RDIRSZ JRST QRLOSE .CLOSE IC, AOS (P) POPJ P, QRLOSE: .CLOSE IC, OASC [ASCIZ /Attempt to read DIRSIZ/] PUSHJ P,OERR POPJ P, ; set quota/alloc cruft. QASET: PUSHJ P,GETDSK ; get dsk info and a channel POPJ P, ; lose .CALL SDIRSZ ; set dir size JRST QSLOSE ; lost? .CLOSE IC, ; close channel we used AOS (P) POPJ P, ; couldn't set it for some reason? QSLOSE: .CLOSE IC, OASC [ASCIZ /Attempt to set DIRSIZ/] PUSHJ P,OERR POPJ P, ; here we get information on QRESRV of each pack and, since the system ; can only get pointer to the directory from an open file, ; we open a file on the active directory (which is permitted to be a link). GETDSK: PUSH P,A PUSH P,B JUMPGE DIR,GETDCT ; no active dir, lose MOVE A,(DIR) ; get current file .CALL [SETZ ; open it SIXBIT "OPEN" [32,,IC] ; link mode, don't mung refdate, asc, blk, inpt INDEV (A) 1(A) INDEV+SNM SETZB LSTERR] JRST GETDFL ; oh well, too bad ; get QRESRV info for disks SKIPE NQS JRST GETDSX ; already did this part... MOVE A,[SQUOZE 0,QRESRV] .EVAL A, FATAL .EVAL of QRESRV failed? MOVSS A HRRI A,QALLOC MOVE B,[SQUOZE 0,NQS] .EVAL B, FATAL .EVAL of NQS failed? MOVNS B ; building an AOBJN pointer HRLZS B MOVEM B,NQS .GETLOC A, ; loop getting QRESRV(Q) AOBJN A,.+1 AOBJN B,.-2 MOVE A,[SQUOZE 0,QPKID] .EVAL A, ; now loop getting pack number associated w/ea drive FATAL .EVAL of QPKID failed? MOVSS A HRRI A,QPKID MOVE B,NQS ; get AOBJN pointer .GETLOC A, AOBJN A,.+1 AOBJN B,.-2 GETDSX: AOS -2(P) ; skip, we won JRST POPBAJ GETDCT: OASCR [ASCIZ "Must be pointing at a file in an active directory."] JRST POPBAJ GETDFL: OASC [ASCIZ "OPEN for DIRSIZ call"] PUSHJ P,OERR JRST POPBAJ NQS: 0 ; number of disks in system (actually -n,,0) QALLOC: BLOCK 8 ; max number of disk packs QPKID: BLOCK 8 ;===================================================================== ; QUOTA ;===================================================================== QQUOTA: ASCIZ / QUOTA Set the quota of the active directory to the argument. If no argument, print current directory status./ QQUOTA QUOTA: SKIPGE TERM JRST QAPRNT PUSH P,B PUSHJ P,SCNUMB JRST QUOBAD JUMPL A,QUOBAD PUSHJ P,QAREAD ; read the current state JRST QUOXIT HRLM A,DQUOTA PUSHJ P,QASET JFCL PUSHJ P,QAPRNT QUOXIT: POP P,B POPJ P, QUOBAD: OASCR [ASCIZ /Bad argument to QUOTA command./] JRST QUOXIT ;===================================================================== ; ALLOC and UNALLOC ;===================================================================== QUNALL: ASCIZ / UNALLOC Unallocate a directory. Flushes Quota and Allocation from the currently active directory./ QUNALL UNALLO: PUSH P,B PUSH P,C PUSHJ P,QAREAD ; read current state JRST ALLXIT HRRZS DQUOTA ; save dir size for printing SETZM DALLOC PUSHJ P,QASET JFCL ; lost, but qaset prints reason PUSHJ P,QAPRNT ; print current state JRST ALLXIT QQALLO: ASCIZ / ALLOC , Set the allocation and pack number allocated on for the active directory. If no argument is given, print the current status of the directory. If the directory is already allocated, you may default the second argument./ QQALLO ALLOC: SKIPGE TERM JRST QAPRNT ; no arg, print current state PUSH P,B PUSH P,C PUSHJ P,SCNUMB ; read size argument JRST ALLARG ; not a number, lose JUMPL A,ALLARG ; negative number, also lose MOVE C,A ; save it away JUMPGE B,ALLOC2 ; if not term with crlf, read another ; here given only one argument PUSHJ P,QAREAD ; read current state JRST ALLXIT SKIPE DALLOC JRST ALLOC3 ; okay, continue ; no allocation, so must give pack # OASCR [ASCIZ "Directory is not currently Allocated. You must give a pack number."] JRST ALLXIT ; here read pack # argument ALLOC2: PUSHJ P,SCNUMB JRST ALLARG ; not a number JUMPL A,ALLARG ; negative sucks, too ALLOC1: PUSHJ P,QAREAD ; read current state JRST ALLXIT MOVE B,NQS ; number of packs CAME A,QPKID(B) AOBJN B,.-1 JUMPGE B,BADPAK SKIPN QALLOC(B) ; pack not allocated? JRST NOTALC ; not an allocated pack, lose HRLM A,DALLOC ; stuff out pack number ; come here with c/ new allocation ALLOC3: HRLM C,DQUOTA ; alloc also sets quota HRRM C,DALLOC PUSHJ P,QASET JFCL ; lost, but qaset prints reason PUSHJ P,QAPRNT ; print current state ALLXIT: POP P,C POP P,B POPJ P, BADPAK: OASCR [ASCIZ /Disk pack specified does not exist on this system./] BADPK1: OASC [ASCIZ /Allocated packs are - /] SETZ A, MOVE B,NQS SKIPE QALLOC(B) JRST [SKIPE A ; print all allocated packs OASC [ASCIZ /, /] ODEC QPKID(B) AOJA A,.+1] AOBJN B,.-2 OASCR [ASCIZ /./] JRST ALLXIT NOTALC: OASC [ASCIZ /Disk pack /] ODEC A OASCR [ASCIZ / is not an allocated pack?/] JRST BADPK1 ; tell user which are OK ALLARG: OASCR [ASCIZ /Bad argument to ALLOC command./] JRST ALLXIT ; print current state of dir--size, quota, alloc, pack QAPRNT: PUSHJ P,QAREAD POPJ P, HRRZ A,DQUOTA OASC [ASCIZ "Blocks="] ODEC A SKIPN DALLOC JRST QAQUOT OASC [ASCIZ ", Allocation="] HRRZ A,DALLOC ODEC A OASC [ASCIZ ", Pack="] HLRZ B,DALLOC ODEC B HLRZ B,DQUOTA CAMN A,B ; if alloc, ignore quota if same JRST QAPXIT QAQUOT: HLRZ B,DQUOTA OASC [ASCIZ ", Quota="] ODEC B QAPXIT: OASCR [0] POPJ P, ;==================================================================== ; AUTHOR ;==================================================================== QQAUTH: ASCIZ / AUTHOR , Set the author field associated with matching files./ QQAUTH AUTHOR: PUSH P,A PUSH P,B MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 PUSHJ P,GETSYL JUMPE B,AUTXIT ; no author? MOVEM B,NAUTHO ; new author MOVE A,[FONE,,TONE] PUSHJ P,FMOVER PUSHJ P,MCHECK JRST AUTARG JRST AUTONE ; mark matches PUSHJ P,MARK JRST AUTNON AUTLUP: PUSHJ P,SEARCH JRST AUTXIT MOVE A,(ALT) ; dont try it if any funny bits on MOVE 0,UNRNDM(A) TLNE 0,UNCDEL+UNMARK+UNWRIT JRST AUTLUP MOVE 0,FONE MOVEM 0,TONE MOVE 0,(A) MOVEM 0,TONE+NM1 MOVE 0,1(A) MOVEM 0,TONE+NM2 MOVE 0,FONE+SNM MOVEM 0,TONE+SNM PUSHJ P,SAUTHO JRST AUTLUP MOVE A,(ALT) SKIPL QUIFLG XCT FILER JRST AUTLUP AUTONE: PUSHJ P,SAUTHO JRST AUTXIT OASC [ASCIZ / /] MOVEI A,FONE SKIPL QUIFLG PUSHJ P,ONAMES OASCR [0] AUTXIT: JRST POPBAJ AUTARG: OASCR STRACT JRST AUTXIT AUTNON: OASCR STRNON JRST AUTXIT ; single file author settage SAUTHO: PUSH P,A MOVEI A,TONE .CALL OPEN ; get tone open on IC JRST AUTLOS .CALL [SETZ SIXBIT /SAUTH/ MOVEI IC SETZ NAUTHO] JRST AUTLOS PUSHJ P,FILBLK JRST .+3 LDB [UNAUTH+FILBFR] DPB [UNAUTH+UNREF(A)] AOS -1(P) AUTDON: .CLOSE IC, JRST POPAJ ; author set failed, complain AUTLOS: OASC [ASCIZ /.CALL SAUTH of /] MOVEI A,TONE PUSHJ P,OERRF JRST AUTDON FILBFR: BLOCK 5 FILBLK: .CALL [SETZ 'FILBLK MOVEI IC MOVEM FILBFR MOVEM FILBFR+1 MOVEM FILBFR+2 MOVEM FILBFR+3 SETZM FILBFR+4] POPJ P, AOS (P) POPJ P, ;==================================================================== ; TYPE, T and such ;==================================================================== TYPSET: SETZM TYPACC MOVE A,[440700,,BUFFER] MOVEM A,TYPBYT POPJ P, QQTYPE: ASCIZ / TYPE Type first N lines of a file./ QQTYPE TYPER: PUSHJ P,TYPSET PUSHJ P,CTYPER POPJ P, QCTYPE: ASCIZ / T Type N lines further into a file./ QCTYPE CTYPER: PUSH P,A PUSH P,B PUSH P,C PUSH P,D SETZM BUFFER+2000 SKIPGE TYPACC JRST CRETYP PUSHJ P,SCNUMB ; skip if arg typed MOVE A,TYPDFL ; typeout default size MOVMS A MOVNS A MOVEM A,TYPDFL MOVE D,A MOVEI A,FILE .CALL OPEN JRST TYPERL SKIPE TYPACC .ACCES IC,TYPACC ; access to where we printed from last TYPLUP: MOVE A,[-2000,,BUFFER] .IOT IC,A JUMPGE A,TYPLIN CAMN A,[-2000,,BUFFER] JRST TYPERX SETZM (A) TYPLIN: ILDB A,TYPBYT JUMPE A,TYPCC CAIN A,^C JRST TYPCC PUSHJ P,IOTA CAIE A,^J JRST TYPLIN AOJL D,TYPLIN JRST TYPERX TYPCC: SETOM TYPACC JRST TYPERX JUMPE D,TYPERX MOVEI A,2000 ADDM A,TYPACC MOVE A,[440700,,BUFFER] MOVEM A,TYPBYT JRST TYPLUP CRETYP: PUSHJ P,TYPSET OASC [ASCIZ /EOF?/] TYPERX: OASCR [0] .CLOSE IC, TYPEX1: POP P,D POP P,C JRST POPBAJ TYPERL: OASC [ASCIZ /OPEN of /] MOVEI A,FILE PUSHJ P,OERRF JRST TYPEX1 ;==================================================================== ; STATUS ;==================================================================== QSTATU: ASCIZ / STATUS Print current input device, output device, file, and safety level./ QSTATU STATUS: PUSH P,A OASCR [0] OASC [ASCIZ /Input: /] MOVEI A,INDEV PUSHJ P,ODIR SKIPE DIR OASC [ASCIZ / (Activated)/] OASCR [0] OASC [ASCIZ /Output: /] MOVEI A,OUTDEV PUSHJ P,ODIR OASCR [0] OASC [ASCIZ /File: /] MOVEI A,FILE PUSHJ P,ONAMES OASCR [0] OASC [ASCIZ /Checksum: /] MOVE A,CHKFLG JUMPE A,.+3 OASCR [ASCIZ /ON/] JRST .+2 OASCR [ASCIZ /OFF/] OASC [ASCIZ /Safety: /] NSAFE .+3 OASCR [ASCIZ /SAFE (some checks)/] JRST STATUX QSORRY .+3 OASCR [ASCIZ /SUPER (many checks)/] JRST STATUX OASCR [ASCIZ /SORRY (no safety checks)/] STATUX: OASCR [0] JRST POPAJ ;==================================================================== ; SAFETY modes ;==================================================================== QSSAFE: ASCIZ / SAFE Set normal safety mode: Confirm deletion commands, check for inadvertent deletion during other commands./ QSSAFE SAFETY: SETOB SAFE,SSAFE POPJ P, QSSUPE: ASCIZ / SUPER Set very safe mode: Confirm each action taken for all commands./ QSSUPE SUPER: MOVEI SAFE,1 MOVEM SAFE,SSAFE POPJ P, QSSORR: ASCIZ / SORRY Set un-safe mode: Only confirm attempt to delete entire active directory./ QSSORR SORRY: SETZB SAFE,SSAFE POPJ P, ;==================================================================== ; AUTO typeout ;==================================================================== QAUTO: ASCIZ / AUTO Toggle state (initially off) of automatic file typeout. If on, first few lines of each file will be typed as it becomes one pointed at./ QAUTO AUTO: SETCMB A,AUTFLG PUSHJ P,ONOFF POPJ P, ONOFF: JUMPE A,.+3 OASCR [ASCIZ /ON/] POPJ P, OASCR [ASCIZ /OFF/] POPJ P, ;==================================================================== ; TRAVEL ;==================================================================== QTRAVE: ASCIZ / TRAVEL Toggle direction of travel, initially least to greatest./ QTRAVE TRAVEL: MOVE A,[NEXT#BACK] XORM A,NEXTER XORM A,BACKER MOVE A,[ANEXT#ABACK] XORM A,ANEXTE MOVE A,[CAMG#CAML] XORM A,TESTER MOVE A,[TOP#BOTTOM] XORM A,TOPPER XORM A,BOTTER MOVE A,[ATOP#ABOTTO] XORB A,ATOPPE CAME A,[PUSHJ P,ATOP] JRST .+3 OASCR [ASCIZ /DOWN/] POPJ P, OASCR [ASCIZ /UP/] POPJ P, QNEXT: ASCIZ / NEXT Go to next file in active directory, in current direction of travel./ QNEXT DONEXT: PUSH P,A PUSHJ P,SCNUMB MOVEI A,1 MOVNS A NEXTER: PUSHJ P,NEXT AOJN A,NEXTER JRST POPAJ ANEXTE: PUSHJ P,ANEXT QBACK: ASCIZ / BACK Go to previous file in active directory in current direction of travel./ QBACK DOBACK: PUSH P,A PUSHJ P,SCNUMB MOVEI A,1 MOVNS A BACKER: PUSHJ P,BACK AOJN A,BACKER JRST POPAJ QTOP: ASCIZ / TOP Go to top of active directory, relative to current direction of travel./ QTOP TOPPER: PUSHJ P,TOP POPJ P, ATOPPE: PUSHJ P,ATOP QEND: ASCIZ / END Go to end of active directory, relative to current direction of travel./ QEND BOTTER: PUSHJ P,BOTTOM POPJ P, ;==================================================================== ; TRAVEL utility routines ;==================================================================== NEXT: JUMPE DIR,[POPJ P,] AOBJN DIR,[POPJ P,] SUB DIR,[1,,1] AOS (P) POPJ P, ANEXT: JUMPE ALT,[POPJ P,] AOBJN ALT,[POPJ P,] SUB ALT,[1,,1] AOS (P) POPJ P, BACK: JUMPE DIR,[POPJ P,] PUSH P,A HRRZ A,DIR CAIN A,DIRVCT AOSA -1(P) SUB DIR,[1,,1] JRST POPAJ ABACK: JUMPE ALT,[POPJ P,] PUSH P,A HRRZ A,ALT CAIN A,DIRVCT AOSA -1(P) SUB ALT,[1,,1] JRST POPAJ TOP: PUSH P,A HRRZ A,DIR SUBI A,DIRVCT HRLS A SUB DIR,A JRST POPAJ ATOP: PUSH P,A HRRZ A,ALT SUBI A,DIRVCT HRLS A SUB ALT,A JRST POPAJ BOTTOM: PUSH P,A HLRE A,DIR MOVNI A,1(A) HRLS A ADD DIR,A JRST POPAJ ABOTTO: PUSH P,A HLRE A,ALT MOVNI A,1(A) HRLS A ADD ALT,A JRST POPAJ ;==================================================================== ; COPY, SAVE, etc. ;==================================================================== ; copy flags %DATE==1 ; do not clobber creation/reference dates %SAVE==2 ; this is a SAVE -- delete after winnage %MOVE==4 ; this is a MOVE -- like super-SAVED command ; file copy, flush source QSAVE: ASCIZ / SAVE , SAVE is similar to COPY, except that after the file is copied to the output directory, the old copy is deleted./ QSAVE SAVE: PUSH P,A PUSH P,B TLO K,%SAVE JRST COPCOM ; save, save creation date QSAVED: ASCIZ / SAVED , SAVED is similar to SAVE, but the creation date of the old file is preserved on output./ QSAVED SAVED: PUSH P,A PUSH P,B TLO K,%SAVE+%DATE JRST COPCOM ; really truly "copy" everything about file. QMOVER: ASCIZ / MOVE , MOVE is the ultimate version of a copier. It attempts to move the file "somewhere" else. If is the same DEV:SNM; as , MOVE will ignore links and even preserve the state of the Author, Dump and Reap bits. If is a different DEV:SNM;, the only thing that will not be preserved is the Dump bit (it will be cleared). Note that as in the "SAVE" command, the source is deleted, and you will not be asked to confirm. For the purposes of this command, DKn: is "the same as" DSK:./ QMOVER MOVER: PUSH P,A PUSH P,B TLO K,%SAVE+%MOVE JRST COPCOM ; file copy, save creation date QCOPYD: ASCIZ / COPYD , COPYD is exactly like COPY, except that the creation and reference dates of the new file will be the same as that of the old file./ QCOPYD COPYD: PUSH P,A PUSH P,B TLO K,%DATE JRST COPCOM ; file copy QCOPY: ASCIZ / COPY , Copy a file, default input is current file, output is onto current output device. Sets output device./ QCOPY COPY: PUSH P,A PUSH P,B SETZ K, ; falls through ;==================================================================== ; common COPY code ;==================================================================== ; parse and hack file names COPCOM: MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 ; defaults for output file MOVE A,[FONE,,FTWO] PUSHJ P,FMOVER MOVE A,OUTDEV+DEV MOVEM A,FTWO+DEV MOVE A,OUTDEV+SNM MOVEM A,FTWO+SNM MOVE A,FONE+MK1 MOVEM A,FTWO+MK1 MOVE A,FONE+MK2 MOVEM A,FTWO+MK2 ; parse output file PUSHJ P,SCQUT2 ; new outdev MOVE 0,FTWO MOVEM 0,OUTDEV MOVE 0,FTWO+SNM MOVEM 0,OUTDEV+SNM ; set up tone and ttwo MOVE A,[FONE,,TONE] PUSHJ P,FMOVER MOVE A,[FTWO,,TTWO] PUSHJ P,FMOVER PUSHJ P,MCHECK JRST CPYARG JRST CPYONE ; mark matches PUSHJ P,MARK JRST CPYNON ; no matches CPYLUP: PUSHJ P,SEARCH JRST CPYXIT MOVE A,(ALT) ; dont try it if any funny bits on MOVE 0,UNRNDM(A) TLNE 0,UNWRIT JRST CPYLUP MOVE 0,FONE MOVEM 0,TONE MOVE 0,(A) MOVEM 0,TONE+NM1 MOVE 0,1(A) MOVEM 0,TONE+NM2 MOVE A,(ALT) PUSHJ P,MAKE PUSHJ P,COPIER JRST CPYLUP ; copy failed, just ignore for non-SAVE MOVE A,(ALT) SKIPL QUIFLG XCT FILER ; here for flushage if successful SAVE TLNN K,%SAVE JRST CPYLUP SETZM @(ALT) PUSHJ P,COMPAC JRST CPYLUP CPYXIT: JRST POPBAJ ; here to if no dir, only one copy! CPYONE: PUSHJ P,COPIER ; no matchery, just straight copy JRST CPYXIT OASC [ASCIZ / /] MOVEI A,TONE SKIPL QUIFLG PUSHJ P,ONAMES OASCR [0] JRST CPYXIT CPYARG: OASCR STRACT JRST CPYXIT CPYNON: OASCR STRNON JRST CPYXIT STRNON: ASCIZ /(No Matches)/ STRACT: ASCIZ /* given for non-active directory?/ ;==================================================================== ; COPY utility ;==================================================================== ; single file copier, from TONE to TTWO ; skip if won totally, no skip if not (for use by SAVE) COPIER: NSUPER COPIE1 ; here to give intentions in super safe mode OASC [ASCIZ / COPY /] MOVEI A,TONE PUSHJ P,OFILE OASC [ASCIZ / to /] MOVEI A,TTWO PUSHJ P,OFILE OASCI "? PUSHJ P,YESNO POPJ P, COPIE1: PUSH P,A PUSH P,B TLNE K,%MOVE ; don't bother if MOVE PUSHJ P,QSAME ; and just moving in same dir. SKIPA JRST COP1 PUSHJ P,OEXIST JRST COPFAI ; open files (output is temp, right now) ; open input file COP1: .CALL [SETZ SIXBIT "OPEN" [6,,IC] TONE TONE+NM1 TONE+NM2 TONE+SNM SETZB LSTERR] JRST COPLOI TLNN K,%DATE+%MOVE JRST COP2 ; restore ref date of the crock .CALL RESRDT JFCL .CALL IFILBL JRST [MOVE A,TONE CAMN A,[SIXBIT "DSK"] FATAL CAN'T READ FILE INFORMATION JRST COP2] .CALL IRAUTH SETOM FAUTH ; fake it ; open temp file for output COP2: MOVE TTWO MOVEM TEMP MOVE TTWO+SNM MOVEM TEMP+3 .CALL [SETZ SIXBIT "OPEN" [7,,OC] TEMP TEMP+1 TEMP+2 TEMP+3 SETZB LSTERR] JRST COPLOO SETZ C, ; preserve creation date TLNN K,%DATE+%MOVE JRST COPLUP .CALL SCDATE JRST [MOVE A,TTWO CAMN A,[SIXBIT "DSK"] FATAL CAN'T SET CREATION DATE JRST COPLUP] .CALL SRDATE JRST [MOVE A,TTWO CAMN A,[SIXBIT "DSK"] FATAL CAN'T SET REFERENCE DATE JRST COPLUP] ; here to set state of output file info to that of input file if MOVE command TLNN K,%MOVE JRST COPLUP ; not MOVE SKIPN FAUTH ; gets huffy about set UNAUTH to 0? JRST MIOREP .CALL OSAUTH JFCL ; who cares? MIOREP: MOVE A,FRNDM TLNN A,UNREAP JRST .+3 .CALL OSREAP JRST [MOVE A,TTWO CAMN A,[SIXBIT "DSK"] FATAL CAN'T SET REAP BIT JRST COPLUP] TLNE A,UNDUMP PUSHJ P,QSAME JRST COPLUP .CALL OSDMPB FATAL CAN'T SET DUMPED BIT? ; copy loop COPLUP: MOVE A,[-2000,,BUFFER] .IOT IC,A SKIPGE A .CLOSE IC, HLLZS A MOVE B,[-2000,,BUFFER] SUB B,A SKIPN CHKFLG JRST COPLU1 ; here update checksum if needed PUSH P,B ADD C,(B) AOBJN B,.-1 POP P,B COPLU1: .IOT OC,B JUMPGE A,COPLUP MOVEM C,CHKSUM ; save checksum ; here to checksum if wants SKIPN CHKFLG ; skip if checksummed JRST COPRNM .CALL [SETZ SIXBIT "RCHST" MOVEI OC RNMLNK RNMLNK+1 RNMLNK+2 SETZ RNMLNK+3] .CLOSE OC, .CALL [SETZ SIXBIT "OPEN" [6,,IC] RNMLNK RNMLNK+1 RNMLNK+2 RNMLNK+3 SETZB LSTERR] JRST CHKOPN SETZ C, CHKLUP: MOVE A,[-2000,,BUFFER] .IOT IC,A HLLZS A MOVE B,[-2000,,BUFFER] SUB B,A ADD C,(B) AOBJN B,.-1 JUMPGE A,CHKLUP CAMN C,CHKSUM JRST CHKRNM OASC [ASCIZ /CHECKSUM FAILED, RETRY?/] PUSHJ P,YESNO JRST CHKFAI JRST COP1 ; retry ; here rename after successful checksum CHKRNM: PUSHJ P,DEXIST .CALL [SETZ 'RENAME RNMLNK RNMLNK+1 RNMLNK+2 RNMLNK+3 TTWO+NM1 TTWO+NM2 SETZB LSTERR] FATAL CAN'T RENAME FILE IN RNMLNK JRST COPSAV ; here to rename while open for writing COPRNM: .CALL [SETZ 'RENMWO MOVEI OC TTWO+NM1 TTWO+NM2 SETZB LSTERR] FATAL CAN'T RENAME WHILE OPEN FILE OPEN ON OC .CLOSE OC, ; here to delete source of copy for "SAVE" command COPSAV: PUSHJ P,QSAME ; skips if tone and ttwo same -- tone already gone TLNN K,%SAVE JRST COPXIT ; here for save hack PUSHJ P,DELETR JRST COPFAI ; single copy win, skip COPXIT: AOS -2(P) ; single copy failure (no skip) COPFAI: JRST POPBAJ ; here if checksum failed CHKFAI: .CLOSE OC, JRST COPFAI ; checksum open failed CHKOPN: MOVEI A,RNMLNK OASC [ASCIZ /CHECKSUM OPEN of /] PUSHJ P,OERRF JRST COPFAI ; copy open for read lost COPLOI: MOVEI A,TONE SKIPA ; copy open for write lost COPLOO: MOVEI A,TEMP OASC [ASCIZ /OPEN of /] PUSHJ P,OERRF JRST COPFAI QSAME: MOVE A,TONE+NM1 CAME A,TTWO+NM1 POPJ P, MOVE A,TONE+NM2 CAME A,TTWO+NM2 POPJ P, MOVE A,TONE+SNM CAME A,TTWO+SNM POPJ P, MOVE A,TONE PUSHJ P,QDISK JRST QSAME1 MOVE A,TTWO PUSHJ P,QDISK POPJ P, AOS (P) POPJ P, QSAME1: MOVE A,TONE CAMN A,TTWO AOS (P) POPJ P, ; skip if dsk-or dkn device QDISK: CAMN A,[SIXBIT "DSK"] JRST QDISKT AND A,[SIXBIT "__"] CAMN A,[SIXBIT "DK"] QDISKT: AOS (P) POPJ P, OSDMPB: SETZ 'SDMPBT MOVEI OC SETZI 1 ; set dump bit IRAUTH: SETZ SIXBIT "RAUTH" MOVEI IC SETZM FAUTH OSAUTH: SETZ SIXBIT "SAUTH" MOVEI OC SETZ FAUTH SCDATE: SETZ 'SFDATE MOVEI OC SETZ FDATE SRDATE: SETZ 'SRDATE MOVEI OC SETZ FREF OSREAP: SETZ 'SREAPB SETZI OC RESRDT: SETZ 'RESRDT SETZI IC IFILBL: SETZ 'FILBLK MOVEI IC MOVEM FNM1 MOVEM FNM2 MOVEM FRNDM MOVEM FDATE SETZM FREF FNM1: 0 FNM2: 0 FRNDM: 0 FDATE: 0 FREF: 0 FAUTH: 0 ;==================================================================== ; EXISTS? ;==================================================================== %EXIST==10 ; if one, delete existing file of same name ; see if open for output will clobber existing file ; and if so, ask user his opinion OEXIST: PUSH P,A TLZ K,%EXIST ; if either name is > or <, won't clobber MOVE A,TTWO+NM1 CAME A,[SIXBIT /> /] CAMN A,[SIXBIT /< /] JRST OEXDEL MOVE A,TTWO+NM2 CAME A,[SIXBIT /> /] CAMN A,[SIXBIT /< /] JRST OEXDEL ; no > or <, must actually look MOVEI A,TTWO .CALL OPEN JRST OEXDEL ; if non-sorry mode, warn that file exists QSORRY OEXIS2 OASCI 11 MOVEI A,TTWO PUSHJ P,OFILE OASC [ASCIZ / already exists, delete it?/] PUSHJ P,YESNO JRST OEXKEP ; no skip, no ; exists, he says delete it! OEXIS2: TLO K,%EXIST ; skip return, deleted or never there OEXDEL: AOS -1(P) ; if kept file, no delete, no skip OEXKEP: JRST POPAJ DEXIST: TLNN K,%EXIST POPJ P, .CALL [SETZ 'DELETE TTWO TTWO+NM1 TTWO+NM2 TTWO+SNM SETZB LSTERR] FATAL CAN'T DELETE FILE IN TTWO POPJ P, ;==================================================================== ; RENAME ;==================================================================== QRENAM: ASCIZ / RENAME , RENAME first argument to second, if two arguments, or current file to argument if only one given. If a directory is active, star matching may be used to rename many files at once./ QRENAM RENAME: PUSH P,A MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 LDB A,COMPTR CAIE A,^M JRST RENTWO MOVE A,[FONE,,FTWO] PUSHJ P,FMOVER MOVE A,[FILE,,FONE] PUSHJ P,FMOVER JRST RENMSK RENTWO: MOVE A,[FONE,,FTWO] PUSHJ P,FMOVER PUSHJ P,SCQUT2 RENMSK: MOVE 0,FTWO MOVEM 0,OUTDEV MOVE 0,FTWO+SNM MOVEM 0,OUTDEV+SNM ; set up tone and ttwo MOVE A,[FONE,,TONE] PUSHJ P,FMOVER MOVE A,[FTWO,,TTWO] PUSHJ P,FMOVER PUSHJ P,MCHECK JRST RENARG JRST RENONE PUSHJ P,MARK JRST RENNON ; here for multiple renames RENLUP: PUSHJ P,SEARCH JRST RENXIT MOVE A,(ALT) MOVE 0,UNRNDM(A) TLNE 0,UNIGFL JRST RENLUP MOVE 0,FONE MOVEM 0,TONE MOVE 0,(A) MOVEM 0,TONE+NM1 MOVE 0,1(A) MOVEM 0,TONE+NM2 PUSHJ P,MAKE PUSHJ P,RENAMR JRST RENLUP MOVE A,(ALT) SKIPL QUIFLG XCT FILER ; update name area MOVE A,(ALT) MOVE 0,TTWO+NM1 MOVEM 0,(A) MOVE 0,TTWO+NM2 MOVEM 0,1(A) JRST RENLUP RENXIT: JRST POPAJ RENONE: PUSHJ P,RENAMR JRST RENXIT OASC [ASCIZ / /] MOVEI A,TONE SKIPL QUIFLG PUSHJ P,ONAMES OASCR [0] RENAMR: PUSH P,A NSUPER RNMER1 ; if super safe, tell intentions OASC [ASCIZ / RENAME /] MOVEI A,TONE PUSHJ P,OFILE OASC [ASCIZ / to /] MOVEI A,TTWO PUSHJ P,ONAMES OASCI "? PUSHJ P,YESNO JRST RNMFAL ; here to check if new name exists RNMER1: PUSHJ P,OEXIST JRST RNMLOS ; here do rename PUSHJ P,DEXIST .CALL [SETZ 'RENAME TONE TONE+NM1 TONE+NM2 TONE+SNM TTWO+NM1 TTWO+NM2 SETZB LSTERR] JRST RNMLOS AOS -1(P) RNMFAL: JRST POPAJ RNMLOS: MOVEI A,TONE OASC [ASCIZ /RENAME of /] PUSHJ P,OERRF JRST RNMFAL RENARG: OASCR STRACT JRST RENXIT RENNON: OASCR STRNON JRST RENXIT QQLINK: ASCIZ / LINK , Create links to all files which match second argument from files on device given in first argument. If only one argument, link it to current file./ QQLINK LINK: PUSH P,A PUSH P,COMPTR PUSHJ P,SCQUT2 MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 POP P,COMPTR MOVE A,[FONE,,FTWO] PUSHJ P,FMOVER MOVE A,OUTDEV MOVEM A,FTWO MOVE A,OUTDEV+SNM MOVEM A,FTWO+SNM PUSHJ P,SCQUT2 MOVE 0,FTWO MOVEM 0,OUTDEV MOVE 0,FTWO+SNM MOVEM 0,OUTDEV+SNM ; set up tone and ttwo MOVE A,[FONE,,TONE] PUSHJ P,FMOVER MOVE A,[FTWO,,TTWO] PUSHJ P,FMOVER PUSHJ P,MCHECK JRST LNKARG JRST LNKONE PUSHJ P,MARK JRST LNKNON LNKLUP: PUSHJ P,SEARCH JRST LNKXIT MOVE A,(ALT) MOVE 0,FONE MOVEM 0,TONE MOVE 0,(A) MOVEM 0,TONE+NM1 MOVE 0,1(A) MOVEM 0,TONE+NM2 PUSHJ P,MAKE PUSHJ P,LINKER JRST LNKLUP MOVE A,(ALT) SKIPL QUIFLG XCT FILER JRST LNKLUP LNKXIT: JRST POPAJ LNKARG: OASCR STRACT JRST LNKXIT LNKNON: OASCR STRNON JRST LNKXIT LNKONE: PUSHJ P,LINKER JRST LNKXIT OASC [ASCIZ / /] MOVEI A,TONE SKIPL QUIFLG PUSHJ P,ONAMES OASCR [0] JRST LNKXIT ; individual linker routine LINKER: NSUPER LINER1 ; now tell intentions if in super mode OASC [ASCIZ / LINK /] MOVEI A,TTWO PUSHJ P,OFILE OASC [ASCIZ / to /] MOVEI A,TONE PUSHJ P,OFILE OASCI "? PUSHJ P,YESNO JRST LINFAL ; here check if from part already exists LINER1: PUSHJ P,OEXIST JRST LINFAL ; now do it! PUSHJ P,DEXIST .CALL [SETZ SIXBIT "MLINK" TTWO TTWO+NM1 TTWO+NM2 TTWO+SNM TONE+NM1 TONE+NM2 TONE+SNM SETZB LSTERR] JRST LINLOS AOS (P) LINFAL: POPJ P, LINLOS: MOVEI A,TONE OASC [ASCIZ /LINK to /] PUSHJ P,OERRF JRST LINFAL ; TYPEOUT UUOS ZZZ==. LOC 40 0 JSR UUOH LOC ZZZ UUOCT==0 UUOTAB: JRST ILUUO IRPS X,,[ODEC OBPTR OOCT OCTLP OASCC OSIX OASC OASCI OASCR OSIXS] UUOCT==UUOCT+1 X=UUOCT_33 JRST U!X TERMIN UUOMAX==.-UUOTAB UUOH: 0 PUSH P,A PUSH P,B PUSH P,C MOVEI @40 ; get eff addr. of uuo MOVEM UUOE' MOVE @0 MOVEM UUOD' ; contents of eff adr MOVE B,UUOE ; eff adr LDB A,[270400,,40] ; get uuo ac, LDB C,[330600,,40] ; op code CAIL C,UUOMAX MOVEI C,0 ; grt=>illegal JRST @UUOTAB(C) ; go to proper rout UUORET: POP P,C POP P,B POP P,A ; restore ac's JRST 2,@UUOH ILUUO: FATAL ILLEGAL UUO UOBPTR: MOVEI C,0 MOVE B,@40 JRST UOASC1 UOASCR: SKIPA C,[^M] ; cr for end of type UOASC: MOVEI C,0 ; no cr HRLI B,440700 ; make ascii pointer UOASC1: ILDB A,B ; get char JUMPE A,.+3 ; finish? PUSHJ P,IOTA JRST .-3 ; and get another SKIPE A,C ; get saved cr? PUSHJ P,IOTA JRST UUORET UOASCC: HRLI B,440700 ; make ascii pointer UOAS1C: ILDB A,B ; get char CAIN A,^C JRST UUORET PUSHJ P,IOTA JRST UOAS1C ; and get another UOCTLP: MOVEI A,^P PUSHJ P,DIOT MOVE A,B PUSHJ P,DIOT JRST UUORET DIOT: .CALL [SETZ SIXBIT /IOT/ MOVSI %TJDIS MOVEI TYOC A SETZB LSTERR] FATAL IOT FAILED POPJ P, UOASCI: MOVE A,B ; prt ascii immediate PUSHJ P,IOTA JRST UUORET UOSIX: MOVE B,UUOD USXOOP: JUMPE B,UUORET LDB A,[360600,,B] ADDI A,40 PUSHJ P,IOTA LSH B,6 JRST USXOOP UOSIXS: MOVE A,[440600,,UUOD] USLOOP: ILDB C,A ADDI C,40 PUSHJ P,IOTC TLNE A,770000 JRST USLOOP JRST UUORET UODEC: SKIPA C,[10.] ; get base for decimal UOOCT: MOVEI C,8. ; octal base MOVE B,UUOD ; get actual word to prt JRST .+3 ; join code UODECI: SKIPA C,[10.] ; decimal UOOCTI: MOVEI C,8. MOVEM C,BASE' SKIPN A HRREI A,-1 ; a=digit count PUSHJ P,UONUM ; print numbr JRST UUORET UONUM: IDIV B,BASE HRLM C,(P) ; save digit SOJE A,UONUM1 ; done if 0 SKIPG A ; + => more SKIPE B ; - => b=0 => done PUSHJ P,UONUM ; else more UONUM1: HLRZ C,(P) ; retreive digits ADDI C,"0 ; make to ascii CAILE C,"9 ; is it good dig ADDI C,"A-"9-1 ; make hex digit PUSHJ P,IOTC POPJ P, ; ret IOTC: PUSH P,A MOVE A,C PUSHJ P,IOTA JRST POPAJ IOTA: CAIN A,^P JRST IOTAP IOTA1: CAIN A,^J JRST .+3 SKIPE SCRFLG .IOT SCR,A .IOT TYOC,A CAIE A,^M POPJ P, SKIPE SCRFLG .IOT SCR,[^J] POPJ P, IOTAP: SKIPE SCRFLG .IOT SCR,A .IOT TYOC,["^] ADDI A,100 JRST IOTA1 ; INTERRUPT HANDLER ZZZ=. LOC 42 JSR TSINT LOC ZZZ TSINT: 0 0 PUSH P,A PUSH P,B SKIPGE A,TSINT JRST TSINTM ; second word int TSINTG: MOVEI A,TYIC .ITYIC A, JRST TSDIS CAIE A,^G CAIN A,^S SKIPA JRST TSCRIP TSINTR: MOVEI A,TYIC PUSHJ P,TRESET MOVEI A,TYOC PUSHJ P,TRESET TSINTS: SETZM QUTFLG ; close all channels .CLOSE IC, .CLOSE OC, .CLOSE ERR, .IOPDL .CLOSE XFIC, SETZM XFLAG MOVE P,[-100.,,PDL+1] MOVE SAFE,SSAFE .DISMIS [QQLOOP] TSINTM: TRNN A,1_TYOC ; more only on output channel JRST TSINTG MOVE A,[440700,,[ASCIZ /--More--/]] MOVEI B,8 .CALL [SETZ SIXBIT /SIOT/ MOVEI TYOC A B SETZB LSTERR] FATAL SIOT LOST .CALL [SETZ ? SIXBIT /FINISH/ ? SETZI TYOC] FATAL FINISH LOST .CALL [SETZ SIXBIT /IOT/ MOVEI TYIC A MOVSI %TIPEK+%TIACT SETZB LSTERR] FATAL IOT LOST CAIE A,40 CAIN A,177 .CALL [SETZ ; eat space and rubout SIXBIT /IOT/ MOVEI TYIC A MOVSI %TIACT SETZB LSTERR] JFCL CAIE A,40 ; space is continue JRST TSINTS ; not space is stop .IOT TYOC,[^M] .IOT TYOC,[^J] JRST TSDIS TSCRIP: SKIPE QUTFLG JRST TSDIS CAIE A,^B JRST .+4 SKIPN SCROPN SETOM SCRFLG JRST TSREAD CAIE A,^E JRST .+3 SETZM SCRFLG JRST TSREAD CAIE A,^W JRST .+3 SETOM QUIFLG JRST TSREAD CAIE A,^V JRST TSDIS SETZM QUIFLG TSREAD: .IOT TYIC,A TSDIS: POP P,B POP P,A .DISMIS TSINT+1 TRESET: LSH A,27 IOR A,[.RESET] XCT A POPJ P, ; EXTERNALS READ: PUSH P,A PUSH P,B SETZM COMMND MOVE [COMMND,,COMMND+1] BLT 0,COMMND+17 PUSHJ P,RCMD SKIPN SCRFLG JRST READ1 MOVE A,[440700,,COMMND] READ2: ILDB 0,A JUMPE READ1 CAIE ^J .IOT SCR, CAIN ^M .IOT SCR,[^J] JRST READ2 READ1: JRST POPBAJ FMOVER: PUSH P,B MOVE B,A BLT A,3(B) POP P,B POPJ P, FMOVET: PUSHJ P,B MOVE B,A BLT A,5(B) POP P,B POPJ P, ; tyi that gets from either tty or an xfile TYI: MOVE A,XFLAG JUMPE A,TYI1 .IOT XFIC,A CAIE A,^C JUMPGE A,[POPJ P,] ; here to close an xfile .CLOSE XFIC, SOSLE XFLAG .IOPOP XFIC, MOVEI A,^J ; need a character that is ignored POPJ P, TYI1: .IOT TYIC,A POPJ P, ; command reader RCMD: MOVE B,[440700,,COMMND] MOVEM B,COMPTR MOVEI C,0 RCMD1: PUSHJ P,TYI CAIN A,177 JRST RUB CAIN A,^D JRST RREPEA CAIN A,^L JRST RCLEAR CAIN A,^J JRST RCMD1 ; characters here get output for xfiles SKIPE XFLAG PUSHJ P,IOTA CAIN A,^Q JRST RQUOTE CAIN A,^M JRST RCMDX RCMDL: IDPB A,B CAMGE B,[350700,,COMMND+17] AOJA C,RCMD1 RCFUL: IDPB A,B MOVEI A,15 IDPB A,B RCMDX: IDPB A,B SKIPE XFLAG OASCI ^J MOVEI A,0 IDPB A,B POPJ P, RREPEA: OASCR [0] JRST REPPER RCLEAR: SKIPE XFLAG JRST RCMD1 OCTLP "C JUMPGE DIR,REPPER MOVE A,(DIR) SKIPN QUIFLG XCT FILER REPPER: OASCI "@ OASC COMMND JRST RCMD1 RQUOTE: IDPB A,B CAML B,[350700,,COMMND+17] JRST RCFUL SETOM QUTFLG AOS C PUSHJ P,TYI SETZM QUTFLG' CAIN A,177 OASC [ASCIZ /^?/] JRST RCMDL RUB: PUSHJ P,RUBBER JRST RCMD JRST RCMD1 RUBBER: SOJL C,[POPJ P,] LDB D,B ; pick up dead character MOVEI A,0 DPB A,B ; smash it in buffer XCT XCTRUB ADD B,[070000,,] TLNE B,400000 ADD B,[347777,,-1] AOS (P) POPJ P, RUBECH: CAIN D,177 JRST [OASC [ASCIZ /^?/] POPJ P,] OASCI (D) POPJ P, RUBFLS: MOVE TTYOPT TLNE %TOSAI JRST RUBONE CAIN D,177 JRST RUBTWO CAIL D,40 JRST RUBONE CAIE D,33 CAIN D,10 JRST RUBONE CAIE D,^I CAIN D,^L JRST RUBONE RUBTWO: OCTLP "X ; controls that echo as ^x RUBONE: OCTLP "X POPJ P, SCNUMB: SETZB A,B ILDB B,COMPTR JUMPE B,[POPJ P,] JRST SCNUMT SCNUM1: ILDB B,COMPTR CAIE B," CAIN B,", JRST SCNUMX CAIN B,^M JRST SCNMX1 ; terminator JUMPE B,SCNUMX SCNUMT: CAIL B,"0 CAILE B,"9 POPJ P, IMULI A,10. SUBI B,"0 ADD A,B JRST SCNUM1 SCNMX1: SETO B, SCNUMX: AOS (P) POPJ P, SCQUT1: PUSH P,D MOVEI D,FONE SETZM 4(D) SETZM 5(D) JRST SCOMON SCQUT2: PUSH P,D MOVEI D,FTWO JRST SCOMON SCNAM1: PUSH P,D MOVEI D,FONE JRST SCNAME SCNAM2: PUSH P,D MOVEI D,FTWO ; read a file name from the buffer SCNAME: SETOM 4(D) SETOM 5(D) SCOMON: PUSH P,A PUSH P,B PUSH P,C PUSH P,E MOVSI C,-4 HRRI C,1(D) SCNGET: PUSHJ P,GETSYL JUMPE B,SCNX CAIN A,': MOVEM B,(D) CAIN A,'; MOVEM B,3(D) JUMPG A,SCNGET MOVEM B,(C) MOVEM E,3(C) JUMPL A,SCNX AOBJN C,SCNGET SCNX: POP P,E POP P,C POP P,B POP P,A POP P,D POPJ P, ; get a syllable from command buffer GETSYL: PUSH P,C PUSH P,[0] MOVEI B,(P) PUSH P,[-1] MOVEI C,(P) HRLI B,440600 HRLI C,440600 GETSLP: PUSHJ P,GETCCA JUMPL A,GETSX SETO E, CAIN A,^Q JRST GETQOT SUBI A,40 JUMPL A,GETSX JUMPE A,GETSP CAIN A,'* SETZ E, CAIE A,': CAIN A,'; JRST GETSX GETSPT: CAIL A,100 SUBI A,40 TLNN B,770000 JRST GETSLP IDPB A,B IDPB E,C JRST GETSLP GETQOT: ILDB A,COMPTR SUBI A,40 JUMPGE A,GETSPT JRST GETSX GETSP: TLNE B,400000 JRST GETSLP GETSX: POP P,E ; star word POP P,B ; character word POP P,C CAMN B,STAR CAME E,[SIXBIT / _____/] POPJ P, SETZ E, POPJ P, GETCCA: ILDB A,COMPTR JUMPE A,GETCCX CAIN A,^I MOVEI A,40 CAIN A,^M JRST GETCCX CAIE A,", CAIN A," GETCCX: SETOM A POPJ P, [ASCIZ / ANSWER Specify treatment of Yes-No questions. Takes 'YES', 'NO', or no argument. 'NO' answers are safe at all times. No argument means ask for answer from TTY./] ANSWER: PUSHJ P,GETSYL CAMN B,[SIXBIT /YES/] JRST ANSYES CAMN B,[SIXBIT /NO/] JRST ANSNO OASCR [ASCIZ /Answering Yes-No questions from TTY./] SETZM FYESNO POPJ P, ANSYES: OASCR [ASCIZ /Always answer 'Yes' to Yes-No questions./] MOVEI 1 MOVEM FYESNO POPJ P, ANSNO: OASCR [ASCIZ /Always answer 'No' to Yes-No questions./] SETOM FYESNO POPJ P, YESNO: OASC [ASCIZ / (Y or N): /] SKIPE FYESNO JRST PYESNO .IOT TYIC,0 SKIPE SCRFLG .IOT SCR,0 CAIE 0,"Y CAIN 0,"y SKIPA JRST NOYES OASCR [ASCIZ /es./] YESANS: AOS (P) POPJ P, NOYES: CAIE 0,"N CAIN 0,"n SKIPA JRST YESNO OASCR [ASCIZ /o./] NOANS: POPJ P, PYESNO: SKIPG FYESNO JRST PNOYES OASCR [ASCIZ /Yes./] JRST YESANS PNOYES: SKIPL FYESNO FATAL HARDWARE LOSES? OASCR [ASCIZ /No./] JRST NOANS MCHECK: PUSH P,A JUMPGE DIR,NOTACT MOVE A,FONE CAME A,INDEV JRST NOTACT MOVE A,FONE+SNM CAME A,INDEV+SNM JRST NOTACT AOS -1(P) ONEACT: AOS -1(P) STRERR: JRST POPAJ NOTACT: MOVNI A,1 CAMN A,FONE+MK1 CAME A,FONE+MK2 JRST STRERR CAMN A,FTWO+MK1 CAME A,FTWO+MK2 JRST STRERR JRST ONEACT ; A/ name to parse NMPARS: PUSH P,B PUSH P,C SETZ C, CAMN A,STAR JRST NMDONE MOVE B,[440600,,A] SETO C, NMPAR1: CAMN B,[000600,,A] JRST NMDONE ILDB 0,B CAIE 0,'* JRST NMPAR1 HRRI B,C SETZ DPB 0,B HRRI B,A JRST NMPAR1 NMDONE: MOVE A,C POP P,C POP P,B POPJ P, ; A/ ptr to a dir slot MATCH: PUSH P,B PUSH P,C MOVE B,FONE+NM1 AND B,FONE+MK1 MOVE C,(A) AND C,FONE+MK1 CAME B,C JRST MATLOS MOVE B,FONE+NM2 AND B,FONE+MK2 MOVE C,1(A) AND C,FONE+MK2 CAMN B,C AOS -2(P) MATLOS: POP P,C POP P,B POPJ P, ; A/ ptr to dir entry MAKE: PUSH P,A PUSH P,B PUSH P,C PUSH P,ALT MOVE C,A MOVE A,FTWO MOVEM A,TTWO MOVE A,FTWO+SNM MOVEM A,TTWO+SNM MOVE A,(C) ANDCM A,FTWO+MK1 MOVEM A,TTWO+NM1 MOVE A,FTWO+NM1 AND A,FTWO+MK1 IOR A,TTWO+NM1 MOVE B,1(C) ANDCM B,FTWO+MK2 MOVEM B,TTWO+NM2 MOVE B,FTWO+NM2 AND B,FTWO+MK2 IOR B,TTWO+NM2 ; if output in active dir, make new name with qfng MOVE 0,INDEV+DEV CAME 0,TTWO+DEV JRST MAKEX MOVE 0,TTWO+SNM CAMN 0,INDEV+SNM PUSHJ P,QFNG ; make > or < in active dir MAKEX: MOVEM A,TTWO+NM1 MOVEM B,TTWO+NM2 POP P,ALT POP P,C JRST POPBAJ ; ----------------- ; LF NAME PRINTER ; ------------------------ LFQUIK: PUSHJ P,PNTFIL OASC [ASCIZ / /] OSIXS (A) OASCI " OSIXS 1(A) OASCR [0] POPJ P, PNTFIL: HRRZS A CAME A,OLDM JRST .+3 OASCI "+ POPJ P, OASCI 40 POPJ P, ; ================================================================ ; listf line file spec printer ; ================================================================ LFPRNT: JUMPE DIR,[POPJ P,] PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,F PUSH P,K PUSH P,M MOVE M,A PUSHJ P,PNTFIL ; print "+" for current file PUSHJ P,LNKFIL JRST RSTLIN ; for non-links ; file is a link OSIXS [SIXBIT/ L /] OSIXS (M) OASCI " OSIXS (M)+1 OASCI " ; here to print file linked to OSIX BUFFER+2 OASCI " OSIX BUFFER OASCI " OSIX BUFFER+1 JRST DATPRT ; print crlf and return ENDLIN: OASCR [0] POP P,M POP P,K POP P,F POP P,E POP P,D POP P,C JRST POPBAJ ; here to print normal file ; print pack number RSTLIN: LDB B,[150500,,(M)UNRNDM] IDIVI B,10. SETZI K, ADDI B,'0 ADDI C,'0 DPB B,[220600,,K] DPB C,[140600,,K] LDB B,[220600,,(M)UNRNDM] TRNE B,UNIGFL TLO K,(SIXBIT/*/) ; if file is open or deleted OSIXS K OSIXS (M) OASCI " OSIXS (M)+1 MOVE A,M ; print length of file in blocks PUSHJ P,FILLEN ; takes pointer in A to name area OASCI " ODEC K OASC [ASCIZ/ (/] ; length in last block LDB K,[301200,,UNRNDM(M)] ODEC K OASCI ") DATPRT: OASCI " MOVE A,UNRNDM(M) MOVSI K,(ASCIZ/!/) SKIPL A,UNRNDM(M) TLNE A,UNLINK MOVSI K,(ASCIZ/ /) ; undumped bit OASC K TLNE A,UNREAP ; don't reap bit OASCI "$ ; print date and time of creation, reference AOSN (M)UNDATE JRST PRTDSH SOS (M)UNDATE LDB K,[270400,,(M)UNDATE] ODEC K OASCI "/ LDB K,[220500,,(M)UNDATE] ODEC K OASCI "/ LDB K,[330700,,(M)UNDATE] ADDI K,1900. ODEC K OASCI " HRRZ B,(M)UNDATE MOVEI A,3 SETZI D, LSH B,-1 TILOP: IDIVI B,10. ADDI C,'0 LSHC C,-6 IDIVI B,6 ADDI C,'0 LSHC C,-6 SOJG A,TILOP MOVEI B,2 MOVEI A,": TILOP2: SETZI C, LSHC C,6 ADDI C,40 PUSHJ P,IOTC SETZI C, LSHC C,6 ADDI C,40 PUSHJ P,IOTC SKIPE B PUSHJ P,IOTA SOJGE B,TILOP2 PRTREF: OASC [ASCIZ / (/] LDB K,[270400,,(M)4] ODEC K OASCI "/ LDB K,[220500,,(M)4] ODEC K OASCI "/ LDB K,[330700,,(M)4] ADDI K,1900. ODEC K OASCI ") ; print creator if not sname LDB K,[UNAUTH+UNREF(M)] JUMPE K,ENDLIN OASCI 40 CAIN K,777 ; random JRST AUTRAN LSH K,1 ADDI K,MFDBUF+2000 SUB K,MDNUDS+MFDBUF SUB K,MDNUDS+MFDBUF MOVE B,(K) CAMN B,DIRBUF+2 JRST ENDLIN OSIX (K) JRST ENDLIN AUTRAN: OASC [ASCIZ /-random-/] JRST ENDLIN PRTDSH: OASC [ASCIZ /-no date- /] JRST PRTREF ; table of sixbit byte pointers BYTPTR: 440600,,B 360600,, 300600,, 220600,, 140600,, 60600,, ; find out length of file ; takes pointer to name area in A FILLEN: LDB A,[UNDSCP+UNRNDM(A)] ANDI A,17777 IDIVI A,UFDBPW ADDI A,DIRBUF+UDDESC HLL A,BYTPTR(B) SETZI K, AFLLN1: ILDB B,A SKIPN B POPJ P, CAILE B,UDTKMX JRST AFLLN2 ADD K,B JRST AFLLN1 AFLLN2: CAIGE B,UDWPH AOJA K,AFLLN1 CAIN B,UDWPH JRST AFLLN1 IBP A IBP A AOJA K,AFLLN1 ; build the spec of the file pointed to by a link ; skip returns if file is a link, with snm nm1 nm2 in first three ; words of BUFFER LNKFIL: PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,F PUSH P,M MOVE M,A MOVE A,(M)UNRNDM TLNN A,UNLINK ; is it a link? JRST LNKNOT ; no, do normal cruft ; here if file is a link ; here to build name of file linked to ANDI A,17777 IDIVI A,UFDBPW ADDI A,DIRBUF+UDDESC HLL A,BYTPTR(B) MOVE F,BYTPTR SETZB B,C SETZB D,E QL1: ILDB 0,A JUMPE 0,QL3 CAIN 0,': SOJL E,QL4 CAIN 0,'; SOJL E,QL2 QL5: IDPB 0,F JRST QL1 QL2: TLZ F,770000 JRST QL1 QL4: MOVEI E,1 JRST QL1 QL3: MOVEM B,BUFFER+2 MOVEM C,BUFFER MOVEM D,BUFFER+1 AOS -6(P) LNKNOT: POP P,M POP P,F POP P,E POP P,D POP P,C POP P,B POPJ P, SEARCH: PUSH P,A SEARC1: MOVE A,(ALT) TLNE A,%MATCH JRST GOTONE ; not a match XCT ANEXTE JRST SEARC1 JRST SEARCX ; found match, remove match bit and return ALT GOTONE: HRLZI 0,%MATCH ANDCAM 0,(ALT) AOS -1(P) SEARCX: JRST POPAJ NSEARC: PUSH P,A NSEAR1: MOVE A,(ALT) TLNN A,%MATCH JRST NGOTON ; not a match XCT ANEXTE JRST NSEAR1 JRST NSEARX ; found match, remove match bit and return ALT NGOTON: HRLZI 0,%MATCH IORM 0,(ALT) AOS -1(P) NSEARX: JRST POPAJ MORE: PUSH P,A PUSH P,B PUSH P,C PUSH P,D HRLZI D,%FOUND JRST MARCOM MARK: PUSH P,A PUSH P,B PUSH P,C PUSH P,D HRLZI D,%FOUND+%FLUSH+%MATCH ; clean out bits, always top down MARCOM: MOVE ALT,DIR PUSHJ P,ATOP ANDCAM D,(ALT) AOBJN ALT,.-1 ; now get right pointer for current dir of travel MOVE ALT,DIR XCT ATOPPER SETZ D, JRST SEALU2 SEALUP: HRLZI 0,%FOUND IORM 0,(ALT) SEALU1: XCT ANEXTER SKIPA JRST SEAXIT SEALU2: MOVE C,(ALT) TLNE C,%FOUND JRST SEALU1 MOVE A,FONE+NM1 CAME A,[SIXBIT /> /] CAMN A,[SIXBIT /< /] JRST MATCH2 ; > and < always match AND A,FONE+MK1 MOVE 0,(C) AND 0,FONE+MK1 CAME A,0 JRST SEALUP MOVE A,(C) MATCH2: MOVE B,FONE+NM2 CAME B,[SIXBIT /> /] CAMN B,[SIXBIT /< /] JRST MATWIN AND B,FONE+MK2 MOVE 0,1(C) AND 0,FONE+MK2 CAME B,0 JRST SEALUP MOVE B,1(C) ; here its a match MATWIN: SETO D, PUSH P,ALT PUSHJ P,QLOOK ; returns dir ptr in A HRLZI 0,%FOUND+%MATCH IORM 0,(ALT) POP P,ALT JRST SEALUP ; skip return if ever found a match, return in ALT the topped dir SEAXIT: MOVE ALT,DIR XCT ATOPPE SKIPE D AOS -4(P) ; skip return, found a match POP P,D POP P,C JRST POPBAJ QFNG: SKIPA C,[SETZ] QLOOK: MOVEI C,0 ; C/ name1 or name2? PUSH P,D PUSH P,H PUSH P,I PUSH P,J PUSH P,K HRRZI J,DIRBUF ; file names in a,b ADD J,UDNAMP(J) ; is name1 or name2 > or /] TLOA J,400000 CAMN A,[SIXBIT / CAMN B,[SIXBIT />/] TLOA J,400000 CAMN B,[SIXBIT / or <, just return it JRST QLKLOS ; no > or < ; done! QLOOK2: JUMPL C,QFNG1 SUB P,[2,,2] MOVE K,(P) JUMPE K,QLKLO1 ; "find" all that match otherwise MOVE ALT,(P) XCT ATOPPER QLKFND: MOVE K,(ALT) XCT QLKI1(C) ; skip if has same name as match JRST .+3 HRLZI 0,%FOUND IORM 0,(ALT) XCT ANEXTER JRST QLKFND QLKLO1: POP P,ALT ; winner! ; return one we found QLKLOS: POP P,K POP P,J POP P,I POP P,H POP P,D POPJ P, QFNG1: SKIPN -2(P) JRST QFNG2 ;NOT FOUND START W/ 1 MOVE H,-1(P) TLC H,400000 MOVE I,[600,,H] QFNG3: LDB D,I CAIL D,'0 CAILE D,'9 JRST QFNG4 ;REACH END OF NUMERIC FIELD AOS D CAILE D,'9 JRST QFNG5 DPB D,I QFNG5A: TLNE H,770000 JRST QFNG3A LSH H,6 JRST QFNG5A QFNG2: MOVSI H,(SIXBIT /1/) QFNG3A: MOVEM H,A(C) ;STORE INTO A OR B AS APPRO SUB P,[3,,3] JRST QLKLOS QFNG5: MOVEI D,'0 DPB D,I ADD I,[60000,,] JUMPL I,QFNG5A JRST QFNG3 QFNG4: TLNN H,770000 ;SKIP ON ALREADY 6 CHAR NAME LSH H,6 MOVEI D,'1 DPB D,I MOVEI D,'0 QFNG4B: TLNN I,770000 JRST QFNG5A IDPB D,I JRST QFNG4B ; actual search: ; C/ 0 = name1, 1 = name2 ; J/ 4.9 = 1, > ; = 0, < ; enter here if name1 is > <, C=0, 4.9 of J set if > QLOOKA: CAME B,[SIXBIT / or /] JRST QLKLOS ; lose ; enter here if name2 is > <, C=1, 4.9 bit of J set if > QLOOK1: XCT ATOPPER PUSH P,[0] ; best index PUSH P,[SETZ] ; best "numeric" part PUSH P,[SETZ] ; best alpha part QLOOK4: MOVE K,(ALT) TLNE K,%FOUND JUMPGE C,QLOOK3 XCT QLKI1(C) JRST QLOOK3 SKIPE H,@QLKI1+1(C) QLOOK6: TRNE H,77 ; right adj JRST QLOOK5 LSH H,-6 JRST QLOOK6 QLOOK5: MOVEI I,0 QLOOK8: LDB D,[600,,H] CAIL D,'0 CAILE D,'9 JRST QLOOK7 ; not a digit QLOK5B: TRNE I,77 ; right adj low non num part JRST QLOK5A LSH I,-6 JUMPN I,QLOK5B QLOK5A: TLC H,400000 ; avoid cam lossage TLC I,400000 SKIPN -2(P) JRST QLOK5D ; first match JUMPGE J,QLOK5E ; get least CAMGE H,-1(P) ; get greatest JRST QLOOK3 CAME H,-1(P) JRST QLOK5D CAMGE I,(P) JRST QLOOK3 ; not as good QLOK5D: MOVEM ALT,-2(P) MOVEM H,-1(P) MOVEM I,(P) QLOOK3: XCT ANEXTER JRST QLOOK4 ; loop ; end of dir, -2(p) contains match JRST QLOOK2 ; end of dir QLOK5E: CAMLE H,-1(P) JRST QLOOK3 CAME H,-1(P) JRST QLOK5D CAMLE I,(P) JRST QLOOK3 JRST QLOK5D QLOOK7: LSHC H,-6 ; low digit not numeric JUMPN H,QLOOK8 ; no numeric digits at all ("bin", maybe?) JUMPL J,QLOK5B ; if looking for greatest, let this be least MOVNI H,1 ; greatest if looking for least JRST QLOK5B ; comparison insts. QLKI1: CAME B,UNFN2(K) CAME A,UNFN1(K) UNFN2(K) QQDIR: ASCIZ / DIR Simulates DIR device, but works on directory in core./ QQDIR DIRECT: MOVE A,[FILE,,FONE] PUSHJ P,FMOVER PUSHJ P,SCNAM1 MOVE A,FONE+NM1 ; is it a comparative subset? HRLZI B,-SBSET1 PUSH P,[0] CAMN A,SBNAM1(B) JRST PRSSBN AOBJN B,.-2 ; is it a not? CAMN A,[SIXBIT/NOT/] SETOM NOTSW MOVE A,FONE+NM2 HRLZI B,-SBSETS CAMN A,SBNAME(B) JRST GOTSBN AOBJN B,.-2 TRZ A,7777 CAME A,[SIXBIT/PACK/] JRST NOSUBS LDB A,[060600,,FONE+NM2] ; get pack number SUBI A,'0 IMULI A,10. MOVEM A,PACKNO LDB A,[000600,,FONE+NM2] SUBI A,'0 ADDM A,PACKNO MOVE A,[PUSHJ P,IFPACK] SETOM (P) JRST DOGC NOSUBS: MOVE A,[SKIPA] JRST DOGC PRSSBN: XCT SBPARS(B) ; parse second name JRST BADOP SKIPA A,SBINS1(B) GOTSBN: MOVE A,SBINST(B) SETOM (P) ; subsetting DOGC: PUSHJ P,GCDIR ; garbage collect it POP P,A ; get back subset switch JUMPN A,NOTOPN ; if subsetting - no sort MOVE A,FONE+NM2 ; see if up or down CAME A,[SIXBIT/DOWN/] JRST .+3 SETOM ASCEND ; descending order JRST FNDWD3 CAME A,[SIXBIT /UP/] JRST BADOP SETZM ASCEND FNDWD3: MOVE A,FONE+NM1 HRLZI B,-SRTCNT CAMN A,SRTNAM(B) JRST DOSRT ; sort needed AOBJN B,.-2 JRST BADOP ; not recognized - no sort DOSRT: MOVEI A,DIRBUF MOVE B,SRTINS(B) PUSHJ P,DIRSRT ; sort the directory NOTOPN: PUSHJ P,PRSDIR MOVE DIR,ALT SETZM OLDM POPJ P, BADOP: OASCR [ASCIZ /DIR -- Illegal mode/] POPJ P, SBNAM1: SIXBIT /CDATE>/ SIXBIT /CDATE=/ SIXBIT /CDATE/ SIXBIT /RDATE=/ SIXBIT /RDATE FREE 1-UDTKMX => TAKE NEXT N ;UDTKMX+1 THRU UDWPH-1 => SKIP N-UDTKMX AND TAKE ONE ;40 BIT SET => LOAD ADDRESS. LOWER 5 BITS PLUS NEXT TWO CHARS (17 BITS IN ALL) FLEN: PUSH P,B PUSH P,C PUSH P,D PUSH P,A MOVE B,UNRNDM(A) TLNE B,UNLINK JRST FLENLK LDB A,[UNDSCP UNRNDM(A)] IDIVI A,6 ADDI A,UDDESC HRLS A ADDI A,DIRBUF MOVE D,A HRLI D,440600 JUMPE B,BLKLUP ILDB 0,D SOJG B,.-1 BLKLUP: ILDB 0,D JUMPE 0,LSTBYT CAIL 0,UDTKMX JRST ADDTHEM ADD B,0 JRST BLKLUP ADDTHE: CAIN 0,UDWPH JRST BLKLUP AOS B CAIG 0,UDWPH JRST BLKLUP ILDB 0,D ILDB 0,D JRST BLKLUP LSTBYT: POP P,A JUMPE B,FLENXT SOS B IMULI B,1024. LDB A,[UNWRDC UNRNDM(A)] ADD B,A FLENXT: MOVE A,B POP P,D POP P,C POP P,B POPJ P, FLENLK: MOVE B,[377777,,-1] POP P,A JRST FLENXT ; dirsrt - directory sort routine (image mode disk-style directories). ; takes two arguments: ; A/ pointer to the directory to be sorted - will be sorted ; in place. ; B/ instruction to use for comparison. Instruction should ; expect pointers to name areas in A and B. It should ; skip if and only if the name area pointed to by B ; should preceed the name area pointed to by A. (the ; instruction can use registers C and D without restoring ; them. DIRSRT: MOVE E,B ; save the compare instruction MOVEI F,2000-LUNBLK(A) ; get pointer to end of dir ADD A,UDNAMP(A) ; get pointer to beginning of name area DSRT01: CAML A,F ; more than one entry left in dir? POPJ P, ; no - done MOVEI B,LUNBLK(A) ; get address of second in this section DSRT02: XCT E ; compare them JRST DSRT04 ; no switch needed HRR C,A ; need to switch HRLI C,-LUNBLK ; make aobjn pointer DSRT03: MOVE D,(C) ; swap the entries EXCH D,(B) MOVEM D,(C) AOS B AOBJN C,DSRT03 SKIPA ; have already incremented b DSRT04: ADDI B,LUNBLK CAMG B,F ; second pointer to the end? JRST DSRT02 ; no - compare this one ADDI A,LUNBLK ; yes - decrease sort space JRST DSRT01 ; go back for more ; this page contains comparison routines for various sort conditions. ; cname1 and cname2 are comparison routines used by the comparison ; routines. they do not skip if the names are the same. skip if ; once if a preceeds b and twice otherwise. CNAME1: MOVE C,UNFN1(A) ; set up comparison of name 1s MOVE D,UNFN1(B) CNAMES: TLC C,400000 ; make letters come last TLC D,400000 CAMN C,D ; the same? POPJ P, ; yes - no skip AOS (P) ; skip at least once CAML C,D ; which is first AOS (P) ; (b) - skip POPJ P, CNAME2: MOVE C,UNFN2(A) ; set up comparison of second names MOVE D,UNFN2(B) JRST CNAMES NAME1: PUSHJ P,CNAME1 ; compare on name 1 JRST NAME1E ; the same - rank based on name 2 JRST AFIRST ; (a) is first JRST BFIRST ; (b) is first NAME1E: PUSHJ P,CNAME2 ; first names the same - compare second POPJ P, ; the same - don't exchange JRST AFIRST ; (a) is first JRST BFIRST ; (b) is first NAME2: PUSHJ P,CNAME2 ; repeat for comparing name 2 first JRST NAME2E JRST AFIRST JRST BFIRST NAME2E: PUSHJ P,CNAME1 POPJ P, JRST AFIRST JRST BFIRST ; compare based on file length LENGTH: PUSH P,A ; save a and b PUSH P,B PUSHJ P,FLEN ; get first length MOVE C,A MOVE A,(P) ; get second length PUSHJ P,FLEN MOVE D,A POP P,B ; restore a and b POP P,A JRST COMPAR ; go do comparison ; compare based on creation dates CDATE: MOVE C,UNDATE(A) ; compare creation dates MOVE D,UNDATE(B) JRST COMPAR ; compare based on reference dates RDATE: HLRZ C,UNREF(A) HLRZ D,UNREF(B) COMPAR: CAMN C,D JRST NAME1 ; if the same - sort on name basis CAMG C,D ; otherwise compare JRST AFIRST JRST BFIRST AFIRST: SKIPE ASCEND ; ascending order? AOS (P) ; no - switch needed POPJ P, BFIRST: SKIPN ASCEND ; ascending order? AOS (P) ; yes - switch needed POPJ P, ASCEND: 0 ; this page contains routines to parse dates into directory format ; and names into * format MASK: 0 ; mask for name DPARSE: PUSH P,A LDB A,[301400,,FONE+NM2] PUSHJ P,SIXNUM JRST DPLOSE DPB A,[UNYRB FDATE] LDB A,[141400,,FONE+NM2] PUSHJ P,SIXNUM JRST DPLOSE DPB A,[UNMON FDATE] LDB A,[001400,,FONE+NM2] PUSHJ P,SIXNUM JRST DPLOSE DPB A,[UNDAY FDATE] AOS -1(P) DPLOSE: JRST POPAJ SIXNUM: CAIL A,(SIXBIT / 00/) CAILE A,(SIXBIT / 99/) POPJ P, PUSH P,B MOVE B,A LSH A,-6 ANDI A,17 IMULI A,10. ANDI B,17 ADD A,B POP P,B AOS (P) POPJ P, ; a/ name to parse DRNAME: PUSH P,A MOVE A,FONE+NM2 PUSHJ P,NMPARS MOVEM A,MASK MOVE A,FONE+NM2 AND A,MASK MOVEM A,FDATE AOS (P) JRST POPAJ ; this page contains routines that are used for directory subset ; selection. ; keep on creation date IFCDG: PUSH P,A HLLZ A,UNDATE(A) CAMG A,FDATE JRST FLSHIT JRST KEEPIT IFCDE: PUSH P,A HLLZ A,UNDATE(A) CAME A,FDATE JRST FLSHIT JRST KEEPIT IFCDL: PUSH P,A HLLZ A,UNDATE(A) CAML A,FDATE JRST FLSHIT JRST KEEPIT ; keep on reference date IFRDG: PUSH P,A HLLZ A,UNREF(A) CAMG A,FDATE JRST FLSHIT JRST KEEPIT IFRDE: PUSH P,A HLLZ A,UNREF(A) CAME A,FDATE JRST FLSHIT JRST KEEPIT IFRDL: PUSH P,A HLLZ A,UNREF(A) CAML A,FDATE JRST FLSHIT JRST KEEPIT ; keep if name1 same IFNM1: PUSH P,A MOVE A,UNFN1(A) AND A,MASK CAME A,FDATE ; does double duty JRST FLSHIT JRST KEEPIT ; keep if name2 same IFNM2: PUSH P,A MOVE A,UNFN2(A) AND A,MASK CAME A,FDATE JRST FLSHIT JRST KEEPIT ; keep if dumped IFDUMP: PUSH P,A MOVE A,UNRNDM(A) TLNE A,UNLINK JRST NEVER TLNN A,UNDUMP JRST FLSHIT JRST KEEPIT ; keep if pack number matches that it packno IFPACK: PUSH P,A MOVE A,UNRNDM(A) TLNE A,UNLINK JRST NEVER LDB A,[UNPKN+A] CAME A,PACKNO JRST FLSHIT JRST KEEPIT ; keep if a link IFLINK: PUSH P,A MOVE A,UNRNDM(A) TLNN A,UNLINK JRST FLSHIT JRST KEEPIT FLSHIT: POP P,A SKIPE NOTSW AOS (P) ; he said not - keep it POPJ P, KEEPIT: POP P,A SKIPN NOTSW AOS (P) ; he said only - keep it POPJ P, NEVER: JRST POPAJ NOTSW: 0 PACKNO: 0 QBTBLI: 440600,, ;IF GOING TO ILDB 360600,, 300600,, 220600,, 140600,, 060600,, 000600,, END START