1 ! Program Name : REORG ! Package Name : REORG ! Purpose : On-line RSTS/E disk reorganizer ! Institution : Timeline Inc. ! Date written : 28-Jun-88 ! Written by : Alan Conroy ! Version : 9.5 ! Revision : ! Edit : 08 ! TO THE GLORY OF GOD THROUGH JESUS CHRIST ! ******************************************************* ! * * ! * M O D I F I C A T I O N H I S T O R Y * ! * * ! * DATE BY REASON * ! * * ! ******************************************************* ! ******************************************************* ! * * ! * P R O G R A M P U R P O S E * ! * * ! ******************************************************* ! This program does on-line disk reorgs for RSTS/E V9 ! ******************************************************* ! * * ! * F I L E D E S C R I P T I O N S * ! * * ! ******************************************************* ! Channel Name Description ! ------- ---- ----------- ! ******************************************************* ! * * ! * V A R I A B L E T A B L E * ! * * ! ******************************************************* DECLARE STRING Disk.Name, ! Name of disk (work variable) & File.Attributes, ! Attributes of file on channel 1 & File.Data, ! File data for channel 1 string & Inp, ! Command line input and disk name & Inp1, ! PPN of current UFD & Save.Name, ! First file in UFD & Stall, ! Stall system string & Unstall, ! Unstall system string & Work, ! Work variable & Work1 ! Work variable #1 DECLARE WORD A, B, B1, C, D, ! Dummy variables & Cluster, ! Cluster size of disk & DEVCNT, ! Device count table & DEVNAM, ! Device name table & F(30), ! File values & F1(30), ! File values & FCBLST, ! FCB table & FUN, ! FIP Unit Number for reorg-disk & FUN2, ! FUN*2 value & Index, ! File index within PPN & IOB, ! IO Block & JDB, ! Job Descripter Block & M(30), ! Monitor table values & Max.Cluster, ! Maximum valid clustersize & Moved, ! True if a file was moved & NOA, ! True if attributes are removed from executables & PPN, ! PPN that we're currently at & PPN.Index, ! PPN index & SATEND, ! Disk size table address & This.Cluster, ! Clustersize for current file & UNTCLU, ! Unit cluster table address & WCB ! Work Control Block DECLARE DOUBLE File.Size, ! Size of current file in blocks & T1, T2 ! Time variables used to check system load ! ******************************************************* ! * * ! * C O N S T A N T D E C L A R A T I O N S * ! * * ! ******************************************************* DECLARE WORD CONSTANT True = -1 ! Standard boolean TRUE value DECLARE WORD CONSTANT False = 0 ! Standard boolean FALSE value DECLARE STRING Null Null='' ! Standard null value DECLARE STRING CONSTANT Version = 'V9.5-08' ! Current version DECLARE STRING CONSTANT Program.Name = 'REORG ' ! Name of program ON ERROR GOTO 29000 ! Set up standard error trap DECLARE WORD FUNCTION NFS DECLARE WORD FUNCTION UFD DECLARE WORD FUNCTION Fil EXTERNAL WORD FUNCTION RAD50(STRING) EXTERNAL SUB RENAME(STRING) 10 SET NO PROMPT PRINT IF CCPOS(0)>0 PRINT Program.Name;' ';Version;' ';ERT$(0);' ';DATE$(0);' at ';TIME$(0) Main: PRINT PRINT 'ORG> '; INPUT LINE Inp Inp=EDIT$(Inp,-1) GOTO Main IF LEN(Inp)=0 ! Ignore blank lines IF Inp='?' OR LEFT(Inp,2)='/H' ! HELP THEN & PRINT '/E Exit' PRINT '/H Print this text' PRINT PRINT ' To start the reorg, enter the disk name (e.g. DU0:) and any of the' PRINT 'following switches:' PRINT '/MAX=n Limit file clustersize increases to n' PRINT '/NOA Remove attributes from executable files' PRINT '/PRI=n Run with a priority of n' PRINT '/RUN=n Run with a runburst of n' GOTO Main END IF GOTO 32767 IF LEFT(Inp,2)='/E' ! Exit command Max.Cluster=256 ! Maximum valid clustersize is 256 B=32767 A=INSTR(1,Inp,'/PRI=') IF A THEN & C=INSTR(A+1,Inp+'/','/') B=VAL(MID(Inp,A+5,C-A-5)) Inp=LEFT(Inp,A-1)+RIGHT(Inp,C) IF B<-120 OR B>120 THEN & PRINT '?Illegal priority value' GOTO Main END IF END IF B1=32767 A=INSTR(1,Inp,'/RUN=') IF A THEN & C=INSTR(A+1,Inp+'/','/') B1=VAL(MID(Inp,A+5,C-A-5)) Inp=LEFT(Inp,A-1)+RIGHT(Inp,C) IF B1<1 OR B>127 THEN & PRINT '?Illegal runburst value' GOTO Main END IF END IF A=INSTR(1,Inp,'/MAX=') IF A THEN & C=INSTR(A+1,Inp+'/','/') Max.Cluster=VAL(MID(Inp,A+5,C-A-5)) Inp=LEFT(Inp,A-1)+RIGHT(Inp,C) A=1 WHILE A<=256 ! Check all valid clustersizes GOTO ClusterOK IF Max.Cluster=A A=A+A NEXT PRINT '?Illegal clustersize value' GOTO Main END IF ClusterOK: NOA=False A=INSTR(1,Inp,'/NOA') IF A THEN & C=INSTR(A+1,Inp+'/','/') Inp=LEFT(Inp,A-1)+RIGHT(Inp,C) ! Remove switch NOA=True END IF IF INSTR(1,Inp,'/') THEN & PRINT '?Syntax error' GOTO Main END IF IF RIGHT(Inp,LEN(Inp))<>':' THEN & PRINT '?Disk must be specified' GOTO Main END IF Disk.Name=SYS(CHR$(6)+CHR$(-10)+Inp) ! FSS on disk name Inp='_'+MID(Disk.Name,23,2) Inp=Inp+NUM1$(ASCII(MID(Disk.Name,25,1))) & IF MID(Disk.Name,26,1)<>CHR$(0) Inp=Inp+':' ! Build name from FSS IF Inp='_SY0:' THEN & OPEN '_SY0:TEMP00.TMP' FOR OUTPUT AS FILE 1, MODE 32 Disk.Name=SYS(CHR$(12)) ! Info on last opened file CLOSE -1 Inp='_'+MID(Disk.Name,23,2) Inp=Inp+NUM1$(ASCII(MID(Inp,25,1))) & IF MID(Inp,26,1)<>CHR$(0) Inp=Inp+':' ! Build a physical name if SY0: is specified END IF OPEN Inp AS FILE 1 ! Attempt NFS disk OPEN A=STATUS AND 255 IF A<>0 THEN & PRINT '?Disk must be specified' CLOSE -1 GOTO Main END IF CLOSE -1 File.Data=CHR$(6)+CHR$(-8)+CHR$(1)+CHR$(1)+STRING$(26,0) File.Attributes=CHR$(6)+CHR$(-26)+CHR$(1)+STRING$(27,0) ! String for returning file attributes of channel 1 Stall=CHR$(6)+CHR$(29)+CHR$(1) ! Stall system string Unstall=CHR$(6)+CHR$(29)+CHR$(0) ! Unstall system string LSET Null=SYS(Stall) ! Attempt a stall LSET Null=SYS(Unstall) ! Unstall (it worked) PRINT 'Beginning reorg of ';Inp CHANGE SYS(CHR$(6)+CHR$(-3)) TO M M(A)=M(A) OR SWAP%(M(A+1)) FOR A=3 TO 29 STEP 2 ! Get monitor tables (part 1) DEVCNT=M(5) UNTCLU=M(17) SATCTL=M(21) SATCTM=M(25) CHANGE SYS(CHR$(6)+CHR$(-12)) TO M M(A)=M(A) OR SWAP%(M(A+1)) FOR A=3 TO 29 STEP 2 ! Get monitor tables (part 2) FCBLST=M(29) DEVNAM=M(5) CHANGE SYS(CHR$(6)+CHR$(-29)) TO M M(A)=M(A) OR SWAP%(M(A+1)) FOR A=3 TO 29 STEP 2 ! Get monitor tables (part 3) SATEND=M(7) Inp=RIGHT(Inp,2) ! Strip underscore Inp=LEFT(Inp,LEN(Inp)-1) ! Strip colon A=0 ! Start with offset 0 D=0 ! Start with first FIP unit SearchLoop: Disk.Name=CVT%$(SWAP%(PEEK(DEVNAM+A))) ! Get disk name C=PEEK(DEVCNT+A) ! Get maximum unit number A=A+2 ! Increment offset GOTO SearchLoop IF C<0 ! None of these disks on the system IF Disk.Name<>LEFT(Inp,2) ! Not the disk we want THEN & D=D+C+1 GOTO SearchLoop END IF D=D+VAL(RIGHT(Inp,3)) FUN=D ! Now we have the disk's FIP Unit Number FUN2=FUN*2 Disk.Name='R.'+Inp ! New name of job A=RAD50(LEFT(Disk.Name,3)) C=RAD50(RIGHT(Disk.Name,4)) Disk.Name=CHR$(A)+CHR$(SWAP%(A))+CHR$(C)+CHR$(SWAP%(C)) ! Convert to RAD50 CALL RENAME(Disk.Name) ! Change our name PRINT 'Detaching...';FF LSET Null=SYS(CHR$(6)+CHR$(7)) ! Detach LSET Null=SYS(CHR$(6)+CHR$(-13)+CHR$(255)+CHR$(255)+CHR$(B)) IF B<121 ! Set priority LSET Null=SYS(CHR$(6)+CHR$(-13)+CHR$(255)+STRING$(2,0)+CHR$(255)+ & CHR$(B1)) IF B1<128 ! Set runburst TopLoop: PPN.Index=0 20 ! Start new PPN: CHANGE SYS(CHR$(6)+CHR$(25)+CHR$(PPN.Index)+CHR$(SWAP%(PPN.Index))+ & CHR$(255)+CHR$(255)+STRING$(16,0)+LEFT(Inp,2)+ & CHR$(VAL(RIGHT(Inp,3)))+CHR$(255)+STRING$(4,0)) TO M PPN.Index=PPN.Index+1 PPN=M(5)+SWAP%(M(6)) Inp1='['+NUM1$(M(6))+','+NUM1$(M(5))+']' Index=0 Save.Name='' NewFile: T1=TIME(0) SLEEP 0 T2=TIME(0) IF T1<>T2 ! System is busy THEN & SLEEP 10 GOTO NewFile END IF Moved=False GOTO AbortDisk IF NFS ! Disk is opened NFS GOTO AbortPPN IF UFD ! UFD is opened GOTO AbortFile IF Fil ! File problems GOTO AbortPPN IF Work=Save.Name ! Done with PPN Save.Name=Work IF LEN(Save.Name)=0 ! Save first filename Index=Index-1 ! Don't increase file index since this was just a test 30 LSET Null=SYS(Stall) ! Stall system IF NFS ! Disk is opened NFS THEN & LSET Null=SYS(Unstall) ! Unstall system GOTO AbortDisk END IF IF UFD ! UFD is opened THEN & LSET Null=SYS(Unstall) ! Unstall system GOTO AbortPPN END IF GOTO DoneFile IF Fil ! File problems OPEN '_'+Inp+':'+Inp1+Work FOR INPUT AS FILE 1, MODE 8192, & RECORDSIZE 16384 ! Open file CHANGE SYS(CHR$(12)) TO M ! Get file statistics M(21)=256 IF M(21)=0 This.Cluster=Max.Cluster File.Size=M(13)+M(14)*256.+M(4)*65536. E=File.Size/7 ! Determine optimal extent size IF E>256 THEN This.Cluster=256 ELSE This.Cluster=INT(E) END IF ! Set file to optimal extent MAX 256 This.Cluster=M(21) IF M(21)>This.Cluster OR (F1(30) AND 16)=16 ! Do not decrease file clustersize from what it already is and do not ! change the clustersize of an already contiguous file A=1 WHILE A<256 ! Make sure clustersize is valid This.Cluster=A+A IF This.Cluster>A AND This.Cluster/SI:'+NUM1$(File.Size) ! Get various file stats OPEN '_'+Inp+':'+Inp1+'TEMP00.TMP'+Disk.Name FOR OUTPUT AS FILE 2, & CLUSTERSIZE This.Cluster, MODE 1072, RECORDSIZE 16384 ! Open new file contiguous GOSUB 4000 ! Copy file Work1=SYS(File.Attributes) ! Get file attributes CHANGE Work1 TO F A=26 A=A-1 WHILE A>4 AND F(A)=0 ! Find end of attributes LSET Null=SYS(CHR$(6)+CHR$(-25)+CHR$(2)+CHR$((A-3)/2)+ & MID(Work1,5,22)+STRING$(4,0)) ! Write attributes & IF A>4 ! (if any) & UNLESS NOA AND (M(22) AND 64)=64 ! No attributes on executables LSET Null=SYS(CHR$(6)+CHR$(-26)+CHR$(2)+CHR$(8)+STRING$(8,0)+ & MID(Work1,27,4)+STRING$(14,0)) IF M(4)=0 ! Change RTS A=5 A=A OR 128 IF F(2) AND 128 A=A OR 64 IF F(2) AND 4 ! Determine caching stuff A=A OR 32 IF (F1(30) AND 16)=0 ! Not contiguous LSET Null=SYS(CHR$(6)+CHR$(-26)+CHR$(2)+CHR$(A)+STRING$(10,0)+ & CHR$(132)+STRING$(15,0)) ! Set file placement, cacheing, and contiguity LSET Null=SYS(CHR$(6)+CHR$(-11)+CHR$(2)+CHR$(F1(17))+CHR$(F1(18))+ & CHR$(F1(19))+CHR$(F1(20))+CHR$(F1(21))+CHR$(F1(22))+STRING$(20,0)) ! Set file dates CLOSE -1 CLOSE 2 ! Close both files KILL '_'+Inp+':'+Inp1+Work ! Delete old file Moved=True 40 NAME '_'+Inp+':'+Inp1+'TEMP00.TMP' AS '_'+Inp+':'+Inp1+Work ! Change name of new file to that of old one DoneFile: LSET Null=SYS(Unstall) ! Unstall system AbortFile: ! Done with this file SLEEP 5 ! Wait a bit IF Index ! Try next file (if any more) THEN & Index=Index-1 IF Moved ! When file is moved to end of UFD, the index shouldn't increase GOTO NewFile END IF AbortPPN: ! Done a complete pass through the UFD GOTO 20 IF PPN.Index ! Try next PPN (if any more) AbortDisk: ! Done a complete pass through disk SLEEP 120 ! Wait one minute before starting next pass GOTO TopLoop ! Start over on disk 1000 DEF WORD NFS ! Verify that the disk is not opened NFS before doing anything. Return ! -1 if a problem, 0 otherwise. ON ERROR GOTO 2000 NFS=True FOR B=1 TO 63 ! Check each possible job slot CHANGE SYS(CHR$(6)+CHR$(26)+CHR$(B)+CHR$(1)+STRING$(26,0)) TO M JDB=M(25) OR SWAP%(M(26)) IOB=PEEK(JDB) FOR C=1 TO 15 ! Check each channel D=PEEK(IOB+C*2) IF D ! Channel is open THEN & IF (PEEK(D) AND 255)=0 ! A WCB THEN & WCB=D D=PEEK(WCB+8)-28 ! Get FCB address EXIT DEF & IF (PEEK(WCB) AND 256) OR & PEEK(WCB+2)<0 ! Open NFS & IF (PEEK(D+24) AND 255)=FUN ! Right disk END IF END IF NEXT C 1500 NEXT B 1600 NFS=False EXIT DEF 2000 RESUME 1600 IF ERR=18 ! No more jobs RESUME 1500 END DEF DEF WORD UFD ! Verify that the current UFD is not opened before doing anything. ! Return -1 if a problem, 0 otherwise. ON ERROR GOTO 2100 UFD=True A=PEEK(FCBLST+FUN2) ! Start with first file opened on this device WHILE A ! While FCBs for this device (A=FCB address) IF (PEEK(PEEK(A+30) AND (NOT 31)) AND 16384)=16384 ! UFD mode THEN & EXIT DEF IF PEEK(A+4)=PPN ! The necessary UFD END IF A=PEEK(A) ! Follow link to next file NEXT UFD=False ! We made it to the end and NO UFD 2050 EXIT DEF 2100 RESUME 2050 ! Some error - so exit END DEF DEF WORD Fil ! Verify that the current file (as specified by Index and PPN) is not ! opened, placed, or deleted before doing anything. Return -1 if a ! problem, 0 otherwise. ON ERROR GOTO 3000 Fil=True CHANGE SYS(CHR$(6)+CHR$(15)+CHR$(Index)+CHR$(SWAP%(Index))+ & CHR$(PPN)+CHR$(SWAP%(PPN))+STRING$(16,0)+LEFT(Inp,2)+ & CHR$(VAL(RIGHT(Inp,3)))+CHR$(255)+STRING$(4,0)) TO F1 ! Get file information Index=Index+1 EXIT DEF IF F1(30) AND 174 ! File is open/placed/non-deletable/deleted Work=RAD$(F1(7)+SWAP%(F1(8)))+RAD$(F1(9)+SWAP%(F1(10)))+'.'+ & RAD$(F1(11)+SWAP%(F1(12))) OPEN '_'+Inp+':'+Inp1+Work AS FILE 1, MODE 4096 ! Open file read-regardless CHANGE SYS(File.Data) TO M ! Get file data CLOSE -1 Fil=False IF M(3)+M(4)=1 ! File is opened only by us EXIT DEF 3000 RESUME 3010 ! End of UFD 3010 Index=0 IF ERL=5 ! End of UFD END DEF 4000 ! Copy files GET #1 PUT #SWAP%(1)+2, COUNT RECOUNT GOTO 4000 4010 RETURN 29000 ! ******************************************************* ! * * ! * E R R O R H A N D L I N G * ! * * ! ******************************************************* IF ERL=10 ! Errors during initializing THEN & RESUME 32767 IF ERR=11 ! Exit on control-Z PRINT ERT$(ERR) RESUME Main END IF RESUME DoneFile IF ERL=30 ! Some error during file processing RESUME AbortDisk IF ERL=20 ! Error during PPN Lookup (means: done) RESUME 4010 IF ERL=4000 ! EOF during copy PRINT ERT$(ERR);' at line';ERL;'. ';Inp;':';Inp1;Work RESUME 32767 32767 LSET Null$ = SYS(CHR$(9)) ! Clear memory END