function dix_fastio_init(control,file,search_block_size,multi_buffer) implicit none c c Now connect a channel to the file c include 'dix_fastio_def.inc' include '($fabdef)' include '($namdef)' include '($fibdef)' include '($atrdef)' include '($efndef)' include '($iodef)' c record /control/ control !:io: control block record /file_info/ file !:io: file block integer*4 search_block_size !:i: block size for search integer*4 multi_buffer !:i: multi buffer integer*4 dix_fastio_init !:f: the result c# integer*4 istat,k,des(2),addr,n,blnr,area_nr,offset c record /atrdef/ cblk(2) record /rec_attributes/ rec_attrib record /fibdef/ fib c integer*4 lib$get_vm_page integer*4 sys$assign integer*4 sys$qiow integer*4 dix_fastio__read c record /area/ area pointer (p_area,area) c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c record /prologue/ prologue c record /fabdef/ fab pointer (p_fab,fab) c character*(max_line_length) line integer*4 nk c byte data_block(block_size) c c Get control block c if ptr <>0 it was already done c istat = 1 if(file.ptr_fast_search .ne. 0) then p_fastio_header = file.ptr_fast_search if(fastio_header.channel .ne. 0) goto 90 c c We already allocted the header, but not yet the data blocks c goto 5 endif c call dix_main_print_debug(control,debug_fastio,'Setup fastio') c c GEt control block, all bytes are cleared to 0 c call get_vm(control,sizeof(fastio_header),addr, 1 control.zone_file, 1 .true.,'FASTIO_HDR') p_fastio_header = addr c c Set defaults c file.ptr_fast_search = p_fastio_header 5 fastio_header.skip = .false. c fastio_header.seq_block_count = 1 min(search_block_size,max_block_count) c c For indexed files, get one buffer of max_bucket size (max_buf_size) c fastio_header.ran_block_count = 1 (max_buf_size+block_size-1)/block_size c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' Seq bufsiz = !UL, random buf !UL',nk,line, 1 %val(fastio_header.seq_block_count), 1 %val(fastio_header.ran_block_count)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c c Now allocate the data blocks for sequential data c we need max_seq_rec blocks , but only for indexed files c if(file.indexed) then c c For indexd files, get max_seq_rec blocks, and one ran block c n = max(1,min(multi_buffer,max_seq_rec)) !we want max_seq_rec seq blocks c c Now allocate the data block for random data (only one in needed) c istat = lib$get_vm_page(fastio_header.ran_block_count,addr) if(.not. istat) goto 90 fastio_header.ran.address = addr else c c Get one seq block c n = 1 endif c do k=1,n istat = lib$get_vm_page(fastio_header.seq_block_count,addr) if(.not. istat) then c c Allocation failed, if we have at least one block, we can continue c if(fastio_header.n_seq_buf .eq. 0) goto 90 goto 10 endif fastio_header.seq(k).address = addr fastio_header.n_seq_buf = fastio_header.n_seq_buf + 1 enddo c c Now assign channel to file c 10 p_fab = file.fabadr c c Get the name of the disk and the fileid of the file c since alpha/ia64 user naml blocks, and vax only nam c this is done in the architecture specific rms library c call dix_rms_get_nam(%val(fab.fab$l_nam),des,fib.fib$w_fid) c c Now assign channel to disk c k = 0 istat = sys$assign(des,k,,) if(.not. istat) goto 90 fastio_header.channel = k c c Set up cblk entry to get rec attrib c cblk(1).atr$w_size = sizeof(rec_attrib) cblk(1).atr$w_type = atr$c_recattr cblk(1).atr$l_addr = %loc(rec_attrib) c cblk(2).atr$w_size = 0 cblk(2).atr$w_type = 0 cblk(2).atr$l_addr = 0 c c Create descriptor for the fib c des(1) = sizeof(fib) des(2) = %loc(fib) c c The nolock needs priv, if you do not have it c it is ignored. c fib.fib$l_aclctx = 0 !clear acl index fib.fib$l_acctl = fib$m_nolock c c connect c istat = sys$qiow(%val(EFN$C_ENF),%val(fastio_header.channel), 1 %val(io$_access .or. io$m_access), 1 fastio_header.iosb,,,des,,,,cblk,) if(istat) istat = fastio_header.iosb(1) if(.not. istat) goto 90 c c Get some data from the rec attrib c fastio_header.file_size = ishftc(rec_attrib.hiblk,16,32) fastio_header.eof_size = ishftc(rec_attrib.eofblk,16,32) fastio_header.ffbyte = zext(rec_attrib.ffbyte) c c Now if the file is indexed, get the prologue c this also includes the definition of the first key c fastio_header.type = fab.fab$b_org if(fab.fab$b_org .eq. fab$c_idx) then c c Read the prologue block c fastio_header.typasc = 'IDX' istat = dix_fastio__read(fastio_header,1,1, 1 prologue,k) c c remember tehe primary key data c fastio_header.prim_key = prologue.key fastio_header.bucket_size = 1 zext(fastio_header.prim_key.data_bucket_size) fastio_header.nb_key = zext(prologue.key.key_size) fastio_header.ran_block_count = 1 min(fastio_header.ran_block_count, 1 fastio_header.bucket_size) c c Get the block for the area definition c Get the first area block c area_nr = zext(fastio_header.prim_key.data_area) offset = area_nr * sizeof(area) blnr = mod(offset,block_size) + zext(prologue.area_vbn) offset = offset/block_size istat = dix_fastio__read(fastio_header,blnr,1,data_block,k) p_area = %loc(data_block) + offset c call dix_search_set_file_size(area.total_alloc/ 1 zext(area.bucket_size)) c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' Keyed file bucket size = !UL , keysize !UL', 1 nk,line, 1 %val(fastio_header.bucket_size), 1 %val(fastio_header.nb_key)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif elseif(fab.fab$b_org .eq. fab$c_rel) then c c Relative files ,read the prologue and get the max record number c fastio_header.typasc = 'REL' istat = dix_fastio__read(fastio_header,1,1, 1 prologue,k) fastio_header.vfc_size = zext(fab.fab$b_fsz) fastio_header.record_length = zext(fab.fab$w_mrs) fastio_header.bucket_size = zext(fab.fab$b_bks) fastio_header.max_recnr = prologue.max_recnr fastio_header.rfm = fab.fab$b_rfm c c Now compute the record size c fastio_header.rel_recsiz = 1 + fastio_header.record_length + 1 fastio_header.vfc_size if(fastio_header.rfm .ne. fab$c_fix) then fastio_header.rel_recsiz = fastio_header.rel_recsiz + 2 endif c c and the count of record/bucket c fastio_header.rel_nrecbuck = 1 (fastio_header.bucket_size * block_size) / 1 fastio_header.rel_recsiz fastio_header.rel_bperbucket = fastio_header.rel_nrecbuck* 1 fastio_header.rel_recsiz c elseif(fab.fab$b_org .eq. fab$c_seq) then c c Get the data for the seuqntial files c fastio_header.typasc = 'SEQ' fastio_header.bucket_size = 1 fastio_header.rfm = fab.fab$b_rfm fastio_header.blk = (fab.fab$b_rat .and. fab$m_blk) .ne. 0 fastio_header.msb = (fab.fab$b_rat .and. fab$m_msb) .ne. 0 fastio_header.vfc_size = zext(fab.fab$b_fsz) fastio_header.record_length = zext(fab.fab$w_mrs) c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' Seq file eof block,byte !UL,!UL', 1 nk,line, 1 %val(fastio_header.eof_size), 1 %val(fastio_header.ffbyte)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif else istat = 0 !should not happen endif c 90 dix_fastio_init = istat return end function dix_fastio_rewind(control,file) implicit none c c Rewind the file c include 'dix_fastio_def.inc' record /control/ control !:i: control block record /file_info/ file !:i: the file block integer*4 dix_fastio_rewind !:f: the io result c include '($fabdef)' c record /bucket/ bucket pointer (p_bucket,bucket) c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c integer*4 istat,k integer*4 dix_fastio__read_bucket integer*4 dix_fastio__read_seq c call dix_main_print_debug(control,debug_fastio,' Rewind fastio') p_fastio_header = file.ptr_fast_search c c Clear all settings c do k=1,max_seq_rec fastio_header.seq(k).start_block = 0 fastio_header.seq(k).end_block = 0 end do c c Get the first block/bucket in c if(fastio_header.type .eq. fab$c_idx) then c c Now get the first data-bucket. c istat = dix_fastio__read_bucket(control,fastio_header, 1 fastio_header.prim_key.first_data_bucket, 1 fastio_header.p_bucket) p_bucket = fastio_header.p_bucket c c Ansd set the data rec to the first entry c fastio_header.data_offset = sizeof(bucket.hdr) c elseif(fastio_header.type .eq. fab$c_rel) then c c REL, get data block 2, and set offset to 0 c istat = dix_fastio__read_seq(fastio_header,1,2) fastio_header.data_offset = 0 else c c SEQ, get the data block in from block 1 c istat = dix_fastio__read_seq(fastio_header,1,1) fastio_header.data_offset = 0 endif c c Set record number to 0 c fastio_header.recnr = 0 dix_fastio_rewind = istat return end function dix_fastio_set_rfa(control,file) implicit none c c Set the file to the wanted RDA c include 'dix_fastio_def.inc' include '($rmsdef)' include '($fabdef)' c record /control/ control !:i: control block record /file_info/ file !:i: the file block integer*4 dix_fastio_set_rfa !:f: the result c record /rfa/ rfa integer*4 istat integer*4 dix_fastio_set_rfa_rfa c c Get the rfa from the current record in the rab c call dix_rms_return_rfa(file,rfa) istat = dix_fastio_set_rfa_rfa(control,file,rfa) dix_fastio_set_rfa = istat return end function dix_fastio_set_rfa_rfa(control,file,rfa) implicit none c c Set the file to the wanted RDA c include 'dix_fastio_def.inc' include '($rmsdef)' include '($fabdef)' c record /control/ control !:i: control block record /file_info/ file !:i: the file block record /rfa/ rfa !:i: the rfa integer*4 dix_fastio_set_rfa_rfa !:f: the result c integer*4 istat,recsiz,bpos,ptr_key,nk character*(max_line_length) line c integer*4 dix_fastio__read_bucket integer*4 dix_fastio__read_seq c c Now readin buffer /bucket c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c record /bucket/ bucket pointer (p_bucket,bucket) c record /data_rec/ data_rec pointer (p_data_rec ,data_rec) c c p_fastio_header = file.ptr_fast_search c c Get the rfa from the current record in the rab c fastio_header.recnr = file.rec_nr fastio_header.skip = .true. fastio_header.cur_rfa = rfa c istat = 1 c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao('setting rfa for !AS file to (!UL,!UW)', 1 nk,line,fastio_header.typasc, 1 %val(fastio_header.cur_rfa.bbnr), 1 %val(fastio_header.cur_rfa.offset)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c if(fastio_header.type .eq. fab$c_idx) then c c Now find the data bucket with this rfa .offset c GEt the bucket c istat = dix_fastio__read_bucket(control,fastio_header, 1 fastio_header.cur_rfa.bbnr, 1 fastio_header.p_bucket) p_bucket = fastio_header.p_bucket istat = rms$_rnf !assume record not found c c And start skipping until the valid data block is found (on out of bucket) c p_data_rec = p_bucket + sizeof(bucket.hdr) c 12 fastio_header.data_offset = p_data_rec - %loc(bucket) c c Seer if we are out of bucket, if so record not found c if(fastio_header.data_offset .ge. 1 zext(bucket.hdr.first_free_byte)) goto 90 c recsiz = zext(data_rec.recsiz) if((data_rec.hdr.flag .and. dhdr_rec_deleted) .ne. 0)then c c Deleted record c recsiz = recsiz + sizeof(data_rec.recsiz) elseif((data_rec.hdr.flag .and. dhdr_rec_rrv) .ne. 0) then c c RRV entry c recsiz = 0 else c c Real data rec, if fda.offset matches, -> gotit c if(data_rec.hdr.rfa_byte .eq. fastio_header.cur_rfa.offset) then istat = 1 goto 90 endif recsiz = recsiz + sizeof(data_rec.recsiz) endif c c Update the keyheader. Compressed keys must be expanded c call dix_fastio__uncompress_key(fastio_header,data_rec.data, 1 bpos,ptr_key) c c Update the data pointer c p_Data_rec = p_data_rec + sizeof(data_rec.hdr) + recsiz goto 12 elseif(fastio_header.type .eq. fab$c_rel) then c c For rel , make sure the whole bucket is in memory c if((fastio_header.cur_rfa.bbnr .lt. 1 fastio_header.seq(1).start_block) .or. 1 ((fastio_header.cur_rfa.bbnr + fastio_header.bucket_size) 1 .gt. fastio_header.seq(1).end_block)) then istat = dix_fastio__read_seq(fastio_header,1, 1 fastio_header.cur_rfa.bbnr) endif fastio_header.data_offset = fastio_header.cur_rfa.offset + 1 (fastio_header.cur_rfa.bbnr- 1 fastio_header.seq(1).start_block)*block_size else c c For seq, just read the block in, and set the offset c if((fastio_header.cur_rfa.bbnr .lt. 1 fastio_header.seq(1).start_block) .or. 1 (fastio_header.cur_rfa.bbnr .gt. 1 fastio_header.seq(1).end_block)) then c c Block not in memory read a chunk c istat = dix_fastio__read_seq(fastio_header,1, 1 fastio_header.cur_rfa.bbnr) endif c c Now update the pointer c fastio_header.data_offset = fastio_header.cur_rfa.offset + 1 (fastio_header.cur_rfa.bbnr- 1 fastio_header.seq(1).start_block)*block_size endif 90 dix_fastio_set_rfa_rfa = istat return end function dix_fastio_get(control,file,nkar,record) implicit none c c Get the next record c include 'dix_fastio_def.inc' record /control/ control !:i: control block record /file_info/ file !:i: file block integer*4 nkar !:o: record length byte record(*) !:o: the record data integer*4 dix_fastio_get !:f: result c# include '($fabdef)' c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c integer*4 istat c integer*4 dix_fastio__get_idx integer*4 dix_fastio__get_rel integer*4 dix_fastio__get_seq integer*4 dix_fastio_rewind c p_fastio_header = file.ptr_fast_search c c Update record number c if(fastio_header.recnr .ge. 0) fastio_header.recnr = 1 fastio_header.recnr + 1 c c If we had not yet done anyting, force a rewind c if(fastio_header.seq(1).start_block .eq. 0) then istat = dix_fastio_rewind(control,file) if(.not. istat) goto 90 endif c c Now we point to the current record, take us to the next c 10 if(fastio_header.type .eq. fab$c_idx) then c c Read indexed file c istat = dix_fastio__get_idx(control,fastio_header,nkar,record) c c Update counters for ^T c call dix_search_update(fastio_header.bucket_size, 1 fastio_header.recnr, 1 fastio_header.nbuckets_read,fastio_header.cur_rfa) c elseif(fastio_header.type .eq. fab$c_rel) then c c Read relative file c istat = dix_fastio__get_rel(control,fastio_header,nkar,record) c c Update counters for ^T c call dix_search_update(0,fastio_header.recnr, 1 fastio_header.nblocks_read,fastio_header.cur_rfa) c elseif(fastio_header.type .eq. fab$c_seq) then c c Read sequential file c istat = dix_fastio__get_seq(control,fastio_header,nkar,record) c c Update counters for ^T c call dix_search_update(0,fastio_header.recnr, 1 fastio_header.nblocks_read,fastio_header.cur_rfa) c else c c Should not happen c istat = 0 endif 90 dix_fastio_get = istat return end function dix_fastio__get_idx(control,fastio_header,nkar,record) implicit none c c Get nextrecord for indexed file c include 'dix_fastio_def.inc' record /control/ control !:i: control block record /fastio_header/ fastio_header !:io: fastio control block integer*4 nkar !:o: length of record byte record(*) !:o: the data integer*4 dix_fastio__get_idx !:f: function result c# record /bucket/ bucket pointer (p_bucket, bucket) record /data_rec/ data_rec pointer (p_data_rec, data_rec) c integer*4 istat,bl_wanted,recsiz,bpos,ptr_key include '($rmsdef)' c integer*4 dix_fastio__read_bucket c c Get the current bucket c istat = 1 p_bucket = fastio_header.p_bucket c c Set the pointer for the data record (in the bucket) c 20 p_data_rec = p_bucket + fastio_header.data_offset c c And find the next c if(fastio_header.data_offset .ge. 1 zext(bucket.hdr.first_free_byte)) then c c No more data records in the bucket, take us to the next bucket c if((bucket.hdr.flag .and. bhdr_flag_last) .ne. 0) then istat = rms$_eof else c c Get the next bucket (follow the chain) c bl_wanted = bucket.hdr.next_bucket c istat = dix_fastio__read_bucket(control,fastio_header, 1 bl_wanted,fastio_header.p_bucket) p_bucket = fastio_header.p_bucket c c One more bucket read c endif c c Adjust the pointer to the begin c fastio_header.data_offset = sizeof(bucket.hdr) if(istat) goto 20 !process the first data_rec of the new bucket goto 90 !error endif c c Check for the contents of the data_rec c if((data_rec.hdr.flag .and. dhdr_rec_rrv) .eq. 0) then c c Was not rrv pointer , expand key value (if compressed) c call dix_fastio__uncompress_key(fastio_header,data_rec.data, 1 bpos,ptr_key) endif c c Get the record size c recsiz = zext(data_rec.recsiz) c if((data_rec.hdr.flag .and. dhdr_rec_deleted) .ne. 0) then c c Deleted record, skip it, there is a record part c recsiz = recsiz + sizeof(data_rec.recsiz) elseif((data_rec.hdr.flag .and. dhdr_rec_rrv) .ne. 0) then c c RRV entry , no record part c recsiz = 0 else c c Real data rec, if skip not set we found it. c if skip set, clear it and go get the next c if(.not. fastio_header.skip) goto 40 recsiz = recsiz + sizeof(data_rec.recsiz) fastio_header.skip = .false. endif c c Update the pointer for data rec c fastio_header.data_offset = fastio_header.data_offset+ 1 sizeof(data_rec.hdr) + recsiz goto 20 c c Now the data record is found, go copy it c 40 call dix_fastio__copy_data(fastio_header,recsiz-bpos+1, 1 data_rec.data(bpos),ptr_key,nkar,record) c c Save the rfa c fastio_header.cur_rfa.bbnr = data_rec.hdr.rfa_block fastio_header.cur_rfa.offset = data_rec.hdr.rfa_byte c c Update the offset in the bucket c fastio_header.data_offset = fastio_header.data_offset + 1 sizeof(data_rec.hdr) + recsiz + 1 sizeof(data_rec.recsiz) c 90 dix_fastio__get_idx = istat return end function dix_fastio__get_rel(control,fastio_header,nkar,record) implicit none c c Get data from a relative file c include 'dix_fastio_def.inc' record /control/ control !:i: control block record /fastio_header/ fastio_header !:io: fastion header integer*4 nkar !:o: record length byte record(*) !:o: record data integer*4 dix_fastio__get_rel !:f: funciton result c# integer*4 istat,offs,bucknr,flag,recsiz,incr include '($rmsdef)' include '($fabdef)' c byte var_data(0:*) pointer (p_var_data,var_data) c integer*4 dix_fastio__get_copy integer*4 dix_fastio__scroll c nkar = 0 c c Each record is a fixed length cell in the bucket c the first byte is the present flag c and then follows a variable (vfc) record just like sequential file c the bucket may be not completely filled. c 21 offs = fastio_header.data_offset c c Get lowest multiple of bucket_size (added the 1 block overhead) c bucknr = (fastio_header.seq(1).start_block - 2)/ 1 fastio_header.bucket_size bucknr = bucknr * fastio_header.bucket_size + 2 offs = offs + (fastio_header.seq(1).start_block - bucknr)*block_size c c Now see if offs is > bucketsize c bucknr = bucknr + offs/(fastio_header.bucket_size*block_Size)* 1 fastio_header.bucket_size offs = mod(offs,fastio_header.bucket_size*block_size) c c Now if offs > #rrec/bucker*recsiz, we need to round up c if(offs .ge. fastio_header.rel_bperbucket) then fastio_header.data_offset = fastio_header.data_offset + 1 fastio_header.bucket_size * block_size - 1 fastio_header.rel_bperbucket goto 21 endif if(bucknr .gt. fastio_header.eof_size) then istat = rms$_eof goto 90 endif c c Set rfa c fastio_header.cur_rfa.bbnr = bucknr fastio_header.cur_rfa.offset = offs c c Make sure the first byte (flag byte) is in memory c do while(fastio_header.data_offset .ge. 1 fastio_header.seq(1).nb_read) istat = dix_fastio__scroll(control,fastio_header) if(.not. istat) goto 90 enddo c c HEre is the data c p_var_data = fastio_header.seq(1).address c c Now var data points to the record c flag = var_data(fastio_header.data_offset) c if(((flag .and. rel_record) .ne. 0) .and. 1 ((flag .and. rel_deleted) .eq. 0)) then c c Got valid record and not deleted, gotit c if(.not. fastio_header.skip) goto 25 fastio_header.skip = .false. endif c c Point to the next record c fastio_header.data_offset = fastio_header.data_offset + 1 fastio_header.rel_recsiz goto 21 c c Now copy the data c 25 fastio_header.data_offset = fastio_header.data_offset + 1 c incr = fastio_header.rel_recsiz - 1 c if(fastio_header.rfm .eq. fab$c_fix) then recsiz = fastio_header.record_length else !vfc/var recsiz = 0 c c Make sure the next 2 bytes are in memory c do while(fastio_header.data_offset+1 .ge. 1 fastio_header.seq(1).nb_read) istat = dix_fastio__scroll(control,fastio_header) if(.not. istat) goto 90 enddo c c And copy the 2 bytes (the record length) c call lib$movc3(2,var_data(fastio_header.data_offset),recsiz) fastio_header.data_offset = fastio_header.data_offset + 2 incr = incr - 2 c if(fastio_header.msb) recsiz = ishftc(recsiz,8,16) if(fastio_header.rfm .eq. fab$c_vfc) then c c VFC, skip the vfc bytes, and set recsiz lower c fastio_header.data_offset = fastio_header.data_offset + 1 fastio_header.vfc_size recsiz = recsiz - fastio_header.vfc_size incr = incr - fastio_header.vfc_size endif endif c c Copy the data to the user record c istat = dix_fastio__get_copy(control,fastio_header,recsiz,incr, 1 nkar,record) c 90 dix_fastio__get_rel = istat return end function dix_fastio__get_seq(control,fastio_header,nkar,record) implicit none c c Gte data from a sequential file (all formats) c include 'dix_fastio_def.inc' record /control/ control !:i: control block record /fastio_header/ fastio_header !:io: fastion header block integer*4 nkar !:o: record length byte record(*) !:o: record data integer*4 dix_fastio__get_seq !:f: function result c# integer*4 istat,extra,recsiz,incr include '($rmsdef)' include '($fabdef)' c integer*4 dix_fastio__get_copy integer*4 dix_fastio__scroll c byte var_data(0:*) pointer (p_var_data,var_data) c byte cr,lf,prev_byte,cur_byte,search_byte parameter (lf=10,cr=13) c c Save the rfa c 10 fastio_header.cur_rfa.bbnr = fastio_header.seq(1).start_block + 1 fastio_header.data_offset/block_size fastio_header.cur_rfa.offset = 1 mod(fastio_header.data_offset,block_size) c istat = 1 nkar = 0 p_var_data = fastio_header.seq(1).address extra = 0 c if(fastio_header.rfm .eq. fab$c_fix) then c c Fixed record length file c recsiz = fastio_header.record_length incr = recsiz c elseif(fastio_header.rfm .eq. fab$c_var .or. 1 fastio_header.rfm .eq. fab$c_vfc) then c c Now copy the record length, first make sure the offset is even c if(fastio_header.data_offset) then fastio_header.data_offset = fastio_header.data_offset + 1 !align c c And recompute the rfa c fastio_header.cur_rfa.bbnr = fastio_header.seq(1).start_block + 1 fastio_header.data_offset/block_size fastio_header.cur_rfa.offset = 1 mod(fastio_header.data_offset,block_size) endif c c Get the record size c 50 recsiz = 0 c c Mak sure the next 2 bytes are in memory c do while(fastio_header.data_offset+1 .ge. 1 fastio_header.seq(1).nb_read) istat = dix_fastio__scroll(control,fastio_header) if(.not. istat) goto 90 enddo c c Get the record size c call lib$movc3(2,var_data(fastio_header.data_offset),recsiz) if(fastio_header.msb) recsiz = ishftc(recsiz,8,16) c fastio_header.data_offset = fastio_header.data_offset + 2 !skip c c Now we need to copy recsiz bytes c if(recsiz .eq. 'ffff'x) then c c Round upto next block c fastio_header.data_offset = 1 (fastio_header.data_offset/block_size + 1)*block_size goto 50 endif c if(fastio_header.rfm .eq. fab$c_vfc) then c c VFC, skipt the vfc bytes, and set recsiz lower c fastio_header.data_offset = fastio_header.data_offset + 1 fastio_header.vfc_size recsiz = recsiz - fastio_header.vfc_size endif c c And go copy the data c incr = recsiz elseif(fastio_header.rfm .eq. fab$c_stm .or. 1 fastio_header.rfm .eq. fab$c_stmcr .or. 1 fastio_header.rfm .eq. fab$c_stmlf) then c c Now for the stm type files c if(fastio_header.rfm .eq. fab$c_stm) then search_byte = lf elseif(fastio_header.rfm .eq. fab$c_stmcr) then search_byte = cr else search_byte = lf endif c c Now go looking for a terminator c prev_byte = 0 c do recsiz=1,max_buf_size c c Make sure the next byte is in memory c do while(fastio_header.data_offset .ge. 1 fastio_header.seq(1).nb_read) c c Copy this part of the buffer to the data buffer c istat = dix_fastio__scroll(control,fastio_header) if(.not. istat) goto 90 enddo c c Get the byte c cur_byte = var_data(fastio_header.data_offset) fastio_header.data_offset = fastio_header.data_offset + 1 c c See if the byte is the wanted one c if(cur_byte .eq. search_byte) then c c Got the terminator, for stm file the previous must be cr c if(fastio_header.rfm .eq. fab$c_stm) then if(prev_byte .eq. cr) then if(fastio_header.skip) goto 60 goto 90 !all done endif else if(fastio_header.skip) goto 60 goto 90 !all done endif endif c c Rememer the previous one c prev_byte = cur_byte c c And add to user buffer c nkar = nkar + 1 record(nkar) = cur_byte enddo c c Exceeded max record length c istat = rms$_rtb goto 90 else !if(fastio_header.rfm .eq. fab$c_udf) then c c Unexpected type c istat = rms$_eof endif c c 60 if(fastio_header.skip) then fastio_header.data_offset = fastio_header.data_offset + incr fastio_header.skip = .false. goto 10 endif c c Now copy the data to the user buffer c istat = dix_fastio__get_copy(control,fastio_header,recsiz,incr, 1 nkar,record) c 90 dix_fastio__get_seq = istat return end function dix_fastio__get_copy(control,fastio_header,recsiz,incr, 1 nkar,record) implicit none c c Copy the current record to the user record /bytecount c include 'dix_fastio_def.inc' record /control/ control !:i: control block record /fastio_header/ fastio_header !:io: fastio block integer*4 recsiz !:i: #byte to copy integer*4 incr !:i: amount to update.data_offset integer*4 nkar !:o: record length byte record(*) !:o: the data record integer*4 dix_fastio__get_copy !:f: function result c# byte var_data(0:*) pointer (p_var_data,var_data) c integer*4 istat integer*4 dix_fastio__scroll c c p_var_data = fastio_header.seq(1).address c istat = 1 c c Now make sure the whole record is in the buffer c do while(fastio_header.data_offset + recsiz .gt. 1 fastio_header.seq(1).nb_read) c c The total record is not in memory, now copy the part that is in memory c Now copy to record c nkar = fastio_header.seq(1).nb_read - fastio_header.data_offset if(nkar .gt. 0) then call lib$movc3(nkar,var_data(fastio_header.data_offset), 1 record) fastio_header.data_offset = fastio_header.seq(1).nb_read recsiz = recsiz - nkar incr = incr - nkar else nkar = 0 endif c c Add scroll the data (read the next chunk) c istat = dix_fastio__scroll(control,fastio_header) if(.not. istat) goto 90 enddo c c And now the rest c call lib$movc3(recsiz,var_data(fastio_header.data_offset), 1 record(nkar+1)) nkar = nkar + recsiz fastio_header.data_offset = fastio_header.data_offset + incr c c 90 dix_fastio__get_copy = istat return end c function dix_fastio_close(control,file) implicit none c c Close (and return all memory allocations) c include 'dix_fastio_def.inc' c record /control/ control !:i: cotntrol block record /file_info/ file !:io: file block integer*4 dix_fastio_close !:f: function result c# integer*4 istat,nk,k character*(max_line_length) line integer*4 sys$dassgn integer*4 lib$free_vm_page integer*4 lib$free_vm c c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c c DO we have a fastion header allocated? c if(file.ptr_fast_search .ne. 0) then p_fastio_header = file.ptr_fast_search c if((control.debug .and. debug_fastio) .ne. 0) then c c Print debug data c do k=1,max_seq_rec call sys$fao('Seq !UL start !UL end !UL hit !SL',nk,line, 1 %val(k),%val(fastio_header.seq(k).start_block), 1 %val(fastio_header.seq(k).end_block), 1 %val(fastio_header.seq(k).hit_rate)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) end do do k=1,max_prev_buckets call sys$fao('Previous bucket !UL = !UL',nk,line, 1 %val(k),%val(fastio_header.prev_buckets(k))) call dix_main_print_debug(control,debug_fastio,line(1:nk)) end do c call sys$fao('Buffer read count !10UL cache hit count !10UL', 1 nk,line, 1 %val(fastio_header.read_count), 1 %val(fastio_header.hit_count)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) call sys$fao(' File size !10UL #block read !10UL', 1 nk,line, 1 %val(fastio_header.file_size), 1 %val(fastio_header.nblocks_read)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) call sys$fao(' #seq reads !10UL #randm reads !10UL', 1 nk,line, 1 %val(fastio_header.nreads_seq), 1 %val(fastio_header.nreads_ran)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c c Close channel c if(fastio_header.channel .ne. 0) then istat = sys$dassgn(%val(fastio_header.channel)) if(.not. istat) goto 90 endif c c If ran data block allocated, return it c if(fastio_header.ran.address .ne. 0) then istat = lib$free_vm_page(fastio_header.ran_block_count, 1 %val(fastio_header.ran.address)) if(.not. istat) goto 90 endif c c If seq data block(s) allocated, return it c do k=1,max_seq_rec if(fastio_header.seq(k).address .ne. 0) then istat = lib$free_vm_page(fastio_header.seq_block_count, 1 %val(fastio_header.seq(k).address)) if(.not. istat) goto 90 end if enddo c c And finally return the fastio control block c istat = lib$free_vm(sizeof(fastio_header),fastio_header) if(.not. istat) goto 90 else istat = 1 endif c 90 dix_fastio_close = istat return end function dix_fastio__read(fastio_header,blocknr,count,address, 1 nbl_read) implicit none c c Read data in either large buffer, or short buffer c this is the real io place c include 'dix_fastio_def.inc' record /fastio_header/ fastio_header !:i: fastio header integer*4 blocknr !:I: the blocknumber wanted integer*4 count !:i: the block count wanted integer*4 address !:i: the data address integer*4 nbl_read !:o: #blocks read integer*4 dix_fastio__read !:f: function result c# include '($efndef)' include '($iodef)' c include '($ssdef)' integer*4 istat,nbyte c integer*4 sys$qiow c c Compute # bytes c nbyte = count * block_size c c Do the io c istat = sys$qiow(%val(EFN$C_ENF), 1 %val(fastio_header.channel), 1 %val(io$_readvblk), 1 fastio_header.iosbw,,, 1 address, 1 %val(nbyte),%val(blocknr),,,) if(istat) istat = fastio_header.iosbw(1) c c Word 2 and 3 contain the bytes read c call lib$movc3(4,fastio_header.iosbw(2),nbl_read) c if(istat .eq. ss$_endoffile) then c c Allow partial read c if(nbl_read .gt. 0) istat = 1 endif c c Make the bytes the blocks c nbl_read = nbl_read/block_size fastio_header.nblocks_read = fastio_header.nblocks_read + nbl_read c dix_fastio__read = istat return end function dix_fastio__read_seq(fastio_header,idx,block) implicit none c c Now update seq buffer c include 'dix_fastio_def.inc' record /fastio_header/ fastio_header !:io: the fastio header integer*4 block !:i: the block wanted integer*4 idx !:i: which seq block wanted integer*4 dix_fastio__read_seq !:f: function result c# include '($rmsdef)' c integer*4 nbl_read,istat c integer*4 dix_fastio__read c if(block .gt. fastio_header.eof_size) then istat = rms$_eof goto 90 endif c c Do the real io (min a bucket size, but max the block size) c istat = dix_fastio__read(fastio_header,block, 1 max(fastio_header.bucket_size, 1 fastio_header.seq_block_count), 1 %val(fastio_header.seq(idx).address), 1 nbl_read) c c And update the counters c fastio_header.seq(idx).start_block = block fastio_header.seq(idx).end_block = 1 fastio_header.seq(idx).start_block + 1 nbl_read-1 fastio_header.seq(idx).end_block = 1 min(fastio_header.seq(idx).end_block, 1 fastio_header.eof_size) fastio_header.seq(idx).nb_read = 1 fastio_header.seq(idx).end_block - 1 fastio_header.seq(idx).start_block + 1 fastio_header.seq(idx).nb_read = fastio_header.seq(idx).nb_read * 1 block_size if(fastio_header.seq(idx).end_block .eq. fastio_header.eof_size) then fastio_header.seq(idx).nb_read = fastio_header.seq(idx).nb_read - 1 block_size + fastio_header.ffbyte endif fastio_header.nreads_seq = fastio_header.nreads_seq + 1 c 90 dix_fastio__read_seq = istat return end function dix_fastio__read_bucket(control,fastio_header,block_nr,ptr) implicit none c c Read bucket "bucket" in and return a pointer to it c This is a fairly complicated routine. c we try to reduce the read count as much as possible c normally buckets sequentially in the file, but after a vbucket split c a bucket can be moved to a different place in the file (no longer sequential) c Initilally we do a large io to a seq buffer. c c If the wanted bucket is in memory, just return a pointer to it. c If the data is not in (on of) the seruential buffers, we c check if the wanted number is just below one of the sequential buffers. c If so, move the next chunk into memory. c If not, check if the last 3 "random" ios' were in the same chunk. c If so reuse the last used sequential buffer and do a new large io to it . c If the random io is readlly random just read one bucket in the c random io buffer, and remember the bucket number c include 'dix_fastio_def.inc' record /fastio_header/ fastio_header !:i: fastio header record /control/ control !:i: control block integer*4 block_nr !:i: lock number wanted integer*4 ptr !:o: pointer to bucket integer*4 dix_fastio__read_bucket !:f: functin result c integer*4 istat,end_block,nbl_read,nk,k,oldest character*(max_line_length) line integer*4 seq_idx c integer*4 dix_fastio__read_seq integer*4 dix_fastio__read integer*4 dix_fastio__check_sanity c c Compute #bytes wanted c See if read in random c or seqential c We assume that most buckets are sequential c but that now and then a bucket is requested that c is out of order (after a bucket split) c fastio_header.nbuckets_read = fastio_header.nbuckets_read + 1 end_block = block_nr + fastio_header.bucket_size - 1 c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' Need block !UL nblk = !UL', 1 nk,line,%val(block_nr),%val(fastio_header.bucket_size)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) do k=1,max_seq_rec call sys$fao('Seq !UL start !UL end !UL hit !SL',nk,line, 1 %val(k),%val(fastio_header.seq(k).start_block), 1 %val(fastio_header.seq(k).end_block), 1 %val(fastio_header.seq(k).hit_rate)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) end do endif c if(fastio_header.seq(1).start_block .eq. 0) then call dix_main_print_debug(control,debug_fastio, 1 'First time, user seq block 1') seq_idx = 1 goto 10 endif c c decrement all seq buffers hit count c do k=1,max_seq_rec fastio_header.seq(k).hit_rate = fastio_header.seq(k).hit_rate - 1 end do c seq_idx = 0 c c See if the watned bucket is in one of the sequential buffers c do k=1,max_seq_rec c c See if in any of the sequential blocks c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' see if in seqidx !UL block !UL-!UL', 1 nk,line, 1 %val(fastio_header.seq(k).start_block),%val(k), 1 %val(fastio_header.seq(k).end_block)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c if(fastio_header.seq(k).start_block .le. block_nr .and. 1 fastio_header.seq(k).end_block .ge. end_block) then c call dix_main_print_debug(control,debug_fastio, 1 ' Got it in this buffer ') fastio_header.hit_count = fastio_header.hit_count + 1 c c Reset the hit rate c fastio_header.seq(k).hit_rate = 0 seq_idx = k !data is in this seq block goto 50 endif end do c c Not in any of the seq in-memory block, see if sequential read c just after any of the seq blocks c c If the block falls in the next chunk, assume that c there are some missing buckets, take the seq type read c do k=1,max_seq_rec if(block_nr .gt. fastio_header.seq(k).end_block .and. 1 block_nr .le. fastio_header.seq(k).end_block + 1 fastio_header.seq_block_count) then c c Just after the 'k' seq buffer, scroll that one c seq_idx = k call dix_main_print_debug(control,debug_fastio, 1 'Second thoughts1') endif enddo c c It can also be just at the end of the previous c do k=1,max_seq_rec if(block_nr .le. fastio_header.seq(k).end_block .and. 1 end_block .ge. fastio_header.seq(k).end_block) then seq_idx = k call dix_main_print_debug(control,debug_fastio, 1 'Second thoughts2') endif enddo c c Now seq_idx c >0, read data to 'idx_seq' serq buffer c =0, try randow io c 10 if(seq_idx .ne. 0) then c c Read to here c c c Do a seq read, this will read a lot of blocks in memory c istat = dix_fastio__read_seq(fastio_header,seq_idx,block_nr) c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' Need seq-Read block =!UL to seq'// 1 ' buffer !UL nbl = !UL', 1 nk,line,%val(block_nr),%vaL(seq_idx), 1 %val(fastio_header.seq_block_count)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c c Now the end block should be in memory, if not abort c if(fastio_header.seq(seq_idx).end_block .ge. end_block) goto 50 c else c c Sequential read not logical c if the last "max_prev_buckets" random reads are in the same block c we assume there is a new sequential stream started c call dix_main_print_debug(control,debug_fastio, 1 'Not seq, see if last random reads in the same block') c do k=1,max_prev_buckets if(fastio_header.prev_buckets(k) .eq. 0) goto 32 if(iabs(fastio_header.prev_buckets(k) -block_nr) .gt. 1 fastio_header.seq_block_count/2) goto 32 end do c c Now all the last "n" buckets are in a single seq_block c get the last used seqential block, and read that one c seq_idx = 0 oldest = fastio_header.seq(1).hit_rate c c The first is always in use c do k=max_seq_rec,2,-1 if(fastio_header.seq(k).start_block .eq. 0) seq_idx = k if(fastio_header.seq(k).hit_rate .lt. 1 fastio_header.seq(oldest).hit_rate) oldest = k end do c if(seq_idx .eq. 0) seq_idx = oldest c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' Oldest seq block = !UL, reuse that one', 1 nk,line,%val(seq_idx)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c c Now seq_idx is the index of the last used seq buffer c goto 10 c c Random blocks not in order, go for the random io c Remember the last "n" block_nrs for random io c Scroll the remember area, and store this buvcket number c 32 do k=max_prev_buckets,2,-1 fastio_header.prev_buckets(k) = fastio_header.prev_buckets(k-1) end do fastio_header.prev_buckets(1) = block_nr c if((control.debug .and. debug_fastio) .ne. 0) then call sys$fao(' Need ran-Read block =!UL nbl = !UL', 1 nk,line,%val(block_nr), 1 %val(fastio_header.bucket_size)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c c Do a raed (only one bucket full of data) c istat = dix_fastio__read(fastio_header,block_nr, 1 fastio_header.bucket_size, 1 %val(fastio_header.ran.address), 1 nbl_read) fastio_header.nreads_ran = fastio_header.nreads_ran + 1 if(nbl_read .eq. fastio_header.bucket_size) goto 50 endif c c Something strange happend, we could not get the whoe bucket in memory c this is fatal c write(*,*) 'Out of buffer' istat = 0 goto 90 c c Now set the pointer to the right peice of memory c c 50 if(seq_idx .ne. 0) then c c Is was in one of the seq buffers c ptr = fastio_header.seq(seq_idx).address + 1 (block_nr - fastio_header.seq(seq_idx).start_block)* 1 block_size else c c It is in the random buffer c ptr = fastio_header.ran.address endif c c Now see itf the bucket is "sane" c istat = dix_fastio__check_sanity(fastio_header, 1 %val(ptr),block_nr,seq_idx) c c Return result c 90 dix_fastio__read_bucket = istat return end function dix_fastio__check_sanity(fastio_header,bucket,blnr,idx) implicit none c c See if the bucket is valid c if not reread the datablock, and try again c if still not valid, abort c include 'dix_fastio_def.inc' record /fastio_header/ fastio_header !:i: fastio header record /bucket/ bucket !:i: the bucket integer*4 blnr !:i: the bucker number integer*4 idx !:i: the index block to read integer*4 dix_fastio__check_sanity !:f: function result c include '($rmsdef)' c integer*4 dix_fastio__read_seq integer*4 dix_fastio__read integer*4 istat,nbl_read c istat = 1 c c See if bucket number is present (low 16 bits) c if(zext(bucket.hdr.check_vbn) .ne. (blnr .and. 'ffff'x)) goto 50 c c Now see if first byte and last btye of bucket are the same c if(bucket.hdr.check .eq. 1 bucket.data(fastio_header.bucket_size*block_size)) goto 90 c c Invalid bucket, try to read again c 50 fastio_header.n_rereads = fastio_header.n_rereads + 1 c if(idx .eq. 0) then istat = dix_fastio__read(fastio_header,blnr, 1 fastio_header.bucket_size, 1 %val(fastio_header.ran.address), 1 nbl_read) else istat = dix_fastio__read_seq(fastio_header,idx, 1 fastio_header.seq(idx).start_block) if(.not. istat) goto 90 endif c c Now chekc again c c See if bucket number is present (low 16 bits) c if(zext(bucket.hdr.check_vbn) .ne. (blnr .and. 'ffff'x)) goto 70 c c Now see if first byte and last btye of bucket are the same c if(bucket.hdr.check .eq. 1 bucket.data(fastio_header.bucket_size*block_size)) goto 90 c c Somethinbg rotten (in the state on danemark) c 70 istat = rms$_chk c 90 dix_fastio__check_sanity = istat return end subroutine dix_fastio__uncompress_key(fastio_header,data,bpos, 1 ptr_key) implicit none include 'dix_fastio_def.inc' c c Uncompress the key to the fastion_header c record /fastio_header/ fastio_header !:i: fastio header byte data(*) !:i: the data integer*4 bpos !:o: start pos of rest of data integer*4 ptr_key !:o: pointer to key c# logical*4 compress integer*4 nb_k,nb_d,k byte last_byte c compress = (fastio_header.prim_key.flags .and. 1 key_flag_key_compr) .ne. 0 c c Check if the key is compressed c if(compress) then c c If Key is compressed, move (and decompress) it to fastio_header.keyval c c the layout is c byte c 1 : total length of key data c 2 : length count from the previous key value c 3..nn : the key data c if the total length of the key is < nk_key, repeat the last char c nb_k = data(1) !total byte count nb_d = zext(data(2)) !get length bpos = 3 !used byte 1/2 c c Now move the real keydata c call lib$movc3(nb_k,data(3),fastio_header.keyval(nb_d)) nb_d = nb_d + nb_k bpos = bpos + nb_k c c it the total length still is too short (0 and not yet used c do k=1,max_segments if(flags(k)) then if(zext(fastio_header.prim_key.keypos(k)) .lt. minval) then minval = zext(fastio_header.prim_key.keypos(k)) !remember minimum value kidx = k !and index end if end if end do if(minval .lt. max_buf_size) then c c We have found a key_segment c flags(kidx) = .false. !do not use this one again c c Now insert keysegment (kidx) c get the position in the keybuffer c kpos = 0 ksiz = zext(fastio_header.prim_key.keysize(kidx)) do k=1,kidx-1 kpos = kpos + zext(fastio_header.prim_key.keysize(k)) end do c c The keydata is in key(pos:pos+sizes(kidx)) c insert in data buffer c pos = zext(fastio_header.prim_key.keypos(kidx)) !the size in the data buffer if(nb .lt. pos) then c c We have data in the record buffer before the current key-segment c copy it c call lib$movc3(pos-nb,recdata(recpos),record(nb+1)) recpos = recpos + pos-nb nb = nb + pos-nb endif c c Now copy the key c call lib$movc3(ksiz,key_data(kpos),record(nb+1)) nb = nb + ksiz goto 50 endif c c Now see it there is still data in the buffer c if(recpos .lt. nb_rec) then c c Append the trailing data c call lib$movc3(nb_rec-recpos,recdata(recpos),record(nb+1)) nb = nb + nb_rec-recpos endif return end function dix_fastio__scroll(control,fastio_header) implicit none c c Take the next piece of file to sequential buffer #1 c this is used for rel/seq files. In this case we only use c one seq_buffer and no random buffer c include 'dix_fastio_def.inc' record /control/ control !:i: control block record /fastio_header/ fastio_header !:io: fastio header integer*4 dix_fastio__scroll !:f: function result c integer*4 k,istat,nk,nb character*(max_line_length) line integer*4 dix_fastio__read_seq c k = fastio_header.seq(1).nb_read if((control.debug .and. debug_fastio) .ne. 0) then nb = max(fastio_header.bucket_size,fastio_header.seq_block_count) call sys$fao(' Need seq_read blnr=!UL nbl = !UL', 1 nk,line,%val(fastio_header.seq(1).end_block+1),%val(nb)) call dix_main_print_debug(control,debug_fastio,line(1:nk)) endif c istat = dix_fastio__read_seq(fastio_header,1, 1 fastio_header.seq(1).end_block + 1) fastio_header.data_offset = 1 fastio_header.data_offset - k c dix_fastio__scroll = istat return end subroutine dix_fastio_return_rfa(file,rfa) implicit none c c Retrun the fastio rfa c include 'dix_fastio_def.inc' record /file_info/ file record /rfa/ rfa c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c p_fastio_header = file.ptr_fast_search rfa = fastio_header.cur_rfa return end subroutine dix_fastio_get_recnr(file) implicit none c c Return the record number to the file c include 'dix_fastio_def.inc' record /file_info/ file !:io: file block c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c p_fastio_header = file.ptr_fast_search file.rec_nr = fastio_header.recnr return end subroutine dix_fastio_show_vm(control,file) implicit none c c Display info about vm c include 'dix_fastio_def.inc' record /control/ control record /file_info/ file c record /vm_zone/ vm_zone c integer*4 nk,k character*(max_line_length) line c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c vm_zone.magic = magic_vm_zone c if(file.ptr_fast_search .ne. 0) then call dix_dump_print_line(control,1,'FASTIO buffers') p_fastio_header = file.ptr_fast_search vm_zone.nb_alloc = fastio_header.seq_block_count*block_size vm_zone.n_alloc = fastio_header.seq_block_count vm_zone.n_dealloc = 0 vm_zone.nb_dealloc= 0 do k=1,fastio_header.n_seq_buf vm_zone.zone = fastio_header.seq(k).address call sys$fao('Seq buffer !UL',nk,line,%val(k)) vm_zone.name = line(1:nk) call dix_util_show_vm1(control,vm_zone,.false.,2) enddo vm_zone.nb_alloc = fastio_header.ran_block_count*block_size vm_zone.n_alloc = fastio_header.ran_block_count vm_zone.name = 'Random buffer' call dix_util_show_vm1(control,vm_zone,.false.,2) endif return end subroutine dix_fastio_stats_init(control,file) implicit none c include 'dix_fastio_def.inc' record /control/ control record /file_info/ file !:i: the file block c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c integer*4 addr c if(file.ptr_fast_search .eq. 0) then c call get_vm(control,sizeof(fastio_header),addr, 1 control.zone_file, 1 .true.,'FASTIO_HDR') p_fastio_header = addr file.ptr_fast_search = p_fastio_header endif c 10 p_fastio_header = file.ptr_fast_search c fastio_header.read_count = 0 fastio_header.hit_count = 0 fastio_header.nblocks_read = 0 fastio_header.nreads_seq =0 fastio_header.nreads_ran =0 fastio_header.nbuckets_read = 0 c return end subroutine dix_fastio_stats_show(control,file) implicit none include 'dix_fastio_def.inc' record /control/ control record /file_info/ file !:i: the file block c record /fastio_header/ fastio_header pointer (p_fastio_header,fastio_header) c character*(max_line_length) line integer*4 nk c if(control.search_flags .eq. 0) goto 90 c p_fastio_header = file.ptr_fast_search c if(fastio_header.channel .eq. 0) goto 90 c call dix_dump_print_line(control,0,'FASTIO statistics') call sys$fao('!UL Seq buffers of !UL blocks, #IO=!UL', 1 nk,line, 1 %val(fastio_header.n_seq_buf), 1 %val(fastio_header.seq_block_count), 1 %val(fastio_header.nreads_seq)) call dix_dump_print_line(control,2,line(1:nk)) c call sys$fao('!UL Seq buffers of !UL blocks, #io = !UL', 1 nk,line, 1 %val(1), 1 %val(fastio_header.ran_block_count), 1 %val(fastio_header.nreads_ran)) call dix_dump_print_line(control,2,line(1:nk)) c call sys$fao('Total blocks read !UL, file size = !UL', 1 nk,line, 1 %val(fastio_header.nblocks_read), 1 %val(fastio_header.file_size)) call dix_dump_print_line(control,2,line(1:nk)) 90 return end