%ì VAX-11 Librarian V03-00ÕÀ$Œà+#Â$Œ’z“  ¼ BUFFER.BLIŽ CACHE.BLI & CHECKSUM.MARÎ FILENAME.BLI¶ INDEX.BLIE® OUTPUT.BLI[ò OWNER.BLIoJ OWNER.REQsX OWNERERR.MSGsÖ PROCESS.BLI~ÜSORT.BLI­ÀNÜd· Œ%MODULE buffer ( IDENT = 'V03-0000') = BEGIN LIBRARY 'sys$library:lib'; REQUIRE 'owner.req'; EXTERNAL free_buffer_mask: BITVECTOR [32], qioblock_base_address: LONG; EXTERNAL ROUTINE: lib$get_vm: ADDRESSING_MODE (GENERAL);, GLOBAL ROUTINE initialize_qioblock_array = BEGIN OWN buffer_number: LONG, status: LONG;C IF (status = lib$get_vm (%REF (qioblock$c_length*buffer_count),9 qioblock_base_address)) THEN BEGIN BIND0 qioblock_array = .qioblock_base_address:K BLOCKVECTOR [buffer_count,qioblock$c_length,BYTE];6 INCR buffer_number FROM 0 TO buffer_count - 1 DO BEGINO qioblock_array [.buffer_number,qioblock$b_event_flag] = .buffer_number;& $setef (efn = .buffer_number); END; END; RETURN .status; END;@ GLOBAL ROUTINE allocate_buffer (buffer_address_ptr): NOVALUE = BEGIN BIND. buffer_address = .buffer_address_ptr: LONG,1 qioblock_array = .qioblock_base_address:L BLOCKVECTOR [buffer_count,qioblock$c_length,BYTE]; BUILTIN FFC; OWN buffer_number: LONG;!A! Loop until a free buffer is found. Actually loop is traversed@! once at most since waiting for an event flag guarantees that%! a buffer will be found next pass.! WHILE FFC (%REF (0),# %REF (buffer_count), free_buffer_mask, buffer_number) DO $wflor ( efn = 0,* mask = free_buffer_mask);!>! Return address of buffer just found, mark buffer as in use$! and clear associated event flag.!= buffer_address = qioblock_array [.buffer_number,0,0,0,0];* free_buffer_mask [.buffer_number] = 1;& $clref ( efn = .buffer_number); END;7 GLOBAL ROUTINE release_buffer (buffer_ptr): NOVALUE = BEGIN BIND& buffer = .buffer_ptr:( BLOCK [,BYTE]; OWN event_flag: BYTE;1 event_flag = .buffer [qioblock$b_event_flag];' free_buffer_mask [.event_flag] = 0;# $setef ( efn = .event_flag); END; ENDELUDOMww­` ¯· Œ#MODULE cache (IDENT = 'V03-0000') = BEGIN LIBRARY 'sys$library:lib'; REQUIRE 'o wner.req'; EXTERNAL cache_header_count: LONG, max_cache: LONG, cache_buffer_ptr: LONG, reference_count_ptr: LONG;= GLOBAL ROUTINE cached (file_number_ptr,cache_address_ptr) = BEGIN BIND3 file_number = .file_number_ptr:' WORD,5 cache_address = .cache_address_ptr:' LONG; BIND4 header_cache =  .cache_buffer_ptr:; BLOCKVECTOR [,512,BYTE],7 reference_count = .reference_count_ptr:2 VECTOR [,WORD]; OWN status;!! Assume failure.! status = false;!%! Update the cache reference count.!9 INCR cache_index FROM 0 TO .cache_header_count - 1 DOK reference_count [.cache_index] = .reference_count [.cache_index] + 1;!G! Now search the cache for the file wh ose id is given by the backlink! in the current header.!9 INCR cache_index FROM 0 TO .cache_header_count - 1 DOI IF .file_number EQL .header_cache [.cache_index,fh2$w_fid_num] THEN BEGIN+ reference_count [.cache_index] = 0; status = true;< cache_address = header_cache [.cache_index,0,0,0,0]; EXITLOOP; END; RETURN .status; END;: GLOBAL ROUTINE update_cache (last_header_ptr): NOVALUE = BEGIN BIND;  last_header = .last_header_ptr:8 BLOCK [,BYTE]; BIND4 header_cache = .cache_buffer_ptr:; BLOCKVECTOR [,512,BYTE],7 reference_count = .reference_count_ptr:2 VECTOR [,WORD];!E! See if there are any empty cache buffers. If there are, then just'! add current header to end of cache.!. IF .cache_header_count LSS .max_cache THEN BEGIN CH$MOVE (512,$ CH$PTR (last_header),D CH$PTR (header_cache [.cache_header_count,0,0,0,0]));3 cache_header_count = .cache_header_count + 1; END ELSE BEGIN OWN index, largest; index = 0;% largest = .reference_count [0];2 INCR cache_index FROM 1 TO .max_cache - 1 DO< IF .reference_count [.cache_index] GTR .largest THEN BEGIN index = .cache_index;4 largest = .reference_count [.cache_index]; END; CH$MOVE (512,$ CH$PTR (last_header),7 CH$PTR (header_cache [.index,0,0,0,0]));# reference_count [.index] = 0; END; END; ENDELUDOMww­Tâ· Œ .title checksum! .ident /03-0000/* .entry checksum,^m@ movl 4(ap),r2 ; header address@ movw  (r2)+,r3 ; initialize sum .rept 14 addw (r2)+,r3 .endr< movzbl #15,r1 ; loop index10$: .rept 16 addw (r2)+,r3 .endr sobgtr r1,10$ clrl r0 cmpw r3,(r2) bneq 20$ incl r0 20$: ret .endww­ÀÖpŽ· Œ(MODULE check_sum ( IDENT = 'V03-0000') = BEGIN LITERAL true = 1, false = 0;0 GLOBAL ROUTINE checksum2 (buffer_ptr,count) = BEGIN BIND. buffer = .buffer_ptr:1 VECTOR [,WORD]; OWN sum: WORD; sum = 0;" INCR j FROM 0 TO .count/2-1 DO sum = .sum + .buffer [.j];' IF .sum EQL .buffer [.count/2] THEN RETURN true ELSE RETURN false; END; ENDELUDOM'MODULE filename ( IDENT = 'V03-0000') = BEGIN LIBRARY 'sys$library:lib'; REQUIRE 'owner.req'; EXTERNAL ROUTINE: release_record: ADDRESSING_MODE (GENERAL);< GLOBAL ROUTINE complete_filename (qioblock_ptr): NOVALUE = BEGIN BIND0 qioblock = .qioblock_ptr:0 BLOCK [,BYTE],= name_descr = qioblock [qioblock$q_name]:1 BLOCK [8,BYTE]; IF CH$EQL (7,6 CH$PTR ( UPLIT BYTE (%ASCII'000000.')), 7,4 CH$PTR (.name_descr [dsc$a_pointer]), %C' ') AND; .qioblock [qioblock$b_state] NEQ initial_segment THEN BEGINA name_descr [dsc$w_length] = .name_descr [dsc$w_length] - 7;C name_descr [dsc$a_pointer] = .name_descr [dsc$a_pointer] + 7; END;? name_descr [dsc$w_length] = .name_descr [dsc$w_length] + 1;A name_descr [dsc$a_pointer] = .name_descr [dsc$a_pointer] - 1; CH$MOVE (1,* CH$PTR ( UPLIT BYTE (%C'[')),3 CH$PTR (.name_descr [dsc$a_pointer])); END;: GLOBAL ROUTINE update_filename (qioblock_ptr): NOVALUE = BEGIN BIND0 qioblock = .qioblock_ptr:0 BLOCK [,BYTE],= name_descr = qioblock [qioblock$q_name]:1 BLOCK [8,BYTE],@ file_header  = .qioblock [qioblock$l_header]:0 BLOCK [,BYTE],P ident_area = file_header + 2*.file_header [fh2$b_idoffset]:? VECTOR [fi2$s_filename,BYTE]; OWN end_of_segment: LONG, length_of_segment: LONG;0 end_of_segment = CH$FIND_CH (fi2$s_filename,5 CH$PTR (ident_area),B .qioblock [qioblock$b_terminal]);1  length_of_segment = CH$DIFF (.end_of_segment,6 CH$PTR (ident_area));/ IF .qioblock [qioblock$b_format] NEQ 0 THEN BEGINA name_descr [dsc$w_length] = .name_descr [dsc$w_length] + 1;C name_descr [dsc$a_pointer] = .name_descr [dsc$a_pointer] - 1; CH$MOVE (1,5 CH$PTR (qioblock [qioblock$b_format]),5 CH$PTR (.name_descr [dsc$a_pointer])); END;< name_descr [dsc$w_length] = .name_descr [dsc$w_length] +3 .length_of_segment;> name_descr [dsc$a_pointer] = .name_descr [dsc$a_pointer] -4 .length_of_segment; CH$MOVE (.length_of_segment,! CH$PTR (ident_area),3 CH$PTR (.name_descr [dsc$a_pointer])); END;/ GLOBAL ROUTINE save_filename (qioblock_ptr) = BEGIN BIND0 qioblock = .qioblock_ptr:0 BLOCK [,BYTE],= name_descr = qioblock [qioblock$q_name]:1 BLOCK [8,BYTE]; OWN status: LONG;7 status = release_record (qioblock [qioblock$l_uic],= qioblock [qioblock$l_blksalloc],< qioblock [qioblock$l_blksused],) name_descr); RETURN .status; END; ENDELUDOMww­`Íà· Œ2MODULE index_file_routines ( IDENT = 'V03-0000') = BEGIN LIBRARY 'sys$library:lib'; REQUIRE 'owner.req'; EXTERNAL bitmap_ptr: LONG, cluster_factor: LONG, current_header_vbn: LONG, disk_acp_channel: LONG, first_header_vbn: LONG, first_vbn_in_buffer: LONG, free_buffer_mask: BITVECTOR [32], header_buffer_ptr: LONG, header_count: LONG, index_bitmap_size: WORD, index_bitmap_vbn: LONG, index_file_iosb: VECTOR [4,WORD], last_header_vbn: LONG, last_vbn_in_buffer: LONG, mfd_header: BLOCK [512,BYTE], uic_flags: BITVECTOR [32], uic_group: WORD, uic_member: WORD, volume_structure_level: BYTE, worst_error: LONG; EXTERNAL LITERAL owner_badlevel, owner_fnmabt, owner_success; EXTERNAL ROUTINE: cached: ADDRESSING_MODE (GENERAL),: checksum: ADDRESSING_MODE (GENERAL),: checksum2: ADDRESSING_MODE (GENERAL),B complete_filename: ADDRESSING_MODE (GENERAL) NOVALUE,: lib$get_vm: ADDRESSING_MODE (GENERAL),B perform: ADDRESSING_MODE (GENERAL) NOVALUE,B release_buffer: ADDRESSING_MODE (GENERAL) NOVALUE,: save_filename: ADDRESSING_MODE (GENERAL),B update_cache: ADDRESSING_MODE (GENERAL) NOVALUE,B update_filename: ADDRESSING_MODE (GENERAL) NOVALUE; OWN atr: BLOCK [12,BYTE], fib: BLOCK [10,BYTE], fib_descr: BLOCK [8,BYTE] INITIAL (10,fib), file_statistics_block:! BLOCK [atr$s_statblk,BYTE];$ GLOBAL ROUTINE access_index_file = BEGIN OWN status: LONG;: fib [fib$l_acctl] = 0; ! read access onlyB fib [fib$w_fid_num] = fid$c_indexf; ! specify id of index fi le' fib [fib$w_fid_seq] = fid$c_indexf;E fib [fib$w_fid_rvn] = 1; ! no multiple volumes allowedF atr [0,0,16,0] = atr$s_statblk; ! access file statistics block# atr [2,0,16,0] = atr$c_statblk;+ atr [4,0,32,0] = file_statistics_block;; atr [8,0,32,0] = 0; ! terminate request. IF (status = $qiow ( efn = buffer_count,< func = io$_access OR io$m_access,4 chan = .disk_acp_channel,2  iosb = index_file_iosb,, p1 = fib_descr,, p5 = atr)) THEN$ status = .index_file_iosb [0]; RETURN .status; END;( ROUTINE ods_level_1 (home_block_ptr) = BEGIN BIND2 home_block = .home_block_ptr:3 BLOCK [512,BYTE];G IF .home_block [hm2$b_struclev] EQL 1 AND ! this is an ods 1 diskB .home_block [hm1$w_cluster] EQL 1 AND  ! cluster size = 1M .home_block [hm1$l_ibmaplbn] NEQ 0 AND ! lbn of bitmap file non zeroR .home_block [hm1$w_maxfiles] NEQ 0 AND ! maximum files on volume non zeroW .home_block [hm1$w_ibmapsize] NEQ 0 AND ! size of index file bitmap is non zero checksum2 (home_block,L $BYTEOFFSET (hm1$w_checksum1)) AND ! and both check sums are ok checksum2 (home_block,0 $BYTEOFFSET (hm1$w_checksum2)) THENK RETURN true  ! assume this is home block ELSE RETURN false; END;& ROUTINE ods_level_2 (home_block_ptr,2 virtual_block_number_ptr) = BEGIN BIND2 home_block = .home_block_ptr:3 BLOCK [512,BYTE],< virtual_block_number = .virtual_block_number_ptr:' BYTE;I IF .home_block [hm2$b_struclev] EQL 2 AND ! this is an ods 2 volumeM . home_block [hm2$w_homevbn] EQL ! vbn of home block points to6 .virtual_block_number AND ! hereM .home_block [hm2$l_altidxlbn] NEQ 0 AND ! lbn of alternate index fileD ! header is non zeroL .home_block [hm2$w_cluster] NEQ 0 AND ! cluster factor is non zeroB .home_block [hm2$w_homevbn] NEQ 0 AND ! vbn start at oneT .home_block [hm2$w_altidxvbn] NEQ 0 AND ! vbn of alternate index file head!erT ! can't be zero since vbn start at 1J .home_block [hm2$w_ibmapvbn] NEQ 0 AND ! vbn of index file bitmapJ .home_block [hm2$l_ibmaplbn] NEQ 0 AND ! lbn of index file bitmapO .home_block [hm2$l_maxfiles] NEQ 0 AND ! volume must permit a non zeroA ! number of filesU .home_block [hm2$w_ibmapsize] NEQ 0 AND ! size of index file bit map (blocks)K " ! must be greater than zeroL .home_block [hm2$w_resfiles] NEQ 0 AND ! there must be at least one? ! reserved fileN checksum2 (home_block, ! both check sums must be good. $BYTEOFFSET (hm1$w_checksum1)) AND checksum2 (home_block,/ $BYTEOFFSET (hm1$w_checksum2)) THENS RETURN true ! this is a ods 2 volume home block ELSE # RETURN false; END;4 GLOBAL ROUTINE read_home_block ( home_block_ptr) =!++! ! FUNCTION:!E! This routine reads the first good home block of the currently1! open index file into the buffer supplied.!! IMPLICIT INPUTS:!(! disk_acp_channel LONGWORD?! channel used to access disk ACP! ! OUTPUTS:!0! home_block BLOCK [512,BYTE]:! results of home block read$!)! read_home_block PROCEDURE:! results of home block read!!-- BEGIN BIND2 home_block = .home_block_ptr:0 BLOCK [,BYTE]; OWN status: LONG;!E! Keep looking at blocks until we get one that reads with no errors ! and looks like a home block.!. INCR virtual_block_number FROM 2 TO 100 DO BEGIN- status = $qiow ( efn = bu %ffer_count,2 chan = .disk_acp_channel,- func = io$_readvblk,0 iosb = index_file_iosb,+ p1 = home_block,$ p2 = 512,7 p3 = .virtual_block_number); IF .status THEN& status = .index_file_iosb [0];. IF (.status AND ods_level_2 (home_block,3 virtual_block_number)) OR4 (.status AND ods_level_1 &(home_block)) THEN EXITLOOP ELSE status = ss$_abort; END; RETURN .status; END;8 ROUTINE inconsistent_area_offsets (header_block_ptr) = BEGIN BIND4 header_block = .header_block_ptr:0 BLOCK [,BYTE];< IF .header_block [fh2$b_idoffset] LSSU fh2$c_length/2 ORL .header_block [fh2$b_mpoffset] LSSU .header_block [fh2$b_idoffset] ORL .header_block [fh2$b_acoffset] LSSU .he'ader_block [fh2$b_mpoffset] ORL .header_block [fh2$b_rsoffset] LSSU .header_block [fh2$b_acoffset] ORL .header_block [fh2$b_map_inuse] GTRU .header_block [fh2$b_acoffset] -N .header_block [fh2$b_mpoffset] THEN RETURN true ELSE RETURN false; END;) ROUTINE invalid_map_area (map_area_ptr,/ header_block_ptr) = BEGIN BIND0 map_area = .map_area_ptr: (0 BLOCK [,BYTE],4 header_block = .header_block_ptr:0 BLOCK [,BYTE];( IF .map_area [fm1$b_ex_rvn] NEQ 0 OR+ .map_area [fm1$b_countsize] NEQ 1 OR) .map_area [fm1$b_lbnsize] NEQ 3 OR$ .map_area [fm1$b_inuse] GTRU $ .map_area [fm1$b_avail] OR# .map_area [fm1$b_avail] GTRUC 255 - (map_area + fm1$c_pointers - header_block) /2 THEN RETURN true ELSE) RETURN false; END;1 GLOBAL ROUTINE verify_header (header_block_ptr,. file_id_ptr) = BEGIN BIND4 header_block = .header_block_ptr:0 BLOCK [,BYTE],/ file_id = .file_id_ptr:0 BLOCK [,BYTE]; !B! Make sure that header structure level matches volume structure ! level.!F IF .header_block [fh2$b_struclev] *NEQ .volume_structure_level THEN RETURN invalid_header;) IF .volume_structure_level EQL 2 THEN> BEGIN ! {* level 2 volume *}!@! Check the area offsets and retrival pointer use counts for! consistency.!6 IF inconsistent_area_offsets (header_block) THEN RETURN invalid_header;!G! At this point we have verified that this block was a valid header! at one time.!0 IF .header_block [fh2$w_fid_num] EQL 0 AND +1 .header_block [fh2$b_fid_nmx] EQL 0 THEN" RETURN deleted_header;) IF NOT checksum (header_block) THEN" RETURN deleted_header;!+! Check the file id and sequence number!B IF .header_block [fh2$w_fid_num] NEQ .file_id [fid$w_num] ORB .header_block [fh2$b_fid_nmx] NEQ .file_id [fid$b_nmx] ORD .header_block [fh2$w_fid_seq] NEQ .file_id [fid$w_seq] THEN" RETURN deleted_header;F END , ! {* level 2 volume *} ELSEF BEGIN ! {* level 1 volume *}) IF invalid_map_area (header_block +0 2*.header_block [fh1$b_mpoffset],! header_block) THEN RETURN invalid_header;!?! This block was a valid header at one time. Check file id.!1 IF .header_block [fh1$w_fid_num] EQL 0 THEN! RETURN deleted_header;) IF NOT checksum (header_block) THEN! RETURN dele-ted_header;B IF .header_block [fh1$w_fid_num] NEQ .file_id [fid$w_num] ORD .header_block [fh1$w_fid_seq] NEQ .file_id [fid$w_seq] THEN! RETURN deleted_header;F END; ! {* level 1 volume *} RETURN valid_header; END;6 GLOBAL ROUTINE process_home_block (home_block_ptr) = BEGIN BIND2 home_block = .home_block_ptr:0 BLOCK [,BYTE]; OWN status.: LONG;: volume_structure_level = .home_block [hm2$b_struclev];) IF .volume_structure_level NEQ 2 THEN status = owner_badlevel ELSE BEGIN3 cluster_factor = .home_block [hm2$w_cluster];8 index_bitmap_size = .home_block [hm2$w_ibmapsize];1 index_bitmap_vbn = 4 * .cluster_factor + 1;F first_header_vbn = 4 * .cluster_factor + .index_bitmap_size + 1;- current_header_vbn = .first_header_vbn; status = owner_success; EN/D; RETURN .status; END;$ GLOBAL ROUTINE read_index_bitmap = BEGIN OWN status: LONG;= IF (status = lib$get_vm (%REF (512 * .index_bitmap_size),. bitmap_ptr)) THEN BEGIN- status = $qiow ( efn = buffer_count,2 chan = .disk_acp_channel,- func = io$_readvblk,0 iosb = index_file_iosb,, p1 = .bitmap_ptr,09 p2 = 512 * .index_bitmap_size,3 p3 = .index_bitmap_vbn); IF .status THEN& status = .index_file_iosb [0]; END; RETURN .status; END;. ROUTINE leftmost_set_bit_of (longword_ptr) = BEGIN BIND0 longword = .longword_ptr:1 BITVECTOR [32];# DECR bit_number FROM 31 TO 0 DO+ IF .longword [.bit_number] EQL 1 THEN RETURN .1bit_number; RETURN 0; END;' GLOBAL ROUTINE find_last_header_vbn = BEGIN BIND. bitmap_array = .bitmap_ptr:1 VECTOR [,LONG]; OWN eof_from_index_header: LONG, index_file_header: BLOCK [512,BYTE], status: LONG; BINDD file_attributes = index_file_header [fh2$w_recattr]:= BLOCK [fh2$s_recattr,BYTE];!2! Read index file header!0 IF ( status = $qiow ( efn = buffer_count,5 chan = .disk_acp_channel,0 func = io$_readvblk,3 iosb = index_file_iosb,5 p1 = index_file_header,' p2 = 512,; p3 = .first_header_vbn)) THEN IF .status THEN& status = .index_file_iosb [0]; IF .status THEN BEGINF 3 eof_from_index_header <16,16> = .file_attributes [fat$w_efblkh];F eof_from_index_header <0,16> = .file_attributes [fat$w_efblkl];D DECR longword_number FROM 128 * .index_bitmap_size - 1 TO 0 DO BEGIN6 IF .bitmap_array [.longword_number] NEQ 0 THEN BEGIN9 last_header_vbn = MAXU (32 * .longword_number +N leftmost_set_bit_of (bitmap_array [.longword_number]) +- .first_header_vbn - 1,/ 4 .eof_from_index_header); EXITLOOP; END; END; status = owner_success; END; RETURN .status; END;: GLOBAL ROUTINE get_next_header ( current_header_vbn_ptr,: header_address_ptr): NOVALUE = BEGIN BIND: current_header_vbn = .current_header_vbn_ptr:' LONG,6 header_address = .header_address_ptr:' LO5NG,5 header_buffer = .header_buffer_ptr:: BLOCKVECTOR [,512,BYTE]; OWN buffer_index: LONG, status: LONG;!! Revision History! ======== =======!'! WVD001 - W. V. DIXON 2/17/834! correct order of ch$fill arguments!7 IF .current_header_vbn GTR .last_vbn_in_buffer THEN? BEGIN ! {* index file read *}4 first_vbn_in_buf 6fer = .last_vbn_in_buffer + 1;7 last_vbn_in_buffer = MINU (.first_vbn_in_buffer +3 .header_count - 1,3 .last_header_vbn);1 IF (status = $qiow ( efn = buffer_count,6 chan = .disk_acp_channel,1 func = io$_readvblk,4 iosb = index_file_iosb,2 p1 = header_buffer,: p2 = (.last 7_vbn_in_buffer -C .first_vbn_in_buffer + 1)*512,? p3 = .first_vbn_in_buffer)) THEN' status = .index_file_iosb [0]; IF NOT .status THENI BEGIN ! {* block read failed *}7 INCR block_number FROM .first_vbn_in_buffer TO 5 .last_vbn_in_buffer DOF BEGIN ! {* read one block *}> buffer_ind 8ex = .block_number - .first_vbn_in_buffer;3 IF (status = $qiow ( efn = buffer_count,8 chan = .disk_acp_channel,3 func = io$_readvblk,6 iosb = index_file_iosb,L p1 = header_buffer [.buffer_index,0,0,0,0],* p2 = 512,: p3 = .block_number)) THEN* status = .index_file_iosb [0]; IF N 9OT .status THEN CH$FILL (0,O 512, !WVD001O CH$PTR (header_buffer [.buffer_index,0,0,0,0])); !WVD001F END; ! {* read one block *}I END; ! {* block read failed *}G END; ! {* index file read *}> buffer_index = .current_header_vbn - .first_vbn_in_buffer;; header_a:ddress = header_buffer [.buffer_index,0,0,0,0]; END;@ ROUTINE in_header_buffer (file_number_ptr,cache_address_ptr) = BEGIN BIND3 file_number = .file_number_ptr:( WORD,5 cache_address = .cache_address_ptr:' LONG,5 header_buffer = .header_buffer_ptr:: BLOCKVECTOR [,512,BYTE]; OWN status, vbn: ; LONG;/ vbn = .file_number + .first_header_vbn - 1; status = false;( IF .vbn GEQ .first_vbn_in_buffer AND( .vbn LEQ .last_vbn_in_buffer THEN BEGINJ cache_address = header_buffer [.vbn - .first_vbn_in_buffer,0,0,0,0]; status = true; END; RETURN .status; END;1 GLOBAL ROUTINE qioast (qioblock_ptr): NOVALUE = BEGIN BIND0 qioblock = .qioblock_ptr:0 BLOCK [,BY<TE],= qioblock_iosb = qioblock [qioblock$q_iosb]:1 VECTOR [,WORD],= name_descr = qioblock [qioblock$q_name]:0 BLOCK [,BYTE]; OWN cache_address, done, issued_qio; DOQ BEGIN ! {* loop until done or do qio *} BIND@ header = .qioblock [qioblock$l_header]:0 = BLOCK [,BYTE],E ident_area = header + 2*.header[fh2$b_idoffset]:1 VECTOR [,BYTE];$ IF NOT .qioblock_iosb [0] THENB BEGIN ! {* qio failed *} SIGNAL (owner_fnmabt, 1, name_descr,# .qioblock_iosb [0], 0);" release_buffer (qioblock); EXITLOOP;B END ! {* qio> failed *} ELSEW BEGIN ! {* qio successful or header cached *}!F! Add file name from this header to accumulated file name string!# update_filename (qioblock);!,! Update file name status information.!@ IF .qioblock [qioblock$b_state] EQL initial_segment THEN BEGIN1 qioblock [qioblock$b_terminal] = %C'.';/ qioblock [qioblock$b_format] = %C']';9 IF .header [fh2$w_bk_fid?num] NEQ fid$c_mfd THEN; qioblock [qioblock$b_state] = filename_segment; ENDF ELSE IF .qioblock [qioblock$b_state EQL filename_segment] THEN BEGIN/ qioblock [qioblock$b_format] = %C'.';: qioblock [qioblock$b_state] = directory_segment; END;!E! If the current header is a directory, and it is not in cache,! add it to cache.!( IF .header [fh2$v_directory] ANDA NOT cached (header [fh2$w_f @id_num],cache_address) THEN! update_cache (header);!>! See if we have reached the end of the back link chain.!/ IF .header [fh2$w_bk_fidnum] EQL 0 THENG BEGIN ! {* backlink is nil *}' complete_filename (qioblock);- perform (save_filename (qioblock));$ release_buffer (qioblock); done = true;G END ! {* backlink is nil *}< ELSE IF .h Aeader [fh2$w_bk_fidnum] EQL fid$c_mfd THENN BEGIN ! {* backlink points to mfd *}4 qioblock [qioblock$l_header] = mfd_header;% update_filename (qioblock);' complete_filename (qioblock);# save_filename (qioblock);$ release_buffer (qioblock); done = true;N END ! {* backlink points to mfd *} ELSEL BEGIN ! {* B still searchin links *} done = false;!F! Begin search for back link header. First look in cache, then@! in header buffer. If all else fails, get it from disk.!A IF cached (header [fh2$w_bk_fidnum],cache_address) THEN@ BEGIN ! {* in cache *} issued_qio = false;: qioblock [qioblock$l_header] = .cache_address;@ END ! {* in cache *}P ELSE C if in_header_buffer (header [fh2$w_bk_fidnum],cache_address) THENH BEGIN ! {* in header_buffer *} issued_qio = false;: qioblock [qioblock$l_header] = .cache_address;H END ! {* in header_buffer *} ELSEA BEGIN ! {* issue qio *} issued_qio = true;> $qio ( efn = .qioblock [qioblock$b_event_flag],. D chan = .disk_acp_channel,) func = io$_readvblk,* iosb = qioblock_iosb,% astprm = qioblock,# astadr = qioast,9 p1 = qioblock [qioblock$t_header], p2 = 512,7 p3 = .header [fh2$w_bk_fidnum] +3 .first_header_vbn - 1);H qioblock [qioblock$l_header] = qioblock [qioblock$t_header];A END; E ! {* issue qio *}G END; ! {* still searching *}W END; ! {* qio successful or header cached *}R END ! {* loop until done or qio issued! UNTIL .done OR .issued_qio; END;" GLOBAL ROUTINE read_mfd_header = BEGIN OWN status: LONG;/ IF (status = $qiow ( efn = buffer_count,4 F chan = .disk_acp_channel,/ func = io$_readvblk,2 iosb = index_file_iosb,- p1 = mfd_header,& p2 = 512,5 p3 = .first_header_vbn +6 fid$c_mfd - 1)) THEN$ status = .index_file_iosb [0]; RETURN .status; END; ENDELUDOMww­ÀÔá· Œ%MODULE output ( IDENT = 'V03-0000') = BEGIN LIBRARGY 'sys$library:lib'; REQUIRE 'owner.req'; LITERAL$ sts_v_terminal = 0,$ sts_v_vt100 = 1,$ sts_v_pause = 2; EXTERNAL current_time: VECTOR [2,LONG], device_name_descr: BLOCK [8,BYTE], index_file_iosb: VECTOR [,WORD]; EXTERNAL ROUTINEB cli$get_value: ADDRESSING_MODE (GENERAL),B cli$present: ADDRESSING_MODE (GENERAL),B ots$cvt_ti_l: H ADDRESSING_MODE (GENERAL),B return_record: ADDRESSING_MODE (GENERAL); OWN reply_buffer: VECTOR [reply_size,BYTE], output_es:! VECTOR [nam$c_maxrss,BYTE], output_rs:! VECTOR [nam$c_maxrss,BYTE], output_nam: $NAM ( ess = nam$c_maxrss, esa = output_es, rss = nam$c_maxrss, rsa = output_rs), output_fab: $FAB ( fac = (put,get), nam = outpuIt_nam, rat = cr), output_rab: $RAB ( fab = output_fab, mbc = 4, mbf = 2, rop = (rah,wbh), ubf = reply_buffer, usz = reply_size); OWN last_uic: LONG, lines_per_page: LONG, lines_written: LONG, output_status: BITVECTOR [32], page_number: LONG;# GLOBAL ROUTINE open_output_file = BEGIN OWN output_file_nameJ: BLOCK [8,BYTE]! INITIAL (%X'020E0000',0), status: LONG;7 IF (status = cli$get_value ($DESCRIPTOR ('OUTPUT'),7 output_file_name)) THEN BEGIN@ output_fab [fab$b_fns] = .output_file_name [dsc$w_length];A output_fab [fab$l_fna] = .output_file_name [dsc$a_pointer];3 IF (status = $create (fab = output_fab)) THEN- status = $connect (rab = output_rab); END; RETURN .status; END;K! GLOBAL ROUTINE output_control = BEGIN OWN ascii_lines_per_page: BLOCK [8,BYTE]! INITIAL (%X'020E0000',0), device_class: LONG, device_type: LONG, class_length: LONG, type_length: LONG, device_info_request: VECTOR [7,LONG] INITIAL ( WORD (4),' WORD (dvi$_devclass), device_class, class_length, L WORD(4),& WORD (dvi$_devtype), device_type, type_length, 0), output_device_descr: BLOCK [8,BYTE]8 INITIAL (%X'010E0000',output_nam [nam$t_dvi]+1), status; CH$MOVE (1,- CH$PTR (output_nam [nam$t_dvi]),: CH$PTR (output_device_descr [dsc$w_length]));0 IF (status = $getdvi (efn = buffer_count,7 devnam = output_device_desMcr,3 iosb = index_file_iosb,= itmlst = device_info_request)) THEN- IF (status = .index_file_iosb [0]) THEN BEGINF output_status [sts_v_terminal] = (.device_class EQL dc$_term);C output_status [sts_v_vt100] = (.device_type EQL dt$_vt100); END;+ IF .output_status [sts_v_terminal] THEN BEGIN) output_status [sts_v_pause] = true; lines_per_page = 22; END ELSE liNnes_per_page = 60; page_number = 0; last_uic = 0;0 IF cli$present ($DESCRIPTOR('NOPAUSE')) THEN* output_status [sts_v_pause] = false;C IF .status AND cli$present ($DESCRIPTOR('LINES_PER_PAGE')) THENA IF (status = cli$get_value ($DESCRIPTOR ('LINES_PER_PAGE'),> ascii_lines_per_page)) THEND status = ots$cvt_ti_l (ascii_lines_per_page,lines_per_page);( lines_written = .lines_per_page + 1; RETURN .status; END;&O ROUTINE new_page (current_group_ptr,2 current_member_ptr): NOVALUE = BEGIN BIND5 current_group = .current_group_ptr:' WORD,6 current_member = .current_member_ptr:' WORD,- reply_rab = output_rab:0 BLOCK [,BYTE]; LITERAL% esc = 27; OWN other_preface: P BYTE INITIAL (BYTE (12)), terminal_preface: BYTE INITIAL (BYTE (0)), vt100_preface: VECTOR [12,BYTE] INITIAL (BYTE (esc), BYTE (%C'<'), BYTE (esc), BYTE (%C'['), BYTE (%C'2'), BYTE (%C'J'), BYTE (esc), BYTE (%C'['), BYTE (%C'0'), BYTE (%C';'), BYTE (%C'0'), Q BYTE (%C'f')), other_preface_descr: BLOCK [8,BYTE] INITIAL (%X'010E0001', other_preface), terminal_preface_descr: BLOCK [8,BYTE] INITIAL (%X'010E0000',# terminal_preface), vt100_preface_descr: BLOCK [8,BYTE] INITIAL (%X'010E000C', vt100_preface); OWN device_and_uic_length: LONG, heading:# VECTOR [heading_size,BYTE],R heading_descr: BLOCK [8,BYTE]. INITIAL (%X'010E0000' OR heading_size, heading), start_of_device: LONG;# page_number = .page_number + 1; IF (.page_number GTR 1) AND( .output_status [sts_v_pause] THEN! $get (rab = reply_rab);B device_and_uic_length = .device_name_descr[dsc$w_length] + 10;6 start_of_device = (80 - .device_and_uic_length)/2;= $fao ($DESCRIPTOR('!AS!#%D!AS[!3OW,!3OW]!#* Page!4UL!/'),! S output_rab [rab$w_rsz], heading_descr,P (IF .output_status [sts_v_vt100] AND .output_status [sts_v_pause] THEN vt100_preface_descr7 ELSE IF .output_status [sts_v_terminal] THEN# terminal_preface_descr ELSE" other_preface_descr), .start_of_device, current_time, device_name_descr, .current_group, .current_member, .start_of_device-8, T .page_number);% output_rab [rab$l_rbf] = heading; $put ( rab = output_rab); lines_written = 2; END;4 ROUTINE print_one_line (sortrecord_ptr): NOVALUE = BEGIN BIND2 sortrecord = .sortrecord_ptr:0 BLOCK [,BYTE]; OWN output_record:" VECTOR [output_size,BYTE], output_record_descr: BLOCK [8,BYTE]- INITIAL (%X'010E0000' OR output_size, out Uput_record);8 IF (.sortrecord [sortrecord$l_uic] NEQ .last_uic) OR0 (.lines_written GTR .lines_per_page) THEN4 new_page (sortrecord [sortrecord$w_uic_group],6 sortrecord [sortrecord$w_uic_member]);) $fao ($DESCRIPTOR ('!67AD!5UL/!5UL'),! output_rab [rab$w_rsz], output_record_descr,, .sortrecord [sortrecord$b_length],- sortrecord [sortrecord$t_filename],. .sortrecord [sortrecord$l_blksused],0 .sortrecVord [sortrecord$l_blksalloc]);+ output_rab [rab$l_rbf] = output_record; $put ( rab = output_rab);' lines_written = .lines_written + 1; END;- ROUTINE swap_word (longword_ptr): NOVALUE = BEGIN BIND0 longword = .longword_ptr:1 BLOCK [4,BYTE]; MACRO- low_word = 0,0,16,0 %,- high_word = 2,0,16,0 %; OWN temp_word: WORD;% teWmp_word = .longword [low_word];0 longword [low_word] = .longword [high_word];& longword [high_word] = .temp_word; END;1 ROUTINE test_page (lines_needed_ptr): NOVALUE = BEGIN BIND4 lines_needed = .lines_needed_ptr:' LONG;@ IF .lines_needed GTR (.lines_per_page - .lines_written) THEN! new_page (last_uic <16,16>,! last_uic <0,16>); END;D ROUTINE print_totals (files_ptr,used_pXtr,allocated_ptr): NOVALUE = BEGIN BIND- files = .files_ptr:' LONG,, used = .used_ptr:' LONG,1 allocated = .allocated_ptr:' LONG; OWN output_record:" VECTOR [output_size,BYTE], output_record_descr: BLOCK [8,BYTE]- INITIAL (%X'010E0000' OR output_size, Y output_record); test_page (%REF(8));+ output_rab [rab$l_rbf] = output_record;H $fao ($DESCRIPTOR('!/!/!/Disk usage summary for UIC [!3OW,!3OW]!/'),! output_rab [rab$w_rsz], output_record_descr, .last_uic <16,16>, .last_uic <0,16>); $put (rab = output_rab);0 $fao ($DESCRIPTOR('!30!5UL'),! output_rab [rab$w_rsz], output_record_descr, .files); $put ( rab = output_rab);6 Z$fao ($DESCRIPTOR('!30!5UL'),! output_rab [rab$w_rsz], output_record_descr, .used); $put ( rab = output_rab);; $fao ($DESCRIPTOR('!30!5UL'),! output_rab [rab$w_rsz], output_record_descr, .allocated); $put ( rab = output_rab); END;) GLOBAL ROUTINE display_files: NOVALUE = BEGIN OWN blocks_allocated: LONG, blocks_used: [ LONG, files_owned: LONG, record_length: LONG, sortrecord_address: LONG; blocks_allocated = 0; blocks_used = 0; files_owned = 0;/ WHILE return_record (sortrecord_address) DO BEGIN BIND6 sortrecord = .sortrecord_address:0 BLOCK [,BYTE];5 swap_word (sortrecord [sortrecord$l_blksused]);6 swap_word (sortrecord [sortrecord$l_blksalloc]);" \print_one_line (sortrecord);% files_owned = .files_owned + 1;G blocks_used = .blocks_used + .sortrecord [sortrecord$l_blksused];R blocks_allocated = .blocks_allocated + .sortrecord [sortrecord$l_blksalloc];0 last_uic = .sortrecord [sortrecord$l_uic]; END;< print_totals (files_owned,blocks_used,blocks_allocated); END;$ GLOBAL ROUTINE close_output_file = BEGIN% RETURN $close (fab = output_fab); END; ENDELUDOMww­€ìsE]¹ Œ"MODULE owner ( IDENT = 'V03-0000', main = owner) = BEGIN LIBRARY 'sys$library:lib'; REQUIRE 'sys$library:tpamac'; REQUIRE 'owner.req'; EXTERNAL ROUTINE: access_index_file: ADDRESSING_MODE (GENERAL),: cli$get_value: ADDRESSING_MODE (GENERAL),: cli$present: ADDRESSING_MODE (GENERAL),: close_output_file: ADDRESSING_MODE (GENERAL),B display_files: ADDRESSING_MODE (GENERAL) NOVALUE,: ^ do_sort: ADDRESSING_MODE (GENERAL),B end_sort: ADDRESSING_MODE (GENERAL) NOVALUE,: find_last_header_vbn: ADDRESSING_MODE (GENERAL),: initialize_qioblock_array: ADDRESSING_MODE (GENERAL),: initialize_sort: ADDRESSING_MODE (GENERAL),B lib$free_vm: ADDRESSING_MODE (GENERAL) NOVALUE,: lib$get_vm: ADDRESSING_MODE (GENERAL),B lib$signal: ADDRESSING_MODE (GENERAL) NOVALUE,: _ lib$tparse: ADDRESSING_MODE (GENERAL),: open_output_file: ADDRESSING_MODE (GENERAL),: ots$cvt_ti_l: ADDRESSING_MODE (GENERAL),: output_control: ADDRESSING_MODE (GENERAL),B process_all_files: ADDRESSING_MODE (GENERAL) NOVALUE,: process_home_block: ADDRESSING_MODE (GENERAL),: read_home_block: ADDRESSING_MODE (GENERAL),: read_index_bitmap: ADDRESSING_MODE (GENERAL),: read_mfd_header:` ADDRESSING_MODE (GENERAL),: str$copy_r: ADDRESSING_MODE (GENERAL); GLOBAL bitmap_ptr: LONG, cache_buffer_ptr: LONG, cache_header_count: LONG, cluster_factor: LONG, current_header_vbn: LONG, current_time: VECTOR [2,LONG], device_name_descr: BLOCK [8,BYTE] INITIAL (%X'020E0000',0), disk_acp_channel: LONG, first_header_vbn: LONG, firsat_vbn_in_buffer: LONG, free_buffer_mask: LONG INITIAL (0), header_buffer_ptr: LONG, header_count: LONG, index_bitmap_size: WORD, index_bitmap_vbn: LONG, index_file_iosb: VECTOR [4,WORD], last_header_vbn: LONG, last_vbn_in_buffer: LONG, max_cache: LONG, mfd_header: BLOCK [512,BYTE], next_display_record: LONG, next_sort_record: LONG b, qioblock_base_address: LONG, reference_count_ptr: LONG," start_of_record_address_table: LONG, uic_flags: BITVECTOR [32], uic_group: WORD, uic_member: WORD, volume_structure_level: BYTE, worst_error: LONG INITIAL (ss$_normal); OWN home_block: BLOCK [512,BYTE];" ROUTINE allocate_header_buffer = BEGIN OWN header_count_descr: BLOCK c[8,BYTE]! INITIAL (%X'020E0000',0), status: LONG;= IF (status = cli$get_value ($DESCRIPTOR ('HEADER_COUNT'),9 header_count_descr)) THEN5 IF (status = ots$cvt_ti_l (header_count_descr,5 header_count)) THEN9 status = lib$get_vm (%REF (512 * .header_count),1 header_buffer_ptr); RETURN .status; END;! ROUTINE allocate_cache_buffer = BEdGIN OWN cache_count_descr: BLOCK [8,BYTE]! INITIAL (%X'020E0000',0), status: LONG;; IF (status = cli$get_value ($DESCRIPTOR ('CACHE_SIZE'),8 cache_count_descr)) THEN4 IF (status = ots$cvt_ti_l (cache_count_descr,2 max_cache)) THEN: IF (status = lib$get_vm (%REF (512 * .max_cache),9 cache_buffer_ptr)) THEN6 status = lieb$get_vm (%REF (4 * .max_cache),5 reference_count_ptr); RETURN .status; END;, GLOBAL ROUTINE perform (status): NOVALUE = BEGIN BUILTIN AP, CALLG; BIND& argument_list = .AP:1 VECTOR [,LONG]; LITERAL$ primary_signal = 1;/ IF NOT .argument_list [primary_signal] THEN' CALLG (argument_list,lib$signal); END;1 ROUTINE geft_parameter (device_name_descr_ptr) = BEGIN BIND9 device_name_descr = .device_name_descr_ptr:0 BLOCK [,BYTE]; OWN device_name_length: WORD, done: LONG, status: LONG, temporary_buffer:* VECTOR [logical_name_length,BYTE], temporary_buffer_descr: BLOCK [8,BYTE]5 INITIAL (%X'010E0000' OR logical_name_length,# temporary_bufgfer);T done = false; ! initially not doneT IF (status = cli$get_value ($DESCRIPTOR ('INPUT1'), ! get next parameter8 device_name_descr)) THENX WHILE .status AND NOT .done DO ! continue to do logicalX BEGIN ! name translation untilX status = $trnlog (lognam = device_name_descr, ! either get an error horV rsllen = device_name_length, ! run out of things toK rslbuf = temporary_buffer_descr); ! translate SELECT true OF SETY [(.status EQL ss$_notran) OR (status<0,1> EQL 0)]: ! error or no translation done = true;[ [.status]: ! success or no translation3 status = str$copy_r (device_name_descr,4 i device_name_length,I .temporary_buffer_descr [dsc$a_pointer]) TES; END; RETURN .status; END; ROUTINE get_uic =G BEGIN ! {* routine get_uic *}!+! Revision History! ======== =======!+! WVD001 W. Dixon 23-Mar-1983?! Change _v refernce to _m format in tparse state! transition.!!- OWN flags: BITVjECTOR [32], group_number: LONG, member_number: LONG, status: LONG, tparse_block:" BLOCK [tpa$k_length0,BYTE] INITIAL (tpa$k_count0), uic_descr: BLOCK [8,BYTE]! INITIAL (%X'020E0000',0); $ $init_state (uic_state,uic_key); $state (, ('[') ); $state (,( (TPA$_OCTAL,,,,group_number),H ('*',,,wild_m_group,flags) k ! wvd001 ); $state (, (',') ); $state (,) (TPA$_OCTAL,,,,member_number),H ('*',,,wild_m_member,flags) ! wvd001 ); $state (, (']',TPA$_EXIT) ); PSECT OWN = $OWN$;# PSECT GLOBAL = $GLOBAL$;8 IF (status =cli$get_value ($DESCRIPTOR('OWNER_UIC'),/ uic_descr)) THEND BEGIN l ! {* /UIC present *}' uic_flags [wild_v_group] = false;( uic_flags [wild_v_member] = false;A tparse_block [tpa$l_stringcnt] = .uic_descr [dsc$w_length];B tparse_block [tpa$l_stringptr] = .uic_descr [dsc$a_pointer];D IF (status = lib$tparse (tparse_block,uic_state,uic_key)) THENA BEGIN ! {* valid uic *}" uic_group = .group_number;$ uic_member = .member_number;9 uic_flags [wild_v_mgroup] = .flags [wild_v_group];; uic_flags [wild_v_member] = .flags [wild_v_member];A END; ! {* valid uic *}D END; ! {* /UIC present *} RETURN .status;G END; ! {* routine get_uic *} ROUTINE owner = BEGIN/ perform ($gettim ( timadr = current_time));( perform (allocate_header_buffer ());' perform (allocate_cache_buffer ());+ n perform (initialize_qioblock_array ());" perform (open_output_file ()); perform (output_control ());. WHILE get_parameter (device_name_descr) DO BEGIN3 perform ($assign ( chan = disk_acp_channel,6 devnam = device_name_descr));% perform (access_index_file ());. perform (read_home_block ( home_block));0 perform (process_home_block (home_block));% perform (read_index_bitmap ());( perform (find_last_header_vbn ());#o perform (initialize_sort ()); perform (get_uic ());1 last_vbn_in_buffer = .first_header_vbn - 1;# perform (read_mfd_header ()); cache_header_count = 0; process_all_files ();+ $dassgn (chan = .disk_acp_channel); IF .bitmap_ptr NEQ 0 THEN5 lib$free_vm (%REF (512 * .index_bitmap_size),! bitmap_ptr); perform (do_sort ()); display_files (); end_sort (); END;# perform (close_output_pfile ()); RETURN .worst_error; END; ENDELUDOMww­@ÞÎ@UŒ!+!! Revision History! ======== =======!3! WVD001 W. Dixon 23-Mar-1983<! Add _m format to wild data structure!!-LITERAL$ true = 1,$ false = 0;LITERAL& logical_name_length = 256;LITERAL$ wild_v_group = 0,H wild_m_group = 1, q ! wvd001$ wild_v_member = 1,H wild_m_member = 2; ! wvd001LITERAL$ invalid_header = 0,$ valid_header = 1,$ deleted_header = 2;MACRO, qioblock$b_event_flag = 0,0,8,0 %,, qioblock$b_state = 1,0,8,0 %,, qioblock$b_format = 2,0,8,0 %,, qioblock$b_terminal = 3,0,8,0 %,- qioblock$l_header = 4,0,32,0 %,- qiroblock$l_uic = 8,0,32,0 %,. qioblock$l_blksused = 12,0,32,0 %,. qioblock$l_blksalloc = 16,0,32,0 %,- qioblock$q_iosb = 20,0,0,0 %,- qioblock$q_name = 28,0,0,0 %,- qioblock$t_name = 36,0,0,0 %,. qioblock$t_header = 256,0,0,0 %;LITERAL& qioblock$c_length = 768;LITERAL$ initial_segment = 0,$ filename_segment = 1,$ directory_segment = s2;LITERAL$ buffer_count = 6;MACRO- sortrecord$l_uic = 0,0,32,0 %,- sortrecord$w_uic_member = 0,0,16,0 %,- sortrecord$w_uic_group = 2,0,16,0 %,- sortrecord$l_blksalloc = 4,0,32,0 %,- sortrecord$l_blksused = 8,0,32,0 %,- sortrecord$b_length = 12,0,8,0 %,- sortrecord$t_filename = 13,0,0,0 %;LITERAL% sortrecord$s_fixed = 13;LITERAL& heading_size = 128,% toutput_size = 90,% reply_size = 10;ww­x«45Œ, .TITLE OWNER_ERROR_MESSAGES- .FACILITY SET,253/PREFIX=OWNER_ .SEVERITY SUCCESS/ SUCCESS  .SEVERITY WARNING. BADLEVEL Q FNMABT/FAO=1 .ENDww­à‡¡á· Œ0MODULE process_all_filues ( IDENT = 'V03-0000') = BEGIN LIBRARY 'sys$library:lib'; REQUIRE 'owner.req'; EXTERNAL bitmap_ptr: LONG, cluster_factor: LONG, current_header_vbn: LONG, disk_acp_channel: LONG, first_header_vbn: LONG, first_vbn_in_buffer: LONG, free_buffer_mask: BITVECTOR [32], header_buffer_ptr: LONG, header_count: LONG, index_bitmap_size: WORD, index_bitmvap_vbn: LONG, index_file_iosb: VECTOR [4,WORD], last_header_vbn: LONG, last_vbn_in_buffer: LONG, mfd_header: BLOCK [,BYTE], qioblock_base_address: LONG, uic_flags: BITVECTOR [32], uic_group: WORD, uic_member: WORD, volume_structure_level: BYTE, worst_error: LONG; EXTERNAL LITERAL owner_fnmabt; EXTERNAL ROUTINEB allocate_buffer: AD wDRESSING_MODE (GENERAL) NOVALUE,B complete_filename: ADDRESSING_MODE (GENERAL) NOVALUE,B get_next_header: ADDRESSING_MODE (GENERAL) NOVALUE,B qioast: ADDRESSING_MODE (GENERAL) NOVALUE,B release_buffer: ADDRESSING_MODE (GENERAL) NOVALUE,: save_filename: ADDRESSING_MODE (GENERAL),B update_filename: ADDRESSING_MODE (GENERAL) NOVALUE,: verify_header: ADDRESSING_MODE (GENERAL);, ROUTINxE uic_match (group_ptr,member_ptr) = BEGIN BIND- group = .group_ptr:' WORD,. member = .member_ptr:' WORD;D IF (.uic_flags [wild_v_group] AND .uic_flags [wild_v_member]) ORC (.uic_flags [wild_v_group] AND (.uic_member EQL .member)) ORB (.uic_flags [wild_v_member] AND (.uic_group EQL .group)) ORC ((.uic_group EQL .group) AND (.uic_member EQLy .member)) THEN RETURN true ELSE RETURN false; END;8 ROUTINE name_that_file (current_header_ptr): NOVALUE = BEGIN BIND6 current_header = .current_header_ptr:0 BLOCK [,BYTE],A record_attributes = current_header [fh2$w_recattr]:0 BLOCK [,BYTE]; OWN qioblock_address: LONG;> allocate_buffer (qioblock_address); ! get a buzffer BEGIN BIND4 qioblock = .qioblock_address:0 BLOCK [,BYTE],= qioblock_iosb = qioblock [qioblock$q_iosb]:1 VECTOR [,WORD],= name_descr = qioblock [qioblock$q_name]:0 BLOCK [,BYTE];!'! Simulate successful io completion!% qioblock_iosb [0] = ss$_normal;!0! Copy info into qio block from file heade{r.!D qioblock [qioblock$l_uic] = .current_header [fh2$l_fileowner];I qioblock [qioblock$l_blksalloc] = .record_attributes [fat$l_hiblk];H qioblock [qioblock$l_blksused] = .record_attributes [fat$l_efblk];!4! initialize state, format, and terminal context!4 qioblock [qioblock$b_state] = initial_segment;' qioblock [qioblock$b_format] = 0;- qioblock [qioblock$b_terminal] = %C' ';!%! initialize file name descriptor!$ name_descr [dsc$w_|length] = 0;@ name_descr [dsc$a_pointer] = qioblock [qioblock$t_header];!E! make header pointer in qio block point to header passed to this! routine.!4 qioblock [qioblock$l_header] = current_header;!! simulate io completion.! $setast (enbflg = 0); qioast (qioblock); $setast (enbflg = 1); END; END;- GLOBAL ROUTINE process_all_files: NOVALUE = BEGIN OWN current_header_address: LONG, } file_id:" BLOCK [fid$c_length,BYTE], file_number: LONG;I INCR current_header_vbn FROM .first_header_vbn TO .last_header_vbn DO BEGIN* get_next_header (current_header_vbn,/ current_header_address); BEGIN BINDB current_header = .current_header_address:8 BLOCK [,BYTE],J file_characteristics = current_header [fh2$l_filechar]:8 ~ BLOCK [,BYTE];B file_number = .current_header_vbn - .first_header_vbn + 1;2 file_id [fid$w_num] = .file_number <0,16>;2 file_id [fid$b_nmx] = .file_number <16,8>;> file_id [fid$w_seq] = .current_header [fh2$w_fid_seq]; file_id [fid$b_rvn] = 1;5 IF verify_header (current_header,file_id) AND4 .current_header [fh2$w_seg_num] EQL 0 AND: .file_characteristics [fch$v_markdel] EQL 0 AND6  uic_match (current_header [fh2$w_uicgroup],< current_header [fh2$w_uicmember]) THEN1 name_that_file ( current_header); END; END; END; ENDELUDOMww­@tõá· Œ#MODULE sort ( IDENT = 'V03-0000') = BEGIN LIBRARY 'sys$library:lib'; REQUIRE 'owner.req'; EXTERNAL first_header_vbn: LONG, last_header_vbn: LONG, next_display_record: LONG, next_sort_record: LONG,€" start_of_record_address_table: LONG; EXTERNAL ROUTINEB lib$free_vm: ADDRESSING_MODE (GENERAL) NOVALUE,: lib$get_vm: ADDRESSING_MODE (GENERAL);) GLOBAL ROUTINE release_record (uic_ptr,6 blocks_allocated_ptr,1 blocks_used_ptr,6 filename_descr_ptr) = BEGIN BIND+ uic = .uic_ptr:'  LONG,8 blocks_allocated = .blocks_allocated_ptr:' LONG,3 blocks_used = .blocks_used_ptr:' LONG,6 filename_descr = .filename_descr_ptr:0 BLOCK [,BYTE]; BINDA record_address_table = .start_of_record_address_table:1 VECTOR [,LONG]; OWN bytes_required: LONG,‚ status: LONG; BUILTIN ACTUALCOUNT;!-! Calculate space required for this record.! IF ACTUALCOUNT () EQL 3 THEN!E! No file name. This is a special case for first or last records.,! These records are delimeters for sort.!) bytes_required = sortrecord$s_fixed ELSE!B! Normal case. File name is stored with record. This record is! actually sorted.!K bytes_required = sortrecord$s_fixed + .filename_descr [dƒsc$w_length];!C! Now that we have calculated length of record, allocate space to! store information.!, IF (status = lib$get_vm (bytes_required,C record_address_table [.next_sort_record])) THEN BEGIN BINDL sortrecord = .record_address_table [.next_sort_record]:0 BLOCK [,BYTE];/ next_sort_record = .next_sort_record + 1;+ sortrecord [sortrecord$l_uic] = .uic;8 sortrecord [sort „record$l_blksused] = .blocks_used;> sortrecord [sortrecord$l_blksalloc] = .blocks_allocated;" IF ACTUALCOUNT () EQL 3 THEN, sortrecord [sortrecord$b_length] = 0 ELSE BEGINJ sortrecord [sortrecord$b_length] = .filename_descr [dsc$w_length];3 CH$MOVE (.sortrecord [sortrecord$b_length],: CH$PTR (.filename_descr [dsc$a_pointer]),> CH$PTR (sortrecord [sortrecord$t_filename])); END; END; RETURN .stat…us; END;7 GLOBAL ROUTINE return_record (starting_address_ptr) = BEGIN OWN record_size; BIND@ starting_address = .starting_address_ptr:/ LONG; BINDI record_address_table = .start_of_record_address_table:9 VECTOR [,LONG];< IF .next_display_record LSS (.next_sort_record - 1) THEN!2! There is at least one more rec†ord to return.! BEGIN BINDS sortrecord = .record_address_table [.next_display_record - 1]:0 BLOCK [,BYTE];!M! There will always be a previous record. Free the previous record before'! returning address of next record.!K record_size = sortrecord$s_fixed + .sortrecord [sortrecord$b_length]; lib$free_vm (record_size,D record_address_table [.next_display_record - 1]);!H! Re ‡turn starting address of next record and calculate index of next! record to be displayed.!F starting_address = .record_address_table [.next_display_record];5 next_display_record = .next_display_record + 1; RETURN true; END@ ELSE IF .next_display_record EQL (.next_sort_record -1) THEN!H! We have just returned the last useful record -- only the terminalK! delimeter remains. Free this last record and return saying that there! are no more recoˆrds.! BEGIN- lib$free_vm (%REF (sortrecord$s_fixed),= record_address_table [.next_sort_record]); RETURN false; END ELSE!! Error. Nothing to do.! RETURN false; END;" GLOBAL ROUTINE initialize_sort = BEGIN OWN status: LONG;!E! Calculate maximum number of files on this disk and allocate space! for sort record pointers.!Q IF (status = lib$get_vm (%REF (4*(.last_ ‰header_vbn - .first_header_vbn + 1)),A start_of_record_address_table)) THEN BEGINM next_sort_record = 0; ! index of next available sort record1 ! pointerI next_display_record = 1; ! we do not display the first (or7 ! last) recordsI status = release_record (%REF (0),! This record will always be less> %REF (0),! Šthan any real record) %REF (0)); END; RETURN .status; END;$ GLOBAL ROUTINE end_sort: NOVALUE = BEGINE lib$free_vm (%REF (4*(.last_header_vbn - .first_header_vbn + 1)),0 start_of_record_address_table); END;- ROUTINE sort (key_ptr,count_ptr): NOVALUE = BEGIN BUILTIN SP; BIND+ key = .key_ptr:1 VECTOR [,LONG],- ‹ count = .count_ptr:' LONG,& stack_top = .SP:' LONG; LITERAL% cutoff = 10; ! LITERAL$! true = 1,$! false = 0; ! MACRO-! sortrecord$l_uic = 0,0,32,0 %,-! sortrecord$b_length = 12,0,8,0 %,-! sortrecord$t_filename = 13,0,0,0 %; MACRO compare (x,op,y) =Œ BEGIN BIND; recordx = x: BLOCK [,BYTE],; recordy = y: BLOCK [,BYTE];J (IF .recordx [sortrecord$l_uic] EQL .recordy [sortrecord$l_uic] THEN: (%NAME ('CH$',op) (.recordx [sortrecord$b_length],: CH$PTR (recordx [sortrecord$t_filename]),0 .recordy [sortrecord$b_length],: CH$PTR (recordy [sortrecord$t_filename]), %C' ')) ELSED  (.recordx [sortrecord$l_uic] op .recordy [sortrecord$l_uic])) END %; MACRO empty = (IF .SP EQL stack_top THEN true ELSE false) %;" MACRO exchange (data1,data2) = BEGIN SP = .SP -4; .SP = .data1; data1 = .data2; data2 = ..SP; SP = .SP + 4; END %; MACRO pop (data1,data2) = BEGIN data2 = ..SP; SP = .SP + 4; data1 = ..SP; SP = .SP + 4; Ž END %; MACRO push (data1,data2) = BEGIN SP = .SP - 4; .SP = data1; SP = .SP - 4; .SP = data2; END %; OWN l,r,i,j; IF .count GEQ cutoff THENE BEGIN ! {* use quicksort *} PUSH (1,.count); WHILE NOT empty DOG BEGIN ! {* stack not empty *} POP (l,r); i = .l; j = .r + 1; DO> BEGIN ! {* i le j *} DOE BEGIN ! {* k[i] lss k[l] *} i = .i + 1;E END ! {* k[i] lss k[l] *}5 WHILE compare(.key [.i], LSS, .key [.l]); DOE BEGIN ! {* k[l] lss k[j] *} j = .j-1;E END ! {* k[l] lss k[j] *}4 WHILE compare(.key[.l], LSS, .key [.j]); IF .j LEQ .i THEN BEGIN' exchange (key[.l],key[.j]); END ELSE BEGIN) exchange (key [.i],key [.j]); END;? END ! {* i lss j *} WHILE .j GTR .i;( IF ((.r - .j) GEQ (.j - .l)) AND& ((.j - .l) GTR cutoff) THEN BEGIN push (.j+1,.r); push (.l,.j-1); END- ELSE I‘F ((.j - .l) GTR (.r - .j)) AND+ ((.r - .j) GTR cutoff) THEN BEGIN push (.l,.j-1); push (.j+1,.r); END* ELSE IF ((.r - .j) GTR cutoff) AND- ( cutoff GEQ (.j - . l)) THEN push (.j+1,.r)+ ELSE IF ((.j - . l) GTR cutoff) AND, ( cutoff GEQ (.r - .j)) THEN push (.l,.j-1);G END; ! {* while not empty *}H END; ’ ! {* count gtr cutoff *} IF cutoff GTR 1 THEN INCR j FROM 2 TO .count DO5 IF compare( .key [.j-1], GTR, .key [.j]) THEN BEGIN SP = .SP - 4; .SP = .key [.j]; i = .j - 1; DO BEGIN# key [.i+1] = .key [.i]; i = .i - 1; END1 UNTIL compare (.key [.i], LEQ, ..SP); key [.i+1] = ..SP; SP = . SP + 4; END; END; GLOBAL ROUTINE do_sort = BEGIN OWN status;5 IF (status = release_record (%REF (%X'3FFF3FFF'),* %REF (0),0 %REF (0))) THEN+ sort (.start_of_record_address_table,* %REF (.next_sort_record - 1)); RETURN .status END; ENDELUDOMww