c
c The RMS library, all access to the files
c  in inside this module
c
 	function dix_rms_open(control,file)
	implicit none
c
c Open the file
c there is a little platform dependend code
c  the vax uses nam blocks
c  the alpha/ipf uses naml blocks
c
	include 'dix_def.inc'
	record /control/ control	!:io: control block
	record /file_info/ file		!:io: file structure
	integer*4 dix_rms_open		!:f: functio result
c#
	include '($rabdef)'
	include '($fabdef)'
c
	record /fabdef/ fab
	pointer (p_fab,fab)
c
	record /fabdef/ fabmod
	pointer (p_fabmod,fabmod)
c
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	record /rabdef/ rabmod
	pointer (p_rabmod,rabmod)
c
	character*(max_filename_length) resnam
c
	integer*4 istat
	integer*4 sys$open,sys$connect
	integer*4 dix_rms_fill_keyinfo
	external dix_msg_filnotop
c
	include '($xabkeydef)'
	record /xabkeydef/ xabkey
	include '($xabsumdef)'
	record /xabsumdef/ xabsum
	include '($xabfhcdef)'
	record /xabfhcdef/ xabfhc
c
	call get_vm(control,sizeof(fab   ),p_fab   ,
     1               control.zone_file,.true.,'FAB')
	file.fabadr = p_fab
c
	call get_vm(control,sizeof(rab   ),p_rab   ,
     1              control.zone_file,.true.,'RAB')
	file.rabadr = p_rab
c
	file.ptr_fast_search = 0
	file.search_block_size = control.search_block_size
c
	if(file.modify) then
c
c Open the file a second time 
c
	  call get_vm(control,sizeof(fabmod),p_fabmod,
     1                control.zone_file,.true.,'FABMOD')
	  file.fabmod = p_fabmod
c
	  call get_vm(control,sizeof(rabmod),p_rabmod,
     1                control.zone_file,.true.,'RABMOD')
	  file.rabmod = p_rabmod
	else
	  file.fabmod = 0
	  file.rabmod = 0
	endif
c
c Init nam block depending on platform
c the code is in two files
c dix_rms_library_not_vax  for aplha/ipf
c dix_rms_library_vax      for vax
c
	call dix_rms_init_nam(fab,file.fnam(1:file.nk_fnam),resnam)
c
	fab.fab$b_bln = fab$c_bln
	fab.fab$b_bid = fab$c_bid
c
	rab.rab$b_bln = rab$c_bln
	rab.rab$b_bid = rab$c_bid
c
	rab.RAB$L_CTX    = %loc(file)		!backlink
c
	file.err_seen = 1		!successstatus
	file.rewound  = .true.
c
	if(.not. file.modify) then
	  fab.fab$b_fac    = fab$m_get
	  fab.fab$b_shr =    fab$m_shrput .or. fab$m_shrget .or.
     1                       fab$m_shrupd .or. fab$m_shrdel
	else
	  fab.fab$b_fac    = fab$m_get .or. fab$m_put .or. fab$m_upd .or. 
     1                       fab$m_trn .or. fab$m_del
	  fab.fab$b_shr =    fab$m_shrput .or. fab$m_shrget .or.
     1                       fab$m_shrupd .or. fab$m_shrdel 
	end if
c
	if(file.block_size .ne. 0) then
c
c BLockmode
c
	  fab.fab$b_fac    = fab.fab$b_fac    .or. fab$m_bio 
	  fab.fab$b_shr    = fab.fab$b_shr    .or. fab$m_upi
	  file.minrecl = 512*file.block_size
	  file.maxrecl = 512*file.block_size
	  file.nb_vfc = zext(fab.fab$b_fsz)
	else
	  file.minrecl = 0
	end if
