subroutine util_cli_get_number(name,def_val,value)
	implicit none
c
	include 'dix_def.inc'
c
c get a number from the cli command line and translate to number
c with a default value
c
	character*(*) name	!:i: the name of the qualifier
	integer*4 def_val	!:i: default value
	integer*4 value		!:o: the result
c#
	character*(max_short_line_length) line
	integer*4 nk
c
	call cli$get_value(name,line,nk)
	if(nk .eq. 0) then
	  value = def_val
	else
	  read(line(1:nk),2000) value
2000	  format(i10)
	endif
	return
	end		
 	function dix_util_overlap(pos1,len1,pos2,len2)
	implicit none
c
c If pos1(len1) overlaps pos2(len2) then return true
c
	integer*4 pos1		!:i: position 1
	integer*4 len1		!:i: length 1
	integer*4 pos2          !:i: position 2
	integer*4 len2		!:i: length 2
	logical*4 dix_util_overlap
c#
	dix_util_overlap = 
     1  (pos1      .ge. pos2 .and. pos1      .lt. pos2+len2) .or.
     1  (pos1+len1 .gt. pos2 .and. pos1+len1 .le. pos2+len2) .or.
     2  (pos1      .lt. pos2 .and. pos1+len1 .gt. pos2+len2)

	return
	end
c
	subroutine dix_util_copy_bits(nbit,offset,src,dest,nbyte)
	implicit none
	include 'dix_size_def.inc'
c
c Copy nbits from bit offset of data src to dest(nbyte) long
c
	integer*4 nbit		!:i: #bits to copy
	integer*4 offset        !:i: offset in bits in buffer src
	byte src(*)             !:i: source buffer
	byte dest(*)            !:o: dest buffer
	integer*4 nbyte         !:i: nbytes to fill
c#
	call dix_util_move_bits(nbit,src,offset,dest,0,
     1                nbyte*bits_per_byte,.false.)
	return
	end
	subroutine dix_util_copy(nb,src,dest)
	implicit none
c
c copy data from src to dest (bytes)
c
	integer*4 nb		!:i: length
	byte src(*)		!:i:source data
	byte dest(*)		!:o: result data
c#
	integer idx,nb_copy
c
	idx = 1
c
c MOVc3 can only copy word length data, so split in parts if nb > 65536
c
10	nb_copy = min(nb-idx + 1,65535)
	call lib$movc3(nb_copy,src(idx),dest(idx))
	idx = idx + nb_copy
	if (idx .le. nb) goto 10
c
	return
	end
c

	subroutine dix_util_fill(byt,nb,dest)
	implicit none
c
c Fill data in dest with binary 0
c
	byte byt		!:i: the filler byte
	integer*4 nb		!:i: length
	byte dest(*)		!:o: result data
c#
	call lib$movc5(0,0,byt,nb,dest)
	return
	end
c
	subroutine dix_util_left_just(line,nkar)
	implicit none
c
c left justify data (remove leading blanks)
c
	character*(*) line		!:io: the line
	integer*4 nkar			!:io: resulting length
c#
	integer*4 ipos
c
	if(line(1:nkar) .eq. ' ') then
	  nkar = 0
	else
	  ipos = 1
	  do while(line(ipos:ipos) .eq. ' ')

	    ipos = ipos + 1
	  end do
	  if(ipos .gt. 1) then
	    line = line(ipos:)
	    nkar = nkar - ipos + 1
	  end if
	end if
	return
	end
c
	function dix_util_kar_conv(kar)
	implicit none
c
c Convert character to printable one, so change unprintable char to .
c
	character kar
	character dix_util_kar_conv
c#
	logical*4 dix_util_kar_in_ran
c
	if(dix_util_kar_in_ran(ichar(kar))) then
	  dix_util_kar_conv = kar
	else
	  dix_util_kar_conv = '.'
	end if
	return
	end

	function dix_util_kar_in_ran(ikar)
	implicit none
c
c check if character is printable one
c
	integer*4 ikar
	logical*4 dix_util_kar_in_ran
c#
	dix_util_kar_in_ran =
     1      (ikar .ge.  32 .and. ikar .le. 126) .or.
     1      (ikar .ge. 160 .and. ikar .le. 254)
	return
	end
	function dix_util_get_field(fieldnr,fields,field,nkar)
	implicit none
c
	include 'dix_def.inc'
c
c Return field value from string
c We have two formats for fields
c 1. value=name,value=name...   (named values)
c 2. name,,name,,name...        (names by index)
c
c
	integer*4 fieldnr		!:i: index
	character*(*) fields		!:i: the list of strings
	character*(*) field		!:o: field value
	integer*4 nkar			!:o: length of field
	logical*4 dix_util_get_field	!:f: true if found
c#
	character*(max_short_line_length) tmp
	integer*4 ipos,nk
c
	logical*4 str$element
	integer*4 dix_util_get_len
c
	nkar = 0
	if(index(fields,'=') .ne. 0) then
c
c Case 1, subfields must be in format value=name
c make the string ",fieldnr=" and asee if we can find it
c
	  call sys$fao(',!SL=',nk,tmp,%val(fieldnr))
	  ipos = index(fields,tmp(1:nk))
	  if(ipos .eq. 0) then
c
c Not found, but the first one does not have the laeding , so try again
c without the , 
c
	    if(fields(1:nk-1) .ne. tmp(2:nk)) goto 90
c
c Yes, now set ipos to 0, so the next statement will copy the right part
c
	    ipos = 0
	  end if
