!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)=K'150'(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)COM %ENDOFPROGRAM