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 (<nb_key)
c  use the last byte as filler
c
	  last_byte = fastio_header.keyval(nb_d-1)
	  do k=nb_d,fastio_header.nb_key
	    fastio_header.keyval(nb_d) = last_byte
	    nb_d = nb_d + 1
	  enddo
c
c return the pointer rto the fastio_header.keyval
c
	  ptr_key = %loc(fastio_header.keyval)
	else
c
c Key is not compressed, return the pointer rto the data 
c
	  ptr_key = %loc(data(1))
	  bpos = fastio_header.nb_key + 1
	endif
	return
	end
c
	subroutine dix_fastio__copy_data(fastio_header,nb_data,data,
     1             ptr_key,nb,record)
	implicit none
c
c copy index record to user
c First see about uncompressing  record data
c
	include 'dix_fastio_def.inc'
	record /fastio_header/ fastio_header	!:i: fastio header
	integer*4 nb_data			!:i: #bytes in record
	integer*4 ptr_key			!:i: pointert to key
	byte data(*)                            !:i: the data
	integer*4 nb				!:o: record length
	byte record(*)				!:o: the data
c#
	byte       key_data(0:*)
	pointer (p_key_data,key_data)
c
	byte tempdata(0:max_buf_size)
c
	logical*4 flags(max_segments)
c
	byte recdata(0:*)
	pointer (p_recdata,recdata)
c
	integer*4 nb_d,rep_count,k,bpos,nb_rec
	integer*4 minval,kidx,kpos,ksiz,recpos,pos
	byte last_byte
	logical*4 compress
c
c The layout in the data buffer is
c  key
c  recorddata (minus key data)
c
c Both fields can be compressed or not
c
c data(bpos) is the first byte of the record data 
c  if can be compressed or not
c
	p_key_data = ptr_key
c
	compress = (fastio_header.prim_key.flags .and. 
     1              key_flag_rec_compr) .ne. 0
	if(compress) then
c
c Move (and uncompress) the data to recdata
c The layout is
c  word_count 		!total length of this part upto and including filler
c  uncompresseddata	!record data
c  fillercount		!repear 'fillercount' times the last byte
c
c  And this structure is repeated as long as there is data in data(1:nb_data)
c
	  nb_rec = 0	!no data in record yet
c
	  bpos = 1
	  do while(bpos .lt. nb_data)
c
c Get the byte count (2 byte word)
c
	    nb_d = 0
	    call lib$movc3(2,data(bpos),nb_d)
	    bpos = bpos + 2	!we used two bytes
c
c Now move the data to the target
c
	    call lib$movc3(nb_d,data(bpos),tempdata(nb_rec))
	    bpos = bpos + nb_d 	!we used another nb_d bytes
	    nb_rec = nb_rec + nb_d
c
c  Now the next byte in data is a fillercount
c  The last byte in tempdata must be repeated 'fillercount' times
c
	    last_byte = tempdata(nb_rec-1)	!last byte in buffer
	    rep_count = zext(data(bpos))!repeat count
	    bpos = bpos + 1		!we used another byte
c
c Now fill out the filler data
c 
	    do k=1,rep_count
	      tempdata(nb_rec) = last_byte
	      nb_rec = nb_rec + 1
	    end do
	  end do
c
c And point to the temp data buffer
c
	  p_recdata = %loc(tempdata)
	else
c
c Data is not compressed, use the data from the original buffer
c
	  nb_rec = nb_data
	  p_recdata = %loc(data)
	endif
c
c Now 
c   keyval contais nb_key bytes of keydata
c   recdata containt nb_rec bytes of record data
c
c Now combine the record data and the key data
c
	nb     = 0	!no bytes yet
	recpos = 0	!no bytes used from recdata
c
	do k=1,max_segments
	  flags(k) = fastio_header.prim_key.keysize(k) .gt. 0
	enddo
c
c Find the key-segment with the lowest offset
c
50	minval = max_buf_size+10
c
c Go through all segments that have a length >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