Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50400/d2d.bli
There are no other files named d2d.bli in the archive.
!
!DISK TO DISK COPY PROGRAM
!STEVE FORTUNE JUNE 75
!PETER DEWOLF FEB 76
!
MODULE D2D(STACK,VERSION=1(5)) =
BEGIN
!
!BUFFER HEADERS FOR I/O TO UFDS AND SFDS:
!THIS IS INDEXED BY THE CHANNEL NUMBER OF I/O
OWN BUFFERHEADERS [32];
MACRO INBUFHEAD(CH) = (BUFFERHEADERS + 4*CH)<0,36>$,
IPTR (CH) = (BUFFERHEADERS + 1 + 4*CH)<0,36>$,
ICOUNT (CH) = (BUFFERHEADERS + 2 + 4*CH)<0,36>$,
SAVEJOBFF (CH) = (BUFFERHEADERS + 3 + 4*CH)<0,36>$;
!BIT VECTOR FOR END-OF-FILE CONDITIONS: EOF HAS OCCURRED
!IF THE APPROPRIATE BIT IS SET
STRUCTURE EOFV[CH] = [1] .EOFV<.CH,1>;
OWN EOFV EOF;
!CONTROL STORAGE
OWN PATH [8], !PATH IS USED AS PATH BLOCK FOR LOOKUP/ENTERS
CHAN, !CHAN IS THE CURRENT I/O CHANNEL NUMBER
INDISK, !INPUT DISK NAME
OUTDISK, !OUTPUT DISK NAME
EXTBLOCK [30]; !USED FOR EXTENDED LOOKUP/ENTERS
!LOCATIONS WITHIN THE EXTENDED LOOKUP/ENTER BLOCK
BIND
PPN=EXTBLOCK[1],
FILENAME=EXTBLOCK[2],
EXTENSION=EXTBLOCK[3]<18,18>,
ERRORCODE=EXTBLOCK[3]<0,18>,
RBEST=EXTBLOCK[#10], !ESTIMATED BLOCK SIZE
RBALC=EXTBLOCK[#11], !ALLOCATED SIZE
RBPOS=EXTBLOCK[#12], !LOGICAL BLOCK NUMBER
FILESTATUS=EXTBLOCK[15],
RPLOG=FILESTATUS<35,1>, !LOGGED IN BIT
RPURE=FILESTATUS<24,1>, !HARD DATA ERROR FOR SOME FILE
RPUWE=FILESTATUS<25,1>, !HARD DATA ERROR (WRITING)
RPUCE=FILESTATUS<26,1>, !CHECKSUM ERROR FOR SOME FILE
RPNFS=FILESTATUS<14,1>, !DO NOT FAILSAFE
!SET IF .SYS FILE (SWAP,HOME,ETC.)
RBUSED=EXTBLOCK[21]; !NUMBER OF BLOCKS USED IN UFD
BIND JOBFF=#121<0,36>; !JOB FIRST FREE
OWN TIME, !SYSTEM UPTIME AT START
FILES, !NUMBER OF FILES XFERRED
BLOCKS, !NUMBER OF BLOCKS TRANSFERRED
UFDS, !NUMBER OF UFD'S XFERRED
SFDS, !NUMBER OF SFD'S XFERRED
SEARCHPPN, !PPN TO TRANSFER
LFLAG; !FLAG TO INDICATE WE ARE DONE
BIND
MFD=0, !MASTER FILE DIRECTORY CHANNEL
UFD=1, !USER FILE DIRECTORY
!SFDS USE CHANNELS 2 - 6
OUTCH=8; !FOR OUTPUT FILES AND UFDS/SFDS
!
!IO INTERFACE DEFINITIONS:
MACHOP
JFCL=#255,
CALLI=#047,
TTCALL=#051,
XCT=#256,
BLT=#251;
BIND
OPENUUO=#050,
RENAMEUUO=#055,
INUUO=#056,
OUTUUO=#057,
SETSTSUUO=#060,
GETSTSUUO=#062,
STATZUUO=#063,
INBUFUUO=#064,
OUTBUFUUO=#065,
INPUTUUO=#066,
OUTPUTUUO=#067,
CLOSEUUO=#070,
RELEASEUUO=#071,
LOOKUPUUO=#076,
ENTERUUO=#077;
MACRO
GETTAB(REG) = CALLI (REG,#41);JFCL(0,0)$,
SKIP(OP)= IFSKIP (OP) THEN 1 ELSE 0$,
MAKEOP(OP,REG,ADDR) = (OP)<0,0>^27 + (REG)<0,0>^23 + (ADDR)<0,0>$,
EXECUTE (X) = (REGISTER QQQQQQ; QQQQQQ_X; SKIP (XCT(0,QQQQQQ)))$;
MACRO
STOP = CALLI (0,#12)$,
MES (E) = TTCALL(3,PLIT ASCIZ E)$;
FORWARD
NEXTWORD, %WORD AT A TIME INPUT ROUTINE%
OPEN, %OPENS A FILE (INCLUDING LOOKUP)%
CLOSE,
XFR, %TRANSFERS ALL FILES IN DIRECTORY
CURRENTLY OPEN%
CREATEDIRECTORY, %BUILDS UFD OR SFD%
COPYFILE, %COPIES TO OUTPUT DISK%
SIXBITPRINT,
SIXBITREAD, !READS A NAME IN SIXBIT, SCANS TO <CR>
OCTALPRINT,
FILEPRINT;
LABEL CHANGE,L;
!ROUTINE TO TRANSFER ALL FILES IN CURRENTLY OPEN DIRECTORY.
!NOTE THIS ROUTINE IS RECURSIVE: AS SOON AS AN SFD IS FOUND,
!ALL FILES IN THAT SFD ARE COPIED.
ROUTINE XFR=
BEGIN
LOCAL SAVEFILE,SAVEEXT;
CREATEDIRECTORY(); !CREATE UFD IF IT DOES NOT ALREADY EXIST
UNTIL .EOF[.CHAN] DO
BEGIN
SAVEFILE_.FILENAME; SAVEEXT_.EXTENSION;
DECR C FROM 29 TO 1 BY 1 DO EXTBLOCK[.C]_0;
FILENAME_NEXTWORD(); EXTENSION_NEXTWORD()^(-18);
IF .FILENAME NEQ 0
THEN
BEGIN
LOCAL C;
PPN_PATH<0,0>; !POINTER TO A SCAN BLOCK
CHAN_.CHAN+1; !A NEW IO CHANNEL TO BE USED
IF OPEN()
THEN
BEGIN
IF .EXTENSION EQL SIXBIT "SFD"
THEN XFR() !AN SFD--COPY ALL FILES IN IT
ELSE COPYFILE(); !A REAL FILE--COPY TO OUTPUTDISK
CLOSE();
END;
CHAN_.CHAN-1; !BACK TO OUR CHANNEL NUMBER
END;
FILENAME_.SAVEFILE; EXTENSION_.SAVEEXT;
END;
IF .EXTENSION EQL SIXBIT "UFD"
THEN
BEGIN
MES ('['); OCTALPRINT(.PATH[2]<18,18>); MES(',');
OCTALPRINT(.PATH[2]<0,18>); MES('] Done?M?J');
END;
PATH[.CHAN-UFD+2]_0; !ERASE SFD/UFD NAME FOR LOOKUPS
END;
!
!ROUTINE TO OPEN AND LOOKUP A FILE. LOOKUPBLOCK IS ASSUMED
!TO BE SET UP AS AN EXTENDED LOOKUP BLOCK.
!
ROUTINE OPEN=
BEGIN
LOCAL OPENBLOCK[3];
OPENBLOCK[0]_#10; !IMAGE MODE
OPENBLOCK[1]_.INDISK; !FILE STRUCTURE NAME
OPENBLOCK[2]_INBUFHEAD(.CHAN)<0,0>; !BUFFER HEADERS
SAVEJOBFF(.CHAN)_@JOBFF; !SAVE JOBFF SO CAN RECLAIM BUFFERS
IF NOT EXECUTE(MAKEOP(OPENUUO,.CHAN,OPENBLOCK))
THEN
%OPEN FAILURE--WHAT ON EARTH COULD CAUSE IT??%
(MES ('??Cannot OPEN structure ');
SIXBITPRINT (.INDISK);
MES ('?M?J');
RETURN 0);
IF EXECUTE (MAKEOP(LOOKUPUUO,.CHAN,EXTBLOCK))
THEN
%LOOKUP SUCCESSFUL--SEE IF FILE IS NULL%
(EXECUTE(MAKEOP(INBUFUUO,.CHAN,6));
EXECUTE(MAKEOP(INUUO,.CHAN,0));
EOF[.CHAN] _ IF .ICOUNT(.CHAN) EQL 0 THEN 1 ELSE 0;
1)
ELSE
%LOOKUP FAILED--PRINT MESSAGE%
(MES ('LOOKUP failure (');
OCTALPRINT (.ERRORCODE);
MES (') ');
FILEPRINT (.INDISK);
MES ('?M?J');
0 %RETURN FAILURE% )
END;
!ROUTINE TO RETURN ONE WORD FROM CHANNEL POINTED TO BY "CHAN".
!SETS THE EOF BIT IF THE WORD RETURNED IS THE LAST WORD
!FROM FILE.
ROUTINE NEXTWORD=
BEGIN
REGISTER T1;
T1 _ @(IPTR(.CHAN) _ @IPTR(.CHAN)+1);
IF (ICOUNT(.CHAN) _ @ICOUNT(.CHAN) - 1) LEQ 0
THEN %THIS BUFFER EMPTY--DO IN UUO%
IF EXECUTE(MAKEOP(INUUO,.CHAN,0))
THEN EOF[.CHAN]_1; %IN UUO SKIPPED--IO ERROR OR EOF%
.T1
END;
!ROUTINE TO CLOSE A FILE
ROUTINE CLOSE=(EXECUTE(MAKEOP(CLOSEUUO,.CHAN,#10));
EXECUTE(MAKEOP(RELEASEUUO,.CHAN,0));
JOBFF_@SAVEJOBFF(.CHAN));
!
!COPIES FILE CURRENTLY OPEN ON CHANNEL CHAN TO OUTDISK
!
ROUTINE COPYFILE=
BEGIN
LABEL COPY;
LOCAL STATUS,SAVEFF,OPENBLOCK[3],OUTBUFHEAD[3];
OPENBLOCK[0]_#30; !IMAGE MODE, USER WORD COUNT
OPENBLOCK[1]_.OUTDISK; !OUTPUT FILE STRUCTURE
OPENBLOCK[2]_OUTBUFHEAD<0,0>^18; !BUFFER HEADER FOR OUTPUT
SAVEFF_@JOBFF; !BUFFER SPACE
IF .RPNFS THEN RETURN; !IGNORE FILE IF DO-NOT-FAILSAFE
IF NOT EXECUTE(MAKEOP(OPENUUO,OUTCH,OPENBLOCK))
THEN
(MES ('??OPEN failure for structure ');
SIXBITPRINT (.OUTDISK);
STOP;);
RBEST_.RBALC; !ALLOCATE DISK SPACE CONTIGUOSLY
RBPOS_RBALC_0; !LET FILSER FIGURE WHERE TO PUT FILE
IF NOT EXECUTE(MAKEOP(ENTERUUO,OUTCH,EXTBLOCK)) AND .ERRORCODE NEQ #17 %PARTIAL ALLOC%
THEN
(MES ('??ENTER failure (');
OCTALPRINT (.ERRORCODE);
MES (') ');
FILEPRINT (.OUTDISK);
MES ('?M?J'))
ELSE
BEGIN
FILES _ .FILES + 1;
EXECUTE(MAKEOP(OUTBUFUUO,OUTCH,6)); !BUILD LOTS OF BUFFERS
EXECUTE(MAKEOP(OUTPUTUUO,OUTCH,0)); !SET UP OUTPUT BUFFERS
COPY: DO
BEGIN REGISTER T2;
(.(OUTBUFHEAD+1))<0,36>_@ICOUNT(.CHAN); !USER WORD COUNT
T2<18,18>_@INBUFHEAD(.CHAN)+2; !BLT START ADDRESS
T2<0,18>_@OUTBUFHEAD[0]+2; !BLT TO ADDRESS
BLT (T2,@OUTBUFHEAD+2+@ICOUNT(.CHAN)-1); !ZAP--MOVE BUFFER
IF EXECUTE (MAKEOP(OUTUUO,OUTCH,0))
THEN
BEGIN
MES ('??Output error, status ');
EXECUTE(MAKEOP(GETSTSUUO,OUTCH,T2));
OCTALPRINT (.T2<0,18>);
FILEPRINT(.OUTDISK);
MES ('; file closed?M?J');
LEAVE COPY;
END;
BLOCKS_.BLOCKS+1;
END
UNTIL EXECUTE(MAKEOP(INUUO,.CHAN,0)); !IN UUO SKIPS
EXECUTE(MAKEOP(GETSTSUUO,.CHAN,STATUS));
IF .STATUS AND #740000 NEQ 0
THEN
(MES ('??Input error, status ');
OCTALPRINT (.STATUS<0,18>);
FILEPRINT(.INDISK);
MES ('; file closed?M?J'););
END;
EXECUTE(MAKEOP(CLOSEUUO,OUTCH,#10));
EXECUTE(MAKEOP(RELEASEUUO,OUTCH,0));
JOBFF_@SAVEFF;
CLOSE();
END;
!
!ROUTINE TO CREATE THE DIRECTORY (UFD OR SFD)
!
ROUTINE CREATEDIRECTORY=
BEGIN
LOCAL OPENBLOCK[3];
BIND UFDTAB=PLIT (#1000002,#1000004,#1000005,#1000003,#10000001,#3000003);
OPENBLOCK[0]_#10; !IMAGE MODE
OPENBLOCK[1]_.OUTDISK; !OUTPUT DISK
OPENBLOCK[2]_0; !NO IO, HENCE NO BUFFERS.
IF .EXTENSION EQL SIXBIT "UFD"
THEN !IF SYSTEM-GENERATED UFD, DON'T CREATE
DECR I FROM .UFDTAB[-1] TO 0
DO
IF .FILENAME EQL .UFDTAB[.I]
THEN (PATH[2]_.FILENAME; PATH[3]_0; UFDS_.UFDS+1; RETURN);
IF NOT EXECUTE(MAKEOP(OPENUUO,OUTCH,OPENBLOCK))
THEN
(MES ('??OPEN failure for structure ');
SIXBITPRINT (.OUTDISK);
STOP;)
ELSE
IF .EXTENSION EQL SIXBIT "UFD"
THEN
BEGIN
UFDS_.UFDS+1; !NUMBER OF UFDS XFERRED GETS BUMPED
PATH[2]_.FILENAME; !ACTUALLY A PPN FOR LOOKUPS
PATH[3]_0; !END OF PATH
RBUSED_0; !CLEAR NUMBER BLOCKS IN UFD
RPLOG_0; !JOB LOGGED IN BIT. CLEAR SO
!AVOID UNNECESSARY RECOMP IF TRANSFERRING
!AFTER A CRASH
RPURE_0; !HARD READ ERROR BIT
RPUWE_0; !HARD WRITE ERROR BIT
RPUCE_0; !CHECKSUM ERROR BIT
IF NOT EXECUTE(MAKEOP(ENTERUUO,OUTCH,EXTBLOCK))
THEN
(MES ('??Cannot create UFD for [');
OCTALPRINT(.FILENAME<18,18>);
MES (',');
OCTALPRINT(.FILENAME<0,18>);
MES (']; ENTER failure, code (');
OCTALPRINT(.ERRORCODE);
MES (')?M?J');)
END
ELSE
BEGIN
IF NOT EXECUTE(MAKEOP(ENTERUUO,OUTCH,EXTBLOCK))
THEN
(MES ('??ENTER failure for SFD, code (');
OCTALPRINT(.ERRORCODE);
MES (') file ');
FILEPRINT (.OUTDISK);
MES ('?M?J'););
SFDS_.SFDS+1; !BUMP SFD COUNT
PATH[.CHAN-UFD+2]_.FILENAME; !SFD NAME
PATH[.CHAN-UFD+3]_0; !END OF LIST
END;
EXECUTE(MAKEOP(RELEASEUUO,OUTCH,0));
END;
!LOW LEVEL TTY IO ROUTINES
ROUTINE OCTALPRINT(NUM)=
BEGIN
REGISTER N;
ROUTINE XN=
BEGIN
LOCAL R;
R _ .N MOD #10;
N _ .N / #10;
IF .N NEQ 0 THEN XN ();
R _ .R + "0";
TTCALL (1,R);
END;
N_.NUM;
XN();
END;
ROUTINE DECIMALPRINT(NUM)=
BEGIN
REGISTER N;
ROUTINE XN=
BEGIN
LOCAL R;
R _ .N MOD 10; N_ .N / 10; IF .N NEQ 0 THEN XN();
R _ .R + "0"; TTCALL(1,R);
END;
N _ .NUM; XN();
END;
ROUTINE SIXBITPRINT(WORD)=
BEGIN
REGISTER POINT,TWORD[2],C;
TWORD[0]_@WORD;
TWORD[1]_0;
POINT_(TWORD-1)<0,6>;
WHILE (C_SCANI(POINT)) NEQ 0 DO (C _ #40+.C; TTCALL (1,C));
END;
ROUTINE CHKEOL(CHAR)=
BEGIN
SELECT .CHAR OF
NSET
#12: RETURN 1;
#13: RETURN 1;
#14: RETURN 1;
#32: RETURN 1;
#33: RETURN 1;
#7: RETURN 1;
OTHERWISE: RETURN 0;
TESN
END;
ROUTINE SIXBITREAD=
BEGIN
REGISTER C,CNT,POINT; LOCAL WORD;
POINT_(WORD-1)<0,6>;
CNT_5;
WORD_0;
WHILE 1 DO
BEGIN
TTCALL(4,C);
IF CHKEOL(.C) THEN RETURN .WORD;
IF .C GEQ #140 THEN C_.C-#40;
IF (.C GEQ #101 AND .C LEQ #132) OR
(.C GEQ #60 AND .C LEQ #71)
THEN IF (CNT_.CNT-1) GEQ 0
THEN REPLACEI(POINT,(.C-#40))
END;
END;
ROUTINE OCTALREAD=
BEGIN
REGISTER WORD,C;
WORD_0;
WHILE 1
DO
BEGIN
TTCALL(4,C);
IF (.C GEQ #60) AND (.C LEQ #67)
THEN WORD_(.WORD^3)+.C-#60
ELSE RETURN .WORD;
END;
END;
ROUTINE READPPN=
BEGIN
REGISTER C;
LOCAL PPN;
DO
(TTCALL(4,C); IF CHKEOL(.C) THEN RETURN 0)
UNTIL
.C EQL "[";
PPN<18,18>_OCTALREAD();
PPN<0,18>_OCTALREAD();
DO
TTCALL(4,C)
UNTIL
CHKEOL(.C);
.PPN
END;
!HIGHER LEVEL TTY IO ROUTINES
ROUTINE FILEPRINT(DISK)=
BEGIN
REGISTER C;
SIXBITPRINT(.DISK);
MES (':');
IF .EXTENSION EQL SIXBIT "UFD"
THEN
BEGIN
MES('[');
OCTALPRINT(.FILENAME<18,18>);
MES(',');
OCTALPRINT(.FILENAME<0,18>);
MES('].UFD');
END
ELSE
BEGIN
SIXBITPRINT(.FILENAME);
IF .EXTENSION NEQ 0 THEN (MES ('.'); SIXBITPRINT(.EXTENSION^18););
MES ('[');
OCTALPRINT(.PATH[2]<18,18>);
MES (',');
OCTALPRINT(.PATH[2]<0,18>);
C_3;
UNTIL .PATH[.C] EQL 0 DO
BEGIN
MES (',');
SIXBITPRINT (.PATH[.C]);
C_.C+1;
END;
MES (']');
END
END;
ROUTINE TIMEPRINT(SECONDS)=
BEGIN
REGISTER HOURS,MINUTES,SEC;
SEC _ .SECONDS MOD 60;
SECONDS _ .SECONDS / 60;
MINUTES _ .SECONDS MOD 60;
HOURS _ .SECONDS / 60;
DECIMALPRINT(.HOURS); MES (':'); DECIMALPRINT(.MINUTES); MES(':');
DECIMALPRINT(.SEC);
END;
!
!TOP LEVEL OF PROGRAM
!
CALLI(0,0); !RESET THE WORLD
MES ('Input disk:');
INDISK_SIXBITREAD();
MES ('Output disk:');
OUTDISK_SIXBITREAD();
FILES_BLOCKS_UFDS_SFDS_LFLAG_0; !INITIALIZE COUNTERS
(REGISTER R; R_#000015000012 %UPTIME%; GETTAB(R); TIME_.R);
DO
L: BEGIN
MES('PPN to transfer:');
SEARCHPPN_READPPN(); !ACCEPT A PPN
IF .SEARCHPPN EQL 0 THEN LFLAG_-1;
IF (.LFLAG NEQ 0) AND (.UFDS NEQ 0)
THEN LEAVE L;
!
!OPEN MFD--FIND ALL PPN'S ON THIS DISK
!
DECR CHAN FROM 29 TO 1 DO EXTBLOCK[.CHAN]_0; EXTBLOCK[0]_29;
CHAN_MFD; !SET IO CHANNEL TO BE MFD
FILENAME_#000001000001;
EXTENSION_SIXBIT "UFD";
PPN_#000001000001;
OPEN(); !OPEN THE MASTER FILE DIRECTORY
NEXTWORD(); NEXTWORD(); !SCAN PAST [1,1].UFD
UNTIL .EOF[MFD] DO
BEGIN
OWN TEMP;
CHAN_MFD; !IO CHANNEL TO READ MFD
FILENAME_NEXTWORD(); TEMP_NEXTWORD(); EXTENSION_.TEMP<18,18>;
IF (.FILENAME NEQ 0) AND (.EXTENSION EQL SIXBIT "UFD")
THEN
IF (.SEARCHPPN EQL 0) OR (.SEARCHPPN EQL .FILENAME)
THEN BEGIN
PPN_#000001000001;
CHAN_UFD; !USE UFD IO CHANNEL
OPEN(); !OPEN THE UFD
XFR(); !TRANSFER ALL FILES IN UFD TO OUTDISK
CLOSE(); !CLOSE THE UFD
END;
END;
END
UNTIL
.LFLAG NEQ 0;
!
!DONE
!
MES('Transferred '); DECIMALPRINT(.BLOCKS); MES(' blocks in ');
DECIMALPRINT(.FILES); MES(' files; ');
DECIMALPRINT(.UFDS); MES (' UFDS, '); DECIMALPRINT(.SFDS); MES(' SFDS?M?J');
(REGISTER R; R_#15000012; GETTAB(R); MES ('Elapsed time '); TIMEPRINT((.R-.TIME)/60));
MES('?M?J');
!CODE TO CHANGE A FILE STRUCTURE NAME
!NOTE--THIS CODE MAY BE MONITOR DEPENDENT (AT LEAST WITH RESPECT TO HOME BLOCKS)
!
CHANGE:
BEGIN
REGISTER R;
LABEL L;
LOCAL OUTDRIVE[10],NDROUT,I,J,RFLAG,
INFSNAME,OUTFSNAME;
BIND OUTCH=1, !CHANNEL FOR FILE STRUCTURE BEING CHANGED
HOMSNM=4, !FILE STRUCTURE NAME
HOMLOG=7, !SIXBIT LOGICAL UNIT # WITHIN STR
HOMLUN=8; !LOGICAL UNIT NUMBER WITHIN STR
OWN OB[128]; !OUTPUT BUFFER
MACRO SYSPHY(R)=(CALLI (R,#51); JFCL(0,0))$,
DSKCHR(R)=(CALLI (R,#45); JFCL(0,0))$,
SUSET(R)=(REGISTER T; T_@0; CALLI (R,#146); JFCL (0,0); 0<0,36>_.T)$;
ROUTINE PHYREAD(BLOCK,CHAN)=
BEGIN REGISTER R; LOCAL CWD[2];
R<27,9>_0; !INPUT
R<23,4>_.CHAN; !CHANNEL NUMBER
R<0,23> _ .BLOCK; !BLOCK TO READ
SUSET(R); !PSUEDO-SUPER USETI
CWD[0]<18,18>_-#200; !WORD COUNT
CWD[0]<0,18>_OB-1;
CWD[1]_0; !END OF COMMAND LIST
IF EXECUTE (MAKEOP(STATZUUO,.CHAN,#740000))
THEN EXECUTE(MAKEOP(INUUO,.CHAN,CWD))
ELSE (MES ('??Something wrong--pseudo super USETI failed on read?M?J'); STOP);
END;
ROUTINE PHYWRITE(BLOCK,CHAN)=
BEGIN REGISTER R; LOCAL CWD[2];
R_0; !MAKE SURE UNUSED FIELDS 0
R<23,4>_.CHAN; !CHANNEL NUMBER FOR SUSET
R<34,1>_1; !OUTPUT
R<0,23>_.BLOCK; !BLOCK TO WRITE
SUSET(R); !PSUEDO SUPER-USETO
CWD[0]<18,18>_-#200;
CWD[0]<0,18>_OB-1;
CWD[1]_0;
IF EXECUTE(MAKEOP(STATZUUO,.CHAN,#740000))
THEN EXECUTE(MAKEOP(OUTUUO,.CHAN,CWD))
ELSE MES ('??Something wrong--pseudo super USETO failed on write?M?J');
END;
ROUTINE LOGUNIT(STRUCTNAME,UNITNUM)=
BEGIN OWN BP,COUNT,TEMP;
LABEL L;
BP_STRUCTNAME<36,6>;
COUNT_
L: DECR I FROM 5 TO 0
DO
IF SCANI(BP) EQL 0
THEN LEAVE L WITH .I;
COUNT_.COUNT+1;
TEMP_.STRUCTNAME;
BP_TEMP<6*.COUNT,6>;
IF .UNITNUM/8 GTR 0 AND .UNITNUM/8 LEQ 7
THEN
IF (COUNT_.COUNT-1) GEQ 0
THEN REPLACEI(BP,.UNITNUM/8+#20);
IF (COUNT_.COUNT-1) GEQ 0
THEN REPLACEI(BP,.UNITNUM MOD 8 +#20);
.TEMP
END;
MES('Do you want to change a file structure name??');
IF SIXBITREAD()^(-30) NEQ SIXBIT "Y" THEN LEAVE CHANGE;
MES('File structure (whose name is to be changed):');
OUTFSNAME_SIXBITREAD();
NDROUT_R_0;
L: WHILE 1 DO
BEGIN LOCAL DSKCHRBLOCK[5]; REGISTER T;
SYSPHY(R); IF .R EQL 0 THEN LEAVE L;
DSKCHRBLOCK[0] _ .R;
T<18,18>_5; T<0,18>_DSKCHRBLOCK<0,0>;
DSKCHR(T);
IF .DSKCHRBLOCK[4] EQL .OUTFSNAME
THEN OUTDRIVE[NDROUT_.NDROUT+1] _ .R;
END;
IF .NDROUT EQL 0
THEN MES('No drives in that structure??!?M?J')
ELSE
BEGIN
MES('['); SIXBITPRINT (.OUTFSNAME); MES(' is on drive(s) ');
INCR I FROM 1 TO .NDROUT DO
(SIXBITPRINT(.OUTDRIVE[.I]); IF .I NEQ .NDROUT THEN MES (','));
MES(']?M?JShould I remove ');
SIXBITPRINT(.OUTFSNAME);
MES('??');
RFLAG_0; !IF RFLAG IS 0, MUST USE OMOUNT
IF SIXBITREAD()^(-30) EQL SIXBIT "Y"
THEN
BEGIN REGISTER T;
LOCAL STRUUOBLOCK[2];
STRUUOBLOCK[0]_5; !.FSREM TO REMOVE A STRUCTURE
STRUUOBLOCK[1]_.OUTFSNAME;
T_#2000000+STRUUOBLOCK<0,0>; !STRUUO AC
IFSKIP CALLI(T,#50) !STRUUO
THEN RFLAG_1 !SUCCESS
ELSE MES('I failed.?M?J');
END;
IF .RFLAG EQL 0 !IF THE STRUCTURE HAS NOT BEEN REMOVED...
THEN
BEGIN
MES('Using OMOUNT, "REMOVE ');SIXBITPRINT(.OUTFSNAME);
MES('". Do not physically remove it.?M?JWhen done, type <CR>');
SIXBITREAD();
END;
MES('New name of file structure:');
INFSNAME_SIXBITREAD();
INCR I FROM 1 TO .NDROUT DO
BEGIN LABEL LP;
LOCAL OPENBLOCK[3];
OPENBLOCK[0]_#17; %DUMP% OPENBLOCK[1]_.OUTDRIVE[.I];
OPENBLOCK[2]_0;
IF EXECUTE (MAKEOP(OPENUUO,OUTCH,OPENBLOCK))
THEN
INCR J FROM 1 TO 10 BY 9
DO
LP: BEGIN
PHYREAD(.J,OUTCH); !READ HOME BLOCK
IF (.OB[0] NEQ SIXBIT 'HOM') OR (.OB[#176] NEQ #707070)
THEN
BEGIN
MES('Consistancy failure reading ');
IF .J EQL 1 THEN MES('first') ELSE MES('second');
MES(' home block.?M?J');
LEAVE LP
END;
OB[HOMSNM]_.INFSNAME; !CHANGE FILE STRUCTURE NAME
OB[HOMLOG]_LOGUNIT(.INFSNAME,.OB[HOMLUN]);
PHYWRITE(.J,OUTCH); !WRITE THE CHANGED HOME BLOCK
END
ELSE
BEGIN
MES('OPEN failure for drive '); SIXBITPRINT(.OUTDRIVE[.I]);
MES ('M?J');
END;
END;
END;
END;
END;