!F---FILE SYSTEM INTERROGATOR
!W.S.CURRIE 4TH DEC 1976
!AMENDED TO HANDLE # FILES - GJB
! V006
!LAST UPDATED 15TH MAY 1977 18:50
! THIS IS TO REPLACE THE EXISTING F.IT HAS THE
!FOLLOWING FACILITIES:-
! A : LISTS ALL FILES IN THE CURRENT DIRECTORY ALONG
! WITH THE START BLOCK,PROTECT CODE AND NUMBER
! OF BLOCKS IN THE FILE.
! B FILENAME : GIVES DATA FOR SPECIFIC FILE AS IN A.
! C : GET CURRENT L VALUES
! D FILENAME : DELETE FILE,D ? LISTS ALL FILES AND
! REQUESTS Y TO DELETE ,N TO KEEP,UNLESS ANSWER
! TO AUTOMATIC REQUEST IS 'Y'.
! F : LISTS FILENAMES IN CURRENT DIRECTORY
! G FILENAME :SEARCH ALL DIRECTORIES FOR FILE
! L X.YY : ALTER CURRENT DIRECTORY TO DISC X,
! AND FILE SYSTEM YY(OCTAL).L CR RETURNS TO
! CURRENT LOGON.
! O : LISTS FILES IN CURRENT DIRECTORY IN ALPHABETICAL ORDER
! R : RENAME FILE,PROMPTS FOR OLD & NEW FILENAMES.
! S :STOP
! T FILENAME : TRANSFER FILE.PROMPTS FOR DESTINATION
! DISC.FSYS OR .TT OR .LP OR .LK
! U : LISTS ALL FILES FOR ALL USERS
! THE PROGRAM ASSUMES THE CURRENT LOGON FILE SYSTEM
!ON DISC 0 ON ENTRY. A ? IN A FILE NAME MEANS DO THE COMMAND
!TO ALL FILES STARTING WITH LETTERS UP TO THE ?.
! UNWANTED OUTPUT CAN BE INTERRUPTED BY SENDING A TO
! TASK 'FILE' USING THE INT MECHANISM.
! STACK=6000 STREAMS=0
CONTROL K'101011'
BEGIN
! DATA AREAS
CONSTINTEGER NCMDS=12; !NO OF COMMANDS
CONSTINTEGERARRAY SERV(0:3)=3,3,8,14
CONSTINTEGERARRAY FSERV(0:3)=4,4,9,15
CONSTINTEGERARRAY DIRBLK(0:3)=97(2),K'1100'(2)
CONSTINTEGERARRAY COMMAND(1:NCMDS)=C
'A','B','D','F','L','R','S','G','C','T','U','O'
CONSTINTEGER EXAMINE=0
CONSTINTEGER GET NEXT=1
CONSTINTEGER DESTROY=2
CONSTINTEGER CREATE=3
CONSTINTEGER APPEND=4
CONSTINTEGER RENAME=5
CONSTINTEGER LP SER=12
CONSTINTEGER DREAD=0
CONSTINTEGER DWRITE=1
CONSTBYTEINTEGERNAME DF=K'160055'
CONSTBYTEINTEGERNAME INT=K'160060'
CONSTBYTEINTEGERNAME ID=K'160030'
RECORDFORMAT FILEF(BYTEINTEGERARRAY NAME(0:5),C
INTEGER FIRST,PR)
RECORD (FILEF)ARRAY DIRECT(0:50)
RECORDFORMAT PF(BYTEINTEGER SERVICE,REPLY,INTEGER A1,C
RECORD (FILEF)NAME A2,INTEGER A3)
RECORD (PF) P
RECORDFORMAT FILEA(BYTEINTEGER UNIT,FSYS,C
BYTEINTEGERARRAY NAME(0:5))
RECORD (FILEA) PZ,PY
RECORDFORMAT P3F(BYTEINTEGER SERVICE,REPLY,INTEGER A1,C
RECORD (FILEA)NAME A2,A3)
RECORD (P3F) PQ
INTEGER DESTDISC,DESTFSYS,SBLK,DBLK
INTEGER OUTST,CURDISC,CURFSYS,COMM,I,J,K,BLKS,REP,QUEST
BYTEINTEGERARRAY SNAME,FNAME,F2NAME(0:5)
BYTEINTEGERARRAY DBUF(0:511)
SWITCH CMD(1:NCMDS)
!*******************************************************************
!********************************************************************
ROUTINE OCTWRT(INTEGER X)
INTEGER Y
CYCLE Y=15,-3,0
PRINTSYMBOL((X>>Y)&7+'0')
REPEAT
SPACES(2)
END
ROUTINE GETFILE(BYTEINTEGERARRAYNAME FILE,INTEGER ST)
INTEGER I,J
FILE(I)=' ' FOR I=ST,1,5
IF ST=0 START
SKIP SYMBOL WHILE NEXT SYMBOL=' '
IF NEXT SYMBOL='#' THEN SKIP SYMBOL AND J=1 ELSE J=0
FINISH ELSE J=0
CYCLE I=ST,1,5
EXIT IF NEXTSYMBOL=NL
READSYMBOL(REP)
FILE(I)=REP
IF REP='?' THEN QUEST=1 AND EXIT
REPEAT
SKIPSYMBOL
FILE(0)=FILE(0)!K'200' IF J=1
END
INTEGERFN GETDISC(INTEGERNAME DISC,FSYS)
INTEGER I,J,K
READSYMBOL(I)
I=I-'0'
READSYMBOL(REP)
READSYMBOL(J)
READSYMBOL(K)
SKIPSYMBOL
J=((J-'0')*8)+K-'0'
IF I<0 OR I>3 OR REP#'.' OR J<0 OR J>63 THEN RESULT =-1
DISC=I
FSYS=J
RESULT =0
END
ROUTINE GETDIR
INTEGER BLOCK
P_SERVICE=SERV(CURDISC)
P_REPLY=ID
P_A1=0; !READ ONLY
P_A2==DIRECT(0)
P_A3=DIRBLK(CURDISC)+CURFSYS
IF CURDISC=1 THEN P_A3=P_A3!K'020000'
PONOFF(P)
IF P_A1#0 START
PRINTSTRING('DIRECTORY BLOCK READ ERROR')
NEWLINE
STOP
FINISH
END
INTEGERFN DA(INTEGER BLOCK,BYTEINTEGERARRAYNAME BL,C
INTEGER MODE,DRIVE)
RECORDFORMAT P6F(BYTEINTEGER SERVICE,REPLY,INTEGER A1,C
BYTEINTEGERNAME A2,INTEGER A3)
RECORD (P6F) NAME PT
PT==P
PT_SERVICE=SERV(DRIVE)
PT_REPLY=ID
PT_A1=MODE
PT_A2==BL(0)
PT_A3=BLOCK
IF DRIVE=1 THEN PT_A3=PT_A3!K'020000'
PONOFF(PT)
RESULT =PT_A1
END
INTEGERFN FSREQ(INTEGER IND,REQ,OLD)
RECORDFORMAT P2F(BYTEINTEGER SERVICE,REPLY,INTEGER A1,C
RECORD (FILEA) NAME A2,INTEGER A3)
RECORD (P2F) PX
INTEGER K
PX_SERVICE=FSERV(CURDISC)
PX_REPLY=ID
PZ_UNIT=CURDISC
PZ_FSYS=CURFSYS
CYCLE K=0,1,5
PZ_NAME(K)=DIRECT(IND)_NAME(K)
REPEAT
PX_A1=REQ
PX_A2==PZ
PX_A3=OLD
PONOFF(PX)
RESULT =PX_A1
END
INTEGERFN DEST(INTEGER IND,REQ,OLD)
INTEGER S1,S2,RES
S1=CURDISC
S2=CURFSYS
CURFSYS=DESTFSYS
CURDISC=DESTDISC
RES=FSREQ(IND,REQ,OLD)
CURDISC=S1
CURFSYS=S2
RESULT =RES
END
ROUTINE PRINTFILE(INTEGER IND)
INTEGER X
SPACES(2)
IF DIRECT(IND)_NAME(0)>127 THEN PRINTSYMBOL('#') ELSE SPACE
CYCLE X=0,1,5
PRINTSYMBOL(DIRECT(IND)_NAME(X))
REPEAT
SPACES(2)
END
INTEGERFN NFILE
INTEGER X,Y
Y=0
CYCLE X=0,1,50
IF DIRECT(X)_FIRST#0 THEN Y=Y+1
REPEAT
RESULT =Y
END
INTEGERFN PNFILE
INTEGER X
X=NFILE
WRITE(X,2)
PRINTSTRING(' FILES')
NEWLINE
RESULT =X
END
ROUTINE CURLOG
INTEGER X
WRITE(CURDISC,2)
PRINTSYMBOL('.')
X=CURFSYS//8
PRINTSYMBOL(X+'0')
PRINTSYMBOL(CURFSYS-(X*8)+'0')
NEWLINE
END
INTEGERFN BLOKS(INTEGER IND)
INTEGER LAST
BLKS=1
LAST=DIRECT(IND)_FIRST
CYCLE
LAST=FSREQ(IND,GET NEXT,LAST)
IF LAST=0 THEN EXIT
IF LAST=-1 THEN PRINTSTRING(' CORRUPT') AND EXIT
BLKS=BLKS+1
REPEAT
RESULT =BLKS
END
INTEGERFN SEARCH(INTEGER IND)
INTEGER I,J
RESULT =-1 IF IND=51
CYCLE I=IND,1,50
IF DIRECT(I)_FIRST#0 START
CYCLE J=0,1,5
EXIT IF FNAME(J)#DIRECT(I)_NAME(J)
REPEAT
IF FNAME(J)='?' THEN RESULT =I
RESULT =I IF FNAME(J)='?'!K'200' AND DIRECT(I)_NAME(J)&K'200'#0
IF J=5 START
IF FNAME(J)=DIRECT(I)_NAME(J) THEN RESULT =I
FINISH
FINISH
REPEAT
RESULT =-1; !NOT FOUND
END
ROUTINE BUFSEND
INTEGER X
RECORDFORMAT LP(BYTEINTEGER SERVICE,REPLY,INTEGER A1,C
BYTEINTEGERNAME A2,INTEGER A3)
RECORD (LP)NAME PL
PL==P
PL_SERVICE=LP SER
PL_REPLY=ID
PL_A1=1
PL_A2==DBUF(0)
IF OUTST=2 START
CYCLE X=0,1,511
IF DBUF(X)=4 START
DBUF(X)=12; !CHANGE EOT TO NEWPAGE
EXIT
FINISH
REPEAT
FINISH ELSE X=511
PL_A3=X+1
PONOFF(PL)
END
ROUTINE FILESOUT
INTEGER I,J,K
NEWLINE
K=0
CYCLE J=0,1,11
CYCLE I=0,1,4
REP=J*5+I
IF REP>50 THEN RETURN
IF DIRECT(REP)_FIRST#0 AND INT#'A' START
PRINTFILE(REP)
K=K+1
IF K=5 THEN NEWLINE AND K=0
FINISH
REPEAT
REPEAT
END
!*****************************************************************
!*******************************************************************
!CODE STARTS HERE
INIT:
CURDISC=0
CURFSYS=DF
GETDIR
CMD(9):
CURLOG
COM:
INT=0
QUEST=0
NEWLINE
PROMPT('>')
WHILE NEXTSYMBOL=' ' THEN SKIPSYMBOL
READSYMBOL(COMM)
IF COMM=NL THEN ->COM ELSE READSYMBOL(REP)
IF 'A'<=REP<='Z' OR '0'<=REP<='9' OR REP='?' START
!
!IMPLIED FILE SEARCH
!
IF COMM='#' START
FNAME(0)=REP!K'200'
GET FILE(FNAME,1)
QUEST=1 IF REP='?'
ELSE
FNAME(0)=COMM
FNAME(1)=REP
IF REP='?' OR COMM='?' THEN QUEST=1
GETFILE(FNAME,2)
FINISH
J=SEARCH(0)
IF J<0 THEN PRINTSTRING('NO FILE') ELSE START
WHILE J>=0 CYCLE
PRINTFILE(J)
EXIT IF QUEST=0
NEWLINE
J=SEARCH(J+1)
REPEAT
FINISH
NEWLINE
->COM
FINISH
!CHECK IF VALID COMMAND
CYCLE J=NCMDS,-1,1
IF COMM=COMMAND(J) THEN ->CMD(J)
REPEAT
ERR:
PRINTSTRING('?')
NEWLINE
->COM
!
!*
!**
!*** A :- PRINT ALL DATA IN CURRENT DIRECTORY
!**
!*
!
CMD(1):
->COM IF PNFILE=0
NEWLINES(2)
PRINTSTRING(' NAME START CODE BLOCKS')
NEWLINES(2)
CYCLE J=50,-1,0
IF DIRECT(J)_FIRST#0 AND INT#'A' START
PRINTFILE(J)
OCTWRT(DIRECT(J)_FIRST)
OCTWRT(DIRECT(J)_PR)
OCTWRT(BLOKS(J))
NEWLINE
FINISH
REPEAT
NEWLINE
->COM
!
!*
!**
!*** B :- PRINT BLOCKS IN FILE
!**
!*
!
CMD(2):
PROMPT(' FILE? ') IF REP=NL
GETFILE(FNAME,0)
J=SEARCH(0)
IF J<0 THEN ->ERR
WHILE J>=0 AND INT#'A' CYCLE
PRINTFILE(J)
OCTWRT(BLOKS(J))
NEWLINE
EXIT IF QUEST=0
J=SEARCH(J+1)
REPEAT
->COM
!
!*
!**
!*** D :- DELETE FILE OR ALL FILES SELECTED
!**
!*
!
CMD(3):
PROMPT(' FILE? ')IF REP=NL
GETFILE(FNAME,0)
J=SEARCH(0)
IF J<0 THEN PRINTSTRING(' NO FILE') AND ->COM
IF QUEST#0 START
PROMPT('AUTOMATIC?')
WHILE NEXTSYMBOL=' ' THEN SKIPSYMBOL
K=0
READ SYMBOL(I)
IF I='Y' START
READ SYMBOL(I)
IF I='E' START
READ SYMBOL(I)
K=1 IF I='S'
FINISH
FINISH
READ SYMBOL(I) WHILE I#NL
!
!PRINT ALL FILES AND REQUEST DELETE OR NOT
!Y=DELETE N=KEEP
!UNLESS PROMPTING TURNED OFF.
!
WHILE J>=0 AND INT#'A' CYCLE
PRINTFILE(J)
IF K=0 START
PROMPT(':')
READSYMBOL(REP)
SKIPSYMBOL
FINISH ELSE REP='Y' AND NEWLINE
IF REP='Y' START
IF FSREQ(J,DESTROY,0)=-1 START
PRINTSTRING('FILE CORRUPT')
NEWLINE
FINISH
FINISH
J=SEARCH(J+1)
REPEAT
FINISH ELSE START
PRINTFILE(J)
IF FSREQ(J,DESTROY,0)=-1 START
PRINTSTRING(' CORRUPT')
FINISH
NEWLINE
FINISH
GETDIR
->COM
!
!*
!**
!*** F :- LIST FILE NAMES
!**
!*
!
CMD(4):
FILESOUT IF PNFILE#0
->COM
!
!*
!**
!*** L :- ALTER CURRENT DISC AND FILE SYSTEM
!**
!*
!
CMD(5):
->INIT IF REP=NL
->ERR IF GETDISC(CURDISC,CURFSYS)#0
GETDIR
CURLOG
->COM
!
!*
!**
!*** R :- RENAME,ASK FOR OLD & NEW FILES
!**
!*
!
CMD(6):
PROMPT('OLD FILE:')
GETFILE(FNAME,0)
PROMPT('NEW FILE:')
GETFILE(F2NAME,0)
PZ_UNIT=CURDISC
PZ_FSYS=CURFSYS
PY_UNIT=CURDISC
PY_FSYS=CURFSYS
CYCLE I=0,1,5
PZ_NAME(I)=FNAME(I)
PY_NAME(I)=F2NAME(I)
REPEAT
PQ_SERVICE=FSERV(CURDISC)
PQ_REPLY=ID
PQ_A1=RENAME
PQ_A2==PZ
PQ_A3==PY
PONOFF(PQ)
IF PQ_A1#0 START
NEWLINE
PRINTSTRING('RENAME FAILS')
NEWLINE
FINISH
GETDIR
->COM
!
!*
!**
!*** S :- STOP
!**
!*
!
CMD(7):
STOP
!
!*
!**
!*** G :- SEARCH ALL DIRECTORIES FOR FILE
!**
!*
!
CMD(8):
K=CURFSYS
PROMPT(' FILE? ') IF REP=NL
GETFILE(FNAME,0)
CYCLE I=0,1,K'77'
CURFSYS=I
GETDIR
J=SEARCH(0)
WHILE J>=0 CYCLE
PRINTFILE(J)
PRINTSTRING(' IN ')
OCTWRT(I)
NEWLINE
->OUT IF QUEST=0 OR INT='A'
J=SEARCH(J+1)
REPEAT
REPEAT
OUT:
NEWLINE
CURFSYS=K
GETDIR
->COM
!
!*
!**
!*** T :TRANSFER A FILE
!**
!*
!
CMD(10):
PROMPT(' FILE? ') IF REP=NL
GETFILE(FNAME,0)
K=SEARCH(0)
IF K<0 THEN PRINTSTRING('NO FILE') AND ->COM
PROMPT('TO:')
IF NEXTSYMBOL='.' START
OUTST=-1
SKIPSYMBOL
READSYMBOL(I)
READSYMBOL(J)
SKIPSYMBOL
IF I=J='T' THEN OUTST=1 ELSE START
IF I='L' AND J='K' THEN OUTST=3
IF I='L' AND J='P' THEN OUTST=2
IF OUTST=-1 THEN ->ERR
FINISH
FINISH ELSE START
->ERR IF GETDISC(DESTDISC,DESTFSYS)#0
OUTST=0
FINISH
WHILE K>=0 CYCLE
SBLK=DIRECT(K)_FIRST
IF OUTST =0 START
DBLK=DEST(K,DESTROY,0)
DBLK=DEST(K,CREATE,0)
->TERR IF DBLK=-1
FINISH
CYCLE
->COM IF INT='A' AND OUTST#0
->TERR IF DA(SBLK,DBUF,DREAD,CURDISC)#0
IF OUTST=0 AND DA(DBLK,DBUF,DWRITE,DESTDISC)#0 THEN ->TERR
IF OUTST=1 START
CYCLE J=0,1,511
EXIT IF (DBUF(J)=4 AND OUTST#3) OR INT='A'
PRINTSYMBOL(DBUF(J))
REPEAT
FINISH
IF OUTST>=2 THEN BUFSEND
SBLK=FSREQ(K,GET NEXT,SBLK)
EXIT IF SBLK=0
DBLK=DEST(K,APPEND,DBLK) IF OUTST=0
REPEAT
R1:
PRINTFILE(K)
NEWLINE
EXIT IF QUEST=0
K=SEARCH(K+1)
CONTINUE
TERR:
PRINTSTRING(' T FAILS ON ')
->R1
REPEAT
->COM
!
!*
!**
!*** U :- LIST ALL FILES OF ALL USERS
!**
!*
!
CMD(11):
K=CURFSYS
CYCLE I=0,1,K'77'
EXIT IF INT='A'
CURFSYS=I
GETDIR
J=NFILE
CONTINUE IF J=0
NEWLINES(2)
PRINTSTRING('USER ')
PRINT SYMBOL(I>>3&7+'0'); PRINT SYMBOL(I&7+'0')
PRINTSYMBOL(':')
WRITE(J,2)
PRINTSTRING(' FILES')
NEWLINE
FILESOUT
REPEAT
->COM
!
!*
!**
!*** O :- LIST FILES IN ALPHABETICAL ORDER
!**
!*
!
CMD(12):
IF PNFILE#0 START
REP=-1
QUEST=0
CYCLE
CYCLE I=0,1,5
SNAME(I)=255
REPEAT
CYCLE J=0,1,50
IF DIRECT(J)_FIRST#0 AND INT#'A' START
CYCLE I=0,1,5
EXIT IF DIRECT(J)_NAME(I)>SNAME(I)
IF DIRECT(J)_NAME(I)<SNAME(I) START
CYCLE K=0,1,5
SNAME(K)=DIRECT(J)_NAME(K)
REPEAT
REP=J
EXIT
FINISH
REPEAT
FINISH
REPEAT
IF REP#-1 START
PRINTFILE(REP)
IF QUEST=4 THEN NEWLINE AND QUEST =0 C
ELSE QUEST=QUEST+1
DIRECT(REP)_FIRST=0
REP=-1
FINISH ELSE EXIT
REPEAT
GETDIR
FINISH
NEWLINE
->COM
ENDOFPROGRAM