Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50407/dskcpy.bak
There are no other files named dskcpy.bak 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)
;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
RIPABC==1B22
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
START: 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
"]
;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
"]
;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
;SWITCH STRING TABLE
SWNAME: 'ACCESS'
'NOACCE'
'CREATE'
'NOCREA'
'DELETE'
'NODELE'
'HELP '
'INCREM'
'MSGLEV'
'PATH '
'QUE '
'NOQUE '
'SORT '
'NOSORT'
'SYS '
'NOSYS '
NUMSW==.-SWNAME
;SWITCH DISPATCH TABLE
SWDISP: EXP ACCSW
EXP NOASW
EXP CRESW
EXP NOCSW
EXP DELSW
EXP NODSW
EXP HELP
EXP INCRSW
EXP MSGSW
EXP PATHSW
EXP QUESW
EXP NOQUE
EXP SORTSW
EXP NOSORT
EXP SYSSW
EXP NOSYS
IFN <.-SWDISP-NUMSW>,<PRINTX ?BAD SWITCH TABLE?
END>
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 ###
CAML T2,CREATE
JRST FILOK ;WITHIN CREATION LIMITS
LDB T1,[POINT 15,.RBEXT(RIBST),35] ;15 BIT ACCESS DATE
CAMGE T1,ACCESS
CAMG T1,PURGE
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: HRRZ T,.RBXRA(RIBST)
JUMPE T,CPOPJ
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
ERLOOK: TRNN A+.RBEXT,-1
JRST NEXTFN ;ERFNF% - JUST BEEN DELETED
MOVE RIBST,.JBFF
HRLZI T,A
HRR T,RIBST
BLT T,3(RIBST)
MOVEI T,[ASCIZ"LOOKUP ERROR CODE "]
JRST CODPNT
ERIBS: MOVEI T,[ASCIZ"ERROR READING RIB FOR "]
JRST MSGOUT
ERSIN: MOVEI T,[ASCIZ"ERROR READING "]
POP P,T1 ;REMOVE DATSIN RETURN ADDR
SKIPA
EROUTO: MOVEI T,[ASCIZ"ERROR WRITING "]
CLOSE OBJ,CL.ACS!CL.RST!CL.DAT
JRST MSGOUT
ERENTO: MOVEI T,[ASCIZ"ENTER ERROR ON OBJECT FS CODE "]
HRRZ T1,.RBEXT(RIBST) ;GET ERROR CODE
CAIE T1,14 ;ERNRM%
JRST CODPNT
MOVEI T,[ASCIZ"OBJECY FS FILLED AT "]
PUSHJ P,MSG
PUSHJ P,FNPNT
JRST QUIT
ERREN: MOVEI T,[ASCIZ"RENAME ERROR CODE "]
CODPNT: PUSHJ P,MSG
HRRZ T,.RBEXT(RIBST)
PUSHJ P,OCTPNT
MOVEI T,[ASCIZ" WITH "]
JRST MSGOUT
ERCLOS: MOVEI T,[ASCIZ"ERROR IN CLOSING "]
MSGOUT: PUSHJ P,MSG
PUSHJ P,FNPNT
JRST DEALL1
XLIST
LIT
RELOC
VAR
END START