c
c Got it, now copy the part after the = sign, and terminate with the
c next , or the length of the string (for the last entry)(
c
	  field = fields(ipos+nk:)
	  nkar = index(field,',')-1
	  if(nkar .lt. 0) nkar = dix_util_get_len(field)
	  field(nkar+1:) = ' '
	else
c
c The next format, name,name,,,name,,
c take the "fieldnr"th element of fields (if it exists)
c
	  if(str$element(field,fieldnr,',',fields)) then
	    nkar = len(field)
 	    call dix_util_left_just(field,nkar)
	    nkar = dix_util_get_len(field)
	  end if
	end if
c
c Now check for the result, if nkar > 0, we have one
c
90	if(nkar .eq. 0) field = ' '
	dix_util_get_field = nkar .gt. 0
	return
	end
	function dix_util_find_field(field,fields,fieldnr)
	implicit none
c
	include 'dix_def.inc'
c
c The reverse from get_field,
c see if we can  find the name "field" in fields
c We have two formats for fields
c 1. value=name,value=name...   (named values)
c 2. name,,name,,name...        (names by index)
c
	character*(*) field		!:i: the name to be found
	character*(*) fields		!:i: the list of fieldnames
	integer*4 fieldnr		!:o: number
	logical*4 dix_util_find_field	!:f: true if found
c#
	logical*4 str$element
	integer*4 dix_util_get_len
	character*(max_symbol_name_length) field1,field2
	integer*4 nk,ipos
c
	fieldnr = -1
c
	dix_util_find_field = .false.
c
	if(index(fields,'=') .ne. 0) then
c
c Format 1
c  value1=name1,value2=name2,value3=name3...
c
c Make a search string as "=name,"
c
	  nk = dix_util_get_len(field)
	  call str$upcase(field2,'='//field(1:nk)//',')
	  nk = nk + 2
c
c Go through all fields, ansd see if we can find i
c
	  fieldnr = 0
	  do while(str$element(field1,fieldnr,',',fields))
	    call str$upcase(field1,field1)
	    ipos = index(field1,field2(1:nk))
	    if(ipos .ne. 0) goto 40	!got a match
	    fieldnr = fieldnr + 1	!try the next
	  end do
c
c If we came here we have no match, check for last entry, 
c  that does not have a trailing ,
c Get the last field back
c
	  call str$element(field1,fieldnr-1,',',fields)
	  call str$upcase(field1,field1)
c
c And check for the search string (without the trailing ,)
c
	  ipos = index(field1,field2(1:nk-1))	
	  if(ipos .ne. 0) goto 40	!got it
	  goto 99			!not found
c
c Field1 has the correct data, value=name
c the = is at pos ipos, so the 1:ipos-1 must be a number
c
40	  read(field1(1:ipos-1),'(i10)',err=99) fieldnr 
c
c Successful
c
	  goto 90
	else
c
c FOrmat2
c name1,name2,name3
c
	  fieldnr = 0
	  do while(str$element(field1,fieldnr,',',fields))
	    if(field1 .eq. field) goto 90
	    fieldnr = fieldnr + 1
	  end do
	  fieldnr = -1
	end if
c
	goto 99
c
90	dix_util_find_field = .true.
c
99	return
	end
	function dix_con_hex_in_string(string,nk,tobin)
	implicit none
c
c Replace all %XX to the hex value   (if tobin is true)
c         or all unprintables to %XX    (tobin is false)
c
	character*(*) string	!:io: the text to b checked
	integer*4 nk		!:io: the length of th string
	logical*4 tobin		!if true convert from text to binary
	logical dix_con_hex_in_string !:f: true if something converted 
c#
	logical*4 dix_util_kar_in_ran
	integer dix_util_hex_kar
c
	integer*4 ipos,k,k1
	logical stat
	integer*4  max_str_size
	parameter (max_str_size=2)
	character*(max_str_size) tmp
c
	ipos = 1
	stat = .false.
	do while(ipos .le. nk) 
	  if(tobin) then               
c
c To binary mode, replace %XX to one binary char, but leave %% to be one %
C
	    if(string(ipos:ipos) .eq. '%') then
	      if(string(ipos+1:ipos+1) .eq. '%') then
	        string(ipos+1:) = string(ipos+2:)
	        nk = nk - 1
	      else
c
c %XX expected, tty to convert next two chars
c
	        k1 = dix_util_hex_kar(ichar(string(ipos+1:ipos+1)))
	        if(k1 .ge. 0) then
	          k = k1*16
	          k1 = dix_util_hex_kar(ichar(string(ipos+2:ipos+2)))
	          if(k1 .ge. 0) then
	            k = k+k1	  
c
c Successful, replace the %XX by the one binary char
c
	            stat = .true.
	            string(ipos:) = char(k)//string(ipos+3:)
	            nk = nk - 2
	          endif
	        endif
	      end if
	    end if
	  else
c
c From bin to ascii
c
	    if(.not. dix_util_kar_in_ran(ichar(string(ipos:ipos)))) then
c
c Unprintable char, replcae by %XX
c
	      write(tmp,1000) ichar(string(ipos:ipos))
1000	      format(z2.2)
	      string(ipos:) = '%'//tmp//string(ipos+2:)
	      nk = nk + 2
	      ipos = ipos + 2
	    end if
	  endif
50	  ipos = ipos + 1
	end do
	dix_con_hex_in_string = stat
	return
	end
c
	subroutine dix_util_link_in(link,top)
	implicit none
c
c Link in "link" in the link started with "top"
c
	include 'dix_def.inc'
	record /link/ link
	integer*4 top
c#
	record /link/ tlink
c	integer*4 p_tlink
	pointer(p_tlink,tlink)
c
	link.forw = 0
c
	if(top .eq. 0) then
	  link.backw = 0
	  top = %loc(link)
	else
	  p_tlink = top
	  do while(tlink.forw .ne. 0)
	    p_tlink = tlink.forw
	  end do
	  tlink.forw = %loc(link)
	  link.backw = p_tlink
	end if
	return
	end 
	subroutine dix_util_link_out(link,top)
	implicit none
c
c Link in "link" in the link started with "top"
c
	include 'dix_def.inc'
	record /link/ link		!:io: link structure
	integer*4 top			!:io: the top pointer
c#
	record /link/ next_link,prev_link
	pointer(p_next_link,next_link)
	pointer(p_prev_link,prev_link)
c
	p_next_link = top		
	p_prev_link = 0
c
c Let next link be equal to link, and remmeber previous
c
	do while(p_next_link .ne. %loc(link))
	  if(p_next_link .eq. 0) then
	    write(*,*) 'Internal error in link_out'
	    stop 
	  endif
	  p_prev_link = p_next_link			!remember prev
	  p_next_link = next_link.forw			!set to next
	end do
c
c Now next_link = link
c     prev_link = previous (or 0)
c
	if(p_prev_link .eq. 0) then
c
c No previous record, so next is new top
c
	  top = next_link.forw		!set new top
	else
c
c there was a previous, set previous to forward to next
c
	  prev_link.forw = next_link.forw
	end if
c
c CHeck if next record exists
c
	if(next_link.forw .ne. 0) then
c
c Netx record exists, set it to point to either 0, or previos
c
	  p_next_link = next_link.forw
	  next_link.backw = p_prev_link
	end if
90	return
	end
	subroutine dix_util_insert_bits(source,offset,nbit,dest)
	implicit none
c
c Insert a bit string in a data string
c
	integer*4 source(*)           	!:i: the source
	integer*4 nbit		        !:i: #bits in source
	integer*4 offset		!:i: offset in buffer
	integer*4 dest			!:io: data buffer 
c#
	call dix_util_move_bits(nbit,source,0,dest,offset,nbit,.false.)
	return
	end
	subroutine dix_util_collapse(line,nk,quotes)
	implicit none
c
c Remove a non-significant spaces (outside a string)
c
	character*(*) line	!:io: the line
	integer*4 nk            !:io: the lnegth (updated)
	logical quotes		!:i: look for quotes?
c#
	integer*4 k,nk1
	logical in_string
c
	nk1 = 0
	in_string = .false.
	do k=1,min(nk,len(line))
	  if(quotes .and. line(k:k) .eq. '"') in_string = .not. in_string
	  if(in_string .or. line(k:k) .ne. ' ') then
	    nk1 = nk1 + 1
	    line(nk1:nk1) = line(k:k)
	  end if
	end do
	nk = nk1
	line(nk1+1:) = ' '
	return
	end
	subroutine dix_util_get_type_name(enttyp,enttyp_nam,enttyp_len,
     1                                   dataitem)
	implicit none
c
c Get the name for an type
c
	integer*4 enttyp  		!:i: the type 
	character*(*) enttyp_nam	!:o: the name of the type
	integer*4 enttyp_len		!:o: length of entyp_nam
	integer*4 dataitem		!:o: is it a data item
c#
	include 'dix_def.inc'
c
	integer*4 str$element
c
	if(.not.str$element(enttyp_nam,enttyp,'/',type_names)) enttyp_nam = ' '
	enttyp_len = len(enttyp_nam)
	call dix_util_collapse(enttyp_nam,enttyp_len,.false.)
	if(enttyp_nam(enttyp_len:enttyp_len) .eq. '&') then
	  enttyp_nam(enttyp_len:) = ' '
	  enttyp_len = enttyp_len - 1
	  dataitem = .false.
	else
	  dataitem = .true.
	endif
	return
	end
	function dix_util_find_char_bracket(name,kars,quotes)
	implicit none
c
c Find a character taking care of ()
c
	character*(*) name        	!:i: the string to serch in
	character*(*) kars		!:i: the kar(s) to find
	logical quotes			!:i: quotes used?
	integer*4 dix_util_find_char_bracket    !:f: the pos (or 0)
c#
	integer*4 k,level
	logical out_string
c
	out_string = .true.
c
	level = 0
	do k=1,len(name)
	  if(quotes .and. name(k:k) .eq. '"') out_string = .not. out_string 
	  if(out_string) then
	    if(name(k:k) .eq. ')') level = level - 1
	    if(index(kars,name(k:k)) .ne. 0 .and. level .le. 0) goto 50
	    if(name(k:k) .eq. '(') level = level + 1
	  endif
	end do
	k = 0
50	dix_util_find_char_bracket = k	  
	return
	end
	function dix_util_get_len(string)
	implicit none
c
c Get the length (the pos of the first space - 1)
c
	character*(*) string		!:i: the string
	integer*4 dix_util_get_len	!:f: the length
c#
	integer*4 nk
c
	nk = index(string,' ')-1
	if(nk .lt. 0) nk = len(string)
	dix_util_get_len = nk
	return
	end
	function dix_util_get_len_fu(string)
	implicit none
c
c  Get the length of the string (the last nonblank)
c
	character*(*) string		!:i: the string
	integer*4 dix_util_get_len_fu	!:f: the length (or 0)
c#
	integer*4 nk
c
	do nk=len(string),1,-1
	  if(string(nk:nk) .ne. ' ') goto 10
	end do
	nk = 0
10	dix_util_get_len_fu = nk
	return
	end
	subroutine dix_util_con_nr(offset,has_fields,offasc,
     1                             nk_off,hex,control)
	implicit none
	include 'dix_def.inc'
c
c Convert offset (bit_offset) to ascii number
c if has_fields is true, the text also includes the bit_offset
c
	integer*4 offset		!:i: the (bit_)offset value
	logical*4 has_fields		!:i: need . part?
	character*(*) offasc		!:o: the text
	integer*4 nk_off		!:io: the width to fit into
	logical*4 hex			!:i: In hex format?
	record /control/ control	!:i: control block
c#
	character*(max_nr_asc_length) nroff
c
	if(nk_off .eq. 0) then
c
c Calller did not specify the width, compute it here
c
	  if(hex) then
	    write(nroff,1000) offset/bits_per_byte
1000	    format(z5)
	    nk_off = 5
 	    call dix_util_left_just(nroff,nk_off)
	  else
            call dix_con_type_intasc(4,offset/bits_per_byte,
     1              enttyp_int,nroff,nk_off,control)
	  endif
          if(has_fields) nk_off = nk_off + 2        !for . and bit 
 	endif
c
c Fill offset field
c
	if(hex) then
c
c Hex mode 
c
          if(has_fields) then
c
c Hex mode with bit offset
c
            write(nroff,1011) offset/bits_per_byte,
     1                        mod(offset,bits_per_byte)
1011        format(z<nk_off-2>,'.',z1)
          else
c
c HEx mode with the bit offset
c
            write(nroff,1012) offset/bits_per_byte
1012        format(z<nk_off>)
          end if
	else
c
c Decimal mode
c
          if(has_fields) then
c
c Decimal mode with of without bit part
c
            write(nroff,1021) offset/bits_per_byte,
     1                        mod(offset,bits_per_byte)
1021        format(i<nk_off-2>,'.',i1)
          else
c
c Decimal mode without bit part
c
            write(nroff,1022) offset/bits_per_byte
1022        format(i<nk_off>)
          end if
        end if
	offasc = nroff
	return
	end
	
	function dix_util_insert_table(control,
     1                      table,elem,extend,vm_zone,
     1                      name)
	implicit none
c
	include 'dix_def.inc'
c
c append the element at the end of the table,
c
	record /control/ control!:i: control block
	record /table/ table	!:io: table control block
	byte elem(*)            !:i: the element to be inserted
	integer*4 extend        !:i: extend in elements if not enough room
	record /vm_zone/ vm_zone!:i: zone id
	character*(*) name	!:I: name of element
	logical*4 dix_util_insert_table !:f: true if table moved
c#
	integer*4 nb_temp
	integer*4 adr_temp
c
c
c Check if no more room in table
c
	dix_util_insert_table = .false.
	if(table.allocated .le. table.count*table.size) then
c
c Not enough room
c Compute new size
c
	  dix_util_insert_table = .true.
	  nb_temp = (table.count+extend) * table.size
c
c 1. create new segment with more memory
c
	  call get_vm(control,nb_temp,adr_temp,vm_zone,.false.,name)
c
	  if(table.address .gt. 0) then
c
c Copy old data to new data, size can be >65535 bytes, so do not use
c  movc3
c
	    call dix_util_copy(table.allocated,%val(table.address),
     1                         %val(adr_temp))
c
c Delete old sement
c
	    call free_vm(control,table.allocated,table.address,vm_zone)
	  end if
c
c Adjust pointers
c
	  table.address   = adr_temp
	  table.allocated = nb_temp
	endif
c
c Insert element in table
c
	call dix_util_copy(table.size,elem,
     1          %val(table.address+table.count*table.size))
	table.count = table.count + 1				!1 more line
	return
	end
	function dix_util_get_nr(maxval,result)
	implicit none
c
	include 'dix_def.inc'
c
c Get  a number  from sys$input
c
	integer*4 maxval	!:i: max value
	integer*4 result        !:o: the value
	logical*4 dix_util_get_nr   !:f: the status of the read
c#
	character*(max_short_line_length) line
	integer*4 k,nk
c
	dix_util_get_nr = .false.
	call sys$fao('!UL',nk,line,%val(maxval))
10      write(*,1010) line(1:nk)
1010    format('$Select number (1..',a,'):')
        read(*,2000,err=10,end=90) k
2000    format(bn,i5)
        if(k .eq. 0) goto 90
        if(k .lt. 1 .or. k .gt. maxval) goto 10
	result = k
	dix_util_get_nr = .true.
90	return
	end
	subroutine dix_util_move_bits(nbits,src,src_offset,
     1                                      dst,dst_offset,
     1                                field_width,right_justify)
c
c Move some bits from somewhere to somewhere else
c
	implicit none
	include 'dix_size_def.inc'
c
	integer*4 nbits		!:i: Number of bits
	byte src(*)             !:i: source address
	integer*4 src_offset    !:i: source offset in bits from src
	byte dst(*)             !:i: destination address
	integer*4 dst_offset    !:i: destination offset in bits from src
	integer*4 field_width   !:i: field_width
	logical*4 right_justify !:i: if true do right justify
c#
	integer*4 data,sidx,didx,sofs,dofs,nbits_to_do,nb,nbytes_to_do
c
	integer*4 lib$extzv
c
	if(nbits .le. 0 .or. field_width .le. 0) goto 90
c
	sidx = src_offset/bits_per_byte+1
	didx = dst_offset/bits_per_byte+1
d	write(*,*) 'Sidx = ',sidx
d	write(*,*) 'Didx = ',didx
c
	if(mod(src_offset ,bits_per_byte) .eq. 0 .and. 
     1     mod(dst_offset ,bits_per_byte) .eq. 0 .and.
     1     mod(field_width,bits_per_byte) .eq. 0 .and. 
     1     mod(nbits      ,bits_per_byte) .eq. 0) then
c
c All boundaries are byte aligned, so we can do byte copies
c
d	  write(*,*) 'Byte oriented'
	  if(right_justify) then
	    nbytes_to_do = (field_width-nbits)/bits_per_byte
	    if(nbytes_to_do .gt. 0) then
d	      write(*,*) 'left  fill, nbytes = ',nbytes_to_do
	      call lib$movc5(0,0,0,nbytes_to_do,dst(didx))
	      didx = didx + nbytes_to_do
	    end if
	  endif
c
	  nbytes_to_do = min(field_width,nbits)/bits_per_byte
d	  write(*,*)     'Copy  data, nbytes = ',nbytes_to_do
	  call lib$movc3(nbytes_to_do,src(sidx),dst(didx))
	  didx = didx + nbytes_to_do
c
	  if(.not. right_justify) then
	    nbytes_to_do = (field_width-nbits)/bits_per_byte
	    if(nbytes_to_do .gt. 0) then
d	      write(*,*) 'right fill, nbytes = ',nbytes_to_do
	      call lib$movc5(0,0,0,nbytes_to_do,dst(didx))
	      didx = didx + nbytes_to_do
	    end if
	  endif
	else
c
c Data is not byte aligned, so we must use lib$extz and lib$insv
c
	  sofs = mod(src_offset,bits_per_byte)
	  dofs = mod(dst_offset,bits_per_byte)
d	  write(*,*) 'Bit oriented'
d	  write(*,*) 'Sofs = ',sofs
d	  write(*,*) 'Dofs = ',dofs
c
c Fill out with 0 at begin
c
	  if(right_justify) then
	    nbits_to_do = field_width-nbits
	    data = 0
	    do while(nbits_to_do .gt. 0) 
	      nb = min(nbits_to_do,32)
d	      write(*,*) 'Left  fill, nbits = ',nb,' didx = ',didx
	      call lib$insv   (data,dofs,nb,dst(didx))
	      if(nb .eq. 32) then
	        didx = didx + 4
	      else
	        dofs = dofs + nb
	      endif
	      nbits_to_do = nbits_to_do - nb
            end do
d	    write(*,*) 'Left  fill, at end didx = ',didx,' dofs = ',dofs
	  end if
c
	  nbits_to_do = min(nbits,field_width)
c
	  do while(nbits_to_do .gt. 0)
	    nb = min(nbits_to_do,32)
d	    write(*,*) 'Copy  data, nbits = ',nb,' sidx ',sidx,' didx = ',didx
	    data = lib$extzv(sofs,     nb,src(sidx))
	    call lib$insv   (data,dofs,nb,dst(didx))
	    if(nb .eq. 32) then
	      sidx = sidx + 4
	      didx = didx + 4
	    else
	      sofs = sofs + nb
	      dofs = dofs + nb
	    endif
	    nbits_to_do = nbits_to_do - nb
	  end do
d	  write(*,*) 'Copy  data, at end didx = ',didx,' dofs = ',dofs
c                                       
c Fill out with 0 at end
c
	  if(.not. right_justify) then
	    nbits_to_do = field_width-nbits
	    data = 0
	    do while(nbits_to_do .gt. 0) 
	      nb = min(nbits_to_do,32)
d	      write(*,*) 'Right fill, nbits = ',nb,' didx = ',didx
	      call lib$insv   (data,dofs,nb,dst(didx))
	      didx = didx + 4
	      nbits_to_do = nbits_to_do - nb
            end do
	  end if
	end if
c
90	return
	end

	function dix_util_file_parse(fnam,type,bpos,epos)
	implicit none
c
c Get a part of the filename
c  type = 'X' : return bpos and epos of file disk
c  type = 'D' : return bpos and epos of file directory
c  type = 'N' : return bpos and epos of file name
c  type = 'T' : return bpos and epos of file type
c  type = 'V' : return bpos and epos of file extension
c
	character*(*) fnam              !:i: filename
	character type		!:i: what, X,D,N,T,V
	integer*4 bpos			!:o: bpos of part
	integer*4 epos			!:o: epos of part
	logical*4 dix_util_file_parse	!:f: True if part found
c#
	include '($fscndef)'
	record /fscndef/ fscn_items(2)
	integer*4 istat,flags,mask
c
	integer*4 sys$filescan
c
	istat = .false.
	bpos = 0
	epos = 0
c
	if(type .eq. 'X') then
	  fscn_items(1).fscn$w_item_code = fscn$_device
	  mask = fscn$v_device
	elseif(type .eq. 'D') then
	  fscn_items(1).fscn$w_item_code = fscn$_directory
	  mask = fscn$v_directory
	elseif(type .eq. 'N') then
	  fscn_items(1).fscn$w_item_code = fscn$_name
	  mask = fscn$v_name
	elseif(type .eq. 'T') then
	  fscn_items(1).fscn$w_item_code = fscn$_type
	  mask = fscn$v_type
	elseif(type .eq. 'V') then
	  fscn_items(1).fscn$w_item_code = fscn$_version
	  mask = fscn$v_version
	else
	  goto 90
	endif
c
	fscn_items(1).fscn$w_length = 0
	fscn_items(1).fscn$l_addr = 0
c
	fscn_items(2).fscn$w_length = 0
	fscn_items(2).fscn$w_item_code = 0
	fscn_items(2).fscn$l_addr = 0
	istat = sys$filescan(fnam,fscn_items,flags)
	if(istat) istat = btest(flags,mask)
	if(istat) then
	  bpos = fscn_items(1).fscn$l_addr - %loc(fnam) + 1
	  epos = bpos + fscn_items(1).fscn$w_length - 1
	endif
90	dix_util_file_parse = istat
	return
	end
	subroutine dix_append(nk,line,topic)
	implicit none
c
c Append a string to another  (skip trailing spaces)
c
	integer*4 nk            !:io: the length of line
	character*(*) line  	!:io: string
	character*(*) topic	!:i: the string to append
c#
	integer*4 nk1

	integer*4 dix_util_get_len_fu
c
	nk1 = dix_util_get_len_fu(topic)
c
	line(nk+1:nk+nk1) = topic
	nk = nk + nk1
	return
	end
	subroutine dix_append1(nk,line,topic)
	implicit none
c
c Append a string to another (include trailing spaces)
c
	integer*4 nk            !:io: the length of line
	character*(*) line  	!:io: string
	character*(*) topic	!:i: the string to append
c#
	integer*4 nk1
c
	nk1 = len(topic)
	line(nk+1:nk+nk1) = topic
	nk = nk + nk1
	return
	end
	function test_bit(bit,mask)
	implicit none
c
c 64 bit btest
c
	integer*4 bit		!:i: the bit to test (0-63)
	integer*4 mask(2)	!:i: the bit mask
	logical test_bit	!:f: true oif bit set
c#
	test_bit = .false.
	if(bit .ge. 0 .and. bit .le. 63) then
	  if(bit .lt. 32) then
	    test_bit = btest(mask(1),bit)
	  else
	    test_bit = btest(mask(2),bit-32)
	  end if
	end if
	return
	end

	subroutine set_bit(bit,mask)
	implicit none
c
c 64 bit set 
c 
	integer*4 bit		!:i: bitnumber (0-63)
	integer*4 mask(2)	!:io: bit mask (updates)
c#		
	if(bit .ge. 0 .and. bit .le. 63) then
	  if(bit .lt. 32) then
	    mask(1) = ibset(mask(1),bit)
	  else
	    mask(2) = ibset(mask(2),bit-32)
	  endif
	endif
	return
	end
	subroutine clear_bit(bit,mask)
	implicit none
c
c 64 bit set 
c 
	integer*4 bit		!:i: the bit to clear (0-63)
	integer*4 mask(2)	!:io: the bitmask (updated)
c#
	if(bit .ge. 0 .and. bit .le. 63) then
	  if(bit .lt. 32) then
	    mask(1) = ibclr(mask(1),bit)
	  else
	    mask(2) = ibclr(mask(2),bit-32)
	  endif
	endif
	return
	end
	function ignore_message()
	implicit none
c
c Ignore a signal, used around cli$dcl_parse to 
c prevent dcl from signalling
c
	integer*4 ignore_message
	logical seen_signal
	common /ignore_message_common/ seen_signal
c#
	include '($ssdef)'
c
	seen_signal = .true.
	ignore_message = ss$_continue
	return
	end
	function dix_util_check_name(symbol)
	implicit none
c
c Check if symbol is a valie one
c  start with letter, continue with letter/digit/$/_
c
	include 'dix_def.inc'
c
	character*(*) symbol
	logical dix_util_check_name
c#
	integer*4 k,istat
c
	external dix_msg_karsallow
	external dix_msg_symbtool
	external dix_msg_symbresv
	logical str$case_blind_compare
c
	logical dix_util_legal_char
c
c CHeck length
c
	if(len(symbol) .gt. name_length) then
	  istat = %loc(dix_msg_symbtool)
	  goto 90
	end if
c
c Check for valid chars
c
	do k=1,len(symbol)
	  if(.not. dix_util_legal_char(symbol(k:k),k)) then
	    istat = %loc(dix_msg_karsallow)
	    goto 90
	  endif
	end do
c
c check if reserved names
c
	if(str$case_blind_compare(symbol,true_name) .eq. 0.or.
     1     str$case_blind_compare(symbol,false_name) .eq. 0) then
	  istat = %loc(dix_msg_symbresv)
	  goto 90
	endif
	istat = 1
90	dix_util_check_name = istat
	return
	end
	function dix_util_legal_char(kar,pos)
	implicit none
c
c See if char 'kar' is legal in symbolname at pos 'pos'
c  Allow a-z,_ at first position
c  Allow 0-9,$ at pos 2 and further
c The $ at pos 2 and further is to prevent normal symbols th
c interfere with the standard $status and $severity
c
	character kar
	integer*4 pos
	logical dix_util_legal_char
c#
	if(    (kar .ge. 'A' .and. kar .le. 'Z') .or.
     1         (kar .ge. 'a' .and. kar .le. 'z') .or.
     1          kar .eq. '_') then
	  dix_util_legal_char = .true.
	elseif((kar .ge. '0' .and. kar .le. '9') .or. 
     1          kar .eq. '$') then
	  dix_util_legal_char = pos .gt. 1
	else
	  dix_util_legal_char = .false.
	endif
	return
	end
	function dix_util_upcase_kar(kar)
	implicit none
c
c Upcase a character
c
	character kar
	character dix_util_upcase_kar
c#
	if((kar .ge.         'a' .and. kar .le.        'z') .or. 
     1     (kar .ge. char('E0'X) .and. kar .le. char('FE'X))) then
	  dix_util_upcase_kar = char(ichar(kar) - ichar('a') + ichar('A'))
	else
	  dix_util_upcase_kar = kar
	end if
	return
	end
	function dix_util_locase_kar(kar)
	implicit none
c
c Upcase a character
c
	character kar
	character dix_util_locase_kar
c#
	if((kar .ge.         'A' .and. kar .le.        'Z') .or. 
     1     (kar .ge. char('C0'X) .and. kar .le. char('DE'X))) then
	  dix_util_locase_kar = char(ichar(kar) - ichar('A') + ichar('a'))
	else
	  dix_util_locase_kar = kar
	end if
	return
	end
	function dix_util_hex_kar(ikar)
	implicit none
c
c Transform a character from ascii to HEX
c return 0..15 for a valid char, and -1 for a not valid
c
	integer*4 ikar	       		!:i: the input char (integer)
	integer*4 dix_util_hex_kar	!:o: The result (or -1)
c#
	integer*4 ival
c
	if(    ikar .ge. ichar('0') .and. ikar .le. ichar('9')) then
	  ival  = ikar - ichar('0')
	elseif(ikar .ge. ichar('A') .and. ikar .le. ichar('F')) then
	  ival  = ikar - ichar('A') + 10
	elseif(ikar .ge. ichar('a') .and. ikar .le. ichar('f')) then
	  ival  = ikar - ichar('a') + 10
	else
	  ival = -1		!illegal char
	endif
	dix_util_hex_kar = ival
	return
	end
c
	function dix_util_remove_comment(nk,line)
	implicit none
c
c Remove trailing ! comment (but only if the ! is not in quotes)
c and all trailing blanks
c
	integer*4 nk
	character*(*) line
	logical dix_util_remove_comment
c#
	integer*4 k
	logical in_quote
c
	in_quote = .false.
	do k=1,nk
	  if(line(k:k) .eq. '"') then
	    in_quote = .not. in_quote
	  else
	    if(.not. in_quote) then
	      if(line(k:k) .eq. '!') then
	        nk = k-1
	        goto 50
	      endif
	    endif
	  endif
	end do
50	if(.not. in_quote) then
	  do k=nk,1,-1
	    if(line(k:k) .ne. ' ') goto 80
	  end do
	  k = 0
80	  nk = k
	endif
	dix_util_remove_comment = .not. in_quote
	return
	end
	subroutine dix_util_decent_line(nk,line)
	implicit none
c
	include 'dix_def.inc'
c
c replace tab by space
c Remove all leading blanks
c replace all multiple blanks by one (but not in quotes)
c if a slash is found (not in_quotes) and the prev char is 
c space, then skip the space
c
c skip trailing blanks
c
	integer*4 nk
	character*(*) line
c#
	integer*4 k,n
	logical in_quote,skip,next_skip
c
	character dix_util_upcase_kar
c
	in_quote  = .false.
	skip      = .true.
	next_skip = .true.
	n         = 0
	do k=1,nk
	  if(line(k:k) .eq. TAB) line(k:k) = SPACE
	  if(line(k:k) .eq. '"') in_quote = .not. in_quote
	  if(.not. in_quote) then
	    if(line(k:k) .eq. SPACE) then
	      next_skip = .true.
	    else
	      skip      = .false.
	      next_skip = .false.
	      line(k:k) = dix_util_upcase_kar(line(k:k))
	      if(index('/=,',line(k:k)) .ne. 0) then
c
c Char is / or =, previous cannot be a space
c
	        if(line(n:n) .eq. SPACE) n = n-1
	        next_skip = .true.
	      endif
	    endif
	  else
	    skip = .false.
	    next_skip = .false.
	  endif
	  if(.not. skip) then
	    n = n + 1
	    line(n:n) = line(k:k)
	  endif
	  skip = next_skip
	end do
	nk = n
	if(nk .gt. 0) then
	  if(line(nk:nk) .eq. SPACE) nk = nk - 1
	endif
90	return
	end
	function dix_util_checksum(type,data,bpos,epos,chktype)
	implicit none
c
	integer*4 type		!:i: b/w/l
	byte data(*)            !:i: the data
	integer*4 bpos		!:i: bpos in bytes (0-start of buffer)
	integer*4 epos		!:i: epos in bytes 
	character chktype	!:X(or) or S(UM)
	integer*4 dix_util_checksum
c#
	integer*4 dix_util_checksum_b
	integer*4 dix_util_checksum_w
	integer*4 dix_util_checksum_l
c
	integer*4 k
c
	if(    type .eq. 1) then	
	  k = dix_util_checksum_b(data,bpos,epos,chktype)
	  k = k .and. 'ff'x
	elseif(type .eq. 2) then	
	  k = dix_util_checksum_w(data,bpos/2,epos/2,chktype)
	  k = k .and. 'ffff'x
	elseif(type .eq. 4) then	
	  k = dix_util_checksum_l(data,bpos/4,epos/4,chktype)
	endif
	dix_util_checksum = k
	return
	end
	function dix_util_checksum_b(data,bpos,epos,chktype)
	implicit none
c
	byte data(0:*)
	integer*4 bpos
	integer*4 epos
	character chktype	!:X(or) or S(UM)
	integer*4 dix_util_checksum_b
c#
	integer*4 k,result
c
	result = 0
	if(chktype .eq. 'S') then
	  do k=bpos,epos
	    result = result + data(k)
	  end do
	elseif(chktype .eq. 'X') then
	  do k=bpos,epos
	    result = result .xor. data(k)
	  end do
	endif
	dix_util_checksum_b = result
	return
	end
	function dix_util_checksum_w(data,bpos,epos,chktype)
	implicit none
c
	integer*2 data(0:*)
	integer*4 bpos
	integer*4 epos
	character chktype
	integer*4 dix_util_checksum_w
c#
	integer*4 k,result
c
	result = 0
	if(chktype .eq. 'S') then
	  do k=bpos,epos
	    result = result + data(k)
	  end do
	elseif(chktype .eq. 'X') then
	  do k=bpos,epos
	    result = result .xor. data(k)
	  end do
	endif
	dix_util_checksum_w = result
	return
	end
	function dix_util_checksum_l(data,bpos,epos,chktype)
	implicit none
c
	integer*4 data(0:*)
	integer*4 bpos
	integer*4 epos
	character chktype	!:X(or) or S(UM)
	integer*4 dix_util_checksum_l
c#
	integer*4 k,result
c
	result = 0
	if(chktype .eq. 'S') then
	  do k=bpos,epos
	    result = result + data(k)
	  end do
	elseif(chktype .eq. 'X') then
	  do k=bpos,epos
	    result = result .xor. data(k)
	  end do
	endif
	dix_util_checksum_l = result
	return
	end
	subroutine dix_util_compress_line(line,nk,collapse)
	implicit none
c
	include 'dix_def.inc'
c
c replace tab by space
c replace all multiple blanks by one (but not in quotes)
c If collapse is true, skip all spaces
c	
	character*(*) line	!:io: the line
	integer*4 nk    	!:io: the number of chars
	logical collapse	!:i: remove all spaces?
c#
	integer*4 k,n
	logical in_quote,prev_space
c
	in_quote  = .false.
	prev_space= .false.
	n         = 0
	do k=1,nk
	  if(line(k:k) .eq. TAB) line(k:k) = SPACE
	  if(line(k:k) .eq. '"') in_quote = .not. in_quote
	  if(.not. in_quote) then
	    if(line(k:k) .eq. SPACE) then
	      if(collapse .or. prev_space) goto 30
	    endif
	  endif
	  n = n + 1
	  line(n:n) = line(k:k)
	  prev_space = line(k:k) .eq. SPACE
30	end do
	nk = n
90	return
	end
	subroutine dix_util_case_line(line,upper)
	implicit none
c
c Change case, execpt within string
c If uppper is true, case is changed to upper, else to lower
c	
	character*(*) line	!:io: the line
	logical upper		!:i: change to upper or lower
c#
	integer*4 k
	logical in_quote
	character dix_util_locase_kar
	character dix_util_upcase_kar
c
	in_quote  = .false.
	do k=1,len(line)
	  if(line(k:k) .eq. '"') in_quote = .not. in_quote
	  if(.not. in_quote) then
	    if(upper) then
	      line(k:k) = dix_util_upcase_kar(line(k:k))
	    else
	      line(k:k) = dix_util_locase_kar(line(k:k))
	    endif
	  endif
	end do
	return
	end
	function dix_util_match(candidate,pattern)
	implicit none
c
c Match partial string
c so f$enum matches f$enum|erate
c The part upto the | must be there,
c if the part after the | is present, it must match
c
	character*(*) candidate
	character*(*) pattern
	logical dix_util_match
c#
	integer*4 ipos,nk1
c
	ipos = index(pattern,'|')
	if(ipos .eq. 0) ipos = len(pattern) + 1
c
	if(len(candidate) .lt. ipos-1) then
	  dix_util_match = .false.
	elseif(len(candidate) .eq. ipos-1) then
	  dix_util_match = candidate .eq. pattern(1:ipos-1)
	else
	  nk1 = len(candidate) - ipos + 1
	  dix_util_match = candidate .eq. 
     1         pattern(1:ipos-1)//pattern(ipos+1:ipos+nk1)
	endif
	return
	end
	function dix_util_tfas(log)
	implicit none
c
	logical log
	character*(*) dix_util_tfas
c#
	if(log) then
	  dix_util_tfas = 'True'
	else
	  dix_util_tfas = 'False'
	end if
	return
	end
	function vms_vers
	implicit none
c
	include 'dix_def.inc'
c
c Deliver the vms-version in an integer
c maj*100+min*10+patch
c for example 7.3-1 => 731
c
	integer*4 vms_vers
c#
	character*(max_short_line_length) string
	include '($syidef)'
	integer*4 nk,majv,minv,patch
c
	call lib$getsyi(syi$_version,,string,nk)
c
	read(string(1:nk),2000) majv,minv,patch
2000	format(1x,i1,1x,i1,1x,i1)
c
	vms_vers = majv*100+minv*10+patch
	return
	end	
	function dix_util_check_field(field,fields,idx)
	implicit none
c
	include 'dix_def.inc'
c
c Check if field is on of the fields allowed in fields
c field can be abbreviated, but must be unique
c fields is a list of strings separated by a |
c
	character*(*) field	!:i: the searched string
	character*(*) fields	!:i: the allowed strings
	integer*4 idx		!:o: the number (0..n)
	integer dix_util_check_field	!:f: result
c#
	character*(max_line_length) element
	integer*4 nk2,nk1,k,istat
c
	integer*4 dix_util_get_len
	external dix_msg_ambig
	external dix_msg_wrargval
	logical str$element
c
	nk1 = dix_util_get_len(field)
	idx = -1
c
        k = 0
        do while(str$element(element,k,'|',fields))
          nk2 = dix_util_get_len(element)
          if(nk1 .le. nk2) then
            if(field(1:nk1) .eq. element(1:nk1)) then
c
c Match complete, if we have a complete match, do not look further
c
              if(nk1 .eq. nk2) then
	        idx = k
                goto 90
              endif
c
c Check if we have more than one match, if so exit
c
              if(idx .ge. 0) then
                istat = %loc(dix_msg_ambig)
                goto 99
              endif
c
c Remember we matched here
c
              idx = k
            endif
          endif
	  k = k + 1
	end do
90	if(idx .lt. 0) then
	  istat = %loc(dix_msg_wrargval)
	else
	  istat = 1
	endif
99	dix_util_check_field = istat
	return
	end
	subroutine vm_info(control,full,detail)
	implicit none
c
	include 'dix_def.inc'
c
	integer*4 control
	logical full
	logical detail
c#
	integer*4 context,zone,full_flag
	integer*4 lib$find_vm_zone
	external vm_info_print
c
	call lib$show_vm(0,vm_info_print,control)
	call lib$show_vm(4,vm_info_print,control)
c
	context = 0
	full_flag             = 0
	if(full)   full_flag  = 1
	if(detail) full_flag  = 3
c
	do while (lib$find_vm_zone(context,zone))
	  call lib$show_vm_zone(zone,full_flag,vm_info_print,control)
	end do
	return
	end
	function vm_info_print(line,control)
	implicit none
c
	character*(*) line
	integer*4 control
	integer*4 vm_info_print
c#
	integer*4 istat
	integer*4 dix_dump_print_line
c	
	istat = dix_dump_print_line(control,2,line)
	vm_info_print = istat
	return
	end
	subroutine init_vm(control,vm_zone,recsiz,name,dzero)
	implicit none
c 
c Create a vm_zone, simplified interface to vm
c
	include 'dix_def.inc'
	record /control/ control	!:I; control block
	record /vm_zone/ vm_zone	!:io: block address
	integer*4 recsiz		!:i: recordsize, 0=variable
	character*(*) name		!:i: name of zone
	logical dzero			!:i: demand zero 
c#
	include '($libvmdef)'
c
	integer*4 istat,algor,flags,nk1
	integer*4 lib$create_vm_zone
c
	character*(max_line_length) line
c
	algor = lib$k_vm_first_fit
	if(recsiz .gt. 0) algor = lib$k_vm_fixed
	flags = 0
	if(dzero) flags = lib$m_vm_get_fill0
c
	istat = lib$create_vm_zone(vm_zone.zone,algor,recsiz,
     1       flags,,,,,,,name)
	if(.not. istat) call lib$signal(%val(istat))
	control.n_vm_area_crea = control.n_vm_area_crea + 1
	vm_zone.n_alloc    = 0
	vm_zone.nb_alloc   = 0
	vm_zone.n_dealloc  = 0
	vm_zone.nb_dealloc = 0
	vm_zone.name       = name
c
	call dix_util_link_in(vm_zone.link,control.top_vm_zones)
c
	if((control.debug .and. debug_vm) .ne. 0) then
	  call sys$fao('!AS',nk1,line,name)
	  if(algor .eq. lib$k_vm_fixed) then
	    call dix_append(nk1,line,' FIX') 
	  else
	    call dix_append(nk1,line,' First Fit') 
	  endif
	  if(dzero) call dix_append(nk1,line,' DZERO')
	  call dix_main_print_debug(control,debug_vm,
     1                  'VM zone   '//line(1:nk1)//' created')
	endif
	return
	end
	subroutine get_vm(control,size,pointer,vm_zone,clear,name)
	implicit none
c
c Allocate memory
c
	include 'dix_def.inc'
c		
	record /control/ control	!:i: control block
	integer*4 size			!:i: size
	integer*4 pointer		!:o: pointer
	record /vm_zone/ vm_zone	!:io: zone info
	logical clear			!:i: init to zero
	character*(*) name		!:i: name of item (debug only)
c#
	integer*4 ptr,istat
	integer*4 lib$get_vm
	integer*4 dix_util_get_len_fu
c
	integer*4 nk1
	character*(max_line_length) line
c
	istat = lib$get_vm(size,ptr,vm_zone.zone)
	if(.not. istat) call lib$signal(%val(istat))
	vm_zone.n_alloc  = vm_zone.n_alloc  + 1
	vm_zone.nb_alloc = vm_zone.nb_alloc + size
	vm_zone.magic    = magic_vm_zone
c
	pointer = ptr
	if(clear) call dix_util_fill(0,size,%val(pointer))
	if((control.debug .and. debug_vm) .ne. 0) then
	  nk1 = dix_util_get_len_fu(vm_zone.name)
	  call sys$fao('!AS(!AS), !UL bytes allocated, address = !8XL',
     1                 nk1,line,vm_zone.name(1:nk1),name,
     1                 %val(size),%val(ptr))
	  if(clear) call dix_append(nk1,line,' Cleared')
	  call dix_main_print_debug(control,debug_vm,
     1                  '  VM zone '//line(1:nk1))
	endif
	return
	end
	subroutine free_vm(control,size,pointer,vm_zone)
	implicit none
c
c Free memory, simplified interface to lib$free_vm
c
	include 'dix_def.inc'
c
	record /control/ control	!:i: control block
	integer*4 size			!:i: #bytes to free
	integer*4 pointer               !:io: pointer
	record /vm_zone/ vm_zone
c#
	integer*4 istat,nk1
	integer*4 lib$free_vm
c
	character*(max_line_length) line
	integer*4 dix_util_get_len_fu
c
	istat = lib$free_vm(size,pointer,vm_zone.zone)
	if(.not. istat) call lib$signal(%val(istat))
	vm_zone.n_dealloc  = vm_zone.n_dealloc  + 1
	vm_zone.nb_dealloc = vm_zone.nb_dealloc + size
c
	if((control.debug .and. debug_vm) .ne. 0) then
	  nk1 = dix_util_get_len_fu(vm_zone.name)
	  call sys$fao('!AS, !UL bytes deallocated, address = !8XL',
     1                 nk1,line,vm_zone.name(1:nk1),
     1                 %val(size),%val(pointer))
	  call dix_main_print_debug(control,debug_vm,
     1                 '  VM zone '//line(1:nk1))
	endif
	pointer = 0		!make sure not reffed again
c
	return
	end
	subroutine delete_vm(control,vm_zone)
	implicit none
c
	include 'dix_def.inc'
	record /control/ control
	record /vm_zone/ vm_zone
c#
	integer*4 istat
	integer*4 lib$delete_vm_zone
	integer*4 dix_util_get_len_fu
c
	integer*4 nk1
	character*(max_line_length) line
c
	if((control.debug .and. debug_vm) .ne. 0) then
	  nk1 = dix_util_get_len_fu(vm_zone.name)
	  call sys$fao('!AS, deleted',nk1,line,vm_zone.name(1:nk1))
	  call dix_main_print_debug(control,debug_vm,
     1                  'VM zone   '//line(1:nk1))
	endif
c
c Link out of the list
c
	call dix_util_link_out(vm_zone.link,control.top_vm_zones)
c
	istat = lib$delete_vm_zone(vm_zone.zone)
	if(.not. istat) call lib$signal(%val(istat))
	control.n_vm_area_dele = control.n_vm_area_dele + 1
	return
	end
	subroutine dix_util_show_vm_link(control)
	implicit none
c
	include 'dix_def.inc'
	record /control/ control
c
	record /vm_zone/ vm_zone
	pointer (p_vm_zone,vm_zone)
	logical*4 fi
c
	p_vm_zone = control.top_vm_zones
	fi = .true.
	do while(p_vm_zone .ne. 0) 		
	  call dix_util_show_vm1(control,vm_zone,fi,1)
	  p_vm_zone = vm_zone.link.forw
	end do
	return
	end

	subroutine dix_util_show_vm(control)
	implicit none
c
	include 'dix_def.inc'
	record /control/ control
c#
	record /file_info/ file
	pointer (p_file,file)
c
	character*(max_line_length) line
	integer*4 nk
c
	record /des_expanded/ des_expanded
	pointer (p_des_expanded,des_expanded)
c
	record /des_info/ des_info
	pointer (p_des_info,des_info)
	logical fi
c
	fi = .true.
c
	call dix_dump_print_line(control,0,'VM activities')
c
	call sys$fao('VM Zones     Opened !10UL deleted !10UL',nk,line,
     1          %val(control.n_vm_area_crea),
     1          %val(control.n_vm_area_dele))
	call dix_dump_print_line(control,0,line(1:nk))
c
	call sys$fao('Memory files Opened !10UL deleted !10UL',nk,line,
     1          %val(control.n_memfiles_opened),
     1          %val(control.n_memfiles_closed))
	call dix_dump_print_line(control,0,line(1:nk))
c
	call dix_util_show_vm1(control,control.zone_file,fi,0)
	call dix_util_show_vm1(control,control.zone_descr,fi,0)
	p_file = control.top_file
	do while(p_file .ne. 0)
	  call dix_dump_print_line(control,0,
     1      'File '//file.fnam(1:file.nk_fnam))
	  p_des_expanded = file.top_des
	  call dix_fastio_show_vm(control,file)
	  do while(p_des_expanded .ne. 0) 
	    p_des_info = des_expanded.p_des_info
	   
	    call dix_dump_print_line(control,1,
     1      'Descriptor '//des_info.fnam(1:des_info.nk_fnam))
	    call dix_util_show_vm1(control,des_info.zone_file,fi,2)
	    call dix_util_show_vm1(control,des_expanded.zone_rec,fi,2)
	    p_des_expanded = des_expanded.link.forw
	  end do
	  p_file = file.link.forw
	end do
	call dix_util_show_vm1(control,control.zone_cfile,fi,0)
	call dix_dump_inter_show_vm(control,fi)
	call dix_util_show_vm1(control,control.zone_general,fi,0)
	call dix_util_show_vm1(control,control.zone_links,fi,0)
	call dix_symbol_show_vm(control,fi)
	call dix_keydefs_show_vm(control,fi)
	return
	end
	subroutine dix_util_show_vm1(control,vm_zone,fi,level)
	implicit none
c
	include 'dix_def.inc'
	record /control/ control
	record /vm_zone/ vm_zone
	logical fi
	integer*4 level
c#
	character*(max_screen_width) line
	integer*4 nk,nk_w
c
	character*(max_short_line_length) text
c
	if(vm_zone.zone .eq. 0) goto 90
	nk_w = len(vm_zone.name)
	if(fi) then
	  call sys$fao('!#AS !8AS !7AS !10AS !7AS !10AS',nk,line,
     1          %val(nk_w),%Descr('Name'),
     1          %descr('Address'),
     1          %descr('n_alloc'),
     1          %descr('  nb_alloc'),
     1          %descr('n_deall'),
     1          %descr('  nb_deall'))
	  fi = .false.
	  call dix_dump_print_line(control,0,line(1:nk))
	end if
	text = ' '
	call sys$fao('!AS !8XL !7UL !10UL !7UL !10UL',nk,line,
     1          text(1:level)//vm_zone.name(1:nk_w-level),
     1          %val(vm_zone.zone),
     1          %val(vm_zone.n_alloc),
     1          %val(vm_zone.nb_alloc),
     1          %val(vm_zone.n_dealloc),
     1          %val(vm_zone.nb_dealloc))
	call dix_dump_print_line(control,0,line(1:nk))
90	return
	end
	subroutine cnv_forterr_message(ier,line)
	implicit none
c
c Convert a fortran error to text
c
	integer*4 ier		!:i: the fortran error
	character*(*) line	!:o: the text
c#
	line = ' '
	if(ier .eq. '00000001'X) line = 'FOR$IOS_NOTFORSPE '
	if(ier .eq. '00000002'X) line = 'FOR$IOS_NOTIMP '
	if(ier .eq. '00000003'X) line = 'FOR$IOS_IGNORED '
	if(ier .eq. '00000004'X) line = 'FOR$IOS_IGNNOTDEL '
	if(ier .eq. '00000005'X) line = 'FOR$IOS_INFO '
	if(ier .eq. '00000006'X) line = 'FOR$IOS_VERSION '
	if(ier .eq. '00000008'X) line = 'FOR$IOS_BUG_CHECK '
	if(ier .eq. '00000009'X) line = 'FOR$IOS_PERACCFIL '
	if(ier .eq. '0000000A'X) line = 'FOR$IOS_CANOVEEXI '
	if(ier .eq. '0000000B'X) line = 'FOR$IOS_UNINOTCON '
	if(ier .eq. '00000011'X) line = 'FOR$IOS_SYNERRNAM '
	if(ier .eq. '00000012'X) line = 'FOR$IOS_TOOMANVAL '
	if(ier .eq. '00000013'X) line = 'FOR$IOS_INVREFVAR '
	if(ier .eq. '00000014'X) line = 'FOR$IOS_REWERR '
	if(ier .eq. '00000015'X) line = 'FOR$IOS_DUPFILSPE '
	if(ier .eq. '00000016'X) line = 'FOR$IOS_INPRECTOO '
	if(ier .eq. '00000017'X) line = 'FOR$IOS_BACERR '
	if(ier .eq. '00000018'X) line = 'FOR$IOS_ENDDURREA '
	if(ier .eq. '00000019'X) line = 'FOR$IOS_RECNUMOUT '
	if(ier .eq. '0000001A'X) line = 'FOR$IOS_OPEDEFREQ '
	if(ier .eq. '0000001B'X) line = 'FOR$IOS_TOOMANREC '
	if(ier .eq. '0000001C'X) line = 'FOR$IOS_CLOERR '
	if(ier .eq. '0000001D'X) line = 'FOR$IOS_FILNOTFOU '
	if(ier .eq. '0000001E'X) line = 'FOR$IOS_OPEFAI '
	if(ier .eq. '0000001F'X) line = 'FOR$IOS_MIXFILACC '
	if(ier .eq. '00000020'X) line = 'FOR$IOS_INVLOGUNI '
	if(ier .eq. '00000021'X) line = 'FOR$IOS_ENDFILERR '
	if(ier .eq. '00000022'X) line = 'FOR$IOS_UNIALROPE '
	if(ier .eq. '00000023'X) line = 'FOR$IOS_SEGRECFOR '
	if(ier .eq. '00000024'X) line = 'FOR$IOS_ATTACCNON '
	if(ier .eq. '00000025'X) line = 'FOR$IOS_INCRECLEN '
	if(ier .eq. '00000026'X) line = 'FOR$IOS_ERRDURWRI '
	if(ier .eq. '00000027'X) line = 'FOR$IOS_ERRDURREA '
	if(ier .eq. '00000028'X) line = 'FOR$IOS_RECIO_OPE '
	if(ier .eq. '00000029'X) line = 'FOR$IOS_INSVIRMEM '
	if(ier .eq. '0000002A'X) line = 'FOR$IOS_NO_SUCDEV '
	if(ier .eq. '0000002B'X) line = 'FOR$IOS_FILNAMSPE '
	if(ier .eq. '0000002C'X) line = 'FOR$IOS_INCRECTYP '
	if(ier .eq. '0000002D'X) line = 'FOR$IOS_KEYVALERR '
	if(ier .eq. '0000002E'X) line = 'FOR$IOS_INCOPECLO '
	if(ier .eq. '0000002F'X) line = 'FOR$IOS_WRIREAFIL '
	if(ier .eq. '00000030'X) line = 'FOR$IOS_INVARGFOR '
	if(ier .eq. '00000031'X) line = 'FOR$IOS_INVKEYSPE '
	if(ier .eq. '00000032'X) line = 'FOR$IOS_INCKEYCHG '
	if(ier .eq. '00000033'X) line = 'FOR$IOS_INCFILORG '
	if(ier .eq. '00000034'X) line = 'FOR$IOS_SPERECLOC '
	if(ier .eq. '00000035'X) line = 'FOR$IOS_NO_CURREC '
	if(ier .eq. '00000036'X) line = 'FOR$IOS_REWRITERR '
	if(ier .eq. '00000037'X) line = 'FOR$IOS_DELERR '
	if(ier .eq. '00000038'X) line = 'FOR$IOS_UNLERR '
	if(ier .eq. '00000039'X) line = 'FOR$IOS_FINERR '
	if(ier .eq. '0000003A'X) line = 'FOR$IOS_FMTSYN '
	if(ier .eq. '0000003B'X) line = 'FOR$IOS_LISIO_SYN '
	if(ier .eq. '0000003C'X) line = 'FOR$IOS_INFFORLOO '
	if(ier .eq. '0000003D'X) line = 'FOR$IOS_FORVARMIS '
	if(ier .eq. '0000003E'X) line = 'FOR$IOS_SYNERRFOR '
	if(ier .eq. '0000003F'X) line = 'FOR$IOS_OUTCONERR '
	if(ier .eq. '00000040'X) line = 'FOR$IOS_INPCONERR '
	if(ier .eq. '00000041'X) line = 'FOR$IOS_FLTINV '
	if(ier .eq. '00000042'X) line = 'FOR$IOS_OUTSTAOVE '
	if(ier .eq. '00000043'X) line = 'FOR$IOS_INPSTAREQ '
	if(ier .eq. '00000044'X) line = 'FOR$IOS_VFEVALERR '
	if(ier .eq. '00000045'X) line = 'FOR$IOS_SIGINT '
	if(ier .eq. '00000046'X) line = 'FOR$IOS_INTOVF '
	if(ier .eq. '00000047'X) line = 'FOR$IOS_INTDIV '
	if(ier .eq. '00000048'X) line = 'FOR$IOS_FLTOVF '
	if(ier .eq. '00000049'X) line = 'FOR$IOS_FLTDIV '
	if(ier .eq. '0000004A'X) line = 'FOR$IOS_FLTUND '
	if(ier .eq. '0000004B'X) line = 'FOR$IOS_SIGFPE '
	if(ier .eq. '0000004C'X) line = 'FOR$IOS_SIGIOT '
	if(ier .eq. '0000004D'X) line = 'FOR$IOS_SUBRNG '
	if(ier .eq. '0000004E'X) line = 'FOR$IOS_SIGTERM '
	if(ier .eq. '0000004F'X) line = 'FOR$IOS_SIGQUIT '
	if(ier .eq. '00000050'X) line = 'FOR$IOS_WRONUMARG '
	if(ier .eq. '00000051'X) line = 'FOR$IOS_INVARGMAT '
	if(ier .eq. '00000052'X) line = 'FOR$IOS_UNDEXP '
	if(ier .eq. '00000053'X) line = 'FOR$IOS_LOGZERNEG '
	if(ier .eq. '00000054'X) line = 'FOR$IOS_SQUROONEG '
	if(ier .eq. '00000057'X) line = 'FOR$IOS_SIGLOSMAT '
	if(ier .eq. '00000058'X) line = 'FOR$IOS_FLOOVEMAT '
	if(ier .eq. '00000059'X) line = 'FOR$IOS_FLOUNDMAT '
	if(ier .eq. '0000005D'X) line = 'FOR$IOS_ADJARRDIM '
	if(ier .eq. '0000005E'X) line = 'FOR$IOS_INVMATKEY '
	if(ier .eq. '0000006C'X) line = 'FOR$IOS_CANSTAFIL '
	if(ier .eq. '00000078'X) line = 'FOR$IOS_OPEREQSEE '
	if(ier .eq. '00000082'X) line = 'FOR$IOS_BRK_USERBP '
	if(ier .eq. '00000083'X) line = 'FOR$IOS_BRK_KERNELBP '
	if(ier .eq. '00000085'X) line = 'FOR$IOS_BRK_BD_TAKEN '
	if(ier .eq. '00000086'X) line = 'FOR$IOS_BRK_BD_NOTTAKEN '
	if(ier .eq. '00000087'X) line = 'FOR$IOS_BRK_SSTEPBP '
	if(ier .eq. '00000088'X) line = 'FOR$IOS_BRK_OVERFLOW '
	if(ier .eq. '00000089'X) line = 'FOR$IOS_BRK_DIVZERO '
	if(ier .eq. '0000008A'X) line = 'FOR$IOS_BRK_RANGE '
	if(ier .eq. '0000008B'X) line = 'FOR$IOS_BRK_RANGE2 '
	if(ier .eq. '0000008C'X) line = 'FOR$IOS_FLTINE '
	if(ier .eq. '0000008D'X) line = 'FOR$IOS_DECOVF '
	if(ier .eq. '0000008E'X) line = 'FOR$IOS_DECDIV '
	if(ier .eq. '0000008F'X) line = 'FOR$IOS_DECINV '
	if(ier .eq. '00000090'X) line = 'FOR$IOS_ROPRAND '
	if(ier .eq. '00000091'X) line = 'FOR$IOS_ASSERTERR '
	if(ier .eq. '00000092'X) line = 'FOR$IOS_NULPTRERR '
	if(ier .eq. '00000093'X) line = 'FOR$IOS_STKOVF '
	if(ier .eq. '00000094'X) line = 'FOR$IOS_STRLENERR '
	if(ier .eq. '00000095'X) line = 'FOR$IOS_SUBSTRERR '
	if(ier .eq. '00000096'X) line = 'FOR$IOS_RANGEERR '
	if(ier .eq. '00000097'X) line = 'FOR$IOS_INVREALLOC '
	if(ier .eq. '00000098'X) line = 'FOR$IOS_RESACQFAI '
	if(ier .eq. '00000099'X) line = 'FOR$IOS_INVDEALLOC '
	if(ier .eq. '000000AD'X) line = 'FOR$IOS_INVDEALLOC2 '
	if(ier .eq. '000000AF'X) line = 'FOR$IOS_SHORTDATEARG '
	if(ier .eq. '000000B0'X) line = 'FOR$IOS_SHORTTIMEARG '
	if(ier .eq. '000000B1'X) line = 'FOR$IOS_SHORTZONEARG '
	if(ier .eq. '000000B2'X) line = 'FOR$IOS_DIV '
	if(ier .eq. '000000B3'X) line = 'FOR$IOS_ARRSIZEOVF '
	if(ier .eq. '00000100'X) line = 'FOR$IOS_UNFIO_FMT '
	if(ier .eq. '00000101'X) line = 'FOR$IOS_FMTIO_UNF '
	if(ier .eq. '00000102'X) line = 'FOR$IOS_DIRIO_KEY '
	if(ier .eq. '00000103'X) line = 'FOR$IOS_SEQIO_DIR '
	if(ier .eq. '00000104'X) line = 'FOR$IOS_KEYIO_DIR '
	if(ier .eq. '00000107'X) line = 'FOR$IOS_OPEREQDIS '
	if(ier .eq. '00000108'X) line = 'FOR$IOS_OPEREQSEQ '
	if(ier .eq. '00000109'X) line = 'FOR$IOS_PROABOUSE '
	if(ier .eq. '0000010A'X) line = 'FOR$IOS_FLOCONFAI '
	if(ier .eq. '0000010C'X) line = 'FOR$IOS_ENDRECDUR '
	if(ier .eq. '00000128'X) line = 'FOR$IOS_FLOINEEXC '
	if(ier .eq. '00000129'X) line = 'FOR$IOS_FLOINVEXC '
	if(ier .eq. '0000012A'X) line = 'FOR$IOS_FLOOVFEXC '
	if(ier .eq. '0000012B'X) line = 'FOR$IOS_FLODIV0EXC '
	if(ier .eq. '0000012C'X) line = 'FOR$IOS_FLOUNDEXC '
	if(ier .eq. '0000018F'X) line = 'FOR$IOS_MSGBUFOVF '
	if(ier .eq. '00000190'X) line = 'FOR$IOS_DIAGNOSTIC '
	if(ier .eq. '0000021C'X) line = 'FOR$IOS_F6096 '
	if(ier .eq. '0000021D'X) line = 'FOR$IOS_F6097 '
	if(ier .eq. '0000021E'X) line = 'FOR$IOS_F6098 '
	if(ier .eq. '0000021F'X) line = 'FOR$IOS_F6099 '
	if(ier .eq. '00000220'X) line = 'FOR$IOS_F6100 '
	if(ier .eq. '00000221'X) line = 'FOR$IOS_F6101 '
	if(ier .eq. '00000222'X) line = 'FOR$IOS_F6102 '
	if(ier .eq. '00000223'X) line = 'FOR$IOS_F6103 '
	if(ier .eq. '00000224'X) line = 'FOR$IOS_F6104 '
	if(ier .eq. '00000225'X) line = 'FOR$IOS_F6105 '
	if(ier .eq. '00000226'X) line = 'FOR$IOS_F6106 '
	if(ier .eq. '00000227'X) line = 'FOR$IOS_F6200 '
	if(ier .eq. '00000228'X) line = 'FOR$IOS_F6201 '
	if(ier .eq. '00000229'X) line = 'FOR$IOS_F6202 '
	if(ier .eq. '0000022A'X) line = 'FOR$IOS_F6203 '
	if(ier .eq. '0000022B'X) line = 'FOR$IOS_F6204 '
	if(ier .eq. '0000022C'X) line = 'FOR$IOS_F6205 '
	if(ier .eq. '0000022D'X) line = 'FOR$IOS_F6206 '
	if(ier .eq. '0000022E'X) line = 'FOR$IOS_F6207 '
	if(ier .eq. '0000022F'X) line = 'FOR$IOS_F6208 '
	if(ier .eq. '00000230'X) line = 'FOR$IOS_F6209 '
	if(ier .eq. '00000231'X) line = 'FOR$IOS_F6210 '
	if(ier .eq. '00000232'X) line = 'FOR$IOS_F6211 '
	if(ier .eq. '00000233'X) line = 'FOR$IOS_F6212 '
	if(ier .eq. '00000234'X) line = 'FOR$IOS_F6213 '
	if(ier .eq. '00000235'X) line = 'FOR$IOS_F6214 '
	if(ier .eq. '00000236'X) line = 'FOR$IOS_F6300 '
	if(ier .eq. '00000237'X) line = 'FOR$IOS_F6301 '
	if(ier .eq. '00000238'X) line = 'FOR$IOS_F6302 '
	if(ier .eq. '00000239'X) line = 'FOR$IOS_F6303 '
	if(ier .eq. '0000023A'X) line = 'FOR$IOS_F6304 '
	if(ier .eq. '0000023B'X) line = 'FOR$IOS_F6305 '
	if(ier .eq. '0000023C'X) line = 'FOR$IOS_F6306 '
	if(ier .eq. '0000023D'X) line = 'FOR$IOS_F6307 '
	if(ier .eq. '0000023E'X) line = 'FOR$IOS_F6308 '
	if(ier .eq. '0000023F'X) line = 'FOR$IOS_F6309 '
	if(ier .eq. '00000240'X) line = 'FOR$IOS_F6310 '
	if(ier .eq. '00000241'X) line = 'FOR$IOS_F6311 '
	if(ier .eq. '00000242'X) line = 'FOR$IOS_F6312 '
	if(ier .eq. '00000243'X) line = 'FOR$IOS_F6313 '
	if(ier .eq. '00000244'X) line = 'FOR$IOS_F6314 '
	if(ier .eq. '00000245'X) line = 'FOR$IOS_F6315 '
	if(ier .eq. '00000246'X) line = 'FOR$IOS_F6316 '
	if(ier .eq. '00000247'X) line = 'FOR$IOS_F6317 '
	if(ier .eq. '00000248'X) line = 'FOR$IOS_F6318 '
	if(ier .eq. '00000249'X) line = 'FOR$IOS_F6319 '
	if(ier .eq. '0000024A'X) line = 'FOR$IOS_F6400 '
	if(ier .eq. '0000024B'X) line = 'FOR$IOS_F6401 '
	if(ier .eq. '0000024C'X) line = 'FOR$IOS_F6402 '
	if(ier .eq. '0000024D'X) line = 'FOR$IOS_F6403 '
	if(ier .eq. '0000024E'X) line = 'FOR$IOS_F6404 '
	if(ier .eq. '0000024F'X) line = 'FOR$IOS_F6405 '
	if(ier .eq. '00000250'X) line = 'FOR$IOS_F6406 '
	if(ier .eq. '00000251'X) line = 'FOR$IOS_F6407 '
	if(ier .eq. '00000252'X) line = 'FOR$IOS_F6408 '
	if(ier .eq. '00000253'X) line = 'FOR$IOS_F6409 '
	if(ier .eq. '00000254'X) line = 'FOR$IOS_F6410 '
	if(ier .eq. '00000255'X) line = 'FOR$IOS_F6411 '
	if(ier .eq. '00000256'X) line = 'FOR$IOS_F6412 '
	if(ier .eq. '00000257'X) line = 'FOR$IOS_F6413 '
	if(ier .eq. '00000258'X) line = 'FOR$IOS_F6414 '
	if(ier .eq. '00000259'X) line = 'FOR$IOS_F6415 '
	if(ier .eq. '0000025A'X) line = 'FOR$IOS_F6416 '
	if(ier .eq. '0000025B'X) line = 'FOR$IOS_F6417 '
	if(ier .eq. '0000025C'X) line = 'FOR$IOS_F6418 '
	if(ier .eq. '0000025D'X) line = 'FOR$IOS_F6419 '
	if(ier .eq. '0000025E'X) line = 'FOR$IOS_F6420 '
	if(ier .eq. '0000025F'X) line = 'FOR$IOS_F6421 '
	if(ier .eq. '00000260'X) line = 'FOR$IOS_F6422 '
	if(ier .eq. '00000261'X) line = 'FOR$IOS_F6423 '
	if(ier .eq. '00000262'X) line = 'FOR$IOS_F6424 '
	if(ier .eq. '00000263'X) line = 'FOR$IOS_F6425 '
	if(ier .eq. '00000264'X) line = 'FOR$IOS_F6500 '
	if(ier .eq. '00000265'X) line = 'FOR$IOS_F6501 '
	if(ier .eq. '00000266'X) line = 'FOR$IOS_F6502 '
	if(ier .eq. '00000267'X) line = 'FOR$IOS_F6503 '
	if(ier .eq. '00000268'X) line = 'FOR$IOS_F6504 '
	if(ier .eq. '00000269'X) line = 'FOR$IOS_F6505 '
	if(ier .eq. '0000026A'X) line = 'FOR$IOS_F6506 '
	if(ier .eq. '0000026B'X) line = 'FOR$IOS_F6507 '
	if(ier .eq. '0000026C'X) line = 'FOR$IOS_F6508 '
	if(ier .eq. '0000026D'X) line = 'FOR$IOS_F6509 '
	if(ier .eq. '0000026E'X) line = 'FOR$IOS_F6510 '
	if(ier .eq. '0000026F'X) line = 'FOR$IOS_F6511 '
	if(ier .eq. '00000270'X) line = 'FOR$IOS_F6512 '
	if(ier .eq. '00000271'X) line = 'FOR$IOS_F6513 '
	if(ier .eq. '00000272'X) line = 'FOR$IOS_F6514 '
	if(ier .eq. '00000273'X) line = 'FOR$IOS_F6515 '
	if(ier .eq. '00000274'X) line = 'FOR$IOS_F6516 '
	if(ier .eq. '00000275'X) line = 'FOR$IOS_F6600 '
	if(ier .eq. '00000276'X) line = 'FOR$IOS_F6601 '
	if(ier .eq. '00000277'X) line = 'FOR$IOS_F6602 '
	if(ier .eq. '00000278'X) line = 'FOR$IOS_F6700 '
	if(ier .eq. '00000279'X) line = 'FOR$IOS_F6701 '
	if(ier .eq. '0000027A'X) line = 'FOR$IOS_F6970 '
	if(ier .eq. '0000027B'X) line = 'FOR$IOS_F6971 '
	if(ier .eq. '0000027C'X) line = 'FOR$IOS_F6972 '
	if(ier .eq. '0000027D'X) line = 'FOR$IOS_F6980 '
	if(ier .eq. '0000027E'X) line = 'FOR$IOS_F6981 '
	if(ier .eq. '0000027F'X) line = 'FOR$IOS_F6982 '
	if(ier .eq. '00000280'X) line = 'FOR$IOS_F6983 '
	if(ier .eq. '00000281'X) line = 'FOR$IOS_F6984 '
	if(ier .eq. '00000282'X) line = 'FOR$IOS_F6985 '
	if(ier .eq. '00000283'X) line = 'FOR$IOS_F6986 '
	if(ier .eq. '00000284'X) line = 'FOR$IOS_F6987 '
	if(ier .eq. '00000285'X) line = 'FOR$IOS_F6988 '
	if(ier .eq. '00000286'X) line = 'FOR$IOS_F6989 '
	if(ier .eq. '00000287'X) line = 'FOR$IOS_F6990 '
	if(ier .eq. '00000288'X) line = 'FOR$IOS_F6991 '
	if(ier .eq. '00000289'X) line = 'FOR$IOS_F6992 '
	if(ier .eq. '0000028A'X) line = 'FOR$IOS_F6993 '
	if(ier .eq. '0000028B'X) line = 'FOR$IOS_F6994 '
	if(ier .eq. '0000028C'X) line = 'FOR$IOS_F6995 '
	if(ier .eq. '0000028D'X) line = 'FOR$IOS_F6996 '
	if(ier .eq. '0000028E'X) line = 'FOR$IOS_F6997 '
	if(ier .eq. '0000028F'X) line = 'FOR$IOS_F6998 '
	if(ier .eq. '00000290'X) line = 'FOR$IOS_F6999 '
	if(ier .eq. '00000291'X) line = 'FOR$IOS_F6702 '
	if(ier .eq. '00000292'X) line = 'FOR$IOS_F6703 '
	if(ier .eq. '00000293'X) line = 'FOR$IOS_F6704 '
	if(ier .eq. '00000294'X) line = 'FOR$IOS_F6705 '
	if(ier .eq. '00000295'X) line = 'FOR$IOS_F6706 '
	if(ier .eq. '00000296'X) line = 'FOR$IOS_F6707 '
	if(ier .eq. '00000297'X) line = 'FOR$IOS_F6708 '
	if(ier .eq. '00000298'X) line = 'FOR$IOS_F6709 '
	if(ier .eq. '00000299'X) line = 'FOR$IOS_F6710 '
	if(ier .eq. '0000029A'X) line = 'FOR$IOS_F6711 '
	if(ier .eq. '0000029B'X) line = 'FOR$IOS_F6712 '
	if(ier .eq. '0000029C'X) line = 'FOR$IOS_F6713 '
	if(ier .eq. '0000029D'X) line = 'FOR$IOS_F6714 '
	if(ier .eq. '0000029E'X) line = 'FOR$IOS_F6715 '
	if(ier .eq. '0000029F'X) line = 'FOR$IOS_F6716 '
	if(ier .eq. '000002A0'X) line = 'FOR$IOS_F6717 '
	if(ier .eq. '000002A1'X) line = 'FOR$IOS_F6718 '
	if(ier .eq. '000002A2'X) line = 'FOR$IOS_F6719 '
	if(ier .eq. '000002A3'X) line = 'FOR$IOS_F6720 '
	if(ier .eq. '000002A4'X) line = 'FOR$IOS_F6721 '
	if(ier .eq. '000002A5'X) line = 'FOR$IOS_F6722 '
	if(ier .eq. '000002A6'X) line = 'FOR$IOS_F6723 '
	if(ier .eq. '000002A7'X) line = 'FOR$IOS_F6724 '
	if(ier .eq. '000002A8'X) line = 'FOR$IOS_F6725 '
	if(ier .eq. '000002A9'X) line = 'FOR$IOS_F6726 '
	if(ier .eq. '000002AA'X) line = 'FOR$IOS_F6727 '
	if(ier .eq. '000002AB'X) line = 'FOR$IOS_F6728 '
	if(ier .eq. '000002AC'X) line = 'FOR$IOS_F6729 '
	if(ier .eq. '000002AD'X) line = 'FOR$IOS_F6730 '
	if(ier .eq. '000002AE'X) line = 'FOR$IOS_F6731 '
	if(ier .eq. '000002AF'X) line = 'FOR$IOS_F6732 '
	if(ier .eq. '000002B0'X) line = 'FOR$IOS_F6733 '
	if(ier .eq. '000002B1'X) line = 'FOR$IOS_F6734 '
	if(ier .eq. '000002B2'X) line = 'FOR$IOS_F6735 '
	if(ier .eq. '000002B3'X) line = 'FOR$IOS_F6736 '
	if(ier .eq. '000002B4'X) line = 'FOR$IOS_F6737 '
	if(ier .eq. '000002B5'X) line = 'FOR$IOS_F6738 '
	if(ier .eq. '000002B6'X) line = 'FOR$IOS_F6739 '
	if(ier .eq. '000002B7'X) line = 'FOR$IOS_F6740 '
	if(ier .eq. '000002B8'X) line = 'FOR$IOS_F6741 '
	if(ier .eq. '000002B9'X) line = 'FOR$IOS_F6742 '
	if(ier .eq. '000002BA'X) line = 'FOR$IOS_F6743 '
	if(ier .eq. '000002BB'X) line = 'FOR$IOS_F6744 '
	if(ier .eq. '000002BC'X) line = 'FOR$IOS_F6745 '
	if(ier .eq. '000002BD'X) line = 'FOR$IOS_F6746 '
	if(ier .eq. '000002BE'X) line = 'FOR$IOS_F6747 '
	if(ier .eq. '000002BF'X) line = 'FOR$IOS_F6748 '
	if(ier .eq. '000002C0'X) line = 'FOR$IOS_F6749 '
	if(ier .eq. '000002C1'X) line = 'FOR$IOS_F6750 '
	if(ier .eq. '000002C2'X) line = 'FOR$IOS_F6751 '
	if(ier .eq. '000002C3'X) line = 'FOR$IOS_F6752 '
	if(ier .eq. '000002C4'X) line = 'FOR$IOS_F6753 '
	if(ier .eq. '000002C5'X) line = 'FOR$IOS_F6754 '
	if(ier .eq. '000002C6'X) line = 'FOR$IOS_F6755 '
	if(ier .eq. '000002C7'X) line = 'FOR$IOS_F6756 '
	if(ier .eq. '000002C8'X) line = 'FOR$IOS_F6757 '
	if(ier .eq. '000002C9'X) line = 'FOR$IOS_F6758 '
	if(ier .eq. '000002CA'X) line = 'FOR$IOS_F6759 '
	if(ier .eq. '000002CB'X) line = 'FOR$IOS_F6760 '
	if(ier .eq. '000002CC'X) line = 'FOR$IOS_F6761 '
	if(ier .eq. '000002CD'X) line = 'FOR$IOS_F6762 '
	if(ier .eq. '000002CE'X) line = 'FOR$IOS_F6763 '
	if(ier .eq. '000002CF'X) line = 'FOR$IOS_F6764 '
	if(ier .eq. '000002D0'X) line = 'FOR$IOS_F6765 '
	if(ier .eq. '000002D1'X) line = 'FOR$IOS_F6766 '
	if(ier .eq. '000002D2'X) line = 'FOR$IOS_F6767 '
	if(ier .eq. '000002D3'X) line = 'FOR$IOS_F6768 '
	if(ier .eq. '000002D4'X) line = 'FOR$IOS_F6769 '
	if(ier .eq. '000002D5'X) line = 'FOR$IOS_F6770 '
	if(ier .eq. '000002D6'X) line = 'FOR$IOS_F6771 '
	if(ier .eq. '000002D7'X) line = 'FOR$IOS_F6772 '
	if(ier .eq. '000002D8'X) line = 'FOR$IOS_F6773 '
	if(ier .eq. '000002D9'X) line = 'FOR$IOS_F6774 '
	if(ier .eq. '000002DA'X) line = 'FOR$IOS_F6775 '
	if(ier .eq. '000002DB'X) line = 'FOR$IOS_F6776 '
	if(ier .eq. '000002DC'X) line = 'FOR$IOS_F6777 '
	if(ier .eq. '000002DD'X) line = 'FOR$IOS_F6778 '
	if(ier .eq. '000002DE'X) line = 'FOR$IOS_F6779 '
	if(ier .eq. '000002DF'X) line = 'FOR$IOS_F6780 '
	if(ier .eq. '000002E0'X) line = 'FOR$IOS_F6781 '
	if(ier .eq. '000002E1'X) line = 'FOR$IOS_F6782 '
	if(ier .eq. '000002E2'X) line = 'FOR$IOS_F6783 '
	if(ier .eq. '000002E3'X) line = 'FOR$IOS_F6784 '
	if(ier .eq. '000002E4'X) line = 'FOR$IOS_F6785 '
	if(ier .eq. '000002E5'X) line = 'FOR$IOS_F6786 '
	if(ier .eq. '000002E6'X) line = 'FOR$IOS_F6787 '
	if(ier .eq. '000002E7'X) line = 'FOR$IOS_F6788 '
	if(ier .eq. '000002E8'X) line = 'FOR$IOS_F6789 '
	if(ier .eq. '000002E9'X) line = 'FOR$IOS_F6790 '
	if(ier .eq. '000002EA'X) line = 'FOR$IOS_F6791 '
	if(ier .eq. '000002EB'X) line = 'FOR$IOS_F6792 '
	if(ier .eq. '000002EC'X) line = 'FOR$IOS_F6793 '
	if(ier .eq. '000002ED'X) line = 'FOR$IOS_F6794 '
	if(ier .eq. '000002EE'X) line = 'FOR$IOS_F6795 '
	if(ier .eq. '000002EF'X) line = 'FOR$IOS_F6796 '
	if(ier .eq. '000002F0'X) line = 'FOR$IOS_F6797 '
	if(ier .eq. '000002F1'X) line = 'FOR$IOS_F6798 '
	if(ier .eq. '000002F2'X) line = 'FOR$IOS_F6799 '
	if(ier .eq. '000002F3'X) line = 'FOR$IOS_F6800 '
	if(ier .eq. '000002F4'X) line = 'FOR$IOS_F6801 '
	if(ier .eq. '000002F5'X) line = 'FOR$IOS_F6802 '
	if(ier .eq. '000002F6'X) line = 'FOR$IOS_F6803 '
	if(ier .eq. '000002F7'X) line = 'FOR$IOS_F6804 '
	if(ier .eq. '000002F8'X) line = 'FOR$IOS_MESSAGE_MAXIMUM '
	return
	end
	subroutine dix_util_insert_string(control,descr,vm_zone,string)
	implicit none
c
c Insert a string, allocate memory from zone_id
c
	include 'dix_def.inc'
	record /control/ control!:i: control block
	record /strdef/ descr	!:io: strig descriptor
	record /vm_zone/ vm_zone!:i: zone id
	character*(*) string	!:i: string to be inserterd
c#
	integer*4 nb
c
	call dix_util_clear_descr(descr,.false.)
	nb = len(string)
	if(nb .gt. 0) then
	  call get_vm(control,nb,descr.dsc$a_pointer,vm_zone,
     1               .false.,'Insert_string')
	  call dix_util_copy(nb,%ref(string),%val(descr.dsc$a_pointer))
	else
	  descr.dsc$a_pointer  = 0
	endif
	call dix_util_copy(2,nb,descr.dsc$w_maxstrlen)
	return
	end
	subroutine dix_util_copy_string(source,dest)
	implicit none
c
c Copy a string, this allows descriptors to be copied
c  
	character*(*) source	!:i: source string
	character*(*) dest	!:o: target string
c#
c
	dest = source
	return
	end
	subroutine dix_util_swap(word1,word2)
	implicit none
c
	integer*2 word1
	integer*2 word2
c
	integer*2 temp
c
	temp  = word1
	word1 = word2 
	word2 = temp
	return
	end
	function dix_util_str_eq(str1,str2)
	implicit none
c
c Return true is str1 = str2
c
	character*(*) str1
	character*(*) str2
	logical dix_util_str_eq
c
	dix_util_str_eq = str1 .eq. str2
	return
	end
	subroutine dix_util_clear_descr(descr,dynamic)
	implicit none
c
c Initialise a string descriptor 
c  to either fixed or dynamic
c
	include 'dix_def.inc'
	include '($dscdef)'
	record /strdef/ descr
	logical*4 dynamic
c
	descr.dsc$w_maxstrlen = 0
	descr.dsc$a_pointer  = 0
	descr.dsc$b_dtype  = dsc$k_dtype_z
	if(dynamic) then
	  descr.dsc$b_class  = dsc$k_class_d
	else
	  descr.dsc$b_class  = dsc$k_class_z
	endif
	return
	end
	subroutine dix_util_free_descr(descr)
	implicit none
c
c Free a string descriptor  (in dynamic)
c
	include 'dix_def.inc'
	include '($dscdef)'
	record /strdef/ descr
c
	integer*4 istat
	integer*4 str$free1_dx
c
	if(descr.dsc$b_class .eq. dsc$k_class_d) then
	  if(descr.dsc$a_pointer .ne. 0) then
            istat = str$free1_dx(descr)
            if(.not. istat) call lib$signal(%val(istat))
	  endif
	  descr.dsc$w_maxstrlen = 0
        end if
	return
	end
	function dix_util_conv_version_Ascint(version,iver)
	implicit none
c
c Convert a version string like 4.1-2 to 412
c
	character*(*) version          	!:i: the ascci string
	integer*4 iver                  !:o: the binary version
	integer*4 dix_util_conv_version_ascint !:f: conversion result
c
	integer*4 ipos,jpos,majver,minver,patver,istat
	external dix_msg_illvers
c
c Locate the major version
c
	ipos = index(version,'.')
	if(ipos .eq. 0) then
c
c No dot, so this is only a major version
c
          read(version,2000,err=85) majver
2000	  format(bn,i10)
          minver = 0
          patver = 0
        else
c
c Upto the . is the major, 
c
          read(version(1:ipos-1),2000,err=85) majver
c
c See if we we can find the patch
c
          jpos = index(version(ipos+1:),'-')
          if(jpos .eq. 0) then
c
c No patch, 
c
            read(version(ipos+1:),2000,err=85) minver
	    patver = 0
          else
	    jpos = jpos + ipos
            read(version(ipos+1:jpos-1),2000,err=85) minver
            read(version(jpos+1:),2000,err=85) patver
	  endif
	endif 
	iver = majver*100 + minver*10 + patver
	istat = 1
	goto 90
85	istat = %loc(dix_msg_illvers)
	iver = 0
90	dix_util_conv_version_ascint = istat
	return
	end
	subroutine dix_util_conv_version_intasc(iver,version,nk)
	implicit none
c
c Convert a version to a string line 4.1-2
c
	integer*4 iver                  !:i: the binary version
	character*(*) version          	!:o: the ascci string
	integer*4 nk                    !:o: length of the string
c
	integer*4 majver,minver,patver,nk1
c
c Locate the major version
c
	patver = mod(iver,10)
	minver = mod(iver/10,10)
	majver = iver/100
c
	nk  = 0
	nk1 = 0
	call sys$fao('!UL.!UL',nk,version,%val(majver),%val(minver))
	if(patver .ne. 0) then
	  call sys$fao('-!UL',nk1,version(nk+1:),%val(patver))
	  nk = nk + nk1
	endif
	return
	end
c
	function dix_util_match_string_wild(data,search,
     1                 case_sens,wildcard_flag)
	implicit none
c
c Match a record to a (wildcard) string 
c in either none , standard(vms) or extended(unix) style wildcard
c  with case blind or case_sensitive
c  the whole record must match
c
	include 'dix_def.inc'
	character*(*) data		!:i: the data
	character*(*) search            !:i: the search string
	logical case_sens		!:i: case sensitive?
	integer*4 wildcard_flag		!:i: search flag 
	integer dix_util_match_string_wild !:f: true or false
c#
c
	integer*4 bpos,endpos,istat
c
	integer*4 dix_util_find_string_wild
	integer*4 str$case_blind_compare
	integer*4 str$match_wild
c
c Some shortcuts.
c  if wild=node, it is just a eq compare
c
	if(wildcard_flag .eq. wildcard_flag_none) then
	  if(case_sens) then
	    istat = data .eq. search
	  else
	    istat = str$case_blind_compare(data,search) .eq. 0
	  endif 
	else
	  if(wildcard_flag .eq. wildcard_flag_standard .and. case_sens) then
	    istat = str$match_wild(data,search)
	  else
c
c Now the general compare
c
	    bpos = dix_util_find_string_wild(data,search,case_sens,
     1                                   wildcard_flag,endpos)
	    istat = (bpos .eq. 1) .and. (endpos .eq. len(data))
	  endif
	endif
90	dix_util_match_string_wild = istat
	return
	end
c
	function dix_util_find_string_wild(data,search,
     1                 case_sens,wildcard_flag,endpos)
	implicit none
c
c Find a record to a (wildcard) string 
c in either none , standard(vms) or extended(unix) style wildcard
c  with case blind or case_sensitive
c  the whole record must match
c
c In none mode no wildcards are supported
c
c In standard mode the following chars are supported
c
c *     : matches all substrings (0 of meer chars)
c %     : matches exactly 1 char
c
c In extended mode the following extra chars are recognized
c
c  [abc] : Matches a "a" or a "b" or a "c"
c  [-abc]: Matches anything except a,b,c
c  [a-z] : Matches all letters (a-z)
c  [-a-z]: Matches anything except letters
c  'a    : Char "a" is not longer a special char ([*%' etc)
c  ~     : If in front of the searchstring , the searchstring must be in the
c          beginning of the line, if at the end of the searchstring,
c          the searchstring must be at the end of the line
c  !     : Matches one or more whitespace chars
c
	include 'dix_def.inc'
	character*(*) data		!:i: the data
	character*(*) search            !:i: the search string
	logical case_sens		!:i: case sensitive?
	integer*4 wildcard_flag		!:i: search flag 
	integer*4 endpos		!:o: endposition of match
	integer dix_util_find_string_wild !:f: true or false
c#
	integer*4 bpos,epos
	logical*4 last,check_first
	integer*4 dix_util_find_string_wild_r
c
	bpos = 1
	epos = len(search)
c
	if(wildcard_flag .eq. wildcard_flag_none) then
c
c Locate mode, if not case sensitive, this is easy
c
	  if(case_sens) then
	    bpos = index(data,search)
	    if(bpos .gt. 0) epos = bpos + len(search)-1
	    goto 90
	  endif 
	elseif(wildcard_flag .eq. wildcard_flag_extended) then
	  if(search(1:1) .eq. '~') then
	    bpos = 2
	    check_first = .true.
	  endif
	  if(search(epos:epos) .eq. '~') then
	    last = .true.
	    epos = epos - 1
	  endif
	endif
c
	bpos = dix_util_find_string_wild_r(data,
     1                             search(bpos:epos),endpos,
     1                             case_sens,1,last,wildcard_flag)

	if(check_first .and. bpos .ne. 1) bpos = 0
	if(bpos .eq. 0) endpos = 0
90	dix_util_find_string_wild = bpos
	return
	end
	options /recursive
	function dix_util_find_string_wild_r(data,search,endpos,
     1                             case_sens,level,last,wildcard_flag)
	implicit none
c
c wildcard search
c
	include 'dix_def.inc'
c
	character*(*) data		!:i: the line
	character*(*) search            !:i: the search string
	integer endpos                  !:o: end pos on success
	logical case_sens		!:i: If true, then case-sensitive
	logical*4 last			!:i: true if must match agains last char
	integer*4 level			!:i: level
	integer*4 wildcard_flag		!:i: search flag none, standard or extended
	integer dix_util_find_string_wild_r   !:f: begin pos of the match(0 if not found)
c#
	integer l,pos1,endpos1,spos,xpos,epos,nkd,nks,pos
	logical normal,neg,match,extended,standard
	character kar_d,kar_s
	character kar_l,kar_h
c
d	write(*,1000) '|'//data//'|','|'//search//'|',level
d1000	format(' Data = ',a30,' Sear = ',a20,' Level=',i5)
	nkd = len(data)
	nks = len(search)
	pos = 1
c
	extended = wildcard_flag .eq. wildcard_flag_extended
	standard = wildcard_flag .eq. wildcard_flag_standard .or.
     1             extended
c
c Try to match all substrings
c  pos = start position of the data
c
	do while(pos .le. nkd)	
c
c Start search for search in substring data(pos:nkd)
c
	  spos = 1		!start for "search"
	  xpos = pos            !start for data string
	  normal = .true.       !special chars have meaning
c
c Now go through all chars of "search"
c
	  do while(spos .le. nks)
	    if(normal) then
c
c Special kars are interpreted
c
	      if    (standard .and. search(spos:spos) .eq. '%') then
c
c Matches exactly one char
c  so the spos and xpos must be incremented
c
	        spos = spos + 1
	        xpos = xpos + 1
	        goto 30
	      elseif(standard .and. search(spos:spos) .eq. '*') then
c
c We have an *, 
c  this matches 0 or more characters
c
	        if(spos .eq. nks) then
c
c The * is the last char of the search string.
c   Now the match is complete
c
	          xpos = nkd + 1
	          goto 35
	        endif
c
c Try to match recursively with the rest of the search string
c   search(spos+1:nks)
c
	        pos1 = dix_util_find_string_wild_r(data(xpos:nkd),
     1                                search(spos+1:nks),
     1                                endpos1,case_sens,level+1,last,
     1                                wildcard_flag)
	        if(pos1 .ne. 0) then
c
c We have a match
c
	          endpos = endpos1 + xpos -1
	          goto 90
	        endif
	        goto 40		!no match
	      elseif(extended .and. search(spos:spos) .eq. '''') then
c
c Next char is no longer special
c  if there is still a character after the ',
c increment spos
c
	        if(spos .eq. nks) goto 20 
	        normal = .false.
	        spos   = spos + 1
	        goto 30
	      elseif(extended .and. search(spos:spos) .eq. '[') then
c
c we found a [, see if we can find a ]
c
	        do epos=spos,nks
	          if(search(epos:epos) .eq. ']') goto 12
	        end do
c
c not found, so now [ is regarded as a normal char
c
	        goto 20
c
c spos..epos contains [....]
c
12	        spos = spos + 1
	        neg = .false.
	        if(search(spos:spos) .eq. '-') then
	          neg = .true.
	          spos = spos + 1
	        endif
	        l = spos
	        if(case_sens) then
	          kar_d = data(xpos:xpos)
	        else
	          call str$upcase(kar_d,data(xpos:xpos))
	        endif
	        do while (l .lt. epos)
	          if((l .lt. epos-2) .and. (search(l+1:l+1) .eq. '-')) then
	            if(case_sens) then
	              kar_l = search(l:l)
	            else
	              call str$upcase(kar_l,search(l:l))
	            endif
	            if(case_sens) then
	              kar_h = search(l+2:l+2)
	            else
	              call str$upcase(kar_h,search(l+2:l+2))
	            endif
	            match = (kar_d .ge. kar_l) .and. (kar_d .le. kar_h)
	            l = l + 3
	          else
	            if(case_sens) then
	              kar_s = search(l:l)
	            else
	              call str$upcase(kar_s,search(l:l))
	            endif
	            match = kar_d .eq. kar_s
	            l = l + 1
	          endif
	          if(match) then
c
c We found a match, if not negative, all oke
c If we had negative, no match so start next data substring
c 
	            if(.not. neg) goto 14	!een match, dus oke als niet neg
	            if(neg) goto 40		!en fout als neg
	          endif
	        end do
c
c No match found, 
c  if negative , all oke
c  else start next data substring
c
	        if(.not. neg) goto 40			!alles matched niet, oke als neg
c
c the [..] matched eieter pos or neg, 
c  so skip the [..] part and 1 char of data
c
14	        spos = epos + 1
	        xpos = xpos + 1
	        goto 30
	      elseif(extended .and. search(spos:spos) .eq. '!') then
c
c Marches one or more whitespace (blank and tab)
c
	        do l=xpos,nkd
	          if(data(l:l) .ne. SPACE .and. data(l:l) .ne. TAB) goto 18
	        end do
	        l = nkd + 1
c
c If we did not find one space, no match, so try next data substring
c
18	        if(l .eq. xpos) goto 40
	        spos = spos + 1
	        xpos = l
	        goto 30
	      endif
	    endif
c
c No more special chars, now the bytes must match
c Check valid char
c
20	    if(case_sens) then
	      if(data(xpos:xpos) .ne. search(spos:spos)) goto 40
	    else
	      call str$upcase(kar_d,data(xpos:xpos))
	      call str$upcase(kar_s,search(spos:spos))
	      if(kar_d .ne. kar_s) goto 40
	    endif
c
c we have a match, so increment spos and xpos 
c
	    spos = spos + 1
	    xpos = xpos + 1
30	    normal = .true.
	  end do
c
c We found all chars of search, so we have it
c if the last is specified,
c xpos must be at the end of the string
c
35	  if(last .and. xpos .le. nkd) goto 40
	  endpos = xpos - 1
c
c Found a match
c
	  goto 90
c
c No match , try the next substring of data
c
40	  pos = pos + 1
	end do
c
c Not found, so set pos to 0
c
	pos = 0
c
c Return the pos 
c
90	dix_util_find_string_wild_r = pos
	return
	end
        subroutine dix_util_set_bit_flag(token,field,bit,negative)
        implicit none
c
c Set a bit flag depending on the token
c
        character*(*) token	!:i: the  cli name
        integer*4 field         !:i: bit mask field
        integer*4 bit           !:i: wanted bit(mask)
	logical*4 negative	!:i: reverse bit meaning
c
        logical*4 lval
c
        lval = (field .and. bit) .ne. 0 !get the bit
	if(negative) lval = .not. lval
        field = field .and. (.not. bit) !and clear it
c
        call dix_util_set_flag(token,lval)
c
c And set it again (if wanted)
c
	if(negative) lval = .not. lval
        if(lval) field = field .or. bit
        return
        end
	function dix_util_set_flag(name,flag)
	implicit none
c
c Set the flag according to the presence
c  if (local) present : set flag
c  if (local) negated : clear flag
c  if neither         : do not touch flag
c
	character*(*) name
	logical*4 flag
	logical*4 dix_util_set_flag	!set if flag changed
c
	external cli$_present
	external cli$_negated
	external cli$_locpres
	external cli$_locneg
c
	integer*4 istat
	integer*4 cli$present
c
	istat = cli$present(name)
c
	dix_util_set_flag = .false.
c
	if(istat .eq. %loc(cli$_present) .or.
     1     istat .eq. %loc(cli$_locpres)) then
	  flag = .true.
	  dix_util_set_flag = .true.
	endif
c
	if(istat .eq. %loc(cli$_negated) .or.
     1     istat .eq. %loc(cli$_locneg)) then
	  flag = .false.
	  dix_util_set_flag = .true.
	endif
	return
	end
	subroutine dix_util_conv_fancy(kar,nam,nk_nam)
	implicit none
c
	integer kar
	character*(*) nam
	integer*4 nk_nam
c
c
	integer*4 dix_util_get_len
c
	character*3 dix_util_c0_name
	character*3 dix_util_c1_name

c
	nk_nam = 0
	nam = ' '
c
	if(kar .ge. 0 .and. kar .lt. 31 .or. kar .eq. 127) then
	  nam = '<'//dix_util_c0_name(kar)
	elseif(kar .ge. 0+128 .and. kar .lt. 31+128 .or. 
     1         kar .eq. 255) then
	  nam = '<'//dix_util_c1_name(kar)
	endif
	nk_nam = dix_util_get_len(nam) + 1
	nam(nk_nam:nk_nam) = '>'	
	return
	end
	function dix_util_c0_name(ikar)
	implicit none
c
c convert a character code in the c0 range to a fancy name
c
	integer*4 ikar
	character*3 dix_util_c0_name
c
	character*3 dix_util_extract
c
	character*(*) names
	parameter (names  = 'NULSOHSTXETXEOTENQACKBEL'//
     1                      'BS HT LF VT FF CR SO SI '//
     1                      'DLEDC1DC2DC3DC4NAKSYNETB'//
     1                      'CANEM SUBESCFS GS RS US ')
	if(ikar .ge. 0 .and. ikar .le. 31) then
	  dix_util_c0_name = dix_util_extract(names,ikar*3+1,3)
	elseif(ikar .eq. 127) then
	  dix_util_c0_name = 'DEL'
	else
	  dix_util_c0_name = ' '
	endif
	return
	end
	function dix_util_c1_name(ikar)
	implicit none
c
c convert a character code in the c1 range to a fancy name
c
	integer*4 ikar
	character*3 dix_util_c1_name
c
	character*3 dix_util_extract
c
	character*(*) names
	parameter (names  = '128129130131INDNELSSAESA'//
     1                      'HTSHTJVTSPLDPLURI SS2SS3'//
     1                      'DCSPU1PU2STSCDhMW SPAEPA'//
     1                      '152153154CSIST OSCPM APC')
	if(ikar .ge. 0+128 .and. ikar .lt. 31+128) then
	  dix_util_c1_name = dix_util_extract(names,(ikar-128)*3+1,3)
	elseif(ikar .eq. 255) then
	  dix_util_c1_name = '255'
	else
	  dix_util_c1_name = ' '
	endif
	return
	end
	
	function dix_util_c0_kar(name)
	implicit none
c
c convert a text name to a c0 range byte
c  if the name does not match, return a -1
c
	character*(*) name
	integer*4 dix_util_c0_kar
c
	integer*4 k
c
	character*(*) names
	parameter (names  = 'NULSOHSTXETXEOTENQACKBEL'//
     1                      'BS HT LF VT FF CR SO SI '//
     1                      'DLEDC1DC2DC3DC4NAKSYNETB'//
     1                      'CANEM SUBESCFS GS RS US ')
	if(len(name) .gt. 3) goto 80
	if(len(name) .lt. 2) goto 80
c
	k = index(names,name)-1
	if(name .eq. 'DEL') k = 127*3
	if(3*(k/3) .ne. k) goto 80
	goto 90
c
80	k = -1
90	dix_util_c0_kar = k
	return
	end
	function dix_util_c1_kar(name)
	implicit none
c
c convert a character code in the c1 range to a fancy name
c  If the name does not match, return a --1
c
	character*(*) name
	integer*4 dix_util_c1_kar
c
	integer*4 k
c
	character*(*) names
	parameter (names  = '128129130131INDNELSSAESA'//
     1                      'HTSHTJVTSPLDPLURI SS2SS3'//
     1                      'DCSPU1PU2STSCDhMW SPAEPA'//
     1                      '152153154CSIST OSCPM APC')
	if(len(name) .gt. 3) goto 80
	if(len(name) .lt. 2) goto 80
c
	k = index(names,name)-1
	if(name .eq. '255') k = 255*3
	if(3*(k/3) .ne. k) goto 80
	k = k + 128
	goto 90
c
80	k = -1
90	dix_util_c1_kar = k
	return
	end
	function dix_util_extract(string,spos,nbyte)
	implicit none
c
c
	character*(*) string
	integer*4 spos
	integer*4 nbyte
	character*(*) dix_util_extract
c
	dix_util_extract = string(spos:spos+nbyte-1)
	return
	end
	subroutine dix_util_hex_conv(value,line,nk,perc)
	implicit none
c
c Convert an integer to a Hex format (pre
c if perc = true, insert a %X in front
c
	integer*4 value		!:i: value
	character*(*) line      !:o: hex string
	integer*4 nk		!:o: length
	logical*4 perc		!:i: INclude %X?
c
	integer*4 k
c
	call sys$fao('!XL',nk,line,%val(value))
	do k=1,nk-1
	  if(line(k:k) .ne. '0') goto 10
	end do
	k = nk
10	if(perc) then
	  line = '%X'//line(k:nk)
	  nk =  2 + nk - k + 1
	else
	  line = line(k:nk)
	  nk   =  nk - k + 1
	endif
	return
	end
	subroutine dix_util_sign_extend(value)
	implicit none
c
cSign extend to i*8
c
	integer*4 value(2)
c
	if(value(1) .ge. 0) then
	  value(2) = 0
	else
	  value(2) = -1
	endif
	return
	end
c
	subroutine dix_util_init_table(table,size)
	implicit none
c
	include 'dix_def.inc'
	record /table/ table
	integer*4 size
c
	table.count     = 0	!nothing in the table yet
	table.size      = size	!size of element
	table.allocated = 0	!no bytes allocated yet
	table.address   = 0	!and no memory pointer
	table.magic     = magic_table !set magic word (sanity check)
	return
	end