github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-23 19:07:45 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/sysen2/dired.188
Lars Brinkhoff 508f8970b3 Some Y2K fixes.
2017-01-11 16:16:14 -08:00

5020 lines
90 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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, ? <cmd> 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 <command>
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 <string>
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 <indev>,<outdev>
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 <directories>
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 <device>,<directories>
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 <file>
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 <file>
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 <file>
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 <file1>,<file2>
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 <file>
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 <file>
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 <dir>
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 <file>
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 <file>
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 <file>
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 <files>
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 <files>
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 <files>
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 <files>
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 <files>
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 <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 <allocn>,<pack#>
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 <file>,<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 <n>
Type first N lines of a file./
QQTYPE
TYPER: PUSHJ P,TYPSET
PUSHJ P,CTYPER
POPJ P,
QCTYPE: ASCIZ /
T <n>
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 <infile>,<outfile>
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 <infile>,<outfile>
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 <infile>,<outfile>
MOVE is the ultimate version of a copier. It attempts to
move the file "somewhere" else. If <outfile> is the same DEV:SNM;
as <infile>, MOVE will ignore links and even preserve the state of the
Author, Dump and Reap bits. If <outfile> 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 <infile>,<outfile>
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 <infile>,<outfile>
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 <file1>,<file2>
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 <file1>,<file2>
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 <how>
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 <?
CAMN A,[SIXBIT />/]
TLOA J,400000
CAMN A,[SIXBIT /</]
JRST QLOOKA ; 4.9 bit of j set if >
CAMN B,[SIXBIT />/]
TLOA J,400000
CAMN B,[SIXBIT /</]
AOJA C,QLOOK1 ; C/ pointer to which name we are looking at
; not > 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 /</] ; can't both be > or <!
CAMN B,[SIXBIT />/]
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 <file>
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=/
SIXBIT /RDATE</
SIXBIT /FIRST/
SIXBIT /SECOND/
SBSET1=.-SBNAM1
SBPARS: PUSHJ P,DPARSE
PUSHJ P,DPARSE
PUSHJ P,DPARSE
PUSHJ P,DPARSE
PUSHJ P,DPARSE
PUSHJ P,DPARSE
PUSHJ P,DRNAME
PUSHJ P,DRNAME
SBINS1: PUSHJ P,IFCDG
PUSHJ P,IFCDE
PUSHJ P,IFCDL
PUSHJ P,IFRDG
PUSHJ P,IFRDE
PUSHJ P,IFRDL
PUSHJ P,IFNM1
PUSHJ P,IFNM2
SBNAME: SIXBIT/DUMPED/
SIXBIT/LINKS/
SIXBIT/LINK/
SBSETS==.-SBNAME
SBINST: PUSHJ P,IFDUMP
PUSHJ P,IFLINK
PUSHJ P,IFLINK
SRTNAM: SIXBIT/NAME1/
SIXBIT/NAME2/
SIXBIT/LENGTH/
SIXBIT/CDATE/
SIXBIT/RDATE/
SRTCNT==.-SRTNAM
SRTINS: PUSHJ P,NAME1
PUSHJ P,NAME2
PUSHJ P,LENGTH
PUSHJ P,CDATE
PUSHJ P,RDATE
; gcdir - directory garbage collector - written especially
; for archiver - does not have all the features needed by
; the system's garbage collector.
; gcdir the directory is already in core started at the location
; whose lable is arcdir. it will also assume that can use a 2000 word
; block beginning at block3. it clobbers acs a,b,c,d,e,tt.
; arg in a - instruction to execute with address of directory
; name area in a. instruction should skip if entry should be
; retained. files with first name of zero are always flushed.
GCDIR: PUSH P,A ; SAVE RETAIN INSRUCTION
MOVE A,[DIRBUF,,BUFFER]
BLT A,BUFFER+UDDESC-1 ; COPY THE DIRECTORY HEADER
MOVE A,(P)
PUSHJ P,GCDIR1 ; CALL REAL GARBAGE COLLECTOR
MOVE A,[BUFFER,,DIRBUF] ; BLT BACK
BLT A,DIRBUF+1777
JRST POPAJ
GCDIR1: PUSH P,A ; save retain instruction
MOVEI E,1 ; index of next available desc byte
MOVE D,[360600,,BUFFER+UDDESC] ; byte pointer to next desc
MOVEI F,BUFFER+2000
MOVEI C,2000-LUNBLK
CAMGE C,DIRBUF+UDNAMP ; anything there?
JRST GCOVER ; done
GCLOOP: SKIPN DIRBUF(C) ; is entry name zero?
JRST GCNEXT ; yes - flush it
HRRZI A,DIRBUF(C)
XCT (P) ; keep it?
JRST GCNEXT ; no
HRLS A ; yes - copy it
SUBI F,LUNBLK
HRR A,F ; make blt pointer
BLT A,4(F)
LDB A,[UNDSCP+UNRNDM+DIRBUF(C)] ; get index of desc area
DPB E,[UNDSCP+UNRNDM(F)] ; set new index
IDIVI A,UFDBPW ; get word number
ADDI A,DIRBUF+UDDESC ; get word address
HLL A,QBTBLI(B) ; get byte pointer
GCDCPY: ILDB B,A ; transfer the descriptor area
IDPB B,D
AOS E ; update index of next one
TRNE B,40 ; is this start of an address?
JRST GCDADR ; yes - jump
JUMPN B,GCDCPY ; go until zero is copied
JRST GCNEXT
GCDADR: ILDB B,A ; disk adr - copy next two bytes
IDPB B,D ; without looking
ILDB B,A
IDPB B,D
ADDI E,2
JRST GCDCPY
GCNEXT: SUBI C,LUNBLK ; go next entry
CAML C,DIRBUF+UDNAMP ; done?
JRST GCLOOP ; no
; yes
GCOVER: MOVEM E,BUFFER+UDESCP ; save index of available byte
SUBI F,BUFFER
MOVEM F,BUFFER+UDNAMP ; save index of first name area
HRRI E,1(D) ; zero in between space
HRLI E,2(D)
SETZM 1(D)
HRRZ A,BUFFER+UDNAMP ; from end of descriptors to name area
ADDI A,BUFFER-1 ; get address of 1-adr of name area
CAILE A,(E) ; any room to zero?
BLT E,(A) ; yes - zero it
JRST POPAJ ; restore instruction
; flen - get file length - input a/ pointer to name area
; OUTPUT A/ FILE LENGTH
; descriptor byte meanings
;0 => 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
Reference in New Issue View Git Blame Copy Permalink