Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50407/dskcpy.mac
There are no other files named dskcpy.mac in the archive.
TITLE DSKCPY V2A FS COPYING PROGRAM
SUBTTL DICK BAKER-MUNTON HATFIELD (OCT 74)
EXTERN .JBREL,.JBFF,.JBREN,.HELPR
TWOSEG
JBVER==137
VWHO==1
VMAJ==2
VMIN==1
VEDIT==53
; (C) COPYRIGHT 1975,1976 DECUS
LOC JBVER
BYTE (3)VWHO(9)VMAJ(6)VMIN(18)VEDIT
RELOC 0
;REVISION HISTORY
; DSKCPY WRITTEN AT HATFIELD POLYTECHNIC, ENGLAND
; SUBMITTED TO DECUS (10-125) WITHOUT VERSION #
; REWRITTEN COMPLETELY BY DICK BAKER-MUNTON IN 1974
; (WHILE AT HATFIELD, NOW WITH DEC, READING, ENGLAND)
; RESUBMITTED TO DECUS SEPT 1975 AS DSKCPY V2(45)
; [46] ADD /SORT SWITCH
; USE SUSET. UUO IN PLACE OF SUPER USETI IF POSS.
; DEFINE SYMBOLS LOGFN,LOGEXT,ERRFN,ERREXT
; REPLACE RIB??? WITH .RB??? SYMBOLS
; [47] MAKE SWITCHES TABLE DRIVEN
; [50] MAKE DECNO WORK (NULL ## CODE WRONG)
; [51] CORRECT EXTENDED RIB HANDLING
; RESUBMITTED TO DECUS AFTER SPRING DECUS AT HYANNIS AS V2A(51)
; [52] CORRECT MULTIPLE PACK FS CODE
; [53] CORRECT /D:n SWITCH
; KEEP CREATION MODE (Hakan Agvald)
; AND IMPLEMENT FTOLQT (ditto)
; PRINT STATUS ON I/O ERRORS
; IMPLEMENT RIPNFS,RIPABU BITS IN .RBSTS
; CORRECT EXTENDED RIB HANDLING (AGAIN)
; RESUBMIT TO DECUS AS XMAS PRESENT
;AC 'S
F=0
A=1
B=A+1
C=A+2
D=A+3
CH=5
T=6
T1=T+1
T2=T+2
N=11
M=N+1
RIBST=13
DIRECT=14
STS=15
RPTR=16
P=17
;HOME BLOCK
HOMBL1==1 ;PRIME HOME BLOCK
HOMBL2==12 ;SPARE HOME BLOCK
HOMNAM==0
HOMID==1
HOMSNM==4
HOMGRP==13
HOMCNP==16
HOMCKP==17
HOMCLP==20
HOMBPC==21
HOMCOD==176
HOMSLF==177
HOMFCF==33 ;FCFS BLOCK COUNT IS PUT HERE
;BIT DEFINITIONS
F.PRO==1B0 ;DIRECTORY NON-PURGABILITY
F.QUE==1B9 ;/QUE
F.SYS==1B10 ;/SYS
F.SORT==1B11 ;TEMPORARY SORT BIT
F.DSRT==1B12 ;/SORT:DIRECTORY
F.FSRT==1B13 ;/SORT:FILES
F.JNK==1B14 ;DIRECTORY NOT EMPTY
F.JNK1==1B15 ;DITTO
F.PRG==1B16 ;"I HAVE PURGED THIS DIRECTORY"
F.COP==1B17 ;"I HAVE COPIED FILES IN THIS DIRECTORY"
F.DIR==1B34 ;NON-VIRGIN DIRECTORY ON OBJ FS
F.FIL==1B35 ;NON-NEW FILE ON OBJ FS
;DEFAULTS
F.DFLT==F.SYS!F.DSRT!F.FSRT ;DEFAULT IS /SORT:ALL/SYS
DFLTD==^D30 ;DEFAULT PURGE IS /D:30
;MSGLEVEL BITS
MSGPRG==1B32
MSGTX==1B33
MSGDEL==1B34
MSGCOP==1B35
;RIB BLOCK DISPLACEMENTS
.RBCNT==0
.RBFIR==0
.RBPPN==1
.RBNAM==2
.RBEXT==3
.RBPRV==4
.RBSIZ==5
.RBEST==10
.RBALC==11
.RBPOS==12
.RBSTS==17
RIPLOG==1B0
RIPDIR==1B18
RIPNDL==1B19
RIPNFS==1B21
RIPABC==1B22
RIPABU==1B24
RIPFCE==1B27
.RBQTF==22
.RBQTO==23
.RBUSD==25
.RBPCA==31
.RBXRA==34
DIRPTR==35 ;DIRECTORY POINTER
DIRDET==36 ;DIRECTORY INFO (SOU,,OBJ)
RIBCOD==176
.RBSLF==177
EXTLEN==.RBPCA+1
;GETTAB VARIABLES
%LDMFD==0,,16
%LDSYS==1,,16
%LDQUE==4,,16
;CLOSE OPTIONS
CL.ACS==10
CL.NMB==20
CL.RST==40
CL.DAT==100
;I/O CHANNELS
HLPCHN==0
RIBS==1
SOU==2
OBJ==3
TTY==4
LOG==5
;FILE.EXT DEFNs
LOGFN=='DSKCPY'
LOGEXT=='LOG '
ERRFN=='DSKCPY'
ERREXT=='ERR '
;OPDEFS
OPDEF SUSET.[CALLI 146]
OPDEF NOP[HALT]
OPDEF PJRST[JRST]
;FT SWITCHES
IFNDEF HATFLD,< HATFLD==0>
IFNDEF ERAZE,< ERAZE==-1> ;NZ = DELETE EMPTY DIRECTORIES
IFNDEF FTOLQT,< FTOLQT=0> ;[53] NZ = KEEP IN/OUT QUOTAS
TTBUFF: BLOCK ^D14
SOUHOM: BLOCK 200
OBJHOM: BLOCK 200
TTYHD: BLOCK 3
ILOGHD: BLOCK 3
OLOGHD: BLOCK 3
FSLINE: BLOCK 17
STACK: BLOCK 20 ;PROCEDURE PUSHDOWN LIST
SFDMAX==6
DSTACK: BLOCK SFDMAX+2 ;DIRECTORY PUSHDOWN STACK
LEVEL: BLOCK 1
PATHPT: BLOCK 1 ;DIRECTORY PATH POINTER
PATHS: BLOCK 11 ;CURRENT DEFAULT DIRECTORY PATH
IOLIST: BLOCK 2
RETPTS: BLOCK 200 ;FOR EXTENDED RIBS
FNOR: BLOCK SFDMAX+1
FNAND: BLOCK SFDMAX+1
OVRFL: BLOCK 1 ;SAFETY FIRST !
EXTOR: BLOCK SFDMAX+1
EXTAND: BLOCK SFDMAX+1
;DSKCHR INDICES
.DCNAM==0
.DCUSZ==6
.CHLEN==.DCUSZ+1
CHRBUF: BLOCK .CHLEN
MAXUN==10 ;MAXIMUM # UNITS IN FS
MAXUNI: BLOCK 1 ;ACTUAL # UNITS IN FS
UNIBPU: BLOCK MAXUN ;# BLOCKS PER UNIT
BLK1AD: BLOCK 1 ;LOG. BLK ADDR OF FIRST BLOCK IN UNIT
MAXCL: BLOCK 1 ;# CLUSTERS ON UNIT
RELOC 400000
DSKCPY: RESET
MOVE P,[IOWD 20,STACK] ;INITIALISE PUSHDOWN LIST
MOVE T,[%LDMFD]
GETTAB T,
MOVE T,[1,,1]
MOVEM T,MFDPPN#
MOVE T,[%LDSYS]
GETTAB T,
MOVE T,[1,,4]
MOVEM T,SYSPPN#
MOVE T,[%LDQUE]
GETTAB T,
MOVE T,[3,,3]
MOVEM T,SPLPPN#
JRST FROMFS
;DETERMINE & VALIDATE FROM- AND TO- FILE-STRUCTURES
FROMSG: OUTSTR [
ASCIZ"? SOURCE FILE-STRUCTURE MUST BE ON-LINE & WRITE-ENABLED"]
FROMFS: OUTSTR [ASCIZ"
FROM WHICH FILE-STRUCTURE ? "]
PUSHJ P,FSNAM ;GET REPLY
MOVE T,[3,,B]
DSKCHR T,
JRST FROMSG ;NOT A MOUNTED DISK
TLNN T,340305
TLNN T,2 ;TEST FOR FS NAME
JRST FROMSG
MOVEM D,SFCFS0# ;ORIGINAL FCFS FOR S FS
MOVEI A,16 ;DUMP MODE
SETZ C,
OPEN SOU,A
SKIPA
OPEN RIBS,A
JRST EROPNS
MOVEI A,40 ;SYNCHRONOUS ASCII MODE
MOVE C,[OLOGHD,,ILOGHD]
OPEN LOG,A
JRST EROPNS
;READ HOME BLOCK
MOVE T,[IOWD 200,SOUHOM]
MOVEM T,IOLIST
MOVEI A,SOUHOM ;ARG FOR HOMTST
MOVEI C,HOMBL1
USETI SOU,C
IN SOU,IOLIST
PUSHJ P,HOMTST ;IS IT OK ?
SKIPA C,[EXP HOMBL2]
JRST CHKSUM ;ALL'S WELL ON SOURCE FS
OUTSTR [ASCIZ"% FIRST HOME BLOCK FAULTY
"]
SETSTS SOU,16 ;[53] CLEAR ERROR BITS IF ANY
;TRY SECOND HOME BLOCK
USETI SOU,C
IN SOU,IOLIST
PUSHJ P,HOMTST
JRST ERINSH
;SET UP CHECKSUM STUFF
CHKSUM: HLLZ T,SOUHOM+HOMCKP ;BYTE POINTER
TLZ T,770077
ADDI T,T1
MOVEM T,LSBITS#
LDB T,[POINT 6,SOUHOM+HOMCKP,11]
MOVNM T,CKSUM# ;RIGHT SHIFTS
;FIND MAX BLOCKS/UNIT
UNICHR: MOVSI N,-MAXUN
SETZM STRBPU#
MOVE T1,SOUHOM+HOMSNM
MOVE T2,[POINT 6,T1]
ILDB T,T2
JUMPN T,.-1
TLNN T2,770000
JRST LNGSNM ;FS NAME IS 6 CHARS LONG
XORI T2,T1
TRZE T2,-1
LNGSNM: SETZ N, ;FS NAME IS 6 CHARS LONG
MOVEM T1,CHRBUF+.DCNAM
HRRI T2,CHRBUF+.DCNAM
MOVEM T2,UNIBP# ;BYTE PTR. TO STORE UNIT #
CHRUNI: HRRZ T1,N
IDIVI T1,^D10
ADDI T2,20 ;SIXBIT UNIT #
TLNE N,-1 ;6 CHAR FS NAME ?
DPB T2,UNIBP ;NO. - APPEND TO FS NAME
MOVE T1,[XWD .CHLEN,CHRBUF]
DSKCHR T1,
JRST STOMXU ;NO SUCH LOGICAL UNIT
MOVE T1,CHRBUF+.DCUSZ
MOVEM T1,UNIBPU(N) ;# BLOCKS ON THIS UNIT
CAMLE T1,STRBPU
MOVEM T1,STRBPU ;BIGGEST BLOCKS PER UNIT
AOBJN N,CHRUNI ;DO NEXT LOGICAL UNIT
STOMXU: TRNN N,-1
JRST ERDSKC ;DSKCHR FAILED
HRRZM N,MAXUNI ;ACTUAL # UNITS IN FS
JRST TOFS
TOMSG: OUTSTR [
ASCIZ"? OBJECT FILE-STRUCTURE MUST BE ON-LINE & WRITE-ENABLED
"]
TOFS: OUTSTR [ASCIZ"TO WHICH FILE-STRUCTURE ? "]
PUSHJ P,FSNAM
MOVE T,[3,,B]
DSKCHR T,
JRST TOMSG ;NOT A MOUNTED DISK
TLNN T,340305
TLNN T,2 ;TEST FOR FS NAME
JRST TOMSG
MOVEM D,OFCFS0# ;ORIGINAL FCFS FOR O FS
MOVEI A,16 ;DUMP MODE
SETZ C,
OPEN OBJ,A
JRST EROPNO
;READ HOME BLOCK
MOVE T,[IOWD 200,OBJHOM]
MOVEM T,IOLIST
MOVEI A,OBJHOM ;ARG FOR HOMTST
MOVEI C,HOMBL1
USETI OBJ,C
IN OBJ,IOLIST
PUSHJ P,HOMTST ;IS IT OK ?
SKIPA C,[EXP HOMBL2]
JRST SETLOW ;ALL'S WELL ON OBJECT FS
OUTSTR [ASCIZ"% FIRST HOME BLOCK FAULTY
"]
SETSTS OBJ,16 ;[53] CLEAR ERROR BITS IF ANY
;TRY SECOND HOME BLOCK
USETI OBJ,C
IN OBJ,IOLIST
PUSHJ P,HOMTST
JRST ERINOH
SETLOW: MOVE T,[FSINFO,,LOWMSG]
BLT T,LOWMSG+MSGLEN-1 ;COPY INTO LOW SEG
MOVE A,[LOGFN]
MOVSI B,(LOGEXT)
MOVE D,SYSPPN
LOOKUP LOG,A
JRST NEWLOG
HLROS D ;- WD CNT
MOVN T,D
IDIVI T,200 ;T:=# BLOCKS IN LOG-FILE
MOVEM T,NOBLOK# ;# BLOCKS IN FILE
JRST LGINIT
LOGET: MOVE B,ILOGHD ;SAVE CURRENT BUFFER POINTER
IN LOG,
JRST LOGIN+1
JRST RESBUF ;END OF FILE
LGINIT: SETZB T1,CH
HRLZI T1,LINST-LINEND ;- # OF FIELDS
LOGBP: MOVE A,LINST(T1)
LOGIN: MOVE T,CH
SOSGE ILOGHD+2
JRST LOGET
ILDB CH,ILOGHD+1
JUMPE CH,LOGIN+1
CAIG CH," " ;FIELD TERMINATOR ?
JRST LGTERM ;YES
CAME A,LINEND
IDPB CH,A
JRST LOGIN
LGTERM: CAIN CH,12
JRST LGINIT ;RESET TO START
CAILE T," " ;ALREADY NOTED ?
AOBJN T1,LOGCLR ;NO
JRST LOGIN ;YES
LOGCLR: SETZ T,
IDPB T,A ;CLEAR NEXT BYTE
JRST LOGBP ;START NEXT FIELD
RESBUF: MOVEM B,ILOGHD ;RESTORE CURRENT BUFFER POINTER
;FIND DATE OF LAST RUN
MOVE A,DATEBP
PUSHJ P,DECNO ;DAYS
SKIPA
CAIE CH,"-"
JRST BADLOG
SUBI N,1
MOVEM N,LASTRN#
PUSHJ P,DECNO ;MONTHS
SKIPA
CAIE CH,"-"
JRST BADLOG
SUBI N,1
IMULI N,^D31
ADDM N,LASTRN
PUSHJ P,DECNO
SKIPA
JUMPN CH,BADLOG
SUBI N,^D64
IMULI N,^D<12*31>
ADDB N,LASTRN ;(STANDARD) DATE OF LAST RUN
MOVEM N,ACDFLT# ;ACCESS & CREATE DEFAULTS
;GET SOURCE FS NAME
MOVE A,SFSNBP
PUSHJ P,FSNM
CAMN B,SOUHOM+HOMSNM ;SAME SOURCE NAME ?
JRST CHKID ;YES
OUTSTR [ASCIZ"% DIFFERENT SOURCE FS NAME !!!
"]
SETZM LASTRN ;SUM FULE SKREWD IT !
SETZM ACDFLT
;GET OBJECT FS ID
CHKID: MOVE A,OIDBP
PUSHJ P,FSNM
CAMN B,OBJHOM+HOMID
JRST CHKFRE
OUTSTR [ASCIZ"% DIFFERENT OBJECT FS ID !!!!
"]
SETZM ACDFLT
CHKFRE: MOVE A,OAFTBP
PUSHJ P,DECNO
JRST BADLOG ;SUM THING NASTY HERE
CAML N,OFCFS0 ;MORE FREE BLOCKS ?
JRST LOGCOP ;NO
BADLOG: SETZM LASTRN ;IT GOT CORRUPTED
SETZM ACDFLT
;COPY LAST (SEMI FILLED) BLOCK TO OUTPUT STREAM
LOGCOP: MOVE A,[LOGFN]
MOVSI B,(LOGEXT)
SETZ C,
MOVE D,SYSPPN
ENTER LOG,A
NOP
MOVE T,NOBLOK ;REWRITE LAST BLOCK
USETO LOG,1(T)
HRRZ A,ILOGHD
ADD A,[440700,,2] ;BYTE POINTER
LOGTX: ILDB CH,A
PUSHJ P,LOGOUT
CAME A,ILOGHD+1
JRST LOGTX
JRST INIPAT
;CREATE NEW LOG FILE
NEWLOG: SETZM LASTRN
SETZM ACDFLT
MOVE A,[LOGFN]
MOVSI B,(LOGEXT)
SETZ C,
MOVE D,SYSPPN
ENTER LOG,A
NOP
MOVEI T,FSINFO
PUSHJ P,LOGMSG
;SET UP SFD PATH ARGS
INIPAT: MOVEI T,2
MOVNM T,PATHS
MOVEI T,1
MOVEM T,PATHS+1
;OPEN TTY CHANNEL FOR ERROR & LOG MESSAGES
MOVEI A,0 ;ASCII MODE
MOVSI B,(SIXBIT/TTY/)
HRLZI C,TTYHD
OPEN TTY,A
JRST ERTTY
MOVE A,[ERRFN]
MOVSI B,(ERREXT)
SETZB C,D
ENTER TTY,A
JRST ERTTY
OUTBUF TTY, ;SET IT UP NOW
JRST MODE
HELP: MOVE 1,[SIXBIT/DSKCPY/]
PUSHJ P,.HELPR
CLRBFI
JRST MODE
HH: OUTSTR [ASCIZ"TYPE H FOR HELP"]
JRST MODE
REE: CLOSE OBJ,CL.ACS!CL.RST!CL.DAT
MOVE T,DSTACK
MOVEM T,.JBFF ;RESTORE FIRST FREE LOC
GETPPN T, ;RESTORE MY PPN
JFCL
MOVEM T,PATHS+2
SETZM PATHS+3
MOVE T,[4,,PATHS]
PATH. T,
JFCL
MODE: MOVE B,SOUHOM+HOMSNM
MOVE T,[3,,B]
DSKCHR T,
NOP
MOVEM D,SOUHOM+HOMFCF ;BEFORE FCFS #
MOVE B,OBJHOM+HOMSNM
MOVE T,[3,,B]
DSKCHR T,
NOP
MOVEM D,OBJHOM+HOMFCF ;BEFORE FCFS #
OUTSTR [ASCIZ"
MODE: "]
PUSHJ P,TTLINE
JRST MODE
;WOT (STANDARD) DATE ?
DATE T,
MOVEM T,STDATE#
;AND (MS) TIME ?
MSTIME T,
MOVEM T,TIMEMS#
;SET DEFAULTS
MOVSI F,(F.DFLT)
MOVE N,ACDFLT
MOVEM N,ACCESS# ;EARLIEST ACCESS DATE
MOVEM N,CREATE# ;EARLIEST CREATE DATE
MOVEI N,DFLTD
PUSHJ P,DDAT
MOVEM N,PURGE# ;LATEST PURGE DATE (ACCESS)
MOVEI T1,MSGDEL ;DEFAULT MSG LEVEL
MOVEM T1,MSGLVL#
SETZM PATH# ;PATH NOT (YET) SPECIFIED
SETOM FNOR
MOVE T,[FNOR,,FNOR+1]
BLT T,EXTAND+SFDMAX ;/PATH:*.*[*,*,*,...]
SETZM OVRFL ;THIS IS THE ABSOLUTE LIMIT !
ILDB CH,A ;GET FIRST CHAR TYPED
CAIN CH,"E"
EXIT
CAIN CH,"H"
JRST HELP ;HELP REQUIRED
CAIN CH,"P"
JRST SKIPSL ;"PURGE"
CAIE CH,"C"
JRST HH ;COMMAND ERROR
;COPY - NO PURGING
SETZM PURGE
SKIPSL: ILDB CH,A ;SKIP TO "/" OR
JUMPE CH,INIMFD ;END OF LINE
CAIE CH,"/"
JRST SKIPSL
GETSW: SETZ B,
MOVE T1,[POINT 6,B]
LODCHR: ILDB CH,A
JUMPE CH,EOLSW ;END OF LINE ?
CAIL CH,"A"
CAILE CH,"Z"
JRST NOAZSW ;NON ALPHABETIC
SUBI CH,40 ;CONVERT TO SIXBIT
TLNE T1,770000 ;SIX CHARS ALREADY ?
IDPB CH,T1 ;NO - APPEND THIS ONE
JRST LODCHR
SKPDEL: ILDB CH,A ;SKIP FOR DELIMITER
NOAZSW: CAIE CH,":"
CAIN CH,"/"
SKIPA ;WE HAVE A ":" OR "/"
JUMPN CH,SKPDEL ;IGNORE THE GARBAGE
EOLSW: SKIPA T1,[770000,,0] ;MASK FIRST SIXBIT CHAR
KEYWLP: ASH T1,-6
MOVSI T2,-NUMSW ;AOBJN PTR
SETZM SWINDX# ;NOTHING MATCHES YET
KEYWSW: MOVE T,B ;GET WHAT HE GAVE US
XOR T,SWNAME(T2)
AND T,T1 ;COMPARE FIRST FEW CHARS
JUMPN T,KEYCNT ;JUMP IF DIFFERENT
SKIPE SWINDX ;ALREADY GOT A MATCH ?
JRST KEYWLP ;YES - USE MORE RESOLUTION
MOVEM T2,SWINDX ;NO - STORE CURRENT INDEX
KEYCNT: AOBJN T2,KEYWSW ;TRY NEXT KEYWORD
SKIPN T2,SWINDX ;DID WE GET ANYTHING ?
JRST HH ;NO SUCH SWITCH
JRST @SWDISP(T2) ;YES - GO DO IT
DEFINE NAMES,< ;DEFINE DSKCPY SWITCHES
XLIST
X ACCESS,ACCSW
X NOACCE,NOASW
X CREATE,CRESW
X NOCREA,NOCSW
X DELETE,DELSW
X NODELE,NODSW
X HELP,HELP
X INCREM,INCRSW
X MSGLEV,MSGSW
X PATH,PATHSW
X QUE,QUESW
X NOQUE,NOQUE
X SORT,SORTSW
X NOSORT,NOSORT
X SYS,SYSSW
X NOSYS,NOSYS
LIST> ;END OF NAMES MACRO
;SWITCH STRING TABLE
DEFINE X(A,B),<
LIST
SIXBIT/A/
XLIST>
SWNAME: NAMES
NUMSW==.-SWNAME
;SWITCH DISPATCH TABLE
DEFINE X(A,B),<
LIST
EXP B
XLIST>
SWDISP: NAMES
DELSW: MOVEI B,PURGE ;/DELETE
SKIPE (B) ;IN PURGE MODE ?
JRST GETAGE ;YES
OUTSTR [ASCIZ"? /D INVALID WITH COPY - USE PURGE
"]
JRST MODE
ACCSW: SKIPA B,[EXP ACCESS] ;/ACCESS:n
CRESW: MOVEI B,CREATE ;/CREATE:n
GETAGE: CAIN CH,":" ;DELIMITER MUST BE ":"
PUSHJ P,DATENO
JRST HH ;SYNTAX ERROR
MOVEM N,(B) ;SAVE DATE
JRST SWDON
NOASW: MOVEI T,-1 ;/NOACCESS
MOVEM T,ACCESS
JRST SWDON
NOCSW: MOVEI T,-1 ;/NOCREATE
MOVEM T,CREATE
JRST SWDON
NODSW: SETZM PURGE ;/NODELETE
JRST SWDON
INCRSW: MOVE T,LASTRN ;/INCREMENTAL
MOVEM T,ACCESS
MOVEM T,CREATE
JRST SWDON
MSGSW: CAIN CH,":"
PUSHJ P,DECNO ;/MSGLEVEL
JRST HH ;SYNTAX ERROR
MOVEM N,MSGLVL
JRST SWDON
QUESW: TLOA F,(F.QUE) ;/QUE
NOQUE: TLZ F,(F.QUE) ;/NOQUE
JRST SWDON
SYSSW: TLOA F,(F.SYS) ;/SYS
NOSYS: TLZ F,(F.SYS) ;/NOSYS
JRST SWDON
SORTSW: SKIPA T1,[TLO F,Z] ;/SORT
NOSORT: MOVSI T1,(TLZ F,Z) ;/NOSORT
SKIPE CH ;/SORT ?
CAIN CH,"/" ; OR /SORT/... ?
JRST SRTALL ;YES - SORT ALL
CAIE CH,":"
JRST HH ;SYNTAX ERROR
ILDB CH,A
CAIN CH,"D" ;/SORT:DIRECTORY ?
TRO T1,(F.DSRT) ;YES - SET MFD SORT BIT
CAIN CH,"F" ;/SORT:FILES ?
TRO T1,(F.FSRT) ;YES - SET UFD SORT BIT
TRNN T1,(F.DSRT!F.FSRT) ;D OR F GIVEN ?
SRTALL: TRO T1,(F.DSRT!F.FSRT) ;NO - /SORT:ALL TAKEN
XCT T1 ;SET/CLEAR SORT BIT(S)
JRST SKIPSL+1
PATHSW: SETOM PATH ;FLAG PATH SPECIFIED
PUSHJ P,SIXIN ;GET FN
JUMPE M,.+3
MOVEM N,FNOR+SFDMAX
MOVEM M,FNAND+SFDMAX
CAIE CH,"."
JRST BRTST
PUSHJ P,SIXIN ;GET EXT
HLLZM N,EXTOR+SFDMAX
HLLZM M,EXTAND+SFDMAX
BRTST: CAIE CH,"["
JRST SWDON ;ALL PPN'S
PUSHJ P,OCTRD ;GET PROJ #
JRST HH ;0 OR TOO BIG
HRLZM N,FNOR
HRLZM M,FNAND
CAIN CH,","
PUSHJ P,OCTRD ;GET PROG #
JRST HH ;ERROR
HRRM N,FNOR
HRRM M,FNAND
MOVSI M,(SIXBIT/UFD/)
SETZM EXTOR
MOVEM M,EXTAND
HRLZI B,-SFDMAX
CAIN CH,"]"
JRST SFDEND
SFDNAM: CAIE CH,","
JRST HH ;ERROR
AOBJP B,HH ;TOO DEEP
PUSHJ P,SIXIN
JUMPE M,.+3
MOVEM N,FNOR(B)
MOVEM M,FNAND(B)
MOVSI M,(SIXBIT/SFD/)
SETZM EXTOR(B)
MOVEM M,EXTAND(B)
CAIE CH,"]"
JRST SFDNAM
SFDEND: TLO F,(F.SYS!F.QUE) ;OVERIDE THE DEFAULTS
AOBJP B,SWDON-1
MOVE N,FNOR+SFDMAX
MOVE M,FNAND+SFDMAX
MOVEM N,FNOR(B)
MOVEM M,FNAND(B)
AOSE N
SETZM FNAND+1(B) ;END OF PATH
HLLO N,EXTOR+SFDMAX
HLLO M,EXTAND+SFDMAX
HLLZM N,EXTOR(B)
HLLZM M,EXTAND(B)
AOSE N
SETZM FNAND+1(B) ;END OF PATH
ILDB CH,A
SWDON: CAIN CH,"/"
JRST GETSW
JUMPN CH,HH ;SYNTAX ERROR
;INITIALISE FOR MFD DIRECTORY
INIMFD: SETOM LEVEL ;DIRECTORY LEVEL (-1=INIT STATE)
MOVEI A+.RBCNT,3
MOVE A+.RBPPN,MFDPPN
MOVE A+.RBNAM,MFDPPN
MOVSI A+.RBEXT,(SIXBIT/UFD/)
LOOKUP RIBS,A
JRST ERMFDS
TRO F,F.FIL ;OBJ MFD HAD BETTER EXIST !
MOVEI T,200
PUSHJ P,CHKCOR
PUSHJ P,PRIBIN ;READ MFD PRIME RIB
JRST ERIBMF ;ERROR
MOVEI T,REE
MOVEM T,.JBREN
DIREAD: MOVE T,SOUHOM+HOMBPC
LSH T,10 ;2 CLUSTERS WORTH
ADD T,.RBSIZ(RIBST) ;PLUS # WORDS IN DIRECTORY
PUSHJ P,CHKCOR ;WE'D BETTER HAVE IT !
MOVE A,.RBNAM(RIBST) ;NEW DIRECTORY NAME
SKIPN N,LEVEL ;AT UFD LEVEL ?
CAME A,SYSPPN ;AND PROCESSING SYS: ?
SETZ A, ;NO
MOVEM A,SIS# ;0 => DON'T CHECK FOR -.SYS[1,4]
MOVE C,.JBFF
MOVEM C,DIRPTR(RIBST) ;DIRECTORY DATA START
SKIPA
DIRIN: MOVEM C,.JBFF
PUSHJ P,DATSIN ;READ A DIRECTORY CHUNK
JRST EODIR ;EOF ON THIS DIRECTORY
;ZERO COMPRESS
SKIPA T1,C
ZCOMP: ADDI T1,2
CAML T1,.JBFF
JRST DIRIN
MOVE A,(T1) ;FN
JUMPE A,ZCOMP ;IGNORE NULL ELEMENTS
HLLZ B,1(T1) ;EXT
CAME B,[SIXBIT/UFD/]
JRST SYSCHK
CAMN A,MFDPPN
JRST ZCOMP ;DON'T COPY MFD
TLNN F,(F.SYS) ;/SYS ?
CAME A,SYSPPN ;NO - TEST FOR [1,4]
SKIPA
JRST ZCOMP
TLNN F,(F.QUE) ;/QUE ?
CAME A,SPLPPN ;NO - TEST FOR [3,3]
SKIPA
JRST ZCOMP
SYSCHK: SKIPN SIS ;CHECK FOR VARIOUS [1,4] FILES ?
JRST FNMASK ;NO
SKIPA T2,[Z]
DONT: ADDI T2,2
CAMN A,NOTCOP(T2)
CAME B,NOTCOP+1(T2)
SKIPA
JRST ZCOMP ;IGNORE THIS ONE
SKIPE NOTCOP+2(T2) ;END OF TABLE ?
JRST DONT ;NO
FNMASK: MOVEM A,(C) ;STORE FN
IOR A,FNOR+1(N)
CAME A,FNAND+1(N)
JRST JNKFND ;FN MATCH FAILED
MOVEM B,1(C) ;STORE EXT
IOR B,EXTOR+1(N)
CAME B,EXTAND+1(N)
JNKFND: TLOA F,(F.JNK1) ;JUNK ALSO IN DIRECTORY
ADDI C,2 ;FINALLY CERTIFIED OK
JRST ZCOMP
EODIR: CLOSE RIBS,CL.ACS ;CLOSE DIRECTORY CHANNEL
AOSN N,LEVEL ;IS THIS MFD ?
SKIPA T,[EXP F.DSRT] ;YES - USE MFD BIT
MOVSI T,(F.FSRT) ;NO - USE UFD/SFD BIT
TDNN F,T ;DO WE WANT TO SORT ?
JRST SRTDUN ;NO
SRTLUP: HRRZ T,DIRPTR(RIBST)
SUB T,.JBFF
HRLZI T,2(T)
JUMPGE T,SRTDUN ;FINISHED IF ONLY 1 FN.EXT
HRR T,DIRPTR(RIBST) ;AOBJN PTR.
;TLZ F,(F.SORT) ;CLEAR ACTIVITY FLAG
SRTCMP: MOVE T1,(T) ;GET FN
CAMGE T1,2(T) ;FN(1) < FN(2) ?
JRST SWPNXT ;YES - LEAVE IT
MOVE T2,1(T) ;GET EXT
CAME T1,2(T) ;FN(1) = FN(2) ?
JRST [EXCH T1,2(T) ;NO - SWAP FNs
MOVEM T1,(T)
JRST SWPEXT] ;AND EXTs
CAMG T2,3(T) ;EXT(1) < EXT(2) ?
JRST SWPNXT ;YES - LEAVE IT
SWPEXT: EXCH T2,3(T) ;NO - SWAP EXTs
MOVEM T2,1(T)
TLO F,(F.SORT) ;SET ACTIVITY FLAG
SWPNXT: AOBJP T,.+2
AOBJN T,SRTCMP
TLZE F,(F.SORT) ;DID WE CHANGE ANYTHING ?
JRST SRTLUP ;YES - NEED ANOTHER PASS
SRTDUN: MOVEM RIBST,DSTACK(N)
EXCH DIRECT,DIRPTR(RIBST) ;NEW ADDR FOR OLD
MOVEM F,DIRDET(RIBST) ;STORE OLD FLAGS
TDZ F,[EXP F.JNK!F.PRG!F.COP!F.DIR]
TLZE F,(F.JNK1) ;DID WE JUST FIND ANY JUNK ?
TLO F,(F.JNK) ;SURE DID !
TRZE F,F.FIL ;DID OBJ DIRECTORY EXIST
TRO F,F.DIR ;YEP !
MOVE A,.RBNAM(RIBST) ;GET DIRECTORY NAME
CAIE N,1 ;JUST READ UFD ?
JRST SETPAT ;NO
;CHECK FOR PROTECTED AREA (IN NOTPRG)
SKIPE PATH ;/PATH SPECIFIED ?
JRST NOTPRO ;YES - ANYTHING GOES
SKIPA T1,[Z]
PRGTST: ADDI T1,2
SKIPN T,NOTPRG(T1)
JRST NOTPRO
AND T,A
CAME T,NOTPRG+1(T1)
JRST PRGTST
TLOA F,(F.PRO) ;THIS ONE'S PROTECTED
NOTPRO: TLZ F,(F.PRO) ;NOT A PROTECTED SPECIES
SETPAT: SKIPN N
MOVEI N,1 ;MFD IS SPECIAL CASE OF UFD
MOVEM A,PATHS+1(N)
SETZM PATHS+2(N)
HRLZI T,3(N)
HRRI T,PATHS
SETZ T1,
PATH. T,
MOVEI T1,PATHS ;PATH. UUO FAILED
MOVEM T1,PATHPT ;PPN POINTER
MOVE T,SOUHOM+HOMGRP
LSH T,7
PUSHJ P,CORPLS ;CAN I HAVE MORE ?
JFCL ;NO - MEAN OLD MONITOR !
JRST NEXTFN+1
;SYSTEM FILES WE NEVER COPY
NOTCOP: SIXBIT/SAT/
SIXBIT/SYS/
SIXBIT/HOME/
SIXBIT/SYS/
SIXBIT/SWAP/
SIXBIT/SYS/
SIXBIT/MAINT/
SIXBIT/SYS/
SIXBIT/BADBLK/
SIXBIT/SYS/
SIXBIT/CRASH/
SIXBIT/SAV/
SIXBIT/SNAP/
SIXBIT/SYS/
SIXBIT/RECOV/
SIXBIT/SYS/
Z ;NOTCOP TABLE TERMINATOR
;PROTECTED AREAS FROM PURGING RAVAGES
;FORMAT EXP MASK
; XWD PROJ#,PROG#
NOTPRG: XWD 777760,0
XWD 0,0 ;[?,*] & [1?,*]
IFN HATFLD,< ;HATFIELD SPECIALS CUMIN UP
XWD 777770,0
XWD 100,0 ;[10?,*] - HPCC PROGRAMMERS
XWD 777700,777700
XWD 200,200 ;[2??,2??] - HPCC LIBRARY AREAS
XWD -1,0
XWD 7203,0 ;[7203,*] - HP STUDENT RECORDS
> ;END HATFLD CONDITIONAL
Z ;NOTPRG TABLE TERMINATOR
;GET NEXT FILENAME FROM CURRENT DIRECTORY
NEXTFN: ADDI DIRECT,2
CAMGE DIRECT,.JBFF ;CHECK FOR END OF DIRECTORY
JRST ANOFIL ;NOT YET
;WAS THAT THE MFD JUST COMPLETED ?
SOSGE N,LEVEL
JRST QUIT ;YES - CONGRATULATIONS !
JUMPN N,TERMZ
;MFD LEVEL IS A SPECIAL CASE OF USER LEVEL (=1)
MOVE T,MFDPPN ;BACK AT GROUND LEVEL
MOVEM T,PATHS+2 ;RESTORE [1,1]
SETZM PATHS+3 ;TERMINATING ZERO
MOVE T,[4,,PATHS]
JRST NEWPAT
TERMZ: SETZM PATHS+2(N) ;TERMINATING ZERO
HRLZI T,3(N)
HRRI T,PATHS
NEWPAT: SETZ T1,
PATH. T,
MOVEI T1,PATHS ;PATH. UUO FAILED
MOVEM T1,PATHPT ;PPN POINTER
MOVE RIBST,DSTACK+1(N) ;OLD DIRECTORY RIB ADDR
TLNN F,(F.PRG)
JRST DIRCOP
MOVEI T,[ASCIZ" PURGED "]
MOVEI T1,MSGPRG
JRST DIRMSK
DIRCOP: TLNN F,(F.COP) ;ANY FILES COPIED ?
JRST RESDIR ;NO
MOVEI T,[ASCIZ" COPIED "]
MOVEI T1,MSGTX
DIRMSK: TDNN T1,MSGLVL ;DO WE WANT IT ?
JRST RESDIR ;NO
PUSHJ P,MSG
PUSHJ P,FNPNT
RESDIR: IFN ERAZE,<
MOVE STS,.RBSTS(RIBST) ;RESTORE STATUS
TLNE F,(F.JNK!F.COP) ;ANYTHING LEFT ?
TRO STS,RIPNDL ;DIRECTORY NOT EMPTY>
MOVE DIRECT,DIRPTR(RIBST) ;RESTORE PREV. DIRECTORY PTR
MOVE F,DIRDET(RIBST) ;AND FLAGS
IFN ERAZE,<
TDNE STS,[EXP RIPLOG!RIPNDL] ;CAN I DELETE OLD DIRECTORY ?
JRST DEALL1 ;NO
LOOKUP RIBS,(RIBST)
JRST ERLOOK
MOVEI T,[ASCIZ" DELETED "]
MOVE STS,.RBSTS(RIBST)
TDNN STS,[EXP RIPLOG!RIPNDL] ;CAN I STILL DELETE IT ?
JRST KILLIT ;YES !>
JRST DEALL1
ANOFIL: MOVEI A+.RBCNT,3
MOVE A+.RBPPN,PATHPT ;DIRECTORY PATH
MOVE A+.RBNAM,(DIRECT)
HLLZ A+.RBEXT,1(DIRECT)
LOOKUP RIBS,A
JRST ERLOOK ;WHOOPS !
PUSHJ P,PRIBIN ;GET PRIME RIB
JRST ERIBS ;ERROR
TRO F,F.FIL ;SUPPRESS COPIED <EMPTY FN> MSG
SKIPN WDCNT
JRST PRGCHK ;IT'S EMPTY
;CHECK FILE WITHIN ACCESS OR CREATE DATE PAIRS
LDB T,[POINT 3,.RBEXT(RIBST),20] ;3 MS BITS
LDB T2,[POINT 12,.RBPRV(RIBST),35] ;12 LS BITS
DPB T,[POINT 3,T2,23] ;15 BIT CREATION DATE
;*** DATE 75 PATCH UNTIL EVERYTHING HAPPY ***
MOVEI T,10000(T2)
CAMLE T,STDATE
JRST GOODT2
MOVE T2,T ;THIS IS THE REAL Mc COY
LSH T,-^D12
DPB T,[POINT 3,.RBEXT(RIBST),20] ;SET IT RIGHT
GOODT2:
;### END OF PATCH ###
LDB T1,[POINT 15,.RBEXT(RIBST),35] ;15 BIT ACCESS DATE
TRNN STS,RIPABU ;ALWAYS BACK UP ?
CAMG T1,PURGE ; OR GOING TO BE PURGED ?
JRST FILOK ;YES - COPY ANYWAY
TRNE STS,RIPNFS ;NEVER BACK UP ?
JRST DEALL ;YES - FORGET IT
CAMGE T1,ACCESS
CAML T1,CREATE
JRST FILOK
TRNE STS,RIPDIR
;DIRECTORY - CAN IT CONTAIN VALID FILES ?
CAMGE T1,CREATE ;ACCESS TOO OLD ?
JRST DEALL
;SET UP EXTENDED LOOKUP AREA
FILOK: HRRZ T2,.JBFF
SETZM (T2)
HRLZ T,T2
HRRI T,1(T2)
BLT T,EXTLEN-1(T2)
MOVEI T,EXTLEN-1
MOVEM T,.RBCNT(T2) ;ARG. COUNT
SKIPE A+.RBPPN,PATHPT
MOVEM A+.RBPPN,.RBPPN(T2)
MOVEM A+.RBNAM,.RBNAM(T2)
MOVEM A+.RBEXT,.RBEXT(T2)
SETZM NDLCNT#
TRNE F,F.DIR ;NEW DIRECTORY ON OBJECT FS ?
LOOKO: LOOKUP OBJ,(T2)
JRST COPY ;CREATE A NEW FILE
CLOSE OBJ,CL.NMB
TRO F,F.FIL ;IT EXISTS ALREADY ON OBJ FS
MOVE T1,.RBSTS(T2) ;OBJECT FILE STATUS
;IS SOURCE FILE A DIRECTORY ?
TRNN STS,RIPDIR
JRST CHKDAT ;NO
;OBJECT FILE OUGHT TO BE A DIRECTORY TOO
TRNN T1,RIPDIR
JRST COPY ;SUPERCEDE THIS VARMINT !
;PROCEED TO NEXT (LOWER) DIRECTORY LEVEL
JRST DIREAD
;CHECK CREATION DATES
CHKDAT: MOVE T,.RBPRV(RIBST) ;SOURCE CREATION TIME,DATE(12)
SUB T,.RBPRV(T2) ;OBJECT CREATION TIME,DATE(12)
TLZ T,777740 ;CLEAR PROT & MODE BITS
JUMPE T,PRGCHK ;THE SAME
;CHECK OBJECT FILE MAY BE SUPERCEDED (RIPNDL CLEAR)
TRNN T1,RIPNDL
JRST COPY ;RIPNDL BIT CLEAR
AOS T,NDLCNT
;THIS FILE IS FIREPROOF - GENERATE NEW EXT
SETZ B,
DIVID: IDIVI T,^D10
MOVEI A,20(T1)
LSHC A,-6
TLNN B,77
JRST DIVID
MOVEM B,.RBEXT(T2) ;UPDATE EXT
JRST LOOKO
;FILE WILL BE COPIED
COPY: TRZ F,F.FIL ;CREATING OR SUPERCEDING FILE
MOVE T,PATHPT
MOVEM T,.RBPPN(RIBST) ;RE SPECIFY PATH
HLLZ B,.RBEXT(T2)
HRR B,.RBEXT(RIBST)
EXCH B,.RBEXT(RIBST) ;PLUG IN NEW EXT
LDB C,[POINT 4,.RBPRV(RIBST),12] ;[53] GET MODE
MOVE T,.RBSIZ(RIBST)
ADDI T,177 ;ROUND UP TO # BLOCKS USED
LSH T,-7 ;200 WORDS PER BLOCK
MOVEM T,.RBEST(RIBST)
SETZM .RBALC(RIBST) ;LET FILSER DO THE WORK
SETZM .RBPOS(RIBST) ;NO WAY !
EXCH STS,.RBSTS(RIBST) ;CLEAR UFD (LH) BITS
;IS THIS FOR A DIRECTORY ?
TRNN STS,RIPDIR
JRST NOTDIR ;NO IT AIN'T
IFE FTOLQT,< ;INFIN QUOTA (UNTIL LOGIN)
MOVEI T,-1
MOVEM T,.RBQTF(RIBST)
MOVEM T,.RBQTO(RIBST)
> ;END OF IFE FTOLQT
SETZM .RBUSD(RIBST) ;NOT EVEN A BONE
ENTER OBJ,(RIBST)
JRST ERENTO ;BLAST !
EXCH STS,.RBSTS(RIBST) ;RESTORE UFD BITS
USETO OBJ,2 ;WRITE BLOCK 1 AS ZEROS
CLOSE OBJ,CL.ACS
JRST DIREAD
NOTDIR: SETSTS OBJ,(C) ;[53] FAKE OUT MODE FOR FILSER
ENTER OBJ,(RIBST)
JRST ERENTO ;BLAST !
SETSTS OBJ,16 ;[53] RESTORE TO DUMP MODE
MOVEM B,.RBEXT(RIBST) ;RESTORE OLD EXT
SKIPA C,.JBFF
COPI: MOVEM C,.JBFF ;RESTORE .JBFF
PUSHJ P,DATSIN ;GET A CHUNK
JRST FINI ;EOF
OUT OBJ,IOLIST
JRST COPI
JRST EROUTO
FINI: CLOSE OBJ,CL.ACS!CL.DAT ;CLOSE OBJECT FS FILE
STATZ OBJ,740000
JRST ERCLOS
;CHECK IF ACCESS DATE WITHIN PURGE RANGE
PRGCHK: TLNE F,(F.PRO) ;ELIGIBLE FOR DELETION ?
JRST COPMSG ;NO - IN PROTECTED AREA
LDB T1,[POINT 15,.RBEXT(RIBST),35] ;15 BIT ACCESS DATE
CAMG T1,PURGE
TRNE STS,RIPNDL ;RIPNDL BIT SET ?
JRST COPMSG ;LEAVE IT
;KILL KILL KILL !
MOVEI T,[ASCIZ"DELETED "]
KILLIT: SETZB A,B
RENAME RIBS,A
JRST ERENAM
MOVEI T1,MSGDEL
TLO F,(F.PRG) ;ITS DIRECTORY "PURGED"
JRST FNMSG
COPMSG: CLOSE RIBS,CL.ACS!CL.DAT
TRZE F,F.FIL
JRST DEALL1 ;NEVER TOUCHED IT
MOVEI T1,MSGCOP
MOVEI T,[ASCIZ"COPIED "]
TLO F,(F.COP)
FNMSG: TDNN T1,MSGLVL
JRST DEALL1+1 ;NOT INTERESTED
PUSHJ P,MSG
PUSHJ P,FNPNT ;PRINT THE FILENAME
JRST DEALL1+1
DEALL: CLOSE RIBS,CL.ACS!CL.DAT ;CLOSE SOURCE FS FILE
DEALL1: TLO F,(F.JNK) ;THERE'S OTHER JUNK AROUND
MOVEM RIBST,.JBFF ;DEALLOCATE THIS FILE'S CORE
JRST NEXTFN
ERENAM: TRNN B,-1
JRST DEALL1+1 ;JUST BEEN DELETED
HRRM B,.RBEXT(RIBST)
JRST ERREN
;WELL WE FINALLY MADE IT
QUIT: SETZM .JBREN
GETPPN T, ;RESTORE MY PPN
JFCL
MOVEM T,PATHS+2
SETZM PATHS+3
MOVE T,[4,,PATHS]
PATH. T,
JFCL
MOVEI T,LOWMSG ;PRINT FS INFORMATION
PUSHJ P,MSG
SETZM LOWMSG ;PRINT FIRST TIME ONLY
MOVE CH,[ASCII/ /]
MOVEM CH,FSLINE
MOVE T1,[FSLINE,,FSLINE+1]
BLT T1,@LINEND
;DATE
MOVE A,DATEBP
MOVE N,STDATE
IDIVI N,^D31
MOVEI T,1(M)
PUSHJ P,DECDD
MOVEI CH,"-"
IDPB CH,A
IDIVI N,^D12
MOVEI T,1(M)
PUSHJ P,DECDD
IDPB CH,A
MOVEI T,^D64(N)
PUSHJ P,DECDD
;TIME
MOVE A,TIMEBP
MOVE N,TIMEMS ;START TIME (MILLISECS)
IDIVI N,^D<1000*60> ;MINUTES
IDIVI N,^D60 ;24 HR TIME
MOVE T,N
PUSHJ P,DECDD
MOVE T,M
PUSHJ P,DECDD
;FUNCTION
MOVE A,FUNCBP
MOVEI T,"C"
SKIPE PURGE
MOVEI T,"P"
IDPB T,A
;SOURCE FS
MOVE A,SFSNBP
MOVE T2,SOUHOM+HOMSNM
PUSHJ P,SIXPUT
MOVE A,SIDBP
MOVE T2,SOUHOM+HOMID
PUSHJ P,SIXPUT
MOVE A,SB4BP
MOVE T,SOUHOM+HOMFCF ;FCFS BEFORE
PUSHJ P,DECOUT
;FIND PRESENT FCFS
MOVE A,SAFTBP
MOVE T,SOUHOM+HOMSNM
MOVE B,[3,,T]
DSKCHR B,
NOP
MOVE T,T2
PUSHJ P,DECOUT
;OBJECT FS
MOVE A,OFSNBP
MOVE T2,OBJHOM+HOMSNM
PUSHJ P,SIXPUT
MOVE A,OIDBP
MOVE T2,OBJHOM+HOMID
PUSHJ P,SIXPUT
MOVE A,OB4BP
MOVE T,OBJHOM+HOMFCF ;FCFS BEFORE
PUSHJ P,DECOUT
;FIND PRESENT FCFS
MOVE A,OAFTBP
MOVE T,OBJHOM+HOMSNM
MOVE B,[3,,T]
DSKCHR B,
NOP
MOVE T,T2
PUSHJ P,DECOUT
MOVEI CH,15
IDPB CH,A
MOVEI CH,12
IDPB CH,A
SETZ CH,
IDPB CH,A ;ZERO TERMINATOR
MOVEI T,FSLINE
PUSHJ P,MSG ;PRINT IT
SKIPE PATH
JRST MODE ;/PATH RETURNS TO MODE LEVEL
;USE ORIGINAL VALUES OF BEFORE # FCFS BLOCKS ON FS
MOVE T,SFCFS0 ;SOURCE FS # FCFS BLOCKS
MOVE A,SB4BP
PUSHJ P,DECOUT
MOVE T,OFCFS0 ;OBJECT FS # FCFS BLOCKS
MOVE A,OB4BP
PUSHJ P,DECOUT
;AND WRITE IT TO THE LOG FILE
MOVEI T,FSLINE
PUSHJ P,LOGMSG
;COPY LOG FILE TO OBJECT FS
CLOSE LOG,
MOVE A,[LOGFN]
MOVSI B,(LOGEXT)
MOVE D,SYSPPN
LOOKUP SOU,A
NOP
MOVE T,D ;-WD CNT IN LH
MOVE D,SYSPPN
ENTER OBJ,A
JRST FINMSG ;OBJ FS MUST BE FULL
HRR T,.JBFF
MOVEM T,IOLIST ;IOWD 'LENGTH',(.JBFF)
HLRZS T
MOVNS T ;WD CNT
PUSHJ P,CHKCOR ;RIDICULOUS IF WE NEED THIS
INPUT SOU,IOLIST
OUTPUT OBJ,IOLIST
FINMSG: OUTSTR [ASCIZ"FS HAS NOW BEEN "]
MOVEI T,[ASCIZ"COPIED
"]
SKIPE PURGE
MOVEI T,[ASCIZ"PURGED
"]
OUTSTR (T)
EXIT
;BYTE POINTER TABLE FOR VARIOUS LOG FILE FIELDS
LINST:
DATEBP: POINT 7,FSLINE
TIMEBP: POINT 7,FSLINE+1,27
FUNCBP: POINT 7,FSLINE+2,27
SFSNBP: POINT 7,FSLINE+3,6
SIDBP: POINT 7,FSLINE+4,20
SB4BP: POINT 7,FSLINE+6
SAFTBP: POINT 7,FSLINE+7,13
OFSNBP: POINT 7,FSLINE+10,27
OIDBP: POINT 7,FSLINE+12,6
OB4BP: POINT 7,FSLINE+13,20
OAFTBP: POINT 7,FSLINE+15
LINEND: POINT 7,FSLINE+16,6
;VALIDATE HOME BLOCK (A)
HOMTST: MOVS T,HOMNAM(A)
CAIE T,(SIXBIT/HOM/)
POPJ P,
CAME B,HOMSNM(A)
OUTSTR [ASCIZ"% FS NAME ON HOME BLOCK IS DIFFERENT
"]
MOVEM B,HOMSNM(A) ;BUT STORE IT ANYWAY
MOVE T,HOMCOD(A)
CAIN T,707070 ;UNLIKELY CODE
CAME C,HOMSLF(A) ;THIS BLOCK #
POPJ P,
;CHECK BYTE POINTERS ARE MUTUALLY CONSISTENT
HRLZI N,-3
HRRI N,HOMCNP(A)
MOVE M,N
BPSET: HLRZ T,(N)
TRZ T,77 ;CLEAR INDEX & INDIRECT FIELDS
ADDI T,RPTR
HRLZM T,(N) ;SET 0(RPTR) ADDR.
AOBJN N,BPSET
MOVEI RPTR,T1
SETZ T1, ;SCRATCH AC
SETO T2,
BPTST: LDB T,(M)
JUMPN T,CPOPJ ;OVERLAPPING FIELDS
DPB T2,(M)
AOBJN M,BPTST
AOJE T1,CPOPJ1 ;ALL BITS ACCOUNTED FOR ?
POPJ P,
;READ PRIME RIB
PRIBIN: MOVE RIBST,.JBFF ;RIB STARTS HERE
MOVEI T,DIRDET+1(RIBST)
MOVEM T,.JBFF ;AND ENDS HERE
USETI RIBS,0 ;PRIME RIB PLEASE
MOVE T,RIBST
SUB T,[200,,1] ;IOWD 200,(RIBST)
SETZ T1,
IN RIBS,T
CAME A+.RBNAM,.RBNAM(RIBST)
POPJ P, ;ERROR
MOVE T,A+.RBEXT
XOR T,.RBEXT(RIBST)
TLNE T,-1
POPJ P, ;ERROR
MOVE RPTR,RIBST
JRST CODCHK
;READ EXTENDED RIB
ERIBIN: HLRZ T,.RBXRA(RIBST) ;[53].. GET UNIT # OF NEXT EXTENDED RIB
JUMPL T,CPOPJ
CAML T,MAXUNI ;VALID UNIT # ?
POPJ P, ;NO - TOO BIG
HRRZ T1,.RBXRA(RIBST) ;CLUSTER ADDR WITHIN UNIT
IMUL T1,SOUHOM+HOMBPC ;BLOCK ADDR WITHIN UNIT
CAML T1,UNIBPU(T) ;VALID ?
POPJ P, ;NO
IMUL T,STRBPU
ADD T,T1 ;..[53] LOGICAL BLOCK ADDR IN FS
USETI SOU,T
IN SOU,[IOWD 200,RETPTS
Z]
CAME T,.RBSLF+RETPTS ;CHECK BLOCK #
POPJ P, ;WRONG ONE
MOVE T,.RBXRA+RETPTS ;GET NEXT EXT RIB PTR
MOVEM T,.RBXRA(RIBST) ;AND SAVE IT
MOVEI RPTR,RETPTS
;RIB BLOCK STARTS AT (RPTR)
CODCHK: MOVE T,RIBCOD(RPTR)
CAIE T,-1 ;RIB 'UNLIKELY' CODE
POPJ P, ;NOT A RIB BLOCK
;VALIDATE AND COPY RETRIEVAL POINTERS TO RETPTS AREA
ADD RPTR,.RBFIR(RPTR) ;RH:=ABS ADDR IN CORE
MOVEI T2,RETPTS
MOVRPT: MOVE T,(RPTR)
MOVEM T,(T2)
ADD T2,[-1,,1]
LDB T1,SOUHOM+HOMCNP
JUMPN T1,NOTCOU ;CHANGE OF UNIT POINTER ?
TRZN T,1B18 ;MAYBE - CHECK FOR EOF
JRST DUNVAL ;YES - EOF
CAML T,MAXUNI ;VALID UNIT ?
POPJ P, ;NO
MOVE T,UNIBPU(T) ;# BLOCKS ON THIS UNIT
IDIV T,SOUHOM+HOMBPC ;# CLUSTERS ON THIS UNIT
MOVEM T,MAXCL
JRST DUNRBP
NOTCOU: LDB T,SOUHOM+HOMCLP ;CLUSTER ADDR IN UNIT
ADDI T,-1(T1) ;LARGEST CLUSTER ADDR OF GROUP
CAML T,MAXCL ;TOO BIG ?
POPJ P, ;YES
DUNRBP: AOBJN RPTR,MOVRPT
DUNVAL: JUMPGE T2,ERIBIN ;TRY NEXT ONE
HLLZ RPTR,T2
HRRI RPTR,RETPTS
MOVEI T,EXTLEN-1 ;# PARAMETERS FOR EXTENDED OPS
MOVEM T,.RBCNT(RIBST)
;DON'T RE-READ THE RIB
LDB T,SOUHOM+HOMCNP ;CLUSTER COUNT
JUMPN T,CPOPJ ;MUST START WITH CH of UNIT PTR
CHOFUN: SKIPE T,(RPTR) ;EOF ?
TRZN T,1B18
POPJ P, ;YES
CAML T,MAXUNI ;UNIT # VALID ?
POPJ P, ;TOO BIG
IMUL T,STRBPU
MOVEM T,BLK1AD ;BLOCK OF START OF UNIT
AOBJP RPTR,CPOPJ ;ADVANCE TO REAL RET PTR
MOVEI T,1
CAME T,SOUHOM+HOMBPC ;ONLY 1 BLOCK PER CLUSTER ?
JRST SKPRIB ;NO
LDB T,SOUHOM+HOMCNP
SOJE T,NXTPTR ;GROUP NOW EMPTY ?
DPB T,SOUHOM+HOMCNP ;NO
LDB T,SOUHOM+HOMCLP
ADDI T,1
DPB T,SOUHOM+HOMCLP ;BUMP CLUSTER ADDRESS
TDZA T,T ;DON'T SKIP A BLOCK
NXTPTR: AOBJP RPTR,ERIBIN ;GROUP EMPTY - GET NEXT RET. PTR
SKPRIB: MOVEM T,RIBSKP# ;SKIP RIBSKP BLOCKS ON INPUT
MOVE T,.RBSIZ(RIBST)
MOVEM T,WDCNT# ;# DATA WORDS IN THE FILE
HRRZ STS,.RBSTS(RIBST)
JUMPLE T,CPOPJ1 ;EOF FOLLOWS
LDB T,SOUHOM+HOMCNP ;CLUSTER COUNT
JUMPE T,CHOFUN ;SHOULDN'T BE A CH OF UNIT PTR REALLY
LDB T,SOUHOM+HOMCLP ;CLUSTER ADDRESS
IMUL T,SOUHOM+HOMBPC ;BLOCK ADDRESS
ADD T,RIBSKP ;DISPLACEMENT FOR RIB
TLZ T,777740 ;CLEAR B0-B12
ADD T,BLK1AD ;OFFSET TO CORRECT UNIT
MOVE T1,T
TLO T1,(<SOU>B12) ;PUT IN CHANNEL #
SUSET. T1, ;SELECT BLOCK FOR INPUT
USETI T, ;USE SUPER USETI UUO
SEEK SOU,
JRST CPOPJ1 ;RETURN
;READ DATA BLOCKS (GIVEN RPTR)
DATSIN: SKIPLE WDCNT
SKIPN (RPTR) ;SHOULD SKIPA
POPJ P, ;EOF
LDB T,SOUHOM+HOMCKP
MOVEM T,CHKWD# ;CURRENT CHECKSUM
MOVE T,.JBREL
SUB T,.JBFF
LSH T,-7 ;# BLOCKS
IDIV T,SOUHOM+HOMBPC ;# CLUSTERS ROOM FOR
LDB T1,SOUHOM+HOMCNP ;CLUSTER COUNT
SUB T1,T
JUMPG T1,TOOFUL ;CAN'T READ ALL CLUSTER GROUP
;ENOUGH ROOM FOR ENTIRE CLUSTER GROUP
LDB T,SOUHOM+HOMCNP ;T=# CLUSTERS TO READ
AOBJN RPTR,READ
JRST READ ;END OF THIS RIB
;NOT ENOUGH ROOM FOR ENTIRE CLUSTER GROUP
TOOFUL: DPB T1,SOUHOM+HOMCNP ;DECREMENT CLUSTER COUNT
LDB T1,SOUHOM+HOMCLP ;CLUSTER ADDRESS
ADD T1,T
DPB T1,SOUHOM+HOMCLP ;BUMP CLUSTER ADDR
TLO STS,RIPFCE ;DON'T CHECKSUM NEXT CHUNK
;READ (T) CLUSTERS
READ: IMUL T,SOUHOM+HOMBPC ;# BLOCKS
SUB T,RIBSKP ;LESS THE RIB BLOCK
SETZM RIBSKP ;ON FIRST CALL ONLY
LSH T,7 ;# WORDS
CAMLE T,WDCNT
MOVE T,WDCNT ;TRUNCATE
MOVN T1,T
ADDM T1,WDCNT ;DECREMENT # WORDS LEFT
HRLOI T1,-1(T1)
ADD T1,.JBFF ;IOWD (T),(.JBFF)
MOVEM T1,IOLIST
ADDM T,.JBFF ;BUMP
MOVE T2,[0,,-1] ;RIB 'UNLIKELY' CODE
IN SOU,IOLIST
CAMN T2,RIBCOD+1(T1) ;IT DIDN'T OUGHT TO BE A RIB
JRST ERSIN
TRNN STS,RIPABC!RIPFCE ;KNOWN CHECKSUM ERROR ?
TLZE STS,RIPABC ;NOT AT START OF GROUP ?
JRST NXTABC ;YES
;PERFORM FOLDED CHECKSUM
MOVE T2,CKSUM ;SHIFT CNT
SKIPA T1,1(T1) ;FIRST WORD IN GROUP
CHSUM: ADD T1,T
LDB T,LSBITS
LSH T1,(T2)
JUMPN T1,CHSUM
CAMN T,CHKWD
JRST NXTABC ;CORRECT CHECKSUM
TRO STS,RIPFCE ;SET FCE BIT
MOVEI T,[ASCIZ"CHECKSUM ERROR WITH "]
PUSHJ P,MSG
PUSHJ P,FNPNT
NXTABC: TLZE STS,RIPFCE ;WILL NEXT INPUT START GROUP ?
TLO STS,RIPABC ;NO
;ISSUE SEEK FOR NEXT CLUSTER
NXTRBP: JUMPGE RPTR,XRIB ;READ ALL THIS RIB ?
LDB T,SOUHOM+HOMCNP ;NO - CLUSTER COUNT
JUMPN T,SEKE ;CHANGE OF UNIT PTR ?
SKIPE T,(RPTR)
TRZN T,1B18
JRST CPOPJ1 ;NEXT CALL WILL BE EOF
IMUL T,STRBPU
MOVEM T,BLK1AD ;BLOCK OFFSET OF THIS UNIT
AOBJN RPTR,NXTRBP
;THIS RIB EMPTY
XRIB: PUSHJ P,ERIBIN ;READ NEXT RIB
JRST ERIBS
JRST CPOPJ1 ;RETURN WHAT WE HAVE
SEKE: SKIPLE WDCNT
SKIPN (RPTR) ;SHOULD SKIPA
JRST CPOPJ1 ;NEXT CALL WILL BE EOF
LDB T,SOUHOM+HOMCLP ;CLUSTER ADDRESS
IMUL T,SOUHOM+HOMBPC ;BLOCK ADDRESS
TLZ T,777740 ;CLEAR B0-B12
ADD T,BLK1AD ;OFFSET TO CORRECT UNIT
MOVE T1,T
TLO T1,(<SOU>B12) ;PUT IN CHANNEL #
SUSET. T1, ;SELECT BLOCK FOR INPUT
USETI T, ;USE SUPER USETI UUO
SEEK SOU,
JRST CPOPJ1 ;FINISHED
;READ A T/T LINE TO <LF> & PERFORM UC_LC CONVERSION
TTLINE: MOVE A,[POINT 7,TTBUFF]
SETZ CH,
TTIN: INCHWL CH
CAIN CH,15 ;CR
JRST TTIN ;IGNORE CR
CAIE CH,12 ;LF
CAIN CH,33 ;ESCAPE
JRST EOL
CAIE CH,175 ;ALT 1
CAIN CH,176 ;ALT 2
JRST EOL
CAIL CH,141 ;LC "A"
ANDI CH,137 ;UC_LC
CAIL CH,40
CAILE CH,137
POPJ P, ;INVALID CHAR
CAIE CH," "
IDPB CH,A
JRST TTIN
EOL: CAMN A,[POINT 7,TTBUFF]
JRST TTLINE ;NULL LINE
SETZ CH,
IDPB CH,A ;NULL TERMINATOR
MOVE A,[POINT 7,TTBUFF]
JRST CPOPJ1 ;SKIP RETURN
;PUT DATE IN N
DATENO: PUSHJ P,DECNO
POPJ P, ;NO #
PUSHJ P,DDAT ;N:=DATE-N (STANDARD FORMAT)
JRST CPOPJ1 ;RETURN
;READ DECIMAL # FROM TTBUFF COMMAND LINE STRING
DECNO: ILDB CH,A
CAIN CH," "
JRST DECNO ;IGNORE LEADING SPACES
SETZB T,N ;[50] NO DIGITS EXTRACTED
DECNO1: CAIL CH,"0"
CAILE CH,"9"
JRST NOTNO ;NON NUMERIC
SETO T, ;[50] WE GOT A DIGIT
IMULI N,^D10
ADDI N,-"0"(CH)
ILDB CH,A
JRST DECNO1
NOTNO: SKIPE T ;[50] ANY NUMERICS ?
CPOPJ1: AOS (P)
CPOPJ: POPJ P, ;RETURN
;RETURN DATE NOW - N DAYS (IN STANDARD FORMAT)
DDAT: MOVE T,STDATE
;RESOLVE INTO YEAR-MONTH-DAY
IDIVI T,^D<12*31> ;T:=# YRS
IDIVI T1,^D31 ;T1:=# MONTHS, T2:=# DAYS
SUB T2,N
SETZ N,
JUMPGE T2,DAYSOK
MONTST: SOJGE T1,MONOK ;BORROW A MONTH
SOJL T,CPOPJ ;BORROW A YEAR
MOVEI T1,^D11
MONOK: ADD T2,DAYS(T1)
JUMPL T2,MONTST ;DAYS STILL NEGATIVE
;RE-PACK INTO STANDARD DATE FORMAT
DAYSOK: MOVE N,T
IMULI N,^D12
ADD N,T1
IMULI N,^D31
ADD N,T2
POPJ P, ;RETURN
RADIX 10
DAYS: 31 ;JAN
28 ;NORMAL FEB
31 ;MAR
30 ;APR
31 ;MAY
30 ;JUN
31 ;JUL
31 ;AUG
30 ;SEPT
31 ;OCT
30 ;NOV
31 ;DEC
RADIX 8
;READ FILE-STRUCTURE NAME FROM TTBUFF
FSNAM: PUSHJ P,TTLINE ;READ A LINE INTO TTBUFF
POPJ P, ;WHOOPS !
FSNM: SETZ B,
MOVE T,[POINT 6,B]
FSNCH: ILDB CH,A
JUMPE CH,CPOPJ
SUBI CH,40 ;CONVERT TO SIXBIT
TLNE T,770000 ;FULL ?
IDPB CH,T ;NO
JRST FSNCH
;GET FN FROM TTBUFF
SIXIN: ILDB CH,A
CAIN CH,"*"
JRST STWILD
SETZB N,M
SKIPA T,[EXP ^D36]
NXTAN: ILDB CH,A
CAIL CH,"0"
CAILE CH,"9"
SKIPA
JRST GOTAN
CAIL CH,"A"
CAILE CH,"Z"
SKIPA
JRST GOTAN
CAIE CH,"?"
JRST NOTAN ;NOT A-N OR WILDCARD
MOVEI CH,137 ;WILDCARD "?"
GOTAN: TLNE M,770000
JRST NXTAN ;6 CHARS ALREADY
LSHC N,6
ADDI M,-40(CH)
CAIN CH,137
TRO N,77
SUBI T,6
JRST NXTAN
NOTAN: LSHC N,(T) ;LEFT JUSTIFY
POPJ P,
STWILD: SETOB M,N
ILDB CH,A
POPJ P,
;GET OCTAL # FOR PPN FROM TTBUFF
OCTRD: ILDB CH,A
CAIN CH,"*" ;WILDCARD "*" ?
JRST WILDST ;YES
SETZB N,M
TLOA N,-1 ;LH:=-1
NXTNO: ILDB CH,A
;TEST FOR WILDCARD "?"
CAIE CH,"?"
JRST NOTQST
TLNN N,-1
POPJ P, ;TOO BIG
LSHC N,3
TRO N,7
TRO M,7
JRST NXTNO
NOTQST: CAIL CH,"0"
CAILE CH,"7"
JRST NOTOCT ;NOT OCTAL #
TLNN N,-1
POPJ P, ;TOO BIG
LSHC N,3
ADDI M,-"0"(CH)
JRST NXTNO
NOTOCT: TLZ N,-1 ;LH:=0
JUMPN M,CPOPJ1
POPJ P,
WILDST: SETOB N,M
ILDB CH,A
JRST CPOPJ1
;ENSURE (T) WORDS AVAILABLE FROM (.JBFF)
CHKCOR: MOVEM T,EXTRA# ;FOR FURTHER ATTEMPTS
PUSHJ P,CORPLS
SKIPA
POPJ P, ;SUCESS !
OUTSTR [ASCIZ"
NOT ENOUGH CORE !!!
"]
EXIT 1, ;CONTINUABLE
MOVE T,EXTRA
AOBJN P,CORPLS ;PSEUDO PUSHJ
;TRY TO GET (T) WORDS FROM (.JBFF)
CORPLS: ADD T,.JBFF
CAMG T,.JBREL
JRST CPOPJ1 ;WE ALREADY HAVE ENOUGH
CORE T,
POPJ P,
JRST CPOPJ1 ;WE HAVE IT NOW
;PRINT ASCIZ STRING STARTING AT (T)
MSG: HRLI T,440700 ;BYTE POINTER
ILDB CH,T
JUMPE CH,CPOPJ
PUSHJ P,OUCH
JRST MSG+1
;PRINT (CH) ON TTY:
OUCH: SOSG TTYHD+2
OUTPUT TTY,
IDPB CH,TTYHD+1 ;STORE IT
CAIN CH,12 ;LF
OUTPUT TTY, ;FORCE IT OUT
POPJ P,
;PRINT ASCIZ STRING STARTING AT (T)
LOGMSG: HRLI T,440700 ;BYTE POINTER
ILDB CH,T
JUMPE CH,CPOPJ
PUSHJ P,LOGOUT
JRST LOGMSG+1
;PRINT (CH) ON LOG CHANNEL
LOGOUT: SOSG OLOGHD+2
OUTPUT LOG,
IDPB CH,OLOGHD+1 ;STORE IT
POPJ P,
;PRINT CURRENT FN.EXT[PPN,A,...]
FNPNT: MOVE T,.RBNAM(RIBST)
HLRZ T1,.RBEXT(RIBST)
CAIE T1,(SIXBIT/UFD/)
JRST SIXFN
PUSHJ P,PPNPNT ;MFD LEVEL - OCTAL PPN
SKIPA
SIXFN: PUSHJ P,SIXPNT ;PRINT THE FILENAME
MOVEI CH,"."
PUSHJ P,OUCH
HLLZ T,.RBEXT(RIBST)
PUSHJ P,SIXPNT ;PRINT THE EXT
MOVEI CH,"["
PUSHJ P,OUCH
MOVE T,PATHS+2 ;PPN
PUSHJ P,PPNPNT ;PRINT IT
MOVEI T2,PATHS+3 ;ADDR FIRST SFD
PATST: SKIPN T,(T2)
JRST PATHND
MOVEI CH,","
PUSHJ P,OUCH
PUSHJ P,SIXPNT
AOJA T2,PATST
PATHND: MOVEI CH,"]"
PUSHJ P,OUCH
MOVEI T,CRLFST
PJRST MSG ;PRINT CRLF
;PRINT SIXBIT IN T ON TTY
SIXPNT: MOVE T1,T
SETZ T,
LSHC T,6
JUMPE T,CPOPJ ;NULL TERMINATES IT
MOVEI CH,40(T)
PUSHJ P,OUCH
JRST SIXPNT+1
;PRINT PROJ #,PROG # LH,RH OF T
PPNPNT: MOVEM T,PPN#
HLRZS T ;GET PROJ #
PUSHJ P,OCTPNT ;PRINT PROJ #
MOVEI CH,","
PUSHJ P,OUCH
HRRZ T,PPN ;GET PROG #
;PRINT OCTAL # IN T
OCTPNT: SETZ T1,
LSHC T,-3
LSH T1,-3
TLO T1,(SIXBIT/0/)
JUMPN T,OCTPNT+1
PJRST SIXPNT+2
;'OUTPUT' 2 DECIMAL DIGITS (T)
DECDD: IDIVI T,^D10
ADDI T,"0"
IDPB T,A
ADDI T1,"0"
IDPB T1,A
POPJ P,
;DECODE 6 DECIMAL DIGITS (LEADING 0 AS SPACES)
DECOUT: SKIPGE T
SETZ T, ;NEG # VERBOTEN
SETZ T2,
IDIVI T,^D10
ADDI T1,20 ;'0'
LSHC T1,-6
DEC1: JUMPE T,DEC2
IDIVI T,^D10
ADDI T1,20 ;'0'
DEC2: LSHC T1,-6
TRNN T2,77
JRST DEC1
;'OUTPUT' 6 SIXBIT CHARS IN T2
SIXPUT: MOVEI T,6
SETZ T1,
LSHC T1,6
ADDI T1,40 ;CONVERT TO ASCIZ
IDPB T1,A
SOJG T,SIXPUT+1
POPJ P,
CRLFST: ASCIZ"
"
FSINFO: ASCIZ" SOURCE FS ^ OBJECT FS
DATE TIME F FSNM FSID BEFORE AFTER FSNM FSID BEFORE AFTER
"
MSGLEN==.-FSINFO
RELOC
LOWMSG: BLOCK MSGLEN
RELOC
;HERE ARE THE ERROR MESSAGES
ERDSKC: OUTSTR [ASCIZ"? DSKCHR FAILED - NO INFO ON BLOCKS ON UNITS
"]
EXIT
EROPNS: OUTSTR [ASCIZ"? CAN'T OPEN SOURCE FS"]
EXIT
ERINSH: OUTSTR [ASCIZ"? ERROR WITH SOURCE FS HOME BLOCK"]
EXIT
EROPNO: OUTSTR [ASCIZ"? CAN'T OPEN OBJECT FS"]
EXIT
ERINOH: OUTSTR [ASCIZ"? ERROR WITH OBJECT FS HOME BLOCK"]
EXIT
ERTTY: OUTSTR [ASCIZ"? CAN'T OPEN OR ENTER TTY FOR ERRORS"]
EXIT
ERMFDS: OUTSTR [ASCIZ"? ERROR LOOKUP ON SOURCE FS MFD"]
JRST QUIT
ERIBMF: OUTSTR [ASCIZ"? ERROR READING MFD RIB ON SOURCE FS"]
JRST QUIT
ERSIN: POP P,T1 ;REMOVE DATSIN RETURN ADDR
CLOSE OBJ,CL.ACS!CL.RST!CL.DAT
SKIPA T,[0,,[ASCIZ"ERROR READING "]]
ERIBS: MOVEI T,[ASCIZ"ERROR READING RIB FOR "]
PUSHJ P,MSG
GETSTS SOU,T1
SETSTS SOU,16 ;CLEAR ERROR BITS FROM DUMP MODE
JRST STSPNT
EROUTO: CLOSE OBJ,CL.ACS!CL.RST!CL.DAT
SKIPA T,[0,,[ASCIZ"ERROR WRITING "]]
ERCLOS: MOVEI T,[ASCIZ"ERROR IN CLOSING "]
PUSHJ P,MSG
GETSTS OBJ,T1
SETSTS OBJ,16 ;CLEAR ERROR BITS IN DUMP MODE
JRST STSPNT
ERENTO: MOVEI T,[ASCIZ"ENTER ERROR ON OBJECT FS "]
HRRZ T1,.RBEXT(RIBST) ;GET ERROR CODE
CAIE T1,14 ;ERNRM%
JRST CODPNT
MOVEI T,[ASCIZ"OBJECT FS FILLED AT "]
PUSHJ P,MSG
PUSHJ P,FNPNT
JRST QUIT
ERLOOK: TRNN A+.RBEXT,-1
JRST NEXTFN ;ERFNF% - JUST BEEN DELETED
MOVE RIBST,.JBFF
HRLZI T,A
HRR T,RIBST
BLT T,3(RIBST)
SKIPA T,[0,,[ASCIZ"LOOKUP ERROR "]]
ERREN: MOVEI T,[ASCIZ"RENAME ERROR "]
CODPNT: PUSHJ P,MSG
HRRZ T1,.RBEXT(RIBST)
SKIPA T,[0,,[ASCIZ"(CODE "]]
STSPNT: MOVEI T,[ASCIZ"(STATUS = "]
PUSH P,T1 ;SAVE ERROR CODE/STATUS
PUSHJ P,MSG
POP P,T
PUSHJ P,OCTPNT
MOVEI T,[ASCIZ") WITH "]
PUSHJ P,MSG
PUSHJ P,FNPNT
JRST DEALL1
XLIST
LIT
RELOC
VAR
END DSKCPY