c
	call dix_main_print_debug(control,debug_file,
     1        'Opening file '//file.fnam(1:file.nk_fnam))
	call dix_main_print_debug(control,debug_file,'  SYS$OPEN fab ')
c
	if(file.modify) then
	  fabmod = fab
	  rabmod = rab
	endif
c
	istat = sys$open(fab,,)
	if(istat) then
c
c
c For modify files, open the second fab, this cannot go wrong??
c
	  if(file.modify) then
	    call dix_main_print_debug(control,debug_file,
     1            '  SYS$OPEN fabmod')
c
	    istat = sys$open(fabmod,,)
	    if(.not. istat) call dix_message(control,%val(istat))
	  endif
c
c Get some extra info of this file
c
	  if(file.block_size .eq. 0) then
	    file.maxrecl = zext(fab.fab$w_mrs)
	  end if
	  file.indexed  = fab.fab$b_org .eq. fab$c_idx
 	  file.relative = fab.fab$b_org .eq. fab$c_rel
	  file.fixed    = fab.fab$b_rfm .eq. fab$c_fix
c
c
	  call dix_rms_fill_xab(fab,xabfhc,xab$c_fhc,xab$k_fhclen)
	  file.filesize = xabfhc.xab$l_ebk
	  if(file.filesize .gt. 0 .and. xabfhc.xab$w_ffb .eq. 0) then
	    file.filesize = file.filesize - 1
	  endif
	  file.rec_nr  = 0
	  file.cur_key = 0
c
	  file.ptr_keyinfo = 0
	  if(file.indexed) then
	    file.bucket_size = zext(fab.fab$b_bks)
	    if(file.block_size .eq. 0) then
	      call dix_rms_fill_xab(fab,xabkey,xab$c_key,xab$k_keylen)
	      file.minrecl = xabkey.xab$w_mrl
	    end if
	    call dix_rms_fill_xab(fab,xabsum,xab$c_sum,xab$k_sumlen)
	    file.nkey    = xabsum.xab$b_nok
c
c Build up keyinfo structures
c
            istat = dix_rms_fill_keyinfo(control,file)
            if(.not. istat) call dix_message(control,%val(istat))
	  else
	    file.nkey = 0
	    file.bucket_size = 0
	  end if
c
c Connect rabadr
c
	  call dix_main_print_debug(control,debug_file,'  SYS$CONNECT rab ')
	  rab.rab$l_fab = p_fab
	  istat = sys$connect(rab,,)
	  if(.not. istat) call dix_message(control,%val(istat))
	  if(file.modify) then
	    call dix_main_print_debug(control,debug_file,
     1                   '  SYS$CONNECT rabmod')
	    rabmod.rab$l_fab = p_fabmod
	    istat = sys$connect(rabmod,,)
	    if(.not. istat) call dix_message(control,%val(istat))
	  endif	  
c
c If file is openend in modify mode, open a second stream also for 
c  updates/deletes
c
	else
c
c Open went wrong, tel user
c
	  call dix_message(control,dix_msg_filnotop,file.fnam(1:file.nk_fnam))
	  call dix_message(control,%val(fab.fab$l_sts))
	  call dix_message(control,%val(fab.fab$l_stv))
	  dix_rms_open = .false.
	  call free_vm(control,sizeof(fab),   p_fab,   control.zone_file)
	  call free_vm(control,sizeof(rab)   ,p_rab,   control.zone_file)
	  file.fabadr = 0
	  file.rabadr = 0
	  file.namadr = 0
	end if
	dix_rms_open = istat
	return
	end
	subroutine dix_rms_close(control,file)
	implicit none
c
	include 'dix_def.inc'
	include '($fabdef)'
	include '($rabdef)'
	record /control/ control
	record /file_info/ file
c#
	integer*4 istat,k
	integer*4 sys$close
c
	record /rabdef/ rab
	pointer (p_rab,rab)
	record /fabdef/ fab
	pointer (p_fab,fab)
c
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
	call dix_main_check_mod_record(control,file)
c
	call dix_main_print_debug(control,debug_file,
     1        'Closing file '//file.fnam(1:file.nk_fnam))
c
	if(file.fabadr .ne. 0) then
c
c First delete all key_info blocks (if there)
c
	  p_key_info = file.ptr_keyinfo
	  do while(p_key_info .ne. 0) 
c
c Save the pointer to the next
c
	    k = key_info.link.forw
	    call free_vm(control,sizeof(key_info),p_key_info,control.zone_file)
	    p_key_info = k    !ret the next block
	  end do
c
	  call dix_main_print_debug(control,debug_file,'  SYS$CLOSE fab ')
	  p_fab = file.fabadr
	  istat = sys$close(fab)
	  if(.not. istat) call dix_message(control,%val(istat))
	  call free_vm(control,sizeof(fab),p_fab,control.zone_file)
	  p_rab = file.rabadr          
	  call free_vm(control,sizeof(rab),p_rab,control.zone_file)
c
	  if(file.modify) then
c
c Close the *mod also
c
	    call dix_main_print_debug(control,debug_file,'  SYS$CLOSE fabmod')
	    p_fab = file.fabmod
	    istat = sys$close(fab)
	    if(.not. istat) call dix_message(control,%val(istat))
	    call free_vm(control,sizeof(fab),p_fab,control.zone_file)
	    p_rab = file.rabmod
	    call free_vm(control,sizeof(rab),p_rab,control.zone_file)
	  endif
	endif
c
	return
	end
	function dix_rms_change_modify(control,file,modify)
	implicit none
c
c Change the modify mode
c
	include 'dix_def.inc'
	record /control/ control
	record /file_info/ file
	logical*4 modify
	integer*4 dix_rms_change_modify
c
	include '($rabdef)'
c
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	integer*4 istat,keynr
	integer*2 rfa(3)
c
	integer*4 dix_rms_close
	integer*4 dix_rms_open
	integer*4 dix_rms_get_rfa
c
	external dix_msg_filalrmod
	external dix_msg_filnotmod
c
c If file in modify, change it to readonly
c
	if(modify) then
	  if(file.modify) then
	    call dix_message(control,dix_msg_filalrmod,
     1                       file.fnam(1:file.nk_fnam))
	    goto 90
	  endif
	else
	  if(.not. file.modify) then
	    call dix_message(control,dix_msg_filnotmod,
     1                       file.fnam(1:file.nk_fnam))
	    goto 90
	  endif
	endif
c
c Save the rfa
c
	keynr = file.cur_key 
	p_rab = file.rabadr
	call dix_rms_copy_rfa(rab.rab$w_rfa,rfa)
c
c Close the file
c
	call dix_rms_close(control,file)
c 
c  Reopen the file
c
	file.modify = modify
	istat = dix_rms_open(control,file)
c
c And get the rfa back
c
	if(istat) then
	  istat = dix_rms_get_rfa(control,file,keynr,rfa)
	endif
c
90	dix_rms_change_modify = istat
	return
	end
c
	function dix_rms_rewind(control,file,key)
	implicit none
c
c
	include '($rabdef)'
	include 'dix_def.inc'
c
	integer*4 control
	record /file_info/ file
	integer*4 key
	integer*4 dix_rms_rewind
c#
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	integer*4 sys$rewind,istat
c
	call dix_main_print_debug(control,debug_file,
     1        'Rewind file '//file.fnam(1:file.nk_fnam))
c
	p_rab = file.rabadr
c	if(key .ge. 0) rab.rab$b_krf = key
cfortran has signed bytes
	if(key .ge. 0) call lib$movc3(1,key,rab.rab$b_krf)
	rab.rab$l_rop = 0
c
c
	call dix_main_print_debug(control,debug_file,'  SYS$REWIND rab')
	rab.rab$l_bkt = 0
	istat = sys$rewind(rab,,)
	if(key .ge. 0) file.cur_key = key
c
c Set record number 0 unless indexed and key>0, set to undefined
c
	if(file.indexed .and. file.cur_key .ne. 0) then
	  file.rec_nr = -1	!signal dont know
	else
	  file.rec_nr = 0	!set to 0
	endif
	file.got_record   = .false.
	file.rewound      = .true.
	file.data.nb_data = 0
	file.data.nb_sav  = 0
	file.data.nb_vfc  = 0
c
c  Mark all desciptions as not expanded
c
	call dix_des_inv_des(control,file)
	dix_rms_rewind    = istat
	return
	end

	subroutine dix_rms_get_reclen(rab,minrecl,maxrecl,nkey)
	implicit none
c
c Get info from file (min/max recordlength and number of keys)
c
	include '($rabdef)'
	record /rabdef/ rab		!:i: the rab
	integer*4 minrecl		!:o: min record length
	integer*4 maxrecl		!:o: max record length
	integer*4 nkey			!:o: #keys
c#
	include '($fabdef)'
	include '($xabkeydef)'
	record /xabkeydef/ xab
	include '($xabsumdef)'
	record /xabsumdef/ xabsum
	record /fabdef/ fab
	pointer(p_fab,fab)
c
c First get the fab
c
	p_fab = rab.rab$l_fab
c
	maxrecl = fab.fab$w_mrs
	if(fab.fab$b_org .ne. fab$c_idx) then
	  minrecl = 0
	  nkey = 0
	else
c
c Make xab key
c
	  call dix_rms_fill_xab(fab,xab,xab$c_key,xab$k_keylen)
	  minrecl = xab.xab$w_mrl
c
	  call dix_rms_fill_xab(fab,xabsum,xab$c_sum,xab$k_sumlen)
	  nkey = xabsum.xab$b_nok
	end if

	return
	end
	function dix_rms_reget_rfa(control,rab,file,check)
	implicit none
c
c function; reread the record in the current record to rfa
c always to key0
c
	include 'dix_def.inc'
	include '($rabdef)'
	include '($rmsdef)'
	record /control/ control
	record /rabdef/ rab
	record /file_info/ file
	logical check			!check if buffer changed
	integer*4 dix_rms_reget_rfa
c
c#
	integer*4 dix_main_question
	integer*4 istat,nk_rfa
	integer*4 sys$get
	logical*4 is_term
c
	record /data_info/ data
	integer*2 rfa(3)
	character*30 rfaasc
c
	integer*4 dix_dump_record_changed
c
c For non indexed file, the get is simply a read /rfa
c
	if((control.debug .and. debug_file) .ne. 0) then
	  call dix_rms_rfa_asc(rab.rab$w_rfa,nk_rfa,rfaasc)
	  call dix_main_print_debug(control,debug_file,
     1        'Reget RFA '//rfaasc(1:nk_rfa)//' for file '//
     1        file.fnam(1:file.nk_fnam))
	endif
c
	if(check) data = file.data
c
c The $GET will clear the RFA is an error occurs
c  save the rfa, so we can reset if
c
	call dix_rms_copy_rfa(rab.rab$w_rfa,rfa)
c
	rab.rab$l_ubf = %loc(data.data_rec)
	rab.rab$l_rhb = %loc(data.vfc_data)
	rab.rab$w_usz = max_buf
	rab.rab$b_rac = rab$c_rfa
	rab.rab$l_kbf = 0
	rab.rab$b_ksz = 0
	rab.rab$l_rop = 0
c
	is_term = control.is_term
c
10	call dix_main_print_debug(control,debug_file,'  SYS$GET RAB ')
	istat = sys$get(rab,,)
c
c Record can be locked, asked if the wants to retry
c 
	if(istat .eq. rms$_rlk) then
c
c Reset rfa
c
	  call dix_rms_copy_rfa(rfa,rab.rab$w_rfa)
c
c Default answer is .true. is on a terminal, .false. if in batch
c
	  if(dix_main_question(control,'Record locked, '//
     1         'Retry ',is_term)) goto 10
	endif
c
	if(istat) then
c
c
	  if(check) then
	    data.nb_data = zext(rab.rab$w_rsz)
	    data.nb_vfc  = file.data.nb_vfc
	    if(dix_dump_record_changed(data)) then
c
c Default answer is .true. is on a terminal, .false. if in batch
c
	      istat = dix_main_question(control,
     1          'Record changed after last read (oplock) '//
     1          ' Continue',is_term)
	    endif
	  endif
	  if(.not. istat) then
	    call dix_main_print_debug(control,debug_file,
     1             '  SYS$RELEASE RAB ')
	    call sys$release(rab,,)
	  endif
	endif
	dix_rms_reget_rfa = istat
	return
	end

	function dix_rms_skip(control,file,nrec)
	implicit none
c
c SKip to record "nrec" for the file
c first do a rewind, and then read "nrec" records
c
c Sinc this can take a while, give a message every second
c about the progress
c
	include '($rabdef)'
	include '($rmsdef)'
	include 'dix_def.inc'	
	record /control/ control       	!:i: the control block
	record /file_info/ file		!:i: the file block
	integer*4 nrec			!:i: skip to record "nrec"
	integer*4 dix_rms_skip		!:f: function result
c#
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	character*(max_int_asc_length) temp
c
	real*4 timstart
	logical showed_mes
	byte data(3)
	integer*4 k,istat,nk_temp
c
	integer*4 sys$get
	integer*4 sys$rewind
	external dix_msg_skipping
c
c Set filepointer to nth record
c
	p_rab = file.rabadr
c
c
	showed_mes = .false.
	timstart = secnds(0.0)
c
c Rewind the file
c
	if((control.debug .and. debug_file) .ne. 0) then
	  nk_temp = 0
	  call sys$fao('!UL',nk_temp,temp,%val(nrec))
	endif
	call dix_main_print_debug(control,debug_file,
     1        'Skipping '//temp(1:nk_temp)//' '//
     1         file.fnam(1:file.nk_fnam))
c
	file.rewound = .true.
	file.got_record = .false.
c
	rab.rab$l_rop = 0
	rab.rab$l_bkt = 0
	call dix_main_print_debug(control,debug_file,'  SYS$REWIND rab')
	istat = sys$rewind(rab,,)
c
c And now skip
c
	call dix_main_print_debug(control,debug_file,
     1        '  Skipping '//temp(1:nk_temp)//' records ')
c
	rab.rab$l_ubf = %loc(data)
	rab.rab$w_usz = 1
	rab.rab$l_rop = rab$m_rrl		!Set rrl
c
	do k=1,nrec
	  if(.not. showed_mes) then
	    if(secnds(timstart) .gt. 1.0) then
	      call dix_message(control,dix_msg_skipping,%val(nrec))
	      showed_mes = .true.
	    endif
	  endif	
c
	  istat = sys$get(rab,,)
c
	  if(.not. istat) then
	    if(istat .ne. rms$_rtb) then
c
c Error is not record to big, if eof reached change error to record not found
c
	      if(istat .eq. rms$_eof) istat = rms$_rnf
	      goto 90
	    end if
	  end if
c
c Update recnr only if record number known >= 0
c
	  if(file.rec_nr .ge. 0) file.rec_nr = file.rec_nr + 1
	end do
c
90	dix_rms_skip = istat
c
c
c  Mark all desciptions as not expanded
c
	call dix_des_inv_des(control,file)
c
	return
	end

	function dix_rms_get(control,file)
c
	implicit none
c
	include '($rabdef)'
	include 'dix_def.inc'
	integer*4 control
	record /file_info/ file
	integer*4 dix_rms_get
c#
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	integer*4 istat
	integer*4 dix_rms_sys_get
	integer*4 sys$read
	external dix_msg_nocurrec
c
	p_rab    = file.rabadr
c
	call dix_main_print_debug(control,debug_file,
     1        'Get next record '//file.fnam(1:file.nk_fnam))
c
c First check is unmodified data present
c
	if(.not. (file.got_record .or. file.rewound)) then
	  istat = %loc(dix_msg_nocurrec)
	  goto 90
	endif
c	  
	call dix_main_check_mod_record(control,file)
c
c Fill with 0's
c
	call dix_util_fill(0,max_buf,file.data.data_rec)
c
	rab.rab$l_rop = 0
	rab.rab$l_ubf = %loc(file.data.data_rec)
	rab.rab$l_rhb = %loc(file.data.vfc_data)
	if(file.block_size .eq. 0) then
c
c Record io
c
	  rab.rab$b_rac = rab$c_seq
	  rab.rab$w_usz = max_buf
c
c Get the data
c
          call dix_main_print_debug(control,debug_file,
     1        '  Getting rec '//file.fnam(1:file.nk_fnam))
	  istat = dix_rms_sys_get(control,rab,file)
	else
c
c Block io
c
	  rab.rab$w_usz = file.block_size*512
	  if(rab.rab$l_bkt .eq. 0) then
	    rab.rab$l_bkt = 1
	  else
	    rab.rab$l_bkt = rab.rab$l_bkt + file.block_size
	  end if
          call dix_main_print_debug(control,debug_file,
     1        '  Reading rec '//file.fnam(1:file.nk_fnam))
	  istat = sys$read(rab,,)
	end if
c
	if(.not. istat) then
c
c error; give sone messages, and restore rfa
c
	  file.got_record   = .false.
	  file.data.nb_data = 0
	  file.data.nb_vfc  = 0
	else
	  file.got_record   = .true.
	  file.data.nb_data = zext(rab.rab$w_rsz)
	  file.data.nb_vfc  = file.nb_vfc
	  if(file.rec_nr .ge. 0) file.rec_nr = file.rec_nr + 1
	  call dix_dump_copy(file)
	end if
c
90	dix_rms_get = istat
c
c  Mark all desciptions as not expanded
c
	call dix_des_inv_des(control,file)
	return
	end

	function dix_rms_get_keyed(control,file,keyopt,nb_key,
     1                             key,key_nr)
c
	implicit none
c
c try to read on alternate file (to keep record contents)
c if successfull read on normal rab
c
	include '($rabdef)'
	include 'dix_def.inc'
	integer*4 control
	record /file_info/ file
c#
	integer*4 keyopt		!key option key_opt_xx
	integer*4 nb_key		!size of key
	byte key(*)                     !key data
	integer*4 key_nr                !key number
	integer*4 dix_rms_get_keyed
c
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
	integer*4 istat,k
c
	integer*4 dix_rms_rewind
	integer*4 dix_rms_sys_get
	integer*4 dix_rms_get_keyinfo
c
	call dix_main_print_debug(control,debug_file,
     1        'Get keyed '//file.fnam(1:file.nk_fnam))
c
	istat = dix_rms_get_keyinfo(file,key_nr,k)
	if(.not. istat) goto 90
c
c Now we have valid key info
c
	p_key_info = k
c
	p_rab    = file.rabadr
c
c First check is unmodified data present
c
	call dix_main_check_mod_record(control,file)
c
	if(nb_key .eq. 0) then
c
c We have no key, so the user wants to rewind
c
	  istat = dix_rms_rewind(control,file,key_nr)
	  goto 90
	endif
c
	rab.rab$l_rop = 0
        if(keyopt .eq. key_opt_lt) then
          rab.rab$l_rop = rab$m_nxt
	  if(key_info.ascending) 
     1        rab.rab$l_rop = rab.rab$l_rop .or. rab$m_rev
        elseif(keyopt .eq. key_opt_le) then
          rab.rab$l_rop = rab$m_eqnxt
	  if(key_info.ascending) 
     1        rab.rab$l_rop = rab.rab$l_rop .or. rab$m_rev
        elseif(keyopt .eq. key_opt_eq) then
          rab.rab$l_rop = 0	!nothing special
        elseif(keyopt .eq. key_opt_ge) then
          rab.rab$l_rop = rab$m_eqnxt
	  if(.not. key_info.ascending) 
     1        rab.rab$l_rop = rab.rab$l_rop .or. rab$m_rev
        elseif(keyopt .eq. key_opt_gt) then
          rab.rab$l_rop = rab$m_nxt
	  if(.not. key_info.ascending) 
     1        rab.rab$l_rop = rab.rab$l_rop .or. rab$m_rev
	endif
c
	rab.rab$l_ubf = %loc(file.data.data_rec)
	rab.rab$l_rhb = %loc(file.data.vfc_data)
	rab.rab$w_usz = max_buf
	rab.rab$b_rac = rab$c_key
	rab.rab$l_kbf = %loc(key)
c
c  Fortran has signed bytes
c
	call lib$movc3(1,key_nr,rab.rab$b_krf)
	call lib$movc3(1,nb_key,rab.rab$b_ksz)
c	rab.rab$b_krf = key_nr
c	rab.rab$b_ksz = nb_key
c
c Fill with 0's
c
	call dix_util_fill(0,max_buf,file.data.data_rec)
c
c Get the data
c
	call dix_main_print_debug(control,debug_file,
     1        '  Get keyed rab '//file.fnam(1:file.nk_fnam))
	istat = dix_rms_sys_get(control,rab,file)
	if(istat) then
	  file.data.nb_data = zext(rab.rab$w_rsz)
	  file.data.nb_vfc  = file.nb_vfc
	  file.got_record   = .true.
	  file.cur_key    = key_nr
	  file.rec_nr     = -1 		!signal unknown record
	  call dix_dump_copy(file)
	else
	  file.data.nb_data = 0
	  file.data.nb_vfc  = 0
	  file.got_record   = .false.
	endif
c
c  Mark all desciptions as not expanded
c
90	dix_rms_get_keyed = istat
	call dix_des_inv_des(control,file)
	return
	end
	function dix_rms_get_rfa(control,file,key_nr,rfa)
c
	implicit none
c
c try to read on rfa
c  this routine is called when a user has save a mark to
c  a file. For a nonkeyed file (or keyed with keynr=0)
c  this is just a read RFA, but for an indexed file
c  with keynr>0, this is not trivial, see code below
c
	include '($rabdef)'
	include '($rmsdef)'
	include 'dix_def.inc'
	record /control/ control
	record /file_info/ file
	integer*4 key_nr
	record /rfa/ rfa
	integer*4 dix_rms_get_rfa
c#
	record /rabdef/ rab
	pointer (p_rab,rab)
c
c
	integer*4 dix_rms_sys_get
c
	integer*4 istat,k,nb_key,nk_rfa
	character*30 rfaasc
c
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
	integer*4 dix_rms_get_keyinfo
c
	byte key_data(255)
c
	external dix_msg_nullkey
	external dix_msg_recdisapp
c
c Make sure no unfinished data left
c
	if((control.debug .and. debug_file) .ne. 0) then
	  call dix_rms_rfa_asc(rfa,nk_rfa,rfaasc)
	  call dix_main_print_debug(control,debug_file,
     1        'Get RFA '//rfaasc(1:nk_rfa)//' for file '//
     1         file.fnam(1:file.nk_fnam))
	endif
c
	call dix_main_check_mod_record(control,file)
	p_rab = file.rabadr
c
c Read the record by RFA, this returns the record
c
	file.cur_key = key_nr
	rab.rab$l_ubf = %loc(file.data.data_rec)
	rab.rab$l_rhb = %loc(file.data.vfc_data)
	rab.rab$w_usz = max_buf
	rab.rab$b_rac = rab$c_rfa
	rab.rab$b_krf = 0
	rab.rab$l_kbf = 0
	rab.rab$b_ksz = 0
	rab.rab$l_rop = 0
	call dix_rms_copy_rfa(rfa,rab.rab$w_rfa)
c
c Get the data by read rfa
c this will read the correct record , but for alternate keys
c this will not set the pointer to the next record correct.
c we fake this by recreating the key
c  reading indexed by key, and sequential until the correct rfa is read
c
c Note: This will not work on alternate keys with NULL keys
c so we check if the key has all NULL values for that key
c  if so return an error
c
c n.b. THis should not happen. The only place this routine is called
c      is from RFA related reads. If the key had a NULL value, DIX
c      could not have read the key, as so also not have saved the RFA pointer
c      So it should not happen, but you never know
c
	call dix_main_print_debug(control,debug_file,
     1        '  Get rec (RFA) rab')
	istat = dix_rms_sys_get(control,rab,file)
	if(.not. istat) goto 90
c
	if(file.indexed .and. key_nr .ne. 0) then
c
c Indexed file, and key<>0, Now rebuild the key from the databuffer
c
	  istat = dix_rms_get_keyinfo(file,key_nr,k)
	  if(.not. istat) goto 90
	  p_key_info = k
	  nb_key = 0
c
c Build up the key from the various key segments
c
	  call dix_rms_get_key_value(key_info,file.data,nb_key,key_data)
	  if(key_info.null_key .ge. 0) then
c
c We have a valid NULL key
c
	    do k=1,nb_key
	      if(zext(key_data(k)) .ne. key_info.null_key) goto 11
	    end do
c
c All bytes of the key are NULL-key values, return a message (should not happen)
c
	    istat = %loc(dix_msg_nullkey)
	    goto 90
	  endif
c
c Get key via normal key (and set key_nr right)
c
11	  rab.rab$l_rop = 0
c
	  rab.rab$l_ubf = %loc(file.data.data_rec)
	  rab.rab$l_rhb = %loc(file.data.vfc_data)
	  rab.rab$w_usz = max_buf
	  rab.rab$b_rac = rab$c_key
	  rab.rab$l_kbf = %loc(key_data)
	  rab.rab$b_krf = key_nr
c
c  Fortran has signed bytes
c	  rab.rab$b_krf = key_nr
c	  rab.rab$b_ksz = nb_key
	  call lib$movc3(1,key_nr,rab.rab$b_krf)
	  call lib$movc3(1,nb_key,rab.rab$b_ksz)
c
c Now get the data
c
	  call dix_main_print_debug(control,debug_file,
     1        '  Get keyed rab '//file.fnam(1:file.nk_fnam))
	  istat = dix_rms_sys_get(control,rab,file)
c
c We have the first record with the same keyvalue
c  Keep on reading until we have the same RFA as before
c  (or hit EOF or lim)
c Check if the rfa correct
c
12	  if(istat) then
	    do k=1,3
	      if(rfa.rfa(k) .ne. rab.rab$w_rfa(k)) then
	       call dix_main_print_debug(control,debug_file,
     1        '  Get seq rab '//file.fnam(1:file.nk_fnam))
c
	        rab.rab$b_rac = rab$c_seq
	        rab.rab$l_rop = rab$m_lim	!read until key changed
c
c Now the status can be oke, but also rms$_ok_lim
c if this status is returned,we went to far, so the record must have been deleted
c between the read_rfa and the sequential reads. This is not very likely
c but we check anyway
c
	        istat = dix_rms_sys_get(control,rab,file)
	        if(istat .eq. rms$_ok_lim) goto 15
c
c handle all others at label 12
c
	        goto 12
c
c Record has disappeared
c
15	        istat = %loc(dix_msg_recdisapp)
	        goto 90
	      endif
	    end do
	  endif
	else
c
c Either not indexed file, or rfa_read on key=0
c Now we can do just a rfa read
c
	  rab.rab$l_ubf = %loc(file.data.data_rec)
	  rab.rab$l_rhb = %loc(file.data.vfc_data)
	  rab.rab$w_usz = max_buf
	  rab.rab$b_rac = rab$c_rfa
cFortran has signed bytes
c	  rab.rab$b_krf = key_nr
	  call lib$movc3(1,key_nr,rab.rab$b_krf)
	  rab.rab$l_kbf = 0
	  rab.rab$b_ksz = 0
	  rab.rab$l_rop = 0
c
	  call dix_rms_copy_rfa(rfa,rab.rab$w_rfa)
c
c Fill with 0's
c
	  call dix_util_fill(0,max_buf,file.data.data_rec)
c
c Get the data
c
	  call dix_main_print_debug(control,debug_file,
     1        '  Get seq(RFA) '//file.fnam(1:file.nk_fnam))
c
	  rab.rab$l_rop = 0
	  istat = dix_rms_sys_get(control,rab,file)
	end if
c
	if(istat) then
	  file.data.nb_data = zext(rab.rab$w_rsz)
	  file.data.nb_vfc  = file.nb_vfc
	  call dix_dump_copy(file)
	else
	  file.data.nb_data = 0
	  file.data.nb_vfc  = 0
	endif
90	dix_rms_get_rfa = istat
c
c  Mark all desciptions as not expanded
c
	call dix_des_inv_des(control,file)
	return
	end

	function dix_rms_get_direct(control,file,recnr)
c
	implicit none
c
c Read record N for direct access file (or relative file)
c
	include '($rabdef)'
	include 'dix_def.inc'
	integer*4 control
	record /file_info/ file
	integer*4 recnr
	integer*4 dix_rms_get_direct
c#
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	integer*4 istat,sys$read
	integer*4 dix_rms_sys_get
c
	call dix_main_print_debug(control,debug_file,
     1        'Get direct  '//file.fnam(1:file.nk_fnam))
c
	p_rab    = file.rabadr
c
c First check is unmodified data present
c
	call dix_main_check_mod_record(control,file)
c
	rab.rab$l_rop = 0
	rab.rab$l_ubf = %loc(file.data.data_rec)
	rab.rab$l_rhb = %loc(file.data.vfc_data)
c
	if(file.block_size .eq. 0) then
c
c Record io
c
	  rab.rab$w_usz = max_buf
	  rab.rab$b_rac = rab$c_key
	  rab.rab$l_kbf = %loc(recnr)
	  rab.rab$b_krf = 0
	  rab.rab$b_ksz = 4
c
c Get the data
c
	  call dix_main_print_debug(control,debug_file,'  Get direct rab ')
	  istat = dix_rms_sys_get(control,rab,file)
	else
c
c Blockio
c
	  rab.rab$w_usz = file.block_size*512
	  rab.rab$l_bkt = recnr
	  call dix_main_print_debug(control,debug_file,'  Read rab ')
	  istat = sys$read(rab,,)
	end if

	dix_rms_get_direct = istat
	if(istat) then
	  file.data.nb_data = zext(rab.rab$w_rsz)
	  file.data.nb_vfc  = file.nb_vfc
	  file.rec_nr = recnr
	  call dix_dump_copy(file)
	  file.got_record = .true.
	else
	  file.data.nb_data = 0
	  file.data.nb_vfc  = 0
	  file.got_record   = .false.
	end if
c
c  Mark all desciptions as not expanded
c
	call dix_des_inv_des(control,file)
c
	return
	end

	function dix_rms_update(control,file,signal)
	implicit none
c
	include '($rabdef)'
	include '($rmsdef)'
	include 'dix_def.inc'
	record /control/ control	!:io: contorl structure
	record /file_info/ file
	logical signal			!:i: signal update?
	integer*4 dix_rms_update
c#
	integer*4 sys$update
	integer*4 sys$delete
	integer*4 sys$write
	integer*4 sys$put
	integer*4 dix_rms_reget_rfa
	integer*4 dix_rms_get_rfa
	external dix_msg_noupd
	external dix_msg_recupd
	external dix_msg_delwrok
	external dix_msg_recins
	external dix_msg_settonew
c
	integer*4 istat
	integer*2 rfa(3)
c
	record /rabdef/ rab		!:io: rab of the file
	pointer (p_rab,rab)
c
	integer*4 dix_main_question
	external dix_msg_reccha
	external dix_msg_notinmod
c
	call dix_main_print_debug(control,debug_file,
     1        'Updating record '//file.fnam(1:file.nk_fnam))
c
	p_rab = file.rabadr
c
	if(file.rabmod .eq. 0) then
	  istat = %loc(dix_msg_notinmod)
	  goto 90
	endif
cc
	if(.not. file.data.newrec) goto 10
c
c Just insert record
c
5	rab.rab$b_rac = rab$c_key
	rab.rab$l_rbf = %loc(file.data.data_rec)
	rab.rab$w_rsz = file.data.nb_data
	rab.rab$l_rop = 0
	call dix_main_print_debug(control,debug_file,
     1        '  SYS$Put (insert) record  rab')
	istat = sys$put(rab,,)
	if(istat) then
	  if(signal) call dix_message(control,dix_msg_recins)
	endif
	goto 90
c
10	if(file.block_size .eq. 0) goto 20
c
c Block mode transfer
c
15	rab.rab$l_bkt = rab.rab$l_bkt	!current record
	rab.rab$w_rsz = file.block_size*512
	rab.rab$l_rbf = %loc(file.data.data_rec)
	call dix_main_print_debug(control,debug_file,
     1        '  SYS$Write (blockmode) record rab ')
	istat = sys$write(rab,,)
	dix_rms_update = istat
	if(istat) then
	  if(signal) call dix_message(control,dix_msg_recupd)
	end if
	goto 99
c
20	if(.not. file.record_locked) then
	  call dix_main_print_debug(control,debug_file,
     1        '  Record not locked')
	endif
c
	if(file.oplock) then
c
c Reget the data , it was released earlier
c  now make use of the rabmod
c the reget_rfa does a read on RFA, and this
c  will change the key to 0 (for an indexed file)
c This will change the keyorder and that is not wanted
c
	  call dix_rms_copy_rfa(rab.rab$w_rfa,rfa)
	  p_rab = file.rabmod
	  call dix_rms_copy_rfa(rfa,rab.rab$w_rfa)
c
	  call dix_main_print_debug(control,debug_file,
     1        '  Now use RABMOD')

	  istat = dix_rms_reget_rfa(control,rab,file,.true.)
	  if(istat .eq. rms$_del) then
	    istat = dix_main_question(control,'Record deleted, '//
     1                'do you want to insert it again',.false.)
	    if(istat) goto 5	!Just do a PUT
	    goto 99
	  endif
	else
	  istat = 1
	endif
c	
	if(istat) then
c
c Now check if record changed in between
c  oplock, either set by reget_rfa ,or set to false
c
	  rab.rab$w_rsz = file.data.nb_data
	  rab.rab$l_rbf = %loc(file.data.data_rec)
	  rab.rab$l_rhb = %loc(file.data.vfc_data)
	  call dix_main_print_debug(control,debug_file,'  Update record rab ')
	  istat = sys$update(rab,,)
c
c if not successfull then try delete/write
c
	  if(.not. istat) then
c
c Update went wrong, maybe keychange (try delete/write)
c
	    if(istat .eq. rms$_chg) then
	      if(dix_main_question(control,
     1     '$Update cause illegal key change ;'//
     1     ' Try delete/write',.true.)) then
c 
c Because previous UPDATE went wrong
C record pointer is illegal; so reset rfa
c
	        istat = dix_rms_reget_rfa(control,rab,file,.false.)
	        if(istat) then
c
c Delete the record
c
	          call dix_main_print_debug(control,debug_file,
     1               '  SYS$Delete rab ')
	          istat = sys$delete(rab,,)
	          if(istat) then
c
c And put it now
c
	            rab.rab$b_rac = rab$c_key
	            rab.rab$l_rbf = %loc(file.data.data_rec)
	            rab.rab$w_rsz = file.data.nb_data
	            rab.rab$l_rop = 0
	            call dix_main_print_debug(control,debug_file,
     1               '  Put record rab ')
	            istat = sys$put(rab,,)
	            if(istat) then
	              call dix_message(control,dix_msg_delwrok)
	            else
	              call dix_message(control,dix_msg_settonew)
	              file.data.newrec = .true.
	            endif
	          endif
	        endif
	      endif
	    endif
	  else
c
c Update went ok
c
	    if(signal) call dix_message(control,dix_msg_recupd)
	  endif
	endif
90	if(istat) then
c 
c If not oplock on, reread the record to have the lock again
c
	  if(.not. file.oplock) then
	    call dix_dump_copy(file)
	    call dix_rms_copy_rfa(rab.rab$w_rfa,rfa)
	    istat = dix_rms_get_rfa(control,file,file.cur_key,rfa)
	  endif
	endif
c
c Reread the record
c
99	if(istat) then
	  call dix_dump_copy(file)
	endif
	dix_rms_update = istat
	return
	end

	function dix_rms_delete(control,file)
	implicit none
c
c Delete the current record
c  Use the rabmod to do not disturb the record info on rab
c
	include '($rabdef)'
	include '($rmsdef)'
	include 'dix_def.inc'
	integer*4 control
	record /file_info/ file
c#
	record /rabdef/ rab
	pointer (p_rab,rab)
	logical*4 dix_rms_delete
c
	integer*4 istat,kstat
	integer*2 rfa(3)
c
	record /file_info/ file_save
c
	integer*4 dix_rms_reget_rfa
	integer*4 sys$delete
	integer*4 dix_rms_sys_get
	external dix_msg_reckill
	external dix_msg_alrdel
	external dix_msg_notinmod
	external dix_msg_notrelidx
c
c We need to delete a record. We try to readin the
c  next record, so there is still a record context
c
	call dix_main_print_debug(control,debug_file,
     1        'Delete record '//file.fnam(1:file.nk_fnam))
c
c Do the delete on rabmod, this will not disturb the
c  record info in rab, if the record has to be read in again
c
	if(file.rabmod .eq. 0) then 
	  istat = %loc(dix_msg_notinmod)
	  goto 90
	endif
	if(.not. (file.indexed .or. file.relative)) then
	  istat = %loc(dix_msg_notrelidx)
	  goto 90
	endif
	p_rab = file.rabadr
c
c Remember the RFA of the current (to be deleted) record
c and the data of the file (including the data)
c 
	call dix_rms_copy_rfa(rab.rab$w_rfa,rfa)
	file_save = file
c
c Read the next record
c
	call dix_main_print_debug(control,debug_file,
     1        '  Reading next record ')
c
c Set for sequential mode
c
	rab.rab$b_rac = rab$c_seq
	rab.rab$w_usz = max_buf
	kstat = dix_rms_sys_get(control,rab,file)
c
	if(kstat) then
	  file.got_record   = .true.
	  file.data.nb_data = zext(rab.rab$w_rsz)
	  file.data.nb_vfc  = file.nb_vfc
c
c This should increment record number, but since this record is deleted
c we should again  decrement, so do nothing
c
	  call dix_dump_copy(file)
	else
	  file.got_record = .false.
	endif
c
	call dix_main_print_debug(control,debug_file,
     1        '  Regetting for rabmod ')
c
c Switch to rabmod
c
	p_rab = file.rabmod
	call dix_rms_copy_rfa(rfa,rab.rab$w_rfa)
c
c Now reread the record on rabmod with the original rfa
c
	istat = dix_rms_reget_rfa(control,rab,file_save,.true.)
c
c If the record was already deleted, all is oke
c
	if(istat .eq. rms$_del) then
	  call dix_message(control,dix_msg_alrdel)
c
c And return the status from the sys_get
c
	  istat = kstat
	  goto 90
	elseif(istat) then
c
c Successfull reget, now delete
c
	  call dix_main_print_debug(control,debug_file,
     1        '  Deleting from rabmod ')
	  istat = sys$delete(rab,,)
	  if(istat) then
	    call dix_message(control,dix_msg_reckill)
	    istat = kstat
	  endif
	endif
90	dix_rms_delete = istat
c
c  Mark all desciptions as not expanded
c
	call dix_des_inv_des(control,file)
	return
	end

	subroutine dix_rms_file_info(control,file) 
	implicit none
c
c Print file info to default output device
c
	include 'dix_def.inc'
	record /control/ control        !:i: control structure
	record /file_info/ file
c#
	logical dix_dump_print_line 
c
	if(dix_dump_print_line(control,0,
     1        'Keyinformation on file '//
     1      file.fnam(1:file.nk_fnam))) then
cc
	  call dix_rms_file_info_scr(control,0,file)
	endif
	return
	end

	function dix_rms_fi_pr(control,dis_id,line)
	implicit none
c
	include 'dix_def.inc'
	record /control/ control
	integer*4 dis_id
	character*(*) line
	integer*4 dix_rms_fi_pr
c#
	integer*4 k,istat
	integer*4 dix_util_get_len_fu
	integer*4 dix_dump_print_line
	integer*4 memtab_add_record
c
	k = dix_util_get_len_fu(line)
	if(k .eq. 0) k = 1
c
	if(control.mode .eq. mode_screen) then
	  istat = memtab_add_record(control,dis_id,line(1:k))
	else
	  istat = dix_dump_print_line(control,0,line(1:k))
	end if
	dix_rms_fi_pr = istat
	return
	end

	function dix_rms_keyinfo(file,key,string,length,ascending,keynam)
	implicit none
c
c Return info for keynumber for RMS, and update keypos/siz in file structure
c
	include 'dix_def.inc'
	record /file_info/ file
	integer*4 key			!:i: keynumber
	logical*4 string		!:o: true is string key
	integer*4 length		!:o: give length of key
	logical*4 ascending		!:o: true if ascending key
	logical*4 dix_rms_keyinfo	!:f: status of sys$display
	character*(*) keynam
c#
c Functions
c
	integer*4 dix_rms_get_keyinfo
c
c local vars
c
	integer*4 k,istat
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
C
C Need keyinfo, where are the keyfields
C
	istat = dix_rms_get_keyinfo(file,key,k)
	if(istat) then
	  p_key_info = k
c
c all ok; length is sum of all siz*
c
	  length    = key_info.length
c
c String type for stg,col,pac or the descending versions
c
	  string    = key_info.string
c
c Ascending if keytype <= max ascending keytype
c
	  ascending = key_info.ascending
	  keynam    = key_info.name
	endif
c
	dix_rms_keyinfo = istat
	return
	end

	function dix_rms_offset_in_key(file,pos,plen)
	implicit none
C
C Check if position is in current key area
c
	include 'dix_def.inc'
	record /file_info/ file
	integer*4 pos
	integer*4 plen
	logical*4 dix_rms_offset_in_key
c#
	logical*4 dix_util_overlap
C
	integer*4 k
c
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
c Start of coding
c
	dix_rms_offset_in_key = .false.
	if(.not. file.indexed) goto 90
	if(file.block_size .gt. 0) goto 90
c
	call dix_rms_get_keyinfo(file,file.cur_key,k)
	p_key_info = k
	do k=1,8
	  if(dix_util_overlap(   pos,                plen,
     1              key_info.keypos(k),key_info.keysiz(k))) then
	    dix_rms_offset_in_key = .true.
	    goto 90
	  end if
	end do
90	return
	end

	function dix_rms_fill_xab(fab,xab,cod,bln) 
	implicit none
c 
c Let the SYS$DISPLAY fill an XAB block
c
	include '($fabdef)'
	record /fabdef/ fab
	include '($xabdef)'
	record /xabdef/ xab
	integer*4 dix_rms_fill_xab
	byte cod
	byte bln
c#
	integer*4 sys$display
	integer*4 savxab
c
	savxab = fab.fab$l_xab
	xab.xab$b_cod = cod		!fill  in type of xab
	xab.xab$b_bln = bln		!fill in block length of xab
	fab.fab$l_xab = %loc(xab)
c
c Let rms handle it; returns with XABKEY filled in
c
	dix_rms_fill_xab = sys$display(fab,,)
	fab.fab$l_xab = savxab
	return
	end
	subroutine dix_rms_save_rfa_rab(control,symbname,rab,recnr)
	implicit none
c
c  Save RFA info the the symbol with name in symbname, and tell the user
c
	include '($RABDEF)'
c
	integer*4 control
	character*(*) symbname
	record /rabdef/ rab
	integer*4 recnr
c#
	external dix_msg_markset
c
	call dix_rms_save_rfa(symbname,rab,recnr)
	call dix_message(control,dix_msg_markset,symbname)
	return
	end
	function dix_rms_check_rfa(symbname)
	implicit none
c
c See if the symbol 'symbname' contains a valid RFA save string
c
	include 'dix_def.inc'
c
	character*(*) symbname
	logical dix_rms_check_rfa
c#
	integer*4 knr,recnr,nk,k
	integer*2 rfa(3)
	integer*2 fid(3)
	character*(max_device_name_length) devnam
	byte chksum,chks
	character*(max_line_length) rfatext
c
	integer*4 dix_util_get_len
c
	dix_rms_check_rfa = .false.
	k = dix_util_get_len(symbname)
        call lib$get_symbol(symbname(1:k),rfatext,nk)
	if(nk .gt. 0) then
          read(rfatext,2010,err=90) fid,devnam,knr,rfa,recnr,chksum
2010      format(3z4.4,a16,z2.2,3z4.4,z8.8,z2.2)
	  chks = 0
	  do k=1,nk-2
	    chks = chks .xor. ichar(rfatext(k:k))
	  end do
	  dix_rms_check_rfa = chks .eq. chksum
	endif
90	return
	end
	subroutine dix_rms_save_rfa_Std(file)
	implicit none
c
c Save file pointer to the standard DIXRFA symbolc
c
	include 'dix_def.inc'
	record /file_info/ file
c#
	call dix_rms_save_rfa('DIXRFA',%val(file.rabadr),file.rec_nr)
	return
	end

	subroutine dix_rms_save_rfa(symbname,rab,recnr)
	implicit none
c
	include 'dix_def.inc'
c
c Save a restore point to a symbol
c
	character*(*) symbname		!:i: the symbol name
	include '($rabdef)'		
	record /rabdef/ rab             !:i: the file rab
	integer*4 recnr			!:i: the record number
c#
	integer*4 nk
	character*(max_line_length) rfa_asc
c
	call dix_rms_compute_rfa(rab,recnr,rfa_asc,nk)
	call lib$set_symbol(symbname,rfa_asc(1:nk))
	return
	end
	subroutine dix_rms_compute_rfa(rab,recnr,rfa_asc,nk)
	implicit none
c
c Compute a restore point
c
	include 'dix_def.inc'
	include '($rabdef)'
	record /rabdef/ rab	!:i: the file rab
	integer*4 recnr		!:i: the record number
	character*(*) rfa_asc	!:o: the text string
	integer*4 nk		!:o: the length of rfa_asc
c#
	integer*2 fid(3)
	character*(max_device_name_length) devnam
c
	integer*4 k,nk1
	byte chksum
c
	call dix_rms_get_fid(rab,fid,devnam)
	nk = 0
	call sys$fao('!4XW!4XW!4XW!AS!2XB!4XW!4XW!4XW!8XL',nk,rfa_asc,
     1   %val(fid(1)),%val(fid(2)),%val(fid(3)),
     1   devnam,
     1   %val(rab.rab$b_krf),
     1   %val(rab.rab$w_rfa(1)),%val(rab.rab$w_rfa(2)),
     1   %val(rab.rab$w_rfa(3)),%val(recnr))
	chksum = 0
	do k=1,nk
	  chksum = chksum .xor. ichar(rfa_asc(k:k))
	end do
	call sys$fao('!2XB',nk1,rfa_asc(nk+1:),%val(chksum))
	nk = nk + nk1
	return
	end
	function dix_rms_set_rfa(control,ptr_file,symbname)
	implicit none
c
c Restore the file-pointer to a previous mark point
c
	include 'dix_def.inc'
	integer*4 control
	integer*4 ptr_file		!:io: pointer to file list
	character*(*) symbname          !:i: the symboalname
	logical dix_rms_set_rfa		
c#
	integer*4 k,nk
	character*(max_line_length) rfatext
c
	logical dix_util_get_len
	logical dix_rms_check_rfa
	logical dix_rms_set_rfa_val
c
	external dix_msg_filnotrfa
c
	dix_rms_set_rfa = .false.
c
c Make sure the symbname has valid contents
c
	k = dix_util_get_len(symbname)
	if(dix_rms_check_rfa(symbname(1:k))) then
          call lib$get_symbol(symbname(1:k),rfatext,nk)
	  dix_rms_set_rfa = dix_rms_set_rfa_val(control,ptr_file,rfatext(1:nk))
	else
	  dix_rms_set_rfa = %loc(dix_msg_filnotrfa)
	endif
	return
	end
	function dix_rms_set_rfa_val(control,ptr_file,rfatext)
	implicit none
c
c Rfatext contains the checked file-pointer info
c set the file to this pointer
c
	include 'dix_def.inc'
	integer*4 control
	integer*4 ptr_file		!:io: pointer to file list
	character*(*) rfatext		!:i: the rfa value
	logical dix_rms_set_rfa_val
c#
	record /file_info/ file
	pointer (p_file,file)
	integer*4 knr,recnr,nk
	integer*2 rfa(3)
c
	logical dix_rms_get_rfa
	external rms$_rnf
	logical dix_util_get_len
	external dix_msg_filnotrfa
c
	integer*2 fid(3),fid1(3)
	character*(max_device_name_length) devnam,devnam1
	character*(max_line_length) line
c
	dix_rms_set_rfa_val = .false.
c
c Translate the data to disk/fid/rfa
c
        read(rfatext,2010,err=90) fid,devnam,knr,rfa,recnr
2010    format(3z4.4,a16,z2.2,3z4,z8.8)
c
c Now we have a fid and a diskname
c get the fid and disk of the current pointed file
c if the same oke, else try the next
c
	p_file = ptr_file
c
	call dix_main_print_debug(control,debug_file,
     1        'Setting RFA '//file.fnam(1:file.nk_fnam))

10	call dix_rms_get_fid(%val(file.rabadr),fid1,devnam1)
	if(fid(1) .ne. fid1(1) .or. fid(2) .ne. fid1(2) .or.
     1     fid(3) .ne. fid1(3) .or. devnam .ne. devnam1) then
c
	  call dix_main_print_debug(control,debug_file,'  Wrong FID ')
c
c No match, try the next one
c
	  p_file = file.link.forw
	  if(p_file .ne. 0) goto 10
c
c Sorry not found
c
	  nk = ichar(devnam(1:1))
	  call lib$fid_to_name(devnam(2:nk+1)//':',fid,line)
	  nk =dix_util_get_len(line)
	  if(nk .gt. 0) then
	    call dix_message(control,dix_msg_filnotrfa,line(1:nk))
	  endif
	  dix_rms_set_rfa_val = %loc(rms$_rnf)
	else
c
c Disk and fid matched, now the rfa
c
          dix_rms_set_rfa_val = dix_rms_get_rfa(control,file,knr,rfa)
	  file.rec_nr = recnr
	  ptr_file = p_file
	endif
90	return
	end
	subroutine dix_rms_get_fid(rab,fid,devnam)
	implicit none
c
	include 'dix_def.inc'
c
	include '($rabdef)'
	record /rabdef/ rab
	integer*2 fid(3)
	character*(*) devnam	
c#
	include '($fabdef)'
	record /fabdef/ fab
	pointer (p_fab,fab)
c
	integer*4 ipos
c
	include '($namdef)'
	record /namdef/ nam
c
	integer sys$display
c
	p_fab = rab.rab$l_fab
	fab.fab$l_nam = %loc(nam)
c
	nam.nam$b_bln = nam$c_bln
	nam.nam$b_bid = nam$c_bid
c
	if(sys$display(fab,,)) then
	  fid(1) = nam.nam$w_fid(1)
	  fid(2) = nam.nam$w_fid(2)
	  fid(3) = nam.nam$w_fid(3)
	  devnam = nam.nam$t_dvi
	  ipos = index(devnam,NULL)
	  if(ipos .ne. 0) devnam(ipos:) = ' '
	end if
	return
	end
	subroutine dix_rms_get_keyname(pos,size,des_expanded,names,nk_names)
	implicit none
c
c Build a list of fields that overlap with (pos:pos+size-1)
c
	include 'dix_def.inc'
c
	integer*4 pos  		!:i: keypos
	integer*4 size		!:i: keysize
	record /des_expanded/ des_expanded
	character*(*) names     !:o: the names , separated
	integer*4 nk_names	!:o: length of names
c#
	integer*4 k,nk
	record /des_rec/ des_recs(1)
	pointer (p_des_recs,des_recs)
c
	logical dix_util_overlap
c
	nk_names = 0
	p_des_recs = des_expanded.table_nor.address
	do k=1,des_expanded.table_nor.count
	  if(dix_util_overlap(des_recs(k).bit_offset,
     1              des_recs(k).size,
     1              pos*8,size*8)) then
c
c Append the name to the string
c
	    nk = des_recs(k).nam.dsc$w_maxstrlen 
	    call dix_util_copy_string(des_recs(k).nam,names(nk_names+1:))
	    nk_names = nk_names + nk + 1
	    names(nk_names:nk_names) = ','
	  end if
	end do
	if(nk_names .gt. 0) nk_names = nk_names - 1
	return
	end
	function dix_rms_fill_keyinfo(control,file)
	implicit none
c
c Make a linked-list of key descriptors
c should only be called for indexed file
c
	include 'dix_def.inc'
	record /control/ control
	record /file_info/ file
	integer*4 dix_rms_fill_keyinfo
c#
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
	include '($xabkeydef)'
	record /xabkeydef/ xab
c
	integer*4 k,istat,l,ipos
c
	integer*4 dix_rms_fill_xab
c
	do k=1,file.nkey
c
c Get a new block
c
	  call get_vm(control,sizeof(key_info),p_key_info,
     1                control.zone_file,.true.,'KEY_INFO')
	  call dix_util_link_in(key_info.link,file.ptr_keyinfo)
c
c Let rms fill in the keyinfo xab
c
	  call lib$movc5(0,0,0,xab$k_keylen,xab)	!clear out xab to zero's
c
c Make xab key
c
	  xab.xab$b_ref = k-1
	  xab.xab$l_knm = %loc(key_info.name)
	  istat = dix_rms_fill_xab(%val(file.fabadr),xab,
     1                   xab$c_key,xab$k_keylen)
c
	  ipos = index(key_info.name,NULL)
	  if(ipos .ne. 0) key_info.name(ipos:) = ' '
c
c Check on status
c
	  if(.not. istat) goto 90
c
c all ok; length is sum of all siz*
c
	  key_info.length = zext(xab.xab$b_tks)
c
c String type for stg,col,pac or the descending versions
c
	  key_info.data_type = xab.xab$b_dtp 
	  key_info.keyidx    = xab.xab$b_ref
	  key_info.nsegment  = zext(xab.xab$b_nsg)
c
	  key_info.duplicate = btest(zext(xab.xab$b_flg),xab$v_dup)
	  key_info.change    = btest(zext(xab.xab$b_flg),xab$v_chg)
	  if(btest(zext(xab.xab$b_flg),xab$v_nul)) then
	    key_info.null_key  = zext(xab.xab$b_nul)
	  else
	    key_info.null_key = -1		!signal no null key
	  endif
c
	  key_info.string =
     1       xab.xab$b_dtp .eq. xab$c_stg  .or.
     1       xab.xab$b_dtp .eq. xab$c_dstg .or.
     1       xab.xab$b_dtp .eq. xab$c_col  .or. 
     1       xab.xab$b_dtp .eq. xab$c_dcol .or. 
     1       xab.xab$b_dtp .eq. xab$c_pac  .or.
     1       xab.xab$b_dtp .eq. xab$c_dpac 
c
c Ascending if keytype <= max ascending keytype
c
	  key_info.ascending = xab.xab$b_dtp .le. xab$c_max_ascend
c
C Save the pos/sizes of all segments for higlighted display
C
	  do l=1,8
	    key_info.keypos(l) = zext(xab.xab$w_pos(l))
	    key_info.keysiz(l) = zext(xab.xab$b_siz(l))
	  end do
c
	end do
90	dix_rms_fill_keyinfo = istat
	return
	end	
	function dix_rms_get_keyinfo(file_info,idx,ptr_key_info)
	implicit none
c
c Get the pointer to the 'idx'th keyinfo block
c
	include 'dix_def.inc'
	record /file_info/ file_info	!:i: the file
	integer*4 idx			!:i: the keynumber (0..nok-1)
	integer*4 ptr_key_info		!:o: the pointer to a keycontrol block
	integer*4 dix_rms_get_keyinfo	!:f: function result
c#
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
	integer*4 istat,k
c
	external dix_msg_illkey
c
	istat = %loc(dix_msg_illkey)
	if(.not. file_info.indexed) goto 90
c
	p_key_info = file_info.ptr_keyinfo
	do k=1,idx		!start at 1, 0 is already present
	  if(p_key_info .eq. 0) goto 90
	  p_key_info = key_info.link.forw
	end do
	istat = 1
	ptr_key_info = p_key_info
90	dix_rms_get_keyinfo = istat
	return
	end
	function dix_rms_sys_get(control,rab,file)
	implicit none
c
c This does a $get, and if a record lock is found, 
c ask the user if he wants a RRL (read regardless lock)
c This can only we done if the file is open for readonly?
c If the file was opened with /lock=rrl, the
c rrl bit is set before the read, ans so suppresses the question
c
c If oplock is set, set th _nlk flag to suppress locking
c
	include 'dix_def.inc'
	include '($rabdef)'
	include '($rmsdef)'
	record /control/ control	!:i: control block
	record /rabdef/ rab		!:io: rab block
	record /file_info/ file		!:io: file block
	integer*4 dix_rms_sys_get	!:f: function result
c#
	integer*2 rfa(3)
	integer*4 istat,old_rop
c
	logical*4 dix_main_question
	integer*4 sys$get
c
	external dix_msg_okrrl
c
	file.record_locked = .true.
	old_rop = rab.rab$l_rop
	if(file.rrl)   then
	  rab.rab$l_rop = rab.rab$l_rop .or. rab$m_rrl
	  call dix_main_print_debug(control,debug_file,'  Read RRL ')
	endif
	if(file.oplock) then
	  rab.rab$l_rop = rab.rab$l_rop .or. rab$m_nlk
	  call dix_main_print_debug(control,debug_file,'  Read Nolock ')
	endif
	if((rab.rab$l_rop .and. rab$m_nlk).ne.0)file.record_locked = .false.
c
c Read can remove RFA values after error
c  so save an restore the rfa on retries
c
	call dix_rms_copy_rfa(rab.rab$w_rfa,rfa)
10	istat = sys$get(rab,,)
	if(.not. istat) then
	  if(istat .eq. rms$_rlk) then
	    if(dix_main_question(control,'Record locked, '//
     1         'Retry with RRL (read regardless lock) ',
     1         .true.)) then  
c
c Set rrl bit, and retry
c
	      rab.rab$l_rop = rab.rab$l_rop .or. rab$m_rrl
	      call dix_rms_copy_rfa(rfa,rab.rab$w_rfa)
	      goto 10
	    endif
	  endif
	endif
c
c Signal to the user if the message OK_RRL is given
c  somebody has this record locked
c
	if(istat .eq. rms$_ok_rrl) then
	  call dix_message(control,dix_msg_okrrl)
	  file.record_locked = .false.
	endif
c
	rab.rab$l_rop = old_rop
c
	dix_rms_sys_get = istat
	return
	end
	subroutine dix_rms_file_info_scr(control,dis_id,file)
	implicit none
c
c Print file info to screen (dis_id<>0) of file (dis_id=0)
c
	include 'dix_def.inc'
	record /control /control	!:i: the control structure
	integer*4 dis_id		!:i: the display id (if screen) or 0
	record /file_info/ file
c#
	include '($fabdef)'		
	include '($rabdef)'		
c
c
	include '($namdef)'
	record /namdef/ nam
c
	logical*4 dix_rms_fill_xab
	logical dix_rms_fi_pr
c
	include '($xabdef)'
	include '($xabkeydef)'
	record /xabkeydef/ xabkey
	include '($xabrdtdef)'
	structure /help/
	  union
	    map
	      record /xabdef/ xab
	    end map
	    map
	      record /xabrdtdef/ xabrdt
	    end map
	  end union
	end structure
	record /help/ xabrdt
	include '($xabdatdef)'
	record /xabdatdef/ xabdat
	include '($xabprodef)'
	record /xabprodef1/ xabpro
	include '($xabsumdef)'
	record /xabsumdef/ xabsum
	include '($xabfhcdef)'
	record /xabfhcdef/ xabfhc
	include '($xaballdef)'
	structure /help1/
	  union
	    map
	      record /xabdef1/ xab
	    end map
	    map
	      record /xaballdef/ xaball
	    end map
	  end union
	end structure
	record /help1/ xaball
c
	logical do_des,is_seq,is_var
	integer*4 k,key,nkar,segment_nr,nk,nk_key
	integer*4 width_key,width_fld,pos_key,pos_fld
	character*(max_rms_key_name_length) keynam
	character*(max_short_line_length) ktp
	character*(max_line_length) line,flds,dupflg,chgflg,nulflg
	integer*4 nk_fld
c
	record /fabdef/ fab             !:i: the fab
	pointer (p_fab,fab)
c
	record /rabdef/ rab             !:i: rab for the file
	pointer (p_rab,rab)
c
	record /des_expanded/ des_expanded !:i: Optional des_info record
	pointer (p_des_expanded,des_expanded)
c
	integer*4 dix_util_get_len_fu
c
c Set the pointers right
c
	p_rab = file.rabadr
	p_fab = rab.rab$l_fab
	p_des_expanded = file.cur_des
c
c Make xab key
c file, get namblk filled
c
	do_des = %loc(des_expanded) .ne. 0
c
	nam.nam$b_bid = nam$c_bid
	nam.nam$b_bln = nam$c_bln	!make it a nam block
	k = fab.fab$l_nam
	fab.fab$l_nam = %loc(nam)
	call sys$display(fab,,)
	fab.fab$l_nam = k
c
	if(.not. dix_rms_fi_pr(control,dis_id,':File')) goto 99
c
	is_seq = .false.
	if(fab.fab$b_org .eq. fab$c_idx) then
	  Line = 'Indexed'
	elseif(fab.fab$b_org .eq. fab$c_rel) then
	  line = 'Relative'
	elseif(fab.fab$b_org .eq. fab$c_seq) then
	  line = 'Sequential'
	  is_seq = .true.
	end if
	if(.not. dix_rms_fi_pr(control,dis_id,
     1           ' Organization     : '//line(1:14))) goto 99
c
	nkar = 0
	if(file.oplock) call dix_append(nkar,line,'Optimistic,')
	if(file.rrl)    call dix_append(nkar,line,'RRL,')
	if(nkar .eq. 0) call dix_append(nkar,line,'Normal,')
	nkar = nkar - 1
c
	if(.not. dix_rms_fi_pr(control,dis_id,
     1           ' Lock mode        : '//line(1:nkar))) goto 99
c

c
	is_var = .false.
	if(fab.fab$b_rfm .eq. fab$c_fix) then
	  line = 'Fixed'
	  nkar = 5
	elseif(fab.fab$b_rfm .eq. fab$c_stm) then
	  line = 'Stream'
	  nkar = 6
	elseif(fab.fab$b_rfm .eq. fab$c_stmcr) then
	  line = 'Stream_CR'
	  nkar = 9
	elseif(fab.fab$b_rfm .eq. fab$c_stmlf) then
	  line = 'Stream_LF'
	  nkar = 9
	elseif(fab.fab$b_rfm .eq. fab$c_udf) then
	  line = 'Undefined'
	  nkar = 9
	elseif(fab.fab$b_rfm .eq. fab$c_var) then
	  line = 'Variable'
	  nkar = 8
	  is_var = .true.
	elseif(fab.fab$b_rfm .eq. fab$c_vfc) then
	  call sys$fao('VFC, !UB byte header',nkar,line,
     1          %val(fab.fab$b_fsz))
	endif
	if(.not. dix_rms_fi_pr(control,dis_id,
     1     ' Record format    : '//line(1:nkar))) goto 99
c
	call  dix_rms_fill_xab(fab,xabdat,xab$c_dat,xab$k_datlen)
c
	call sys$asctim(,line,xabdat.xab$q_cdt)
	if(.not. dix_rms_fi_pr(control,dis_id,' Creation   date  : '//
     1           line(1:23))) goto 99
c
	if((xabdat.xab$q_edt(1) .or. xabdat.xab$q_edt(2)) .eq. 0) then
	  line = '<None specified>'
	else
	  call sys$asctim(,line,xabdat.xab$q_edt)
	endif
	if(.not. dix_rms_fi_pr(control,dis_id,' Expiration date  : '//
     1             line(1:23))) goto 99
c
	if((xabdat.xab$q_bdt(1) .or. xabdat.xab$q_bdt(2)) .eq. 0) then
	  line = '<No backup recorded>'
	else
	  call sys$asctim(,line,xabdat.xab$q_bdt)
	endif
	if(.not. dix_rms_fi_pr(control,dis_id,' Backup     date  : '//
     1            line(1:23))) goto 99
c
	call  dix_rms_fill_xab(fab,xabrdt,xab$c_rdt,xab$k_rdtlen)
	if((xabrdt.xab.xab$q_rdt(1) .or. xabrdt.xab.xab$q_rdt(2)) .eq. 0) then
	  line = '<None specified>'
	else
	  call sys$asctim(,line,xabrdt.xab.xab$q_rdt,)
	endif
	if(.not. dix_rms_fi_pr(control,dis_id,' Revision   date  : '//
     1            line(1:23))) goto 99
c
	call dix_con_type_intasc(6,nam.nam$w_fid,enttyp_fid,
     1                           line,nkar,control)
	if(.not. dix_rms_fi_pr(control,dis_id,' File id          : '//
     1             line(1:nkar))) goto 99
c
	call  dix_rms_fill_xab(fab,xabpro,xab$c_pro,xab$k_prolen)
	call sys$fao('!%I = !%U',nkar,line,%val(xabpro.xab$l_uic),
     1                                   %val(xabpro.xab$l_uic))
	if(.not. dix_rms_fi_pr(control,dis_id,' File owner       : '//
     1            line(1:nkar)))goto 99
c
	call dix_con_type_intasc(2,xabpro.xab$w_pro,
     1             enttyp_prot,line,nkar,control)
	if(.not. dix_rms_fi_pr(control,dis_id,' File protection  : '//
     1            line(1:nkar))) goto 99
c
	write(line,10021) zext(fab.fab$w_gbc)
10021	format(' Globalbuffercount: ',i10)
	if(.not. dix_rms_fi_pr(control,dis_id,line)) goto 99
c
	if(.not. dix_rms_fi_pr(control,dis_id,':Record')) goto 99
c
c Record
c
	line = ' '
	k = zext(fab.fab$b_rat)
	if(btest(k,fab$v_cr )) line = 'Carriage-return'
	if(btest(k,fab$v_FTN)) line = 'Fortran'
	if(btest(k,fab$v_PRN)) line = 'Print'
	if(is_seq) then
	  if(btest(k,fab$v_blk)) then
	  else
	    line = 'NoBlockspan,'//line
	  end if
	endif
	if(is_var) then
	  if(btest(k,fab$v_msb)) then
	    line = 'MSB,'//line
	  end if
	endif
	if(line .eq. ' ') line = 'NONE'
	if(.not. dix_rms_fi_pr(control,dis_id,' Record attribute : '//
     1           line(1:30))) goto 99
c
	call  dix_rms_fill_xab(fab,xabfhc,xab$c_fhc,xab$k_fhclen)
c
	write(line,1002) zext(xabfhc.xab$w_mrz)
1002	format(' Max record size  : ',i10)
	if(.not. dix_rms_fi_pr(control,dis_id,line)) goto 99
	write(line,1003) xabfhc.xab$w_lrl
1003	format(' Longest record   : ',i10)
	if(.not. dix_rms_fi_pr(control,dis_id,line)) goto 99
c
c Allocation
c
	if(.not.dix_rms_fi_pr(control,dis_id,':Allocation')) goto 99
	write(line,1004) xabfhc.xab$l_ebk,xabfhc.xab$w_FFB
1004	format(' EOF block        : ',i10,' (FFB = ',i4,')')
	if(.not. dix_rms_fi_pr(control,dis_id,line)) goto 99
	write(line,1005) xabfhc.xab$l_hbk
1005	format(' Allocated blocks : ',i10)
	if(.not. dix_rms_fi_pr(control,dis_id,line)) goto 99
	write(line,10041) zext(fab.fab$b_bks)
10041	format(' Bucketsize       : ',i10)
	if(.not. dix_rms_fi_pr(control,dis_id,line)) goto 99
c
	if(fab.fab$b_org .ne. fab$c_idx) goto 99
c
c The rest is only defined for indexed files
c
	call  dix_rms_fill_xab(fab,xabsum,xab$c_sum,xab$k_sumlen)
c
	if(xabsum.xab$b_noa .gt. 0) then
	  if(.not.dix_rms_fi_pr(control,dis_id,':Areas')) goto 99
	  if(.not. dix_rms_fi_pr(control,dis_id,
     1      ' Area Allocation bucketsize extension')) goto 99
	end if
	do k=0,xabsum.xab$b_noa-1
	  xaball.xaball.xab$b_aid = k
	  call  dix_rms_fill_xab(fab,xaball,xab$c_all,xab$k_alllen)
	  write(line,1006) k,xaball.xaball.xab$l_alq,
     1                zext(xaball.xab.xab$b_bkz),
     1                     xaball.xaball.xab$w_deq
1006	  format(1x,i4,1x,i10,1x,i5,i10)
	  if(.not. dix_rms_fi_pr(control,dis_id,line)) goto 99
	end do
c
c Key information
c 
	if(.not. dix_rms_fi_pr(control,dis_id,':Keyinformation')) goto 99
	if(.not. dix_rms_fi_pr(control,dis_id,
     1  '                                 ..INDEX. ..DATA..')) goto 99
	nk = 0
	call sys$fao('  Nr Type  Dup Chg Null  Pos Siz Area Bkt Area Bkt  ',
     1               nk,line)
	pos_key = nk
	line(nk:) = 'Keyname'
c
c Compute remaining width
c
	if(do_des) then
c
c We need two columns, compute size
c
	  width_key = (control.ncols - nk - 1)/2
	  width_key = min(len(keynam),width_key)	!key_width
	  nk = nk + width_key + 1
	  pos_fld = nk
	  width_fld = control.ncols - nk
	  line(nk+1:) = 'Field'
	  nk = nk + 6
	else
	  width_key = len(keynam)	!fits in 80 cols
	  width_fld = 0
	  line(nk:) = 'Keyname'
	  nk = nk + 7
	endif
	if(.not. dix_rms_fi_pr(control,dis_id,line(1:nk))) goto 99
	if(.not.  dix_rms_fi_pr(control,dis_id,
     1  '                                   Nr siz   Nr siz')) goto 99
c
	xabkey.xab$l_knm = %loc(keynam)
c
	do key=0,xabsum.xab$b_nok-1
	  xabkey.xab$b_ref = key
c
	  call dix_rms_fill_xab(fab,xabkey,xab$c_key,xab$k_keylen)
	  nk = index(keynam,NULL)
	  if(nk .gt. 0) keynam(nk:) = ' '
	  call dix_rms_cvt_keytype(xabkey.xab$b_dtp,ktp)
	  dupflg = 'N'
	  if(btest(zext(xabkey.xab$b_flg),xab$v_dup)) dupflg = 'Y'
	  chgflg = 'N'
	  if(btest(zext(xabkey.xab$b_flg),xab$v_dup)) chgflg = 'Y'
	  nulflg = 'NO'
	  if(btest(zext(xabkey.xab$b_flg),xab$v_nul)) then
	    write(nulflg(1:3),'(z2.2)') zext(xabkey.xab$b_nul)
	  endif
c	  
	  write(line,1010) key,ktp(1:5),
     1                        dupflg(1:3),chgflg(1:3),nulflg(1:3),
     1                        xabkey.xab$w_pos0,
     1                        zext(xabkey.xab$b_siz0),
     1                        xabkey.xab$b_ian,
     1                        xabkey.xab$b_ibs,
     1                        xabkey.xab$b_dan,
     1                        xabkey.xab$b_dbs
1010	  format(1x,i3,1x,a,1x,3a4,i5,1x,i3,i5,i4,i5,i4)
	  nk_key = dix_util_get_len_fu(keynam) 
	  do segment_nr=1,xabkey.xab$b_nsg
c
	    if(segment_nr .gt. 1) then
	      write(line,1020) xabkey.xab$w_pos(segment_nr),
     1                         zext(xabkey.xab$b_siz(segment_nr))
1020	      format(23x,i5,1x,i3)
	    endif
c
	    if(do_des) then
	      call dix_rms_get_keyname(
     1                 zext(xabkey.xab$w_pos(segment_nr)),
     1                 zext(xabkey.xab$b_siz(segment_nr)),
     1                 des_expanded,flds,nk_fld)
	    else
	      nk_fld = 0
	    endif
	    if(nk_key .eq. 0) nk_key = 1	!force first time print
c
c Now fit in keynam and names
c
	    do while(nk_key .gt. 0 .or. nk_fld .gt. 0)
	      if(nk_key .gt. 0) then
	        nk = min(width_key,nk_key)
	        line(pos_key:pos_key+nk) = keynam(1:nk)
	        nk_key = nk_key - nk
	        keynam = keynam(nk+1:)
	        nk = pos_key + nk
	      endif
	      if(nk_fld .gt. 0) then
	        nk = min(width_fld,nk_fld)
	        line(pos_fld:pos_fld+nk) = flds(1:nk)
	        nk_fld = nk_fld - nk
	        flds = flds(nk+1:)
	        nk= pos_fld + nk
	      end if
	      if(.not. dix_rms_fi_pr(control,dis_id,line(1:nk))) goto 99
	      line = ' '
	    end do
	  end do
c
c If number of segments is >1, print total keysize
c
	  if(xabkey.xab$b_nsg .gt. 1) then
	    nk = 0
	    call sys$fao('                   Total     !3UL',nk,line,
     1               %val(zext(xabkey.xab$b_tks)))
	    if(.not. dix_rms_fi_pr(control,dis_id,line(1:nk))) goto 99
	  endif
	end do
99	return
	end
	subroutine dix_rms_copy_rfa(rfas,rfad)
	implicit none
c
	integer*2 rfas(3)
	integer*2 rfad(3)
c
	integer*4 k
c
	do k=1,3
	  rfad(k) = rfas(k)
	end do
	return
	end
	subroutine dix_rms_return_rfa(file,rfa)
	implicit none
c
c Return the rfa field to the caller
c
	include 'dix_def.inc'
	record /file_info/ file
	record /rfa/ rfa
c
	include '($rabdef)'
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	integer*4 k
c
	p_rab = file.rabadr
c
	do k=1,3
	  rfa.rfa(k) = rab.rab$w_rfa(k)
	end do
	return
	end	
	subroutine dix_rms_put_rfa(file,rfa)
	implicit none
c
c Set the rfa field to the rab
c
	include 'dix_def.inc'
	record /file_info/ file
	record /rfa/ rfa
c
	include '($rabdef)'
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	integer*4 k
c
	p_rab = file.rabadr
c
	do k=1,3
	  rab.rab$w_rfa(k) = rfa.rfa(k) 
	end do
	return
	end	
	subroutine dix_rms_cvt_keytype(keytype,ktp)
	implicit none
c
c COnvert key type to text
c
	byte keytype
	character*(*) ktp
c
	include '($xabkeydef)'
c
	if(keytype .eq. xab$c_bn2) then
	  ktp = 'BIN2'
	elseif(keytype .eq. xab$c_dbn2) then
	  ktp = 'DBIN2'
	elseif(keytype .eq. xab$c_bn4) then
	  ktp = 'BIN4'
	elseif(keytype .eq. xab$c_dbn4) then
	  ktp = 'DBIN4'
	elseif(keytype .eq. xab$c_bn8) then
	  ktp = 'BIN8'
	elseif(keytype .eq. xab$c_dbn8) then
	  ktp = 'DBIN8'
	elseif(keytype .eq. xab$c_in2) then
	  ktp = 'INT2'
	elseif(keytype .eq. xab$c_din2) then
	  ktp = 'DINT2'
	elseif(keytype .eq. xab$c_in4) then
	  ktp = 'INT4'
	elseif(keytype .eq. xab$c_din4) then
	  ktp = 'DINT4'
	elseif(keytype .eq. xab$c_in8) then
	  ktp = 'INT8'
	elseif(keytype .eq. xab$c_din8) then
	  ktp = 'DINT8'
	elseif(keytype .eq. xab$c_col) then
	  ktp = 'COL'
	elseif(keytype .eq. xab$c_dcol) then
	  ktp = 'DCOL'
	elseif(keytype .eq. xab$c_pac) then
	  ktp = 'PAC'
	elseif(keytype .eq. xab$c_dpac) then
	  ktp = 'DPAC'
	elseif(keytype .eq. xab$c_stg) then
	  ktp = 'STG'
	elseif(keytype .eq. xab$c_dstg) then
	  ktp = 'DSTG'
	else
	  ktp = '?????'
	end if
	return
	end
	function dix_rms_read_prev_rec_idx(control,file)
	implicit none
c
c Try to read the previous record for an indexed file
c
	include 'dix_def.inc'
	include '($rabdef)'
	include '($rmsdef)'
c
	record /control/ control		!:i: control block
	record /file_info/ file		!:io: file info block
	integer*4 dix_rms_read_prev_rec_idx
c
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
	integer*4 istat,k,nb_key,jstat,nk_rfa
	byte key_data(255)
	character*30 rfaasc
c
	integer*4 dix_rms_get_keyinfo
	integer*4 dix_rms_sys_get
	integer*4 dix_rms_get_rfa
	integer*4 sys$get
	external dix_msg_nullkey
	external dix_msg_recdisapp
c
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	record /rfa/ orig_rfa,save_rfa,work_rfa
c
c
	call dix_main_print_debug(control,debug_file,
     1        ' Read prev record for keyed files ')
c
	call dix_main_check_mod_record(control,file)
c
c We must do this the hard way
c  recreate the key
c  read /keylt=key
c  remebmer rfa
c  read forward until rfa=orig rfa
c  read_rfa from the remembered rfa
c
	call dix_rms_return_rfa(file,orig_rfa)
	istat = dix_rms_get_keyinfo(file,file.cur_key,k)
	if(.not. istat) goto 90
	if((control.debug .and. debug_file) .ne. 0) then
	  call dix_rms_rfa_asc(orig_rfa,nk_rfa,rfaasc)
	  call dix_main_print_debug(control,debug_file,
     1         ' RFA of original record = '//rfaasc(1:nk_rfa))
	endif
	p_key_info = k
	nb_key = 0
c
c Build up the key from the various key segments
c
	call dix_rms_get_key_value(key_info,file.data,nb_key,key_data)
	if(key_info.null_key .ge. 0) then
c
c We have a valid NULL key
c
	  do k=1,nb_key
	    if(zext(key_data(k)) .ne. key_info.null_key) goto 11
	  end do
c
c All bytes of the key are NULL-key values, return a message (should not happen)
c
	  istat = %loc(dix_msg_nullkey)
	  goto 90
	endif
c
c Get key via normal key (and set key_nr right)
c
11	p_rab = file.rabadr
        rab.rab$l_rop = rab$m_nxt .or. rab$m_rev
c
	rab.rab$l_ubf = %loc(file.data.data_rec)
	rab.rab$l_rhb = %loc(file.data.vfc_data)
	rab.rab$w_usz = max_buf
	rab.rab$b_rac = rab$c_key
	rab.rab$l_kbf = %loc(key_data)
c
c  Fortran has signed bytes
c	rab.rab$b_ksz = nb_key
c	rab.rab$b_krf = file.cur_key
	call lib$movc3(1,file.cur_key,rab.rab$b_krf)
	call lib$movc3(1,nb_key,rab.rab$b_ksz)
c
c Now get the data
c
	call dix_main_print_debug(control,debug_file,
     1        '  Get keyed rab '//file.fnam(1:file.nk_fnam))
	istat = dix_rms_sys_get(control,rab,file)
	if(.not. istat) then
c
c Could not get the record with a keyvalue less than the current
c  this migh be because this record is the record with the first keyvalue
c let try to read keyle, but if we then find the same record, we were
c on the first record
c
          rab.rab$l_rop = rab$m_eqnxt .or. rab$m_rev
          istat = dix_rms_sys_get(control,rab,file)
          if(.not. istat) goto 70
c
c Now if the rfa is the same, signal an error (we were already on
c  the first record)
c
          call dix_rms_return_rfa(file,work_rfa)
          if(work_rfa.bbnr   .eq. orig_rfa.bbnr .and.
     1       work_rfa.offset .eq. orig_rfa.offset) then
	    istat = rms$_bof
	    goto 70
	  endif
        endif
c
c Now we have the record with a key value less than the current
c Now try to read forward, and see if the next record has the orig_rfa
c  if so, the save_rfa is the record we want
c		
	call dix_main_print_debug(control,debug_file,
     1        '  Skipping over records ')
c
	rab.rab$l_rop = rab$m_rrl .or. rab$m_lim
	rab.rab$b_rac = rab$c_seq
c
c Get the key of this record
c
	call dix_rms_get_key_value(key_info,file.data,nb_key,key_data)
c
c Loop , read the next record until the rfa=orig_rfa (or status=ok_lim)
c
20	call dix_rms_return_rfa(file,save_rfa)	!save rfa
c
	if((control.debug .and. debug_file) .ne. 0) then
	  call dix_rms_rfa_asc(save_rfa,nk_rfa,rfaasc)
	  call dix_main_print_debug(control,debug_file,
     1         ' RFA of current record = '//rfaasc(1:nk_rfa))
	  call dix_main_print_debug(control,debug_file,
     1                           '  Reading next rec ')
	endif
	istat = sys$get(rab,,)
c
c An error should occur if the key value has changed (the _LIM is up)
c
	if(.not. istat) then
	  if(istat .ne. rms$_rtb) goto 70
	endif
c
c All ok, see if (ok_lim is a sucesful status)
c
	call dix_rms_return_rfa(file,work_rfa)
c
	if(work_rfa.bbnr   .ne. orig_rfa.bbnr .or.
     1     work_rfa.offset .ne. orig_rfa.offset) then
c
c Not yet the correct record, see if status returned ok_lim
c if so, we went too far, the original record must have been deleted between
c the read_lt and the sequential reads. This is not very likely, but
c we check anyhow
c
	  if(istat .eq. rms$_ok_lim) goto 60	!unexpected
	  goto 20	!try next record
	endif
c
c Now the rfa is the same as the original record, so
c  save_rfa is the record we need
c
	if((control.debug .and. debug_file) .ne. 0) then
	  call dix_rms_rfa_asc(save_rfa,nk_rfa,rfaasc)
	  call dix_main_print_debug(control,debug_file,
     1         ' RFA of wanted record = '//rfaasc(1:nk_rfa))
	endif
c
	istat = dix_rms_get_rfa(control,file,file.cur_key,save_rfa)
	if(.not. istat) goto 70
	goto 90
60 	istat = %loc(dix_msg_recdisapp)
c
c Some error occurred, try to reread the orig_rfa record
c
70	if((control.debug .and. debug_file) .ne. 0) then
	  call dix_rms_rfa_asc(orig_rfa,nk_rfa,rfaasc)
	  call dix_main_print_debug(control,debug_file,
     1                           '  Reading original RFA '//
     1                            rfaasc(1:nk_rfa))
	endif
c
	jstat = dix_rms_get_rfa(control,file,file.cur_key,orig_rfa)
	if(.not. jstat) then
c
c Now signal the original message and return the new one
c
	  call dix_message(control,%val(istat))
	  istat = jstat
	endif
c
90	dix_rms_read_prev_rec_idx = istat
	return
	end		
	subroutine dix_rms_rfa_asc(rfa,nk_rfa,rfaasc)
	implicit none
c
	include 'dix_def.inc'
c
	record /rfa/ rfa
	integer*4 nk_rfa
	character*(*) rfaasc
c
	nk_rfa = 0
	call sys$fao('(!UL,!UW)',nk_rfa,rfaasc,
     1        %val(rfa.bbnr),%val(rfa.offset))
	return
	end
	subroutine dix_rms_get_key_value(key_info,data,nb_key,key_data)
	implicit none
c
c Copy the data from the record to make a key value
c
	include 'dix_def.inc'
	record /key_info/ key_info	!:i: the key information
	record /data_info/ data		!:i: the record data
	integer*4 nb_key		!:o: the lenght of the key
	byte key_data(*)		!:o: the key value
c
	integer*4 k,siz,pos,l
c
	nb_key = 0
c
c There can be max 8 key_segments
c
	do k=1,8
	  siz = key_info.keysiz(k)
	  if(siz .gt. 0) then
	    pos = key_info.keypos(k)
c
c Valid segment, append the data
c check if in record
c
	    if(pos+siz .lt. data.nb_data) then	    
c
c It is still in the record, do a fast move
c
	      call lib$movc3(siz,data.data_rec(pos+1),key_data(nb_key+1))
	    else
c
c DOes not completely fit in the record, do a byte/byte move
c the data_rec is defines as starting at byte 1
c so the compare is one off
c
	      do l=1,siz
	        if(pos .ge. data.nb_data) then
	          key_data(nb_key+l) = 0
	        else
	          key_data(nb_key+l) = data.data_rec(pos)
	        endif
	        pos = pos + 1
	      end do
	    endif
	    nb_key = nb_key + siz
	  endif
	end do
	return
	end
	function dix_rms_read_prev_rec_rel(control,file)
	implicit none
c
c Try to read the previous record for an relative file
c
	include 'dix_def.inc'
	include '($rabdef)'
	include '($rmsdef)'
c
	record /control/ control		!:i: control block
	record /file_info/ file		!:io: file info block
	integer*4 dix_rms_read_prev_rec_rel
c
c Read the key value < the current one
c
	record /rabdef/ rab
	pointer (p_rab,rab)
c
	integer*4 istat,recnr
	integer*4 dix_rms_sys_get
	external dix_msg_firstrec
c
	call dix_main_print_debug(control,debug_file,
     1        'Get prev rec relative  '//
     1          file.fnam(1:file.nk_fnam))
c
c
	recnr = file.rec_nr
	if(recnr .eq. 1) then
	  istat = %loc(dix_msg_firstrec)
	  goto 90
	endif
c
c First check is unmodified data present
c
	call dix_main_check_mod_record(control,file)
c
	p_rab    = file.rabadr
        rab.rab$l_rop = 0
	rab.rab$l_ubf = %loc(file.data.data_rec)
	rab.rab$l_rhb = %loc(file.data.vfc_data)
c
	rab.rab$w_usz = max_buf
	rab.rab$b_rac = rab$c_key
	rab.rab$l_kbf = %loc(recnr)
	rab.rab$b_krf = 0
	rab.rab$b_ksz = 4
c
c Get the data for record  number -1
c
10	recnr = recnr - 1
	if(recnr .gt. 0) then
	  call dix_main_print_debug(control,debug_file,'  Get prevrec rab  ')
	  istat = dix_rms_sys_get(control,rab,file)
	  if(istat .eq. rms$_rnf) goto 10
	else
	  istat = rms$_bof
	endif
c
	if(istat) then
	  file.data.nb_data = zext(rab.rab$w_rsz)
	  file.data.nb_vfc  = file.nb_vfc
	  file.rec_nr = recnr
	  call dix_dump_copy(file)
	  file.got_record = .true.
	else
	  file.data.nb_data = 0
	  file.data.nb_vfc  = 0
	  file.got_record   = .false.
	end if
c
c  Mark all desciptions as not expanded
c
	call dix_des_inv_des(control,file)
c
90	dix_rms_read_prev_rec_rel = istat
	return
	end