;%%%%%%%%%%%%%%%%%%%%%%%%% Program Identification %%%%%%%%%%%%%%%%%%%%%%%%%% ; .Title Space_By_Dir .Ident \Version 1.0a\ .Sbttl Title Page .Library \SYS$LIBRARY:LIB\ ; This program is designed to read INDEXF.SYS and output statistics on the ; space usage. Space usage is accumulated for each directory and each ; directory tree. ; ; Written by Richard DeJordy, American Mathematical Society, 4-Dec-1990 .Enable Sup $hm2def ; include def module for Home Block Structure $fi2def ; include def module for File Header Ident Area $fh2def ; include def module for File Header Structure $rmsdef ; include def module for RMS $fatdef ; include def module for File Record Attributes ;%%%%%%%%%%%%%%%%%%%%%%%% MACRO and CONSTANT DEFS %%%%%%%%%%%%%%%%%%%%%%%%% ; .Sbttl Macro Definitions ;VMSErr - Macro to check for and signal error conditions .Macro VMSErr ?go blbs r0,go ;if lower bit set, then no error pushl r0 ;save status word calls #1, g^lib$stop ;and halt the program go: .EndM VMSErr ; Define our data structure. For each directory we find in the indexf.sys file ; we keep track of the following: ; ; +----------------------+ ; | fid flink | ; linked by fid and by back link for sorting ; +----------------------+ ; | fid blink | ; +----------------------+ ; | back link flink | ; +----------------------+ ; | back link blink | ; +----------------------+ ; | back link fid | ; fid of directory this directory is in ; +----------------------+ ; | directory fid | ; fid of this directory file ; +----------------------+ ; | num files this dir | ; +----------------------+ ; | # files this dir ... | ; from this point down ; +----------------------+ ; | Size Used in this dir| ; +----------------------+ ; | Siz Alloc this dir | ; +----------------------+ ; | Size used in tree | ; +----------------------+ ; | Alloc in tree | ; +----------------------+----------------+ ; | 40 bytes for directory name string....| ; +---------------------------------------+ ; $EQU FFLINK= 0 $EQU FBLINK= 4 $EQU BFLINK= 8 $EQU BBLINK= 12 $EQU BLFID= 16 $EQU DIRFID= 20 $EQU N1FILS= 24 $EQU N2FILs= 28 $EQU S1USED= 32 $EQU S1ALOC= 36 $EQU S2USED= 40 $EQU S2ALOC= 44 $EQU DIRNAM= 48 $EQU VMSZ= 88 ;%%%%%%%%%%%%%%%%%%%%%%%% READ ONLY DATA %%%%%%%%%%%%%%%%%%%%%%%%%%%%% ; .Sbttl Pure Data .PSect ROData NoExe,Page,Pic,NoWrt ;========================================================================== ; Data for CLD manipulation ; ; DevLbl: .word 6 ; length of 'DEVICE' srting .word 0 ; fill to long word .address DevLbls ; pointer to data DevLbls: .ASCII /DEVICE/ ; name of label for P1 from .CLD file OutLbl: .word 6 ; length of 'OUTPUT' string .word 0 ; fill to longword .address OutLbls ; pointer to data OutLbls: .ASCII /OUTPUT/ ; name of label for /OUTPUT qualifier ;=========================================================================== ; Data for file names and output records ; Outdefx: .ASCII /.SPACE/ ; default extension for output file FaoControl: ; FAO Control string descriptor for detail line .word FaoControlEnd-faoControlStr .word 0 .address FaoControlStr FaoControlStr: ; FAO Control string for detail line .ASCII /!8UL !40AS !8UL allocated, !8UL files. Cum: !8UL files,/ .ASCII | !8UL/!8 blocks used/allocated.| FaoControlEnd: .long 0 FaoLong: ; FAO Control string desc for detail line .word FaoLongEnd-faoLongStr ; with dirname > 40 chars .word 0 .address FaoLongStr FaoLongStr: ; FAO Control string for dirname > 40 chars .ASCII /!8UL !AS !UL allocated, !UL files. Cum: !UL files,/ .ASCII | !UL/!UL blocks used/allocated.| FaoLongEnd: .long 0 FaoHeader: ; Fao header line 1 descriptor .word FaoHdrEnd-FaoHdrStr .word 0 .address FaoHdrStr FaoHdrStr: ; Control string for header line 1 .ASCII /Space report for !AS formatted on !%D/ FaoHdrEnd: .long 0 FaoTotal: ; Fao total line descr .word FaoTotEnd-FaoTotStr .word 0 .address FaoTotStr FaoTotStr: ; Fao total line control string .ASCII /!5UL directories listed/ FaoTotEnd: .long 0 ;%%%%%%%%%%%%%%%%%%%%%%%% READ/WRITE DATA %%%%%%%%%%%%%%%%%%%%%%%%%%%%% ; .Sbttl Impure Data .PSect RWData NoExe,Page,Pic,Wrt ;---------------------------------------------------------------------- ; File RABs and FABs ; ; Input file RMS blocks ; .Align Long ; efficiency HeadFab: $fab fnm=<[000000]INDEXF.SYS>,- ; Filename, rfm=,- ; fixed-length records mrs=<512>,- ; 512 byte records dna=,- ; default device name fac=,- ; write access shr= ; no locking enabled .Align Long HeadRab: $rab fab=HeadFab,- ; address of fab ubf=,- ; address of data buffer usz=<512> ; size of data buffer ; Output file RMS blocks .Align Long ; efficiency OutFab: $fab fna=,- ; Filename, dna=,- ; specify .SPACE as default extension dns=<6>,- ; with a size of 6 characters rfm=,- ; variable-length records mrs=<256>,- ; maximum 256 character records rat=,- ; carriage return carriage control org=,- ; sequential organization fac= ; write access .Align Long OutRab: $rab fab=OutFab,- ; address of fab rbf= ; address of data buffer ;---------------------------------------------------------------------- ; Other read/write volatile data. .Align Page HeadBuff: ; Where the $get puts the data .blkb 512 HdrNum: ; location to hold file number counter .long 0 ResNum: ; holder for number of resevered files .long 0 Devnam: ; Device name descriptor .word 32 ; length .word 0 ; fill long word .address Dvnm ; pointer to data Dvnm: .blkb 32 ; Device name data space Outnam: ; Output filename descriptor .word 72 ; length .word 0 ; fill long word .address Outnm ; pointer to data Outnm: .blkb 72 ; Output filename data space Dirs: ; Number of directory files found .long 0 BaseAd: ; Base Address of vm allocated .long 0 TopFid: ; Pointer to top of linked list sorted by fid .long 0 TopTree: ; Pointer to top of linked list sorted by back link fid .long 0 MidFid: ; Pointer to middle of linked list sorted by fid .long 0 MidTree: ; Pointer to middle of linked list sorted by back link .long 0 Balance: ; determine if the tree is balanced .long 0 SameFid: ; logical boolean in linking entries .long 0 Extras: ; variable to count down the number extra blocks to .long -3 ; the beginning of the file headers in the Index file Missing: .long 0 ; Address of data for files with bad back links OutDir: ; Descriptor for directory name string .word 256 .word 0 .address DirStr DirStr: .ascii '[' ; starts with a [ .blkb 255 FaoOutline: ; Descriptor for output line created by FAO .word 256 .word 0 .address FaoOutLn FaoOutLn: .blkb 256 Fao1: .long 0 ; holders for fao parameter values. Fao2: .long 0 Fao3: .long 0 Fao4: .long 0 Fao5: .long 0 Fao6: .long 0 Fao7: .long 0 ;%%%%%%%%%%%%%%%%%%%%%%%% PROGRAM CODE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ; .Sbttl Code .PSect SortDirData Exe,Page,Pic,NoWrt .Entry SortDir,^M<> pushaq DevLbl ; push descriptor address of 'DEVICE' calls #1,g^cli$present ; check if it's there VMSerr ; if not, signal an error and exit pushaw Devnam ; push word address to receive length pushaq Devnam ; push descriptor address to get string pushaq DevLbl ; push descriptor address of 'DEVICE' calls #3,g^cli$get_value ; and get the value for this entity VMSerr ; if not, signal error and exit moval HeadFab,R0 ; move address of head fab to r0 cvtwb Devnam,FAB$B_DNS(R0) ; and update the size field on the fab $open fab=HeadFab ; Open the Index file VMSerr ; and check for errors $connect rab=HeadRab ; Connect to it VMSerr ; and check for errors pushaq OutLbl ; push descriptor address of 'OUTPUT' calls #1,g^cli$present ; check if it's there VMSerr ; if not, signal an error and exit pushaw Outnam ; push word address to receive length pushaq Outnam ; push descriptor address to get string pushaq OutLbl ; push descriptor addess of 'OUTPUT' calls #3,g^cli$get_value ; and get the value for this entity VMSerr ; if not, signal error and exit moval OutFab,R0 ; move address of output fab to r0 cvtwb Outnam,FAB$B_FNS(R0) ; and update the size field on the fab ; Read in the boot block and ignore it, except errors. $get rab=HeadRab ; get the first block VMSerr ; and check for errors ; Read in the home block and check for errors $get rab=HeadRab ; get the second (HOME) block VMSerr ; and check for errors ; We think we have a home block now, let's check it out - perform home block ; validity checks. jsb ValidateHB ; Use Subroutine to Validate Home Block ; Subroutine will exit if there is ; an error. ; When we fall through here, we should be on the first valid file header ; which is always for INDEXF.SYS (First valid direcrtory file should be ; 000000.DIR) 10$: $get rab=HeadRab ; get the file header blbs R0,20$ ; if sucessfull, jump cmpl R0,#RMS$_EOF ; is it end of file beql toosoon ; if so, it's too soon VMSerr ; if it's a different error, signal it 20$: incl HdrNum ; Increment the header number moval HeadRab,R0 ; move the address of the RAB to R0 movl RAB$L_RBF(R0),R0 ; output buffer address to R0 bbc #FH2$V_DIRECTORY,FH2$L_FILECHAR(R0),10$ ; If it's not a dir file, get next ; Only get here on the first directory file, should be 4,4 cmpl #4,HdrNum ; Is the first directory file 4? bneq NotFourth ; Signal Error jsb ValidateHDR ; Use subroutine to verify if the ; header is a good and should be used. blbc R0,NotFourth ; if the validity fails, it's still bad brb GotFirst ; Error processing for initial errors TooSoon: pushl #SRTDIR_EOFB4HDRS ; push premature end of file message calls #1,g^lib$stop ; and signal error and exit NotFourth: pushl #SRTDIR_BAD1STDIR ; push bad first dir message calls #1,g^lib$stop ; and signal error and exit ; Okay, we have a good directory file in file header number 4 GotFirst: incl Dirs ; increment # of dirs pushal BaseAd ; Go get area for entry of 000000.DIR pushal #VMSZ ; of 88 bytes calls #2,g^lib$get_vm ; using lib$get_vm VMSerr ; and process errors movl BaseAd,R11 ; move address to pointer movl R11,TopFid ; fill in pointer to top of fid queue movl R11,TopTree ; fill in pointer to top of back queue movl R11,MidTree ; fill in pointer to mid of back queue jsb FillEntry ; fill in directory entry ar R11 ; Here is the main section of code that reads through the index file and ; creates the two doubly linked list of all directory files GetHdr: $get rab=HeadRab ; get the file header incl HdrNum ; and increment counter blbs R0,GotHdr ; if sucessfull, jump cmpl R0,#RMS$_EOF ; if not, is it EOF? bneq 10$ ; if not, goto standard error routine cmpl HdrNum,ResNum ; compare it to number of res'd files bgeq EndLoop ; if current >= reserved, it's the end brw TooSoon ; otherwise, it was too soon 10$: VMSerr ; signal other errors GotHdr: moval HeadRab,R0 ; move the address of the RAB to R0 movl RAB$L_RBF(R0),R0 ; output buffer address to R0 bbc #FH2$V_DIRECTORY,FH2$L_FILECHAR(R0),GetHdr jsb ValidateHDR ; Use subroutine to verify if the ; header should be processed. blbc R0,GetHdr ; if the validate says no, get next one Valid: movl R11,R10 ; Save the old location incl Dirs ; Count the number of directories pushal BaseAd ; push the address to receive the base pushal #VMSZ ; push address of # of bytes to get calls #2,g^lib$get_vm ; and get free memory VMSerr ; check for errors movl BaseAd,R11 movl R10,fblink(R11) ; pointer to previous entry movl R11,fflink(R10) ; pointer to this entry jsb FillEntry ; go fill in the data jsb LinkEntry ; insert it into the back link queue brw GetHdr ; go back and get the next header ; This is the end of the first pass through the header file, we now know about ; all the directory files in the index file. EndLoop: $close fab=HeadFab ; close the Index File movl Dirs,R0 ; move the number of dirs into R0 ashl #-1,R0,R0 ; divide by 2 movl TopFid,R10 ; start at top of fid linked list 10$: movl fflink(r10),R10 ; and find the middle entry sobgtr R0,10$ ; until we've done half of them movl r10,MidFid ; save the value into MidFid ; FIDs are stored sequentially in the Index file, so we built the linked ; list by adding to the end constantly. To find the middle, we just ; use the number of entries to determine half way through. ;*** SECOND PASS *** ; Okay, this is the second time through the file and we want to keep track ; of several things, like sizes in directories and numbers of files in ; directories. $open fab=HeadFab ; Open the Index file VMSerr ; and check for errors $connect rab=HeadRab ; Connect to it VMSerr ; and check for errors ; Read in the boot block and ignore it, except errors. $get rab=HeadRab ; get the first block VMSerr ; and check for errors ; Read in the home block and check for errors $get rab=HeadRab ; get the second (HOME) block VMSerr ; and check for errors ; We think we have a home block now, let's check it out - perform home block ; validity checks. jsb ValidateHB ; Use Subroutine to Validate Home Block ; Subroutine will exit if there is ; an error. ; When we fall through here, we should be on the first valid file header ; which is always for INDEXF.SYS (First valid direcrtory file should be ; 000000.DIR) ; Second pass through, clear the header number counter clrl HdrNum NextHeader: $get rab=HeadRab ; get the file header blbs R0,20$ ; if successfull, jump cmpl R0,#RMS$_EOF ; is it end of file bneq 10$ ; if so, we're done (it was okay) brw Done1 ; Finished first pass 10$: VMSerr ; if it's a different error, signal it ; We don't have to do some of the error processing we did before because ; it's already been done once. This is not entirely true, but ... 20$: incl HdrNum ; increment the header number jsb ValidateHDR ; check if I should use the header blbc R0,NextHeader ; if not, get the next one ; get address of header buffer into R0 moval HeadRab,R0 ; Move the address of RAB to R0 movl RAB$L_RBF(R0),R0 ; Move the buffer address to R0 ; get backlink file id, move into entry cvtbl FH2$B_BK_FIDNMX(R0),R1 ; Get the file number extension rotl #16,R1,R1 ; move it to high word addw FH2$W_BK_FIDNUM(R0),R1 ; Get the file number ; get size of file used into R2 movl FAT$L_HIBLK+FH2$W_RECATTR(R0),R2 ; get the allocated size to R2 rotl #16,R2,R2 ; switch the words movl FAT$L_EFBLK+FH2$W_RECATTR(R0),R3 ; get the used sized to R3 rotl #16,R3,R3 ; switch the words ; Take care of full files tstw FAT$W_FFBYTE+FH2$W_RECATTR(R0) ; is the last used byte byte 0? bneq FindEntry ; if not, we're okay decl R3 ; if so, the last block is not used ; Find the entry for this fid. FindEntry: ; start in the middle of the tree movl MidFid,R11 FindLoop: ; From above, R1 holds the back link file id of the current file. cmpl R1,dirfid(r11) ; is this the directory the file is in? beql FoundIt ; Yes, we found it blss GoDown ; if it's more, go down brb GoUp ; If it's less, go up. FoundIt: ; we found it. incl N1FILS(R11) ; increment the number of files in here addl R2,S1ALOC(R11) ; add the size allocated to this dir addl R3,S1USED(R11) ; add the size used to this dir brw NextHeader ; and go get the next header GoDown: ; The fid was too high on the dir. movl fblink(r11),R11 ; get the previous entry, fid order beql NotFound ; if it's 0, we didn't find it cmpl R1,dirfid(r11) ; is it the right one? bgtr NotFound ; if it's less, we can't find it brb FindLoop ; otherwise, it's still lower, keep on NotFound: ; Couldn't find it movl Missing,R11 ; reference through a register bneq 10$ ; if it's not zero we already have vm ; Here if this is the first bad backlink we find. pushal Missing ; push the address to receive the base pushal #VMSZ ; push address of # of bytes to get calls #2,g^lib$get_vm ; and get free memory movl Missing,R11 ; reference through a register clrq N1FILS(r11) ; clear these locations clrq S1USED(r11) ; clear these locations clrq S2USED(R11) ; clear these lcoations 10$: incl N2FILS(r11) ; There is another bad back linked file addl R2,S2ALOC(R11) ; Add the space allocated to this entry addl R3,S2USED(R11) ; Add the space used to this entry brw NextHeader ; Go get the next header GoUp: ; The fid was too low on the dir movl fflink(r11),r11 ; get the next entry, fid order beql NotFound ; if it's 0, we didn't find it cmpl R1,dirfid(r11) ; is it the right one? blss NotFound ; if it's more, we can't find it brb FindLoop ; else, it's still higher, keep going ; ** Completed Second Pass ** ; At this point, we have all the information about each individual directory ; ; Now, go put all the data into the summary fields for each back dir. ; Done1: $close fab=HeadFab ; close the Index File movl topfid,r11 ; Start from first Fid movl S1USED(R11),S2USED(R11) ; update s2used movl S1ALOC(R11),S2ALOC(R11) ; update s2aloc movl N1FILS(R11),N2FILS(R11) ; update n2fils Loop1: movl midfid,r10 ; start from middle Fid movl fflink(r11),r11 ; get the next fid beql Done2 ; if at end, go to output addl S1USED(R11),S2USED(R11) ; update s2used for self addl S1ALOC(R11),S2ALOC(R11) ; update s2aloc for self addl N1FILS(R11),N2FILS(R11) ; update n2fils for self movl blfid(r11),r0 ; and move my back link fid to r0 Loop2: cmpl r0,dirfid(r10) ; compare it to bl for r10 beql Match ; if same, go to Match Routine blss 10$ ; if less, goto look down routine movl fflink(r10),r10 ; if more, go up to next file beql NotFnd ; if that's last, we didn't find it cmpl r0,dirfid(r10) ; compare it again beql Match ; if it's the same, got to match bgtr Loop2 ; it's greater, keep trying brb NotFnd ; else, we don't have a back link. 10$: movl fblink(r10),r10 ; if it's less, go down one file beql NotFnd ; if at start, we didn't find it cmpl r0,dirfid(r10) ; compare the fid to this one beql Match ; mathc, gothere blss Loop2 ; if less, keep going down brb NotFnd ; otherwise, we can't find it NotFnd: ; missing back list movl missing,r10 ; move the address of the missing area ; and fall through to match Match: addl N1FILS(R11),N2FILS(R10) ; add to the backlink cumms addl S1USED(R11),S2USED(R10) addl S1ALOC(R11),S2ALOC(R10) cmpl TopFid,R10 ; is the backlink the mfd dir (000000) beql Loop1 ; yes, , process next file movl blfid(R10),R0 ; else, move the backlink if this to r0 beql Loop1 ; if it's 0 (missing), get next file movl midfid,r10 ; move middle FID to r10 brb Loop2 ; and restart ; ** Okay, we've updated all the back link dirs ** ; Start outputting the data. Done2: $create fab=OutFab ; Create the Output file VMSerr ; and check for errors $connect rab=OutRab ; Connect to it VMSerr ; and check for errors $fao_s ctrstr=FaoHeader, outlen=FaoOutLine, outbuf=FaoOutLine - p1=#devnam, p2=#0 ; Create the header record VMSerr ; check for errors moval OutRab,R3 ; Adjust the record output size movw FaoOutLine,RAB$W_RSZ(R3) $put rab=OutRab ; and output the record VMSerr ; check for errors movw #0,RAB$W_RSZ(R3) ; make a zero byte record $put rab=OutRab ; output it VMSerr ; check for errors movw #256,FaoOutLine ; maximum output line length $fao_s ctrstr=FaoTotal, outlen=FaoOutLine, outbuf=FaoOutLine - p1=Dirs ; make the total line VMSerr ; check for errors moval OutRab,R3 ; adjust the record output size movw FaoOutLine,RAB$W_RSZ(R3) $put rab=OutRab ; output the record VMSerr ; check for errors movw #0,RAB$W_RSZ(R3) ; make another zero bytee record $put rab=OutRab ; output it VMSerr ; check for errors movl TopFid,r8 ; starting from the top of the tree movl r8,r10 ; in r8 and r10 OutLoop1: jsb BuildDir ; build this directories name movl s2aloc(r8),Fao7 ; put the data into the locations movl s2used(r8),Fao6 movl n2fils(r8),Fao5 movl n1fils(r8),Fao4 movl s1aloc(r8),Fao3 moval OutDir,Fao2 movl s1used(r8),Fao1 movw #256,FaoOutLine ; maximum output record size $fao_s ctrstr=FaoControl, outlen=FaoOutLine, outbuf=FaoOutLine, - p1=Fao1, p2=Fao2, p3=Fao3, p4=Fao4, p5=Fao5, p6=Fao6, p7=Fao7 ; call $FAO to create a formated line VMSerr moval OutRab,R3 ; move location of out rab to R3 movw FaoOutLine,RAB$W_RSZ(R3) ; move the length from $fao to buf size $put rab=OutRab ; and output it to a file VMSerr ; check for errors jsb GetSubOfThis ; now get the subs of this (all dirs) tstl missing ; were there missing back links? beql Finished ; no, we're done movl missing,R8 ; get address pushl S2ALOC(R8) ; push data values on the stack pushl S2USED(R8) pushl N2FILS(R8) pushl #3 pushl #SRTDIR_MISSING ; show an error status pushl #0 pushl #SRTDIR_REPAIR ; and signal an error condition calls #7,g^lib$signal ; fatal status will force it to stop Finished: $exit_s code=#srtdir_success ; exit cleanly. ;********************************************************************** ; Subroutines ;********************************************************************** ;---------------------------------------------------------------------- ValidateHB: moval HeadRab,R0 ; move the address of the RAB to R0 movl RAB$L_RBF(R0),R0 ; output buffer address to R0 movl #SRTDIR_BADODSVER,R7 ; assume a bad version error cvtwl HM2$W_STRUCLEV(R0),R1 ; get the level and version info tstb R1 ; test the version bleq invalhb ; <=0 is invalid movl #SRTDIR_BADSTRLVL,R7 ; assume a bad structure level ashl #-8,R1,R1 ; move structure level into lower byte cmpb #2,R1 ; compare it to #2 bneq invalhb ; if it's not equal, it's bad movl #SRTDIR_BADHOMVBN,R7 ; assume a bad home block VBN tstw HM2$W_HOMEVBN(R0) ; compare it to zero beql invalhb ; if it's equal, it's bad movl #SRTDIR_BADIBMLBN,R7 ; assume a bad index bitmap LBN tstl HM2$L_IBMAPLBN(R0) ; compare it to zero beql invalhb ; if it's equal, it's bad movl #SRTDIR_TOOFEWFIL,R7 ; assume max files < reserved files cvtwl HM2$W_RESFILES(R0),R1 ; get number of reserved files cmpl HM2$L_MAXFILES(R0),R1 ; compare with max files bgtr moretests ; if max is greater, it's okay ; else fall through with error invalhb: ; this routine is here so that it can be reached with a ; byte branch instruction (bleq, etc) by all error checking code pushl #SRTDIR_BADHOMBLK ; signal bad home block error pushl #0 ; no arguments for R7 pushl R7 ; signal error type calls #3,g^lib$stop ; call lib$stop to exit program moretests: ; continue with other Home Block validity checks movl #SRTDIR_BADIBMSIZ,R7 ; assume bad index bit map size tstw HM2$W_IBMAPSIZE(R0) ; compare it to zero beql invalhb ; if it's equal, it's bad movl #SRTDIR_TOOFEWRES,R7 ; assume less than 5 reserved files cmpl #5,R1 ; check (R1 loaded in a previous test) bgtr invalhb ; if it's less than 5, it's bad movw R1,ResNum ; save number of reserved files movl #SRTDIR_HMBCHKSM2,R7 ; assume a bad second checksum moval HM2$W_CHECKSUM1(R0),R3 ; find address of first checksum clrw R6 ; clear R6 movl R0,R2 ; move location of word 0 of hdr to R2 movl #255,R1 ; setup counter for second checksum 10$: addw (R2)+,R6 ; add the word at R2 to R6 cmpl R3,R2 ; are we at the first checksum? bneq 20$ ; no, continue at 20$ cmpw R6,HM2$W_CHECKSUM1(R0) ; else compare them beql 20$ ; if they're equal, continue at 20$ movl #SRTDIR_HMBCHKSM1,R7 ; else, error is bad first checksum brb invalhb ; go signal it 20$: sobgtr R1,10$ ; go through 255 words cmpw R6,HM2$W_CHECKSUM2(R0) ; when done, check the second checksum bneq invalhb ; if not equal, it's bad. ; fall thorugh if the homeblock is good clrl R1 ; clear R1 movw HM2$W_IBMAPVBN(R0),R1 ; move the bit map start vbn to R1 addw HM2$W_IBMAPSIZE(R0),R1 ; and add the size to get start of hdrs addl3 #-3,R1,extras ; add this to -3 to compensate for ; the two blocks we've already read ; use memory instead of registers cause ; RMS plays with the registers Loop: $get rab=HeadRab ; get the next block VMSerr ; and check for errors sobgtr extras,Loop ; and loop if not yet done rsb ; Return to main program ;---------------------------------------------------------------------- ValidateHDR: moval HeadRab,R0 ; move the address of the RAB to R0 movl RAB$L_RBF(R0),R0 ; move the address of buffer to R0 tstw FH2$W_FID_NUM(R0) ; check if file Num is 0 bneq Active ; if it isn't, the header is "active" tstb FH2$B_FID_NMX(R0) ; check if the Ext to the Num is 0 bneq Active ; if it isn't, the header is "active" tstb FH2$B_FID_RVN(R0) ; check if the RVN is 0 bneq Active ; if it isn't, the header is "active" clrl R0 ; signal header not in use rsb ; go back Active: ; If it's an extension header, skip it. tstw FH2$W_SEG_NUM(R0) ; Check if it's first header for file beql 01$ ; and continue if it is clrl R0 ; signal header not to be used rsb ; go back 01$: ; not an extension header, check validity cmpw FH2$W_FID_NUM(R0),HdrNum; compare the header number to current beql 05$ ; it's okay, continue pushl HdrNum ; push header number pushl #1 ; tell lib$signal there's one argument pushl #SRTDIR_HDRSKIP ; push hdr skipped message code pushl HdrNum ; push header number pushl #1 ; tell lib$signal there's one argument pushl #SRTDIR_BADHDRNUM ; push bad hdr number message code calls #6,g^lib$signal ; call lib$signal clrl R0 ; signal not to use header rsb ; go back 05$: ; okay, file num is okay, now try the checksum clrw R7 ; clear R7 movl R0,R2 ; move location of word 0 of hdr to R2 movl #255,R1 ; initialize counter 10$: addw (R2)+,R7 ; add the word at R2 to R7 sobgtr R1,10$ ; for the first 255 bytes of the header cmpw R7,FH2$W_CHECKSUM(R0) ; when done, check the checksum bneq 20$ ; if not equal, it's an invalid header movl #1,R0 ; signal header is good rsb ; go back ; If the checksum does not match, signal a warning and ignore the header 20$: pushl HdrNum ; push the header number pushl #1 ; tell lib$signal we have 1 argument pushl #SRTDIR_HDRSKIP ; push skip message pushl HdrNum ; push the header number pushl #1 ; tell lib$signal we have 1 argument pushl #SRTDIR_HDRCHCKSM ; push header checksum message calls #6,g^lib$signal ; call lib$signal clrl R0 ; signal not to use header rsb ; go back ;---------------------------------------------------------------------- FillEntry: ; get address of header buffer into R0 moval HeadRab,R0 ; Move the address of RAB to R0 movl RAB$L_RBF(R0),R0 ; Move the buffer address to R0 ; get file id, move into entry cvtbl FH2$B_FID_NMX(R0),R1 ; Get the file number extension rotl #16,R1,R1 ; move it to high word addw FH2$W_FID_NUM(R0),R1 ; Get the file number movl R1,DIRFID(R11) ; move it to the new entry ; get back link fid, move it into entry cvtbl FH2$B_BK_FIDNMX(R0),R1 ; get the back link num extention rotl #16,R1,R1 ; move it to high word addw FH2$W_BK_FIDNUM(R0),R1 ; get the back link file number movl R1,BLFID(R11) ; move it to the new entrry ; clear the number of files order 1 and 2 clrq N1FILS(R11) ; clear the space used and allocated clrq S1USED(R11) clrq S2USED(R11) ; get the first 40 characters of the filename into the entry moval DIRNAM(R11),R3 ; get the destination address into R3 cvtbl FH2$B_IDOFFSET(R0),R1 ; move the byte offset to R1 addl R1,R0 ; add it to R0 addl R1,R0 ; and again because it's in 16bit words moval FI2$T_FILENAME(R0),R1 ; R1 now points at beginning of name movc3 #FI2$S_FILENAME,(R1),(R3) ; FI2$S_FILENAME characters moved ; R3 points at next free byte in entry moval HeadRab,R0 ; Move the address of RAB to R0 movl RAB$L_RBF(R0),R0 ; Move the buffer address to R0 cvtbl FH2$B_IDOFFSET(R0),R1 ; move the byte offset to R1 addl R1,R0 ; add it to R0 addl R1,R0 ; and again because it's in 16bit words moval FI2$T_FILENAMEXT(R0),R1 ; R1 now points at name extension movc3 #40-FI2$S_FILENAME,(R1),(R3) ; Moved remainder of 40 bytes moval DIRNAM(R11),R1 ; R1 points at name in entry locc #46,#40,(R1) ; Look for a . in the name tstl R0 ; Did we find it? beql 10$ ; No, signal an error clrb (R1) ; Clear the byte (For sorting) rsb ; just return 10$: pushl #SRTDIR_BADDIRNAM ; if a period is not in 40 characters calls #1,g^lib$stop ; it's illegal ;---------------------------------------------------------------------- LinkEntry: clrl SameFid ; clear the boolean Movl MidTree,R8 ; start at the middle of the tree cmpl blfid(R11),blfid(r8) ; is this the back link? beql ProcSame ; yes, go find alphabetic within dir blss ProcLess ; if less, go there brw ProcMore ; if more, go there ProcSame: ; same backlink, suborder alphabetically moval dirnam(r11),r1 ; point to found dirname moval dirnam(r8),r3 ; point to current dirname cmpc3 #40,(r1),(r3) ; compare them blss ProcLess ; go process less brw ProcMore ; go process more ProcLess: decl balance ; adding to left, decrement balance ProcLess1: 10$: tstl bblink(r8) ; test the backlink beql 20$ ; if equal, we're the beginning movl R8,R9 ; save current one movl #-1,SameFid ; set flag to negative movl bblink(r8),r8 ; move backlink into r cmpl blfid(r11),blfid(r8) ; same backlink? beql ProcEqual ; yes, process equal blss 10$ ; if it's less, go back more brw InsLeft ; Insert a left branch 20$: movl #0,bblink(r11) ; at the beginning, new blink is 0 movl R11,toptree ; the top is now here movl r11,bblink(R8) ; the previous top's blink is this one movl r8,bflink(r11) ; and the previous entry is the flink brw comend ; goto common end ProcEqual: moval dirnam(r11),r1 ; equal backlink, find dirname moval dirnam(r8),r3 ; equal backlink, find other dirname cmpc3 #40,(r1),(r3) ; compae the names blss Less ; if less, goto Less tstl SameFid ; else, check the caller bgtr ProcMore1 ; if positive, proc more brw InsLeft ; if not, insert it as left Less: tstl SameFid ; was less, check caller blss ProcLess1 ; if negative, reprocess brw InsRight ; otherwise, insert right ProcMore: incl balance ; adding to right, increment balance ProcMore1: 10$: tstl bflink(r8) ; if the next one the last beql 20$ ; yes, add to end movl R8,R9 ; else, svae this movl #1,SameFid ; set status of SameFid movl bflink(r8),R8 ; move next into r8 cmpl blfid(R11),blfid(R8) ; compare beql ProcEqual ; if equal, process bgtr 10$ ; if greater, keep going brw InsRight ; otherwise, insert on right 20$: movl #0,bflink(r11) ; insert at end, this flink is 0 movl r11,bflink(r8) ; this is flink of old last movl r8,bblink(r11) ; old last is it's blink brw comend ; goto common end InsRight: ; tricky to keep size down, might not be worth it, but... movl R8,R1 ; swap r8 and r9 movl R9,R8 movl R1,R9 ; fall through InsLeft: ; Here, R11 points to new entry ; R9 points to entry which is greater than current ; R8 points to entry which is less than current ; Insert new entry between R8 and R9 movl R8,bblink(R11) ; set current blink to r8 movl r9,bflink(r11) ; set current flink to r9 movl r11,bflink(r8) ; move this to flink of r8 movl r11,bblink(r9) ; move this to blink of r8 ; fall through ComEnd: blbc Dirs,10$ ; if this is an even number, skip tstl balance ; every other time, check the b beql 10$ ; if zero, we're in balance blss 20$ ; if negative, we've added lefts ; added two rights movl MidTree,R8 ; get the current middle movl bflink(r8),MidTree ; bring forward one clrl balance ; clear balance 10$: rsb ; return ; added two lefts 20$: movl MidTree,R8 ; get the current middle movl bblink(r8),MidTree ; bring back one clrl balance ; and clear balance rsb ; return ;---------------------------------------------------------------------- BuildDir: ; of dir pointed to by R8 moval DirStr,r3 ; move address to r3 incl r3 ; increment past [ jsb BuildDirName ; call the real routine movb #^A/]/,-(r3) ; change the last . to a ] moval DirStr,r2 ; get beginning of string to r2 subl3 r2,r3,OutDir ; calc lenght into that word incw OutDir ; and increment by one rsb ; return ;---------------------------------------------------------------------- BuildDirName: ; of dir pointer to by R8 pushl r8 ; push for retrieval pushl #0 ; push signal that we're done GotDir: cmpl #4,blfid(R8) ; is this at top? beql GotTop ; yes, we're done pushl r8 ; otherwise, pushit movl blfid(r8),r11 ; get it's back link movl midfid,r8 ; start in middle cmpl dirfid(r8),r11 ; compare beql GotDir ; if equal, process blss DoLess ; if this fid is less ; This fid is more DoMore: movl fblink(r8),r8 ; move the previous on into r8 cmpl dirfid(r8),r11 ; is this the one? beql GotDir ; yes, go process it brb DoMore ; else, keep trying ; This fid is less DoLess: movl fflink(r8),r8 ; move the next one into r8 cmpl dirfid(r8),r11 ; is this the one? beql GotDir ; yes go process it brb DoLess ; Else, keep trying GotTop: ; at the top, print out each dirname and a period ; pull the next dir off stack and process til the end moval dirnam(r8),r7 ; get this dir's name address locc #0,#40,(r7) ; find the end subl3 r7,r1,r2 ; get the length movc3 r2,(r7),(r3) ; move those characters to outDir movb #46,(r3)+ ; put a period (ASCII 46) movl (sp)+,r8 ; get the previous directory bneq GotTop ; if it's a real dir, goto GotTop movl (sp)+,r8 ; otherwise, pull off stored R* rsb ; and return ;---------------------------------------------------------------------- GetSubOfThis: movl r8,r9 ; save r8 into r9 jsb FindSubToThis ; find a Sub to this one tstl r8 ; was there one? (R8 points to it) bneq CurDir ; yes, go process it brw LeaveHere ; otherwise, leavehere CurDir: jsb BuildDir ; okay, Build this dir movl s2aloc(r8),Fao7 ; move counters movl s2used(r8),Fao6 movl n2fils(r8),Fao5 movl n1fils(r8),Fao4 movl s1aloc(r8),Fao3 moval OutDir,Fao2 movl s1used(r8),Fao1 moval FaoControl,R1 movw #256,FaoOutLine ; maximum output record length cmpw #40,OutDir ; is the dirname longer than 40 bgtr 01$ ; no, okay moval FaoLong,R1 ; yes, use the alternate line format 01$: $fao_s ctrstr=(R1), outlen=FaoOutLine, outbuf=FaoOutLine, - p1=Fao1, p2=Fao2, p3=Fao3, p4=Fao4, p5=Fao5, p6=Fao6, p7=Fao7 ; call $FAO to create a formated line VMSerr moval OutRab,R3 ; move location of out rab to R3 movw FaoOutLine,RAB$W_RSZ(R3) ; move the length from $fao to buf size $put rab=OutRab ; and output it to a file VMSerr ; check for errors movl r8,r10 ; okay, save this dir to r10 jsb FindSubToThis ; are there subs to this? tstl r8 ; was there one (pointed to by r8) beql NoMoreSubs ; if no more, goto NoMoreSubs pushl r10 ; otherwise, push this sub movl r10,r8 ; move it to r8 jsb GetSubOfThis ; call self recursively movl (sp)+,r10 ; upon return, pull off dir NoMoreSubs: movl bflink(r10),r8 ; get next file in list beql LeaveHere ; if it was the last one, exit cmpl r8,topfid ; pointing at [000000]? bneq 10$ ; if not, it's fine movl bflink(r8),r8 ; if it is, skip it, we did it first. 10$: cmpl blfid(r8),blfid(r10) ; is the back link the same? bneq LeaveHere ; no, leave brw CurDir ; otherwise, process this one LeaveHere: rsb ; we're done ;---------------------------------------------------------------------- FindSubToThis: movl dirfid(r8),r0 ; this fid it in r0 movl midtree,r8 ; start in middle cmpl blfid(r8),r0 ; compare the fids beql GetFirst ; if fids are same, get first match bgtr 10$ ; if greater, process backwards ; else, fall through & process forward 01$: movl bflink(r8),r8 ; get next file by back link order beql 99$ ; if it's the last one, there are none cmpl blfid(r8),r0 ; else, compare blss 01$ ; if still less, keep trying bgtr 98$ ; if greater, jump to signal none rsb ; if equal, return it 10$: movl bblink(r8),r8 ; process backward back link order beql 99$ ; if last, there is none cmpl blfid(r8),r0 ; compare to new blfid bgtr 10$ ; if still greater, keep trying beql GetFirst ; if equal, get first match 98$: movl #0,r8 ; else, signal none 99$: rsb ; and return GetFirst: movl bblink(r8),r8 ; get the previous entry beql 20$ ; if it's the first entry, handle cmpl blfid(r8),r0 ; otherwise, is it still the same beql GetFirst ; yes, keep trying 10$: movl bflink(r8),r8 ; no, get the next one again rsb ; return 20$: movl toptree,r8 ; move the beginning to r8 cmpl topfid,r8 ; is this 000000.dir? bneq 30$ ; no, we're done movl bflink(r8),r8 ; and get the next file 30$: rsb ; return ;********************************************************************** ; End Subroutines ;********************************************************************** .End SortDir