function dix_eval_check(control,line,err_arg)
	implicit none
c
c Check if expression is ok
c
	include 'dix_def.inc'
	record /control/ control
	character*(*) line           	!:i: input line
	character*(*) err_arg		!:o: output parameter
	logical*4 dix_eval_check	!:f: return status
c#
	logical*4 dix_eval_expression
c
	integer*4 dix_util_get_len_fu
c
	integer*4 nk
	record /value/ result
	logical is_symbol
c
	nk = dix_util_get_len_fu(line)
	call dix_eval_init_char(result.strdes)
c
	dix_eval_check = dix_eval_expression(control,line(1:nk),result,
     1                     .true.,err_arg,.false.,is_symbol)

	call dix_util_free_descr(result.strdes)
	return
	end
	function dix_eval_express_int(control,line,result,err_arg,set_dep)
	implicit none
c
c Evaluate expression, and allow only integer*4 results
c
	include 'dix_def.inc'
	record /control/ control
	character*(*) line    		!:i: the line to be "eval"ed
	integer*4 result		!:o: result value (integer)
	character*(*) err_arg     	!:o: error parameter
	logical*4 set_dep               !:i: if field is used, do we set dependency flag?
	logical*4 dix_eval_express_int	!:f: funtion result
c#
	logical is_symbol
	logical*4 dix_eval_expression
	external dix_msg_enotint
c
	record /value/ result1
c
c Evaluate expression
c
	call dix_eval_init_char(result1.strdes)
	dix_eval_express_int = dix_eval_expression(control,
     1            line,result1,
     1            .false.,err_arg,set_dep,is_symbol)
	if(dix_eval_express_int) then
c
c Evaluate oke; is the result an integer?
c
	  if(result1.type .eq. symb_typ_int) then
	    result = result1.ival
	  else
	    err_arg = line
	    dix_eval_express_int = %loc(dix_msg_enotint)
	  endif
	endif
	call dix_util_free_descr(result1.strdes)
	return
	end
	function dix_eval_express_log(control,line,result,err_arg,set_dep)
	implicit none
c
c Evaluate expression, and allow only logical results
c
	include 'dix_def.inc'
	record /control/ control
	character*(*) line    		!:i: the line to be "eval"ed
	logical*4 result		!:o: result value (logical)
	character*(*) err_arg     	!:o: error parameter
	logical*4 set_dep               !:i: if field is used, do we set dependency flag?
	logical*4 dix_eval_express_log	!:f: funtion result
c#
	logical is_symbol
	logical*4 dix_eval_expression
	external dix_msg_enotint
c
	record /value/ result1
c
c Evaluate expression
c
	call dix_eval_init_char(result1.strdes)
	dix_eval_express_log = dix_eval_expression(control,
     1            line,result1,
     1            .false.,err_arg,set_dep,is_symbol)
	if(dix_eval_express_log) then
c
c Evaluate oke; is the result an integer?
c
	  if(result1.type .eq. symb_typ_log) then
	    result = result1.lval
	  else
	    err_arg = line
	    dix_eval_express_log = %loc(dix_msg_enotint)
	  endif
	endif
	call dix_util_free_descr(result1.strdes)
	return
	end
c
	function dix_eval_expression(control,line,result,
     1                syntax,err_arg,set_dep,is_symbol)
	implicit none
c
c Evaluate expression, the whole line must be a valid expression
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	character*(*) line		!:i: the expression
	record /value/ result		!:o: the value
	logical syntax			!:i: syntax only ?
	character*(*) err_arg		!:o: error argument
	logical set_dep			!:i: set dependancy for field?
	logical is_symbol		!:o: was the expresion a symbol?
	integer*4 dix_eval_expression	!:f: function result
c#
	integer*4 ipos,istat
	character kar
c
	integer*4 dix_eval_expression1
	external dix_msg_toomuch
c
	istat = dix_eval_expression1(control,line,result,
     1                syntax,err_arg,set_dep,
     1                kar,ipos,is_symbol)
	if(istat) then
c
c Evalution oke, now check if the rest of the line is empty
c
	  if(kar .ne. NULL) then
	    istat = %loc(dix_msg_toomuch)
	    err_arg = line(ipos-1:)
	  endif	
	endif
	dix_eval_expression = istat
	return
	end
	function dix_eval_expression1(control,line,result,
     1                syntax,err_arg,set_dep,
     1                kar,ipos,is_symbol)
	implicit none
c
c Evaluate expression, return terminating char (maybe a , for a list of expressions)
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	character*(*) line		!:i: expressoin
	record /value/ result		!:o: result
	logical syntax			!:i: syntax only check?
	character*(*) err_arg		!:o: error argument
	logical set_dep			!:i: set dependancy for fields?
	character kar			!:o: terminating char
	integer*4 ipos			!:o: position of terminating char
	logical is_symbol		!:o: was the expression a symbol?
	integer*4 dix_eval_expression1	!:f: funciton result
c#
	integer*4 istat
c
	integer*4 dix_eval_expres
	character dix_eval_getkar
c
	external dix_msg_aroverfl
c
	logical overflow
	volatile overflow
	common /dix_eval_overflow_common/ overflow
c
	overflow = .false.
c
c
	call dix_eval_free_value(result)
	is_symbol = .true.
	err_arg = ' '
	ipos    = 1
	istat   = dix_eval_expres(control,
     1                 line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	if(overflow) istat = %loc(dix_msg_aroverfl)
	if(istat) then
	  kar = dix_eval_getkar(line,ipos,.true.)
	endif
	dix_eval_expression1 = istat
	return
	end
	options /recursive
	function dix_eval_expres(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	implicit none
c
c Evaluate expression, can be called resursively
c expression is
c  andor-expression [operator andor-expresion [operator andorr-expression...]
c operator is >,<,=,>=,<=,<>
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	character*(*) line		!:i: the expression
	integer*4 ipos			!:io: the position of the start
	record /value/ result		!:o: result value
	logical syntax			!:i: syntax only check?
	character*(*) err_arg		!:o: error argument
	logical set_dep			!:i: set dependancy for fields ?
	logical is_symbol		!:o: is the expression a symbol?
	integer*4 dix_eval_expres	!:f: functin result
c#
	character kar
	integer*4 istat,oper
	logical isless,isequal
	record /value/ result1
c
	character dix_eval_getkar
	integer dix_eval_andor
	integer dix_eval_setflags
c
	integer*4 oper_lt
	integer*4 oper_le
	integer*4 oper_eq
	integer*4 oper_ge
	integer*4 oper_gt
	integer*4 oper_ne
	integer*4 oper_none
c
	parameter (oper_none = 0,oper_lt = 1,oper_le = 2,
     1             oper_eq   = 3,oper_ge = 4,oper_gt = 5,oper_ne=6)

c
c	write(*,*) 'In expr with pos ',ipos
	call dix_eval_init_char(result1.strdes)
c
c Evaluate an andor block
c
	istat = dix_eval_andor(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	if(istat) then
c
c Now get the operator
c
10	  oper = oper_none
	  kar = dix_eval_getkar(line,ipos,.true.)
	  if(kar .eq. '<') then
	    oper = oper_lt
	    kar = dix_eval_getkar(line,ipos,.true.)
	    if(kar .eq. '=') then
	      oper = oper_le
	    elseif(kar .eq. '>') then
	      oper = oper_ne
	    else
	      ipos = ipos - 1
	    endif
	  elseif(kar .eq. '>') then     
	    oper = oper_gt
	    kar = dix_eval_getkar(line,ipos,.true.)
	    if(kar .eq. '=') then
	      oper = oper_ge
	    else
	      ipos = ipos - 1
	    endif
	  elseif(kar .eq. '=') then
	    oper = oper_eq
	  elseif(kar .eq. NULL) then
	  else
	    ipos = ipos - 1
	  endif
c
c If we have a valid operator, execute it
c
	  if(oper .ne. oper_none) then
	    is_symbol = .false.
c
c Now the second andor expression
c
	    istat = dix_eval_andor(control,line,ipos,result1,
     1                syntax,err_arg,set_dep,is_symbol)
            if(istat) then
	      if(.not. syntax) then
c
c Set the flags (less and equal
c
	        istat = dix_eval_setflags(control,result,
     1                                    result1,isless,isequal)
	        if(istat) then
c
c Now execute the operator
c
	          if(oper .eq. oper_lt) then
	            result.lval = isless .and. .not. isequal
	          elseif(oper .eq. oper_le) then	   
	            result.lval = isless
	          elseif(oper .eq. oper_eq) then
	            result.lval = isequal
	          elseif(oper .eq. oper_ge) then
	            result.lval = .not. isless
	          elseif(oper .eq. oper_gt) then
	            result.lval = .not. (isless .or. isequal)
	          elseif(oper .eq. oper_ne) then
	            result.lval = .not. isequal
	          endif
	          result.type = symb_typ_log
	        endif
c
c See if there are more operators
c
	        goto 10
	      endif     !not syntax
	    endif	!evaluate 2nd andor oke
	  endif         !operator <> none
	endif		!evaluate 1st andor oke
	call dix_util_free_descr(result1.strdes)
	dix_eval_expres = istat
	return
	end
	function dix_eval_setflags(control,result,result1,isless,isequal)
	implicit none
c
c Set two flags ,isless and isequal depending on the both result values
c
	include 'dix_def.inc'
	record /control/ control	!:i: control structure
	record /value/ result		!:i: result 1
	record /value/ result1          !:i: result 2
	logical isless                  !:o: true if 1<2
	logical isequal                 !:o: true if 1=2
	integer dix_eval_setflags	!:f: function result
c#
	integer*4 istat,diff(2),is
	external dix_msg_invcomp
	integer*4 str$compare
c 
c Assume invalid compares
c
	istat = %loc(dix_msg_invcomp)
	if(result.type .eq. symb_typ_int) then
c
c 1 is integer
c
	  if    (result1.type .eq. symb_typ_int) then
	    if(control.integer_size .eq. 8) then
	      call lib$subx(result.date,result1.date,diff)
	      isequal = diff(1) .eq. 0 .and. diff(2) .eq. 0
	      isless  = diff(2) .lt. 0
	    else
	      isequal = result.ival .eq. result1.ival
	      isless  = result.ival .lt. result1.ival
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
	    if(    control.real_size .eq. 8) then
	      if(control.integer_size .eq. 8) then
	        call dix_eval_i8_comp(result.i8val,result1,
     1             control.real_size,isequal,isless)
	      else
	        isequal = result.ival .eq. result1.rval8
	        isless  = result.ival .lt. result1.rval8
	      endif
	    elseif(control.real_size .eq. 16) then
	      if(control.integer_size .eq. 8) then
	        call dix_eval_i8_comp(result.i8val,result1,
     1             control.real_size,isequal,isless)
	      else
	        isequal = result.ival .eq. result1.rval16
	        isless  = result.ival .lt. result1.rval16
	      endif
	    else
	      if(control.integer_size .eq. 8) then
	        call dix_eval_i8_comp(result.i8val,result1,
     1             control.real_size,isequal,isless)
	      else
	        isequal = result.ival .eq. result1.rval
	        isless  = result.ival .lt. result1.rval
	      endif
	    endif
	  else
c
c Invalid compares
c
	    goto 90	
	  endif	
	elseif(result.type .eq. symb_typ_real) then
c
c 1 is real
c
	  if    (result1.type .eq. symb_typ_int) then
	    if(    control.real_size .eq. 8) then
	      if(control.integer_size .eq. 8) then
	        call dix_eval_i8_comp(result.i8val,result1,
     1             control.real_size,isequal,isless)
	        isless = .not. isless
	      else
	        isequal = result.rval8 .eq. result1.ival
	        isless  = result.rval8 .lt. result1.ival
	      endif
	    elseif(control.real_size .eq. 16) then
	      if(control.integer_size .eq. 8) then
	        call dix_eval_i8_comp(result.i8val,result1,
     1             control.real_size,isequal,isless)
	        isless = .not. isless
	      else
	        isequal = result.rval16 .eq. result1.ival
	        isless  = result.rval16 .lt. result1.ival
	      endif
	    else
	      if(control.integer_size .eq. 8) then
	        call dix_eval_i8_comp(result.i8val,result1,
     1             control.real_size,isequal,isless)
	        isless = .not. isless
	      else
	        isequal = result.rval .eq. result1.ival
	        isless  = result.rval .lt. result1.ival
	      endif
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
	    if(    control.real_size .eq. 8) then
	      isequal = result.rval8 .eq. result1.rval8
	      isless  = result.rval8 .lt. result1.rval8
	    elseif(control.real_size .eq. 16) then
	      isequal = result.rval16 .eq. result1.rval16
	      isless  = result.rval16 .lt. result1.rval16
	    else
	      isequal = result.rval .eq. result1.rval
	      isless  = result.rval .lt. result1.rval
	    endif
	  else
c
c Invalid compare
c
	    goto 90	
	  endif	
	elseif(result.type .eq. symb_typ_char) then
c
c 1 is char
c
	  if(result1.type .eq. symb_typ_char) then
	    is = str$compare(result.strdes,result1.strdes)
	    isequal = is .eq. 0
	    isless  = is .lt. 0
	  else
c
c Invalid
c
	    goto 90	
	  endif	
	elseif(result.type .eq. symb_typ_date) then
c
c 1 is date
c
	  if(result1.type .eq. symb_typ_date) then
	    call lib$subx(result.date,result1.date,diff)
	    isequal = diff(1) .eq. 0 .and. diff(2) .eq. 0
	    isless  = diff(2) .lt. 0
	  else
c
c Invalid
c
	    goto 90	
	  endif	
	elseif(result.type .eq. symb_typ_log) then
c
c For logicals compares are not allowed
c
	  goto 90
	endif	
	istat = 1
90	dix_eval_setflags = istat
	return
	end
	options /recursive
	function dix_eval_andor(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	implicit none
c
c Evaluate a andor expression
c  A valid andor expression is
c  addsub-expression [operator addsub-expression [operator addsub-expressoin...]
c  and operator is & (and) ,| (or)
c
	include 'dix_def.inc'		
	record /control/ control	!:i: control block
	character*(*) line		!:i: expression
	integer*4 ipos			!:io: position in line
	record /value/ result		!:o: value 
	logical syntax			!:i: syntax only check??
	character*(*) err_arg		!:o: error argument
	logical set_dep			!:i: set dependancy for fields?
	logical is_symbol		!:o: is expressoin a symbol?
	integer*4 dix_eval_andor	!:f: function result
c#
	character kar
	integer*4 istat
	record /value/ result1
c
	character dix_eval_getkar
	integer dix_eval_addsub
	integer*4 dix_eval_and
	integer*4 dix_eval_or

c
c	write(*,*) 'In expr with pos ',ipos
	call dix_eval_init_char(result1.strdes)
	istat = dix_eval_addsub(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	if(istat) then
c
c First eval oke, now check for operator
c
10	  kar = dix_eval_getkar(line,ipos,.true.)
	  if(kar .eq. '&' .or. kar .eq. '|') then
c 
c A valid operator
c
	    is_symbol = .false.
c
c Get the next part
c 
	    istat = dix_eval_addsub(control,line,ipos,result1,
     1                syntax,err_arg,set_dep,is_symbol)
            if(istat) then
	      if(.not. syntax) then
	        if(kar .eq. '&') then
	          istat = dix_Eval_and(result,result1)
	        else
	          istat = dix_Eval_or(result,result1)
	        endif
	      endif
	    endif
	    if(istat) goto 10
	  elseif(kar .eq. NULL) then
c
c EOL, is oke
c
	  else
c
c All others, skip back one char, can be and operator for a higher level
c
	    ipos = ipos - 1
	  endif
	endif
	call dix_util_free_descr(result1.strdes)
	dix_eval_andor = istat
	return
	end
	options /recursive
	function dix_eval_addsub(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	implicit none
c
c Evaluate an addsub exprerssion
c  muldiv-expression [operator muldiv-expression [operator muldiv-expressoin...]
c  and operator is + (and) ,- (or)
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	character*(*) line		!:i: expression
	integer*4 ipos			!:io: position in line
	record /value/ result		!:o: result value
	logical syntax			!:i: syntax only mode?
	character*(*) err_arg		!:o: error argument
	logical set_dep			!:i: set dependancy for field?
	logical is_symbol		!:o: is expression a symbol?
	integer*4 dix_eval_addsub	!:f: function result
c#
	character kar
	integer*4 istat
	record /value/ result1
	character dix_eval_getkar
	integer*4 dix_eval_add
	integer*4 dix_eval_sub
	integer*4 dix_eval_muldiv
c
c	write(*,*) 'In addsub with pos ',ipos
	call dix_eval_init_char(result1.strdes)
c
c Get a muldiv expression
c
	istat = dix_eval_muldiv(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	if(istat) then
c
c Evaluate oke, now check for the operator
c
10	  kar = dix_eval_getkar(line,ipos,.true.)
	  if(kar .eq. '+' .or. kar .eq. '-') then
c
c A known operator 
c
	    is_symbol = .false.
c
c Get the next block
c
	    istat = dix_eval_muldiv(control,line,ipos,result1,
     1                syntax,err_arg,set_dep,is_symbol)
            if(istat) then
	      if(.not. syntax) then
c
c Now execute the operator
c
	        if(kar .eq. '+') then
	          istat = dix_eval_add(control,result,result1)
	        else
	          istat = dix_eval_sub(control,result,result1)
	        endif
	      endif
	    endif
	    if(istat) goto 10
	  elseif(kar .eq. NULL) then
c
c EOL , oke
c
	  else
c
c All others, skip back one pos, so the higher level can check
c
	    ipos = ipos - 1
	  endif
	endif
	call dix_util_free_descr(result1.strdes)
	dix_eval_addsub = istat
	return
	end
	options	/recursive
	function dix_eval_muldiv(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	implicit none
c
c Evalute a muldiv expression
c  element-expression [operator element-expression [operator element-expressoin...]
c  and operator is / ,*
c
	include 'dix_def.inc'
	record /control/ control
	character*(*) line
	integer*4 ipos
	record /value/ result
	logical syntax
	character*(*) err_arg
	logical set_dep
	logical is_symbol
	integer*4 dix_eval_muldiv
c#
	character kar
	integer*4 istat
	record /value/ result1
c
	character dix_eval_getkar
	integer dix_eval_mul
	integer dix_eval_div
	integer*4 dix_eval_element
c
c	write(*,*) 'In muldiv with pos ',ipos
	call dix_eval_init_char(result1.strdes)
c
c Get the first part
c
	istat = dix_eval_element(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	if(istat) then
10	  kar = dix_eval_getkar(line,ipos,.true.)
	  if(kar .eq. '*' .or. kar .eq. '/') then
c
c Known operator
c
	    is_symbol = .false.
	    istat = dix_eval_element(control,line,ipos,result1,
     1                syntax,err_arg,set_dep,is_symbol)
            if(istat) then
	      if(.not. syntax) then
c
c Exexcute the operator
c
	        if(kar .eq. '*') then
	          istat = dix_eval_mul(control,result,result1)
	        else
	          istat = dix_eval_div(control,result,result1)
	        endif
	      endif
	    endif
	    if(istat) goto 10
	  elseif(kar .eq. NULL) then
c
c EOL, oke
c
	  else
c
c Unknown operator, skip back one pos for the higher level to check
c
	    ipos = ipos - 1
	  endif
	endif
	call dix_util_free_descr(result1.strdes)
	dix_eval_muldiv = istat
	return
	end
	options /recursive
	function dix_eval_element(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	implicit none
c
c Evaluate an element
c An element can be
c 1. (expression)
c 2. "string"
c 3. Number
c 4. symbol name
c 5. parameter name
c 6. field name
c 7. function
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	character*(*) line		!:i: expression
	integer*4 ipos                  !:io: position in line
	record /value/ result		!:o: result value
	logical syntax			!:i: syntax only?
	character*(*) err_arg		!:o: error argument
	logical set_dep			!:i: set dependancy for field?
	logical is_symbol		!:o: is expression a symbol?
	integer*4 dix_eval_element	!:f: function result
c#
	character dix_eval_getkar
	integer*4 dix_eval_expres
	logical dix_eval_is_tf
	integer dix_des_find_field
	integer*4 dix_symbol_find
	integer*4 dix_eval_func
	logical dix_util_legal_char
	logical dix_des_find_par
	integer*4 dix_con_ascint
c
	record /des_rec/ des_rec
c
	character kar
	logical got_exponent,got_fraction,try_field,try_symb
	character*(max_str_len) work
	integer*4 nk,narg,istat,xpos,spos
	integer*4 k,nk_name,ptr
c
	integer*4 max_arguments
	parameter (max_arguments = 10)
	record /value/ args(max_arguments)
c
	integer*4 dix_eval_cvt
	integer*4 dix_eval_tryradix
c
	external dix_msg_symbtool
	external dix_msg_invelem
	external dix_msg_invreal
	external dix_msg_invint
	external dix_msg_closbnotf
	external dix_msg_empty
	external dix_msg_unexpchar
	external dix_msg_invfunc
	external dix_msg_invradexp
	external dix_msg_toomanarg
c
c Init all parameters for function
c
	do k=1,max_arguments
	  call dix_eval_init_char(args(k).strdes)
	  args(k).type = symb_typ_none	!no value present
	end do
	  
c	write(*,*) 'In element with pos ',ipos
	istat = 1
c
c Get next char
c	
	kar = dix_eval_getkar(line,ipos,.true.)
	if(kar .eq. NULL) then
c
c EOL, is error
c
	  istat = %loc(dix_msg_empty)
	elseif(kar .eq. '(') then
c
c Start of a new expression
c syntax (expression)
c
	  is_symbol = .false.
	  istat = dix_eval_expres(control,line,ipos,result,
     1                syntax,err_arg,set_dep,is_symbol)
	  if(istat) then
c
c Now we expect a )
c
	    kar = dix_eval_getkar(line,ipos,.true.)
	    if(kar .ne. ')') then
	      istat = %loc(dix_msg_closbnotf)
	    endif
	  endif
	elseif(kar .eq. '''') then
c
c Could be something like 'dddd'R   R=D/H/O/B
c copy text until the trailing quote
c
	  nk = 0
7	  kar = dix_eval_getkar(line,ipos,.false.)
	  if(kar .eq. NULL) then
	    err_arg = work(1:nk)
	    istat = %loc(dix_msg_invradexp)
	    goto 90
	  elseif(kar .ne. '''') then
	    nk = nk + 1
	    work(nk:nk) = kar
	    goto 7
	  endif	  
c
c Get terminator should be b/o/d/h
c Prepare a string for tyradix
c
	  kar = dix_eval_getkar(line,ipos,.false.)
	  work = kar//work(1:nk)
	  nk = nk + 1
	  call str$upcase(work(1:nk),work(1:nk))
	  istat = dix_eval_tryradix(work(1:nk),result,
     1            control.integer_size)
	  if(.not. istat) then
	    istat = %loc(dix_msg_invradexp)
	    err_arg = work(1:nk)//kar
	    goto 90	    
	  endif	  
	elseif(kar .eq. '"') then
c
c Start of string
c
	  is_symbol = .false.
	  result.type = symb_typ_char
	  nk = 0
12	  kar = dix_eval_getkar(line,ipos,.false.)
	  if(kar .eq. '"') then
c
c Get next char, if a quote too, goon with one "
c
	    kar = dix_eval_getkar(line,ipos,.false.)
	    if(kar .eq. '"') then
c
c ", so insert a single "
c
	    elseif(kar .eq. NULL) then
c
c EOL, all oke
c
	      goto 15
	    else
c
c All else skip back one pos, for the next higher level
c
	      ipos = ipos - 1
	      goto 15
	    endif
	  endif
c
c Insert a char
c
	  if(nk .lt. max_str_len) then
	    nk = nk + 1
	    work(nk:nk) = kar
	    goto 12
	  else
	    istat = %loc(dix_msg_symbtool)
	  endif
c
c String complete, now make it dynamic
c
15	  call dix_eval_fill_char(result.strdes,work(1:nk))
	elseif((kar .ge. '0' .and. kar .le. '9') .or. 
     1          kar .eq. '+' .or. kar .eq. '-') then
c
c Must be a number
c syntax
c  [sign]dddd[.ddd[e[sign]ddd]
c
	  is_symbol = .false.
	  got_fraction = .false.
	  got_exponent = .false.
	  nk = 0
10	  nk = nk + 1
	  work(nk:nk) = kar
	  kar  = dix_eval_getkar(line,ipos,.false.)
	  if(kar .ge. '0' .and. kar .le. '9') then
c
c One more digit
c
	    goto 10
	  elseif(kar .eq. '.') then
c
c fraction seperator, oke if we did not yet see one
c
	    if(got_fraction .or. got_exponent) then
	      istat = %loc(dix_msg_invreal)
	      goto 90
	    endif
	    got_fraction = .true.
	    goto 10
	  elseif(kar .eq. 'E' .or. kar .eq. 'e') then
c
c Exponent , oke if we did not yet see one
c
	    if(got_exponent) then
	      istat = %loc(dix_msg_invreal)
	      goto 90
	    endif	      
	    if(.not. got_fraction) then
	      nk = nk + 1
	      work(nk:nk) = '.'
	      got_fraction = .true.
	    endif
	    got_exponent = .true.
	    if(kar .eq. 'e') kar = 'E'
	    goto 10
	  elseif(kar .eq. '+' .or. kar .eq. '-') then
c
c + or -, oke just after the E char
c
	    if(work(nk:nk) .eq. 'E') goto 10
	    ipos = ipos - 1
	  elseif(kar .eq. NULL) then
c
c EOL, oke
c
	  else
c 
c Skip back one pos, for the next higher level
c
	    ipos = ipos - 1	!skipback one char
	  endif
c
	  des_rec.flags      = 0
	  des_rec.bit_offset = 0
	  err_arg = work(1:nk)
	  des_rec.min_val      = 0
	  des_rec.max_val      = 0
	  call dix_util_clear_descr(des_rec.fldnam,.false.)
	  if(got_exponent .or. got_fraction) then
c
c FLoating point value
c
	    des_rec.size       = bits_per_byte*control.real_size
	    call dix_con_cvt_float_type(control,control.real_size,
     1                            des_rec.ent_type)
	    result.type = symb_typ_real
	    istat = dix_con_ascint(work(1:nk),result.rval,des_rec,
     1                             des_flag_translate_nor,k,control)
	    if(.not. istat) istat = %loc(dix_msg_invreal)
	  else
c
c Integer
c
	    des_rec.size       = bits_per_byte*control.integer_size
	    des_rec.ent_type   = enttyp_int
c
	    istat = dix_con_ascint(work(1:nk),result.ival,des_rec,
     1                             des_flag_translate_nor,k,control)
	    if(.not. istat) istat = %loc(dix_msg_invint)
	    result.type = symb_typ_int
	  endif
	elseif(dix_util_legal_char(kar,1) .or. 
     1              kar .eq. '%' .or. 
     1              kar .eq. '$') then
c
c Symbol
c format can be something like
c  name                                symbol,parameter,radix constant
c  name(dim,dim,dim)	               field with dimensions
c  name("xyz")                         function
c  name(dim,dim).name(dim,dim).name    fieldname
c  or radix notation like  %Xddd
c 
	  spos         = ipos-1
	  nk           = 0		!no chars yet
	  nk_name      = 0		!no name yet	
	  try_field    = .true.		!it can still be a fieldname
	  try_symb     = .true.		!it can still be symb/par/radix char
c
20	  nk = nk + 1
	  work(nk:nk) = kar
c
c Must be a symbol
c
	  kar  = dix_eval_getkar(line,ipos,.false.)
	  if(dix_util_legal_char(kar,2)) goto 20
	  if(kar .eq. '.' .or. kar .eq. '\') then
c
c Part of fieldname filetag\name
c
	    is_symbol = .false.
	    try_symb = .false.
	    goto 20
	  endif
c
	  if(kar .eq. ' ') kar = dix_eval_getkar(line,ipos,.true.)
	  narg = 0
	  if(kar .eq. '(') then
	    is_symbol = .false.
	    try_symb = .false.		!no more symbol
c
c We had ( before so it cannot be a function. If try_field is also false
c
	    nk_name = nk	!remember the function name position
c
c See if the text contains a function line f$time() with
c () without any argument
c
	    kar = dix_eval_getkar(line,ipos,.true.)
	    if(kar .eq. ')') then
	      try_field = .false.		!cannot be a field name
	      goto 35
	    else
	      ipos = ipos - 1
	      kar = '('
	    endif  
c
30	    nk = nk + 1
	    work(nk:nk) = kar
	    narg = narg + 1
	    if(narg .gt. max_arguments) then
	      istat = %loc(dix_msg_toomanarg)
	      call str$upcase(err_arg,work(1:nk_name))
	      goto 90
	    endif
	    if(narg .gt. max_dimension) try_field = .false.
c
c Check if next char a , or a )  if so we have an empty argument
c
	    kar = dix_eval_getkar(line,ipos,.true.)
	    ipos = ipos - 1
	    if(kar .eq. ',' .or. kar .eq. ')') then
	      try_field = .false.
	      args(narg).type = symb_typ_none
	      goto 32
	    endif

	    xpos = ipos
	    istat = dix_eval_expres(control,line,ipos,args(narg),
     1                syntax,err_arg,set_dep,is_symbol)
	    if(.not. istat) goto 90
	    if(args(narg).type .ne. symb_typ_int) then
c
c Not integer argument, cannot be a fieldname
c
	      try_field = .false.
	    else
c
c Can still be a field name (matrix), so keep on filling work
c
	      if(try_field) then
	        call dix_con_type_intasc(4,args(narg).ival,enttyp_int,
     1                      work(nk+1:),xpos,control)
	        nk = nk + xpos
	      endif
	    endif
c
c Get next char
c
32	    kar = dix_eval_getkar(line,ipos,.true.)
35	    if(kar .eq. ',') then
	      goto 30			!next argument
	    elseif(kar .eq. ')') then
c
c Now we have all thing present for this funcion,
c try if it is one
c
	      call str$upcase(work(1:nk_name),work(1:nk_name))
              istat = dix_eval_func(control,work(1:nk_name),narg,args,
     1                result,err_arg,set_dep)
	      if(istat .ne. %loc(dix_msg_invfunc)) goto 90	!oke or specific message
c
c Not a valid function. It can still be a fieldname
c  for tables e.g. name(1,2,3).name
c
c Now kar still contains the )
c
	      nk = nk + 1
	      work(nk:nk) = kar
c
c Get the next char, it can be either a . (next part of field)
c or a eol
c  all other chars are illegal
c
	      kar  = dix_eval_getkar(line,ipos,.false.)
	      if(kar .eq. NULL) then
c
c Not a valid function
c  if try_field or try_symbol both false, exit
c
	        if(.not. (try_symb .or. try_field)) goto 90
	        goto 39
	      endif
	      if(kar .ne. '.') try_field = .false.
	      if(try_field) goto 20	!if field still possible try the next char
	      goto 90			!and return the invfunc
	    else
	      istat = %loc(dix_msg_closbnotf)
	      goto 90
	    endif
	  elseif(kar .eq. NULL) then
	  else
	    ipos = ipos - 1	!skip back
	  endif
c
c Now we finally have the name in work
c  work(1:nk) can be a fieldname (if try_field is still true)
c  or work(1:nk_name) can be the  name of the function with args(1:narg)
c                      its arguments
c
39	  call str$upcase(work(1:nk),work(1:nk))
c
c Set the type to nothing
c
	  result.type = symb_typ_none
c
c First check for things that do not have arguments
c
	  if(try_symb) then
c
c Check for reserved words (true, false)
c
	    if(dix_eval_is_tf(.true.,work(1:nk))) then
	      is_symbol = .false.
	      result.lval = 1
	      result.type = symb_typ_log
	    elseif(dix_eval_is_tf(.false.,work(1:nk))) then
	      is_symbol = .false.
	      result.lval = 0
	      result.type = symb_typ_log
	    endif
c
c If not yet oke, Try the a %rdddd format
c
	    if(result.type .eq. symb_typ_none) then
	      if(work(1:1) .eq. '%') then
c
c Try to convert, but if it fails do not abort
c since it may also be %recordnumber and so no (a symbol)
c
	        istat = dix_eval_tryradix(work(2:nk),result,
     1            control.integer_size)
	        if(.not. istat) goto 90
	      endif
	    endif
c
c If not yet oke, try as a symbol
c
	    if(result.type .eq. symb_typ_none) then
	      call dix_symbol_find(control,work(1:nk),result)
	    else
	      is_symbol = .false.
	    endif
c
c If not yet oke, Try as a parameter
c
	    if(result.type .eq. symb_typ_none) then
	      is_symbol = .false.
	      if(dix_des_find_par(control,work(1:nk),result.ival)) then
	        result.type = symb_typ_int
	        call dix_Eval_sign_extend(result)
	      endif
	    endif
	  else
	    is_symbol = .false.
	  endif
c
c if result.typ still _none try fields
c
	  if(result.type .eq. symb_typ_none .and. .not. syntax) then
c
c fields can have max_dimension arguments, all of type integer
c check if this is valid
c
	    if(try_field) then
c
c Try to find the field (with or without the dimensions)
c
	      istat = dix_des_find_field(control,work(1:nk),des_rec,
     1                                   set_dep,ptr,.false.)
	      if(istat) then
c
c we have a valid prev field, nmow convert from des_rec to symbol
c
	        istat = dix_eval_cvt(control,des_rec,%val(ptr),result)
	      endif 
	    endif
c
c Still not found, so return invelem
c
	    if(result.type .eq. symb_typ_none) then
	      istat = %loc(dix_msg_invelem)
	      err_arg = line(spos:min(len(line),ipos))
	    endif
	  endif	
	else
	  istat = %loc(dix_msg_unexpchar)
	  err_arg = kar
	endif
90	do k=1,max_arguments
	  call dix_util_free_descr(args(k).strdes)
	end do
	dix_eval_element = istat
	return
	end
	function dix_eval_tryradix(line,value,size)
	implicit none
c
c Try if the text is a valid radix structure
c if so return result.ival set value.type to int
c  if some conversion error return the error status
c
	include 'dix_def.inc'
	character*(*) line      !:i: the text Rdddd
	record /value/ value	!:o: the value
	integer*4 size		!:i: integer size (4 or 8)
	logical dix_eval_tryradix!:f: true if conversion oke
c#
	integer*4 istat
	integer*4 ots$cvt_to_l
	integer*4 ots$cvt_tb_l
	integer*4 ots$cvt_ti_l
	integer*4 ots$cvt_tz_l
c
c Format Bddddd  where B can be X(hexadecimal), O(Octal) or  D(ecimal) or
c                               B(inary)
c
c
	if(line(1:1) .eq. 'X') then
c
c Hex number(if not valid do not set type to int)
c
	  istat = ots$cvt_tz_l(line(2:),value.ival,%val(size),%val(1))
	elseif(line(1:1) .eq. 'O') then
c
c Octal number all digits must be between 0 and 7
c
	  istat = ots$cvt_to_l(line(2:),value.ival,%val(size),%val(1))
	elseif(line(1:1) .eq. 'D') then
c
c Decimal number?
c
	  istat = ots$cvt_ti_l(line(2:),value.ival,%val(size),%val(1))
        elseif(line(1:1) .eq. 'B') then
	  istat = ots$cvt_tb_l(line(2:),value.ival,%val(size),%val(1))
	else
	  istat = 0		!Not valid
	endif
	if(istat) value.type = symb_typ_int
c
c Valid result, so now it is an integer
c
	dix_eval_tryradix = istat
	return
	end

	function dix_eval_cvt(control,des_rec,file,result)
	implicit none
	include 'dix_def.inc'
c
c Convert a des_rec value (a field in a record in  the file)
c  to a result value
c  Types supported
c   1. int,uint => int symbol
c   2. real     => real symbol
c   3. date     => date symbol
c   4. log      => log symbol
c
	record /control/ control	!:i: control structure
	record /des_rec/ des_rec	!:i: des record
	record /file_info/ file		!:i: file data
	record /value/ result		!:o: result
	integer*4 dix_eval_cvt
c#
	integer*4 p_data,offset
	character*(max_str_len) work
	integer*4 nkar,max_len,istat
	byte real_val(16)
	integer*4 date(2),idate
	logical*4 overflow
c
	external dix_msg_aroverfl
c
	istat = 1
	if(des_rec.ent_type .eq. enttyp_int) then
c
c For some valued ($RECORDSIZE) offset can be begative
c compensate this by decreasing the pointer and increasing the offset
c
	  p_data = %loc(file.data.data_rec)
	  offset = des_rec.bit_offset
	  do while (offset .lt. 0)
	    offset = offset + 8		!offset is in bits
	    p_data = p_data - 1
	  end do
          result.type = symb_typ_int
          result.ival = 0
	  call dix_util_copy_bits(
     1        min(bits_per_byte*control.integer_size,des_rec.size),
     1        offset,%val(p_data),result.ival,8)
c
        elseif(des_rec.ent_type .eq. enttyp_uint) then
c
c Uint , map to int
c
          result.type = symb_typ_int
          result.ival = 0
          call dix_util_copy_bits(
     1          min(bits_per_byte*control.integer_size,des_rec.size),
     1          des_rec.bit_offset,file.data.data_rec,result.ival,8)
c
        elseif(des_rec.ent_type .eq. enttyp_real_f .or. 
     1         des_rec.ent_type .eq. enttyp_real_g .or. 
     1         des_rec.ent_type .eq. enttyp_real_d .or. 
     1         des_rec.ent_type .eq. enttyp_real_h .or. 
     1         des_rec.ent_type .eq. enttyp_real_s .or. 
     1         des_rec.ent_type .eq. enttyp_real_t .or.
     1         des_rec.ent_type .eq. enttyp_real_x) then
c
c We can have a lot of reals, Symbols can have other formats, so do conversion
c
          call dix_util_copy_bits(des_rec.size,
     1          des_rec.bit_offset,file.data.data_rec,real_val,16)
c
c We put a result (1.0) in result.rval. In the routine dix_eval_cvt_float
c we can decide if the floating point format is float_f or float_s
c
	  call dix_eval_cvt_float(control,real_val,result.rval,
     1                            des_rec.ent_type,overflow,
     1                            control.real_size)
          result.type = symb_typ_real
	  if(overflow) istat = %loc(dix_msg_aroverfl)
        elseif(des_rec.ent_type .eq. enttyp_dat) then
c
c Date type, 
c  we have 2 formats
c  1. (size=64), the normal VMS date
c  2. (size=32) #minutes sinc VMS start date
c
          if(des_rec.size .eq. 64) then	!normal VMS date
c
c Normal vms data, just copy
c
            call dix_util_copy_bits(des_rec.size,
     1          des_rec.bit_offset,file.data.data_rec,date,8)
	  else
c
c #minutes, make 64 bits by multiplying by 60*1000*1000*10
c
            call dix_util_copy_bits(des_rec.size,
     1          des_rec.bit_offset,file.data.data_rec,idate,4)
            call lib$emul(idate,600000000,0,date)
	  endif
	  call dix_util_copy(8,date,result.date)
          result.type = symb_typ_date
        elseif(des_rec.ent_type .eq. enttyp_log) then
c
c Logical type, tke the low bit only
c
          call dix_util_copy_bits(des_rec.size,
     1          des_rec.bit_offset,file.data.data_rec,idate,1)
	  result.lval = idate
	  result.type = symb_typ_log
        else
c
c All others result in string
c
          result.type = symb_typ_char
          call dix_con_intasc(32768,des_rec,file.data.data_rec,
     1               work,nkar,des_flag_translate_nor,max_len,
     1               control)
	  call dix_eval_fill_char(result.strdes,work(1:nkar))
        endif
	dix_eval_cvt = istat
	return
	end
	subroutine dix_eval_copy_char_fix(string,result,nk)
	implicit none
c
c Copy a dynamic string to a fixed one
c
	include 'dix_def.inc'
	record /strdef/ string	!:i: the source
	character*(*) result	!:o: the fixed string
	integer*4 nk		!:o: the lengh
c#
	integer*4 istat
	integer*4 str$copy_dx
c
	nk = zext(string.dsc$w_maxstrlen)
	istat = str$copy_dx(result,string)
	if(.not. istat) call lib$signal(%val(istat))
	return
	end
	subroutine dix_eval_copy_char_dyn(string,result)
	implicit none
c
c Copy a fixed string to a dynamic one
c
	include 'dix_def.inc'
	character*(*) string 	!:i: the fixed string
	record /strdef/ result	!:i: the dest
c#
	integer*4 istat
	integer*4 str$copy_dx
c
	istat = str$copy_dx(result,string)
	if(.not. istat) call lib$signal(%val(istat))
	return
	end
	subroutine dix_eval_upcase(result,string,nk)
	implicit none
c
c Copy a dymamic string (in uppercase) to a fixed one
c
	include 'dix_def.inc'
	record /strdef/ result	!:i: source
	character*(*) string	!:o: destination
	integer*4 nk		!:o: Length
c#
	integer*4 istat
	integer*4 str$upcase
c
	nk = zext(result.dsc$w_maxstrlen)
	istat = str$upcase(string,result)
	if(.not. istat) call lib$signal(%val(istat))
	return
	end
	subroutine dix_eval_fill_char(result,string)
	implicit none
c
c Fill the fixed string with the dynamic source
c
	include 'dix_def.inc'
	record /strdef/ result		!:i: source
	character*(*) string		!:o: destination
c#
	integer*4 istat
	integer*4 str$copy_dx
c
	istat = str$copy_dx(result,string)
	if(.not. istat) call lib$signal(%val(istat))
	return
	end	
	subroutine dix_eval_free_value(value)
	implicit none
c
c Free a string value (return the possible string value)
c
	include 'dix_def.inc'
	record /value/ value	!:io: value
c#
	call dix_util_free_descr(value.strdes)
	return
	end
	subroutine dix_eval_init_value(value)
	implicit none
c
c Init a value for an empty dynamic string
c
	include 'dix_def.inc'
	record /value/ value 	!:io: the value
c#
	call dix_eval_init_char(value.strdes)
	return
	end
	subroutine dix_eval_copy_value(src,dst)
	implicit none
c
c Copy a value to another one
c  since string value are dynamic, it is not enough
c  to do a dst=scr for strings
c
	include 'dix_def.inc'
	record /value/ src		!:i: source
	record /value/ dst		!:o: destination
c#
	record /strdef/ save
c
	if(src.type .eq. symb_typ_char .or.
     1     src.type .eq. symb_typ_decimal) then
c
c  Make a str copy for type STRING/decimal
c
	  call str$copy_dx(dst.strdes,src.strdes)
	  dst.type = src.type
	  if(src.type .eq. symb_typ_decimal) then
	    dst.sign = src.sign
	    dst.exponent = src.exponent
	  endif
	else
c
c Copy the rest of the data, but keep the string part
c
	  save = dst.strdes
	  dst = src
	  dst.strdes = save
	end if
	return
	end
	subroutine dix_eval_init_char(result)
	implicit none
c
c Initialise the stirng part of a value
c
	include 'dix_def.inc'
	record /strdef/ result    !:o: string descriptor
c#
	call dix_util_clear_descr(result,.true.)
	return
	end
	function dix_eval_getkar(line,ipos,skip_blanks)
	implicit none
c
c Get the next char from line (0=EOL)
c
	include 'dix_def.inc'
c
	character*(*) line	!:i: the string
	integer*4 ipos		!:io: the position
	logical skip_blanks	!:i: skip blanks?
	character dix_eval_getkar !:f: the character found
c#
	character kar
c
10	if(ipos .gt. len(line)) then
c
c Return EOL
c
	  kar = NULL
	else
c
c Return the character
c
	  kar = line(ipos:ipos)
	  ipos = ipos + 1
	  if(skip_blanks) then
c
c Skip blanks and tabs)
c
            if(kar .eq. SPACE .or. kar .eq. TAB) goto 10
	  endif
	endif
c
c Return result
c
	dix_eval_getkar = kar
	return
	end
	function dix_eval_is_tf(true,line)
	implicit none
c
c See if line contains TRUE or FALSE
c
	include 'dix_def.inc'
c
	logical true		!:i: check for True of False
	character*(*) line	!:i: The expressoin 
	logical dix_eval_is_tf	!:f: return true if match oke
c#
	integer*4 str$case_blind_compare	
c
	if(true) then
	  dix_eval_is_tf = str$case_blind_compare(line,true_name).eq. 0
	else
	  dix_eval_is_tf = str$case_blind_compare(line,false_name).eq. 0
	endif
	return
	end
	function dix_eval_add(control,total,result1)
	implicit none
c
c Result1 must be addded to total
c check for the types
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	record /value/ total		!:io: total value
	record /value/ result1		!:i: addend
	integer*4 dix_eval_add		!:f: function result
c#
	integer*4 istat	
c
	external dix_msg_invmixic
	external dix_msg_invtype
	external dix_msg_aroverfl
	external dix_msg_invmixdate
	external dix_msg_invmixdatd
	external dix_msg_invmixdeci
	external dix_eval_overflow
	logical overflow
	volatile overflow
	common /dix_eval_overflow_common/ overflow
c
	record /strdef/ addfunc
	integer*4 exponent,sign
c
	integer*4 dix_eval_cvt_to_decimal
	real*16 dix_eval_int_real
	integer*4 str$add
	real*16 xval

c
	integer*4 dix_eval_i8_oper
c
	overflow = .false.
	call lib$establish(dix_eval_overflow)
c
	istat = 1
c
	if(result1.type .eq. symb_typ_decimal .and. 
     1     total.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,total.type)
	  if(.not. istat) goto 90
	endif	  
	if(total.type .eq. symb_typ_decimal .and. 
     1     result1.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,result1.type)
	  if(.not. istat) goto 90
	endif	  
c
	if(total.type .eq. symb_typ_int) then
c
c Total is int
c
	  if(result1.type .eq. symb_typ_int) then
	    if(control.integer_size .eq. 8) then
	      overflow = .not. dix_Eval_i8_oper(total.i8val,
     1              result1.i8val,total.i8val,'+')
	    else
	      total.ival = total.ival + result1.ival
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
c
c Addend is real, convert total to real and add
c
	    xval = dix_eval_int_real(total.ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      total.rval8 = xval + result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = xval + result1.rval16
	    else
	      total.rval = xval + result1.rval
	    endif
	    total.type = symb_typ_real
	  else
	    istat = %loc(dix_msg_invmixic)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_real) then
c
c TOTAL is REAL
c
	  if(result1.type .eq. symb_typ_int) then
	    xval = dix_eval_int_real(result1.ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      total.rval8 = total.rval8 + xval
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 + xval
	    else
	      total.rval = total.rval + xval
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
	    if(control.real_size .eq. 8) then
	      total.rval8 = total.rval8 + result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 + result1.rval16
	    else
	      total.rval = total.rval + result1.rval
	    endif
	  else
	    istat = %loc(dix_msg_invmixic)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_char) then
c
c TOTAL is CHAR
c
	  if(result1.type .eq. symb_typ_char) then
	    call str$append(total.strdes,result1.strdes)
	  else
	    istat = %loc(dix_msg_invmixic)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_date) then
c
c TOTAL is DATE
c
	  if(result1.type .eq. symb_typ_date) then
	    istat = %loc(dix_msg_invmixdatd)	!assume problem
	    if(total.date(2) .ge. 0) then	!total=absolute
	      if(result1.date(2) .ge. 0) goto 90!two abs times
	      call lib$subx(total.date,result1.date,total.date)
	    else				!total = delta
	      if(result1.date(2) .ge. 0) then
	        call lib$subx(result1.date,total.date,total.date)
	      else                              !both delta
	        call lib$addx(total.date,result1.date,total.date)
	      endif
	    endif	      
	    istat = 1
	  else
	    istat = %loc(dix_msg_invmixdate)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_decimal) then
	  if(result1.type .eq. symb_typ_decimal) then
	    call dix_eval_init_char(addfunc)
	    istat = str$add(
     1             total.sign,  total.exponent,  total.strdes,
     1             result1.sign,result1.exponent,result1.strdes,
     1             sign,exponent,addfunc)
	    call dix_eval_copy_char_dyn(addfunc,total.strdes)
	    total.exponent = exponent
	    total.sign     = sign
	    call dix_util_free_descr(addfunc)
	  else
	    istat = %loc(dix_msg_invmixdeci)	!assume problem
	  endif
	else
	  istat = %loc(dix_msg_invtype)
	endif
	if(overflow) istat = %loc(dix_msg_aroverfl)
90	dix_eval_add = istat
	return
	end
	function dix_eval_sub(control,total,result1)
	implicit none
c
c Result1 must be subtracted from total
c check for the types
c
	include 'dix_def.inc'
	record /control/ control!:i: control block
	record /value/ total	!:io: total value
	record /value/ result1	!:i: subtrahend
	integer*4 dix_eval_sub	!:f: function result
c#
	record /strdef/ zero_string
c
	integer*4 istat,ipos,nk
c
	external dix_msg_invmixic
	external dix_msg_invtype
	external dix_msg_aroverfl
	external dix_eval_overflow
	external dix_msg_invmixdate
	external dix_msg_invmixdatd
	external dix_msg_invmixdeci
	integer*4 str$add
	logical overflow
	volatile overflow
	common /dix_eval_overflow_common/ overflow
	integer*4 dix_eval_i8_oper
	integer*4 dix_eval_cvt_to_decimal
	record /strdef/ addfunc
	integer*4 exponent,sign,signs
c
	real*16 dix_eval_int_real
	real*16 xval
c
	integer*4 str$position
c
	overflow = .false.
	call lib$establish(dix_eval_overflow)
	istat = 1
c
	if(result1.type .eq. symb_typ_decimal .and. 
     1     total.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,total.type)
	  if(.not. istat) goto 90
	endif	  
	if(total.type .eq. symb_typ_decimal .and. 
     1     result1.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,result1.type)
	  if(.not. istat) goto 90
	endif	  
c
	if(total.type .eq. symb_typ_int) then
c
c TOTAL is int
c
	  if(result1.type .eq. symb_typ_int) then
	    if(control.integer_size .eq. 8) then
	      overflow = .not. dix_Eval_i8_oper(total.i8val,
     1              result1.i8val,total.i8val,'-')
	    else
	      total.ival = total.ival - result1.ival
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
c
c addend is real convert total to real
c
	    xval = dix_eval_int_real(total.ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      total.rval8 = xval - result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = xval - result1.rval16
	    else
	      total.rval = xval - result1.rval
	    endif
	    total.type = symb_typ_real
	  else
	    istat = %loc(dix_msg_invmixic)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_real) then
c
c Total is REAL
c
	  if(result1.type .eq. symb_typ_int) then
	    xval = dix_eval_int_real(result1.ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      total.rval8 = total.rval8 - xval
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 - xval
	    else
	      total.rval = total.rval - xval 
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
	    if(control.real_size .eq. 8) then
	      total.rval8 = total.rval8 - result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 - result1.rval16
	    else
	      total.rval = total.rval - result1.rval
	    endif
	  else
	    istat = %loc(dix_msg_invmixic)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_char) then
c
c TOTAL is CHAR
c
	  if(result1.type .eq. symb_typ_char) then
	    call dix_eval_init_char(zero_string)		!make a zero length string
	    ipos = str$position(total.strdes,result1.strdes)
	    if(ipos .ne. 0) then
c
c Replace the substring by an empty string
c
	      nk = zext(result1.strdes.dsc$w_maxstrlen)
	      call str$replace(total.strdes,total.strdes,ipos,ipos+nk-1,
     1                 zero_string)
	    end if
	  else
	    istat = %loc(dix_msg_invmixic)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_date) then
	  if(result1.type .eq. symb_typ_date) then
c
c TOTAL is DATE
c
	    istat = %loc(dix_msg_invmixdatd)		!assume problems
	    if(total.date(2) .lt. 0) then		!Total is delta
	      if(result1.date(2) .lt. 0) then           !subt = delta
	        call lib$subx(total.date,result1.date,total.date)	!total=delta
	        if(total.date(2) .ge. 0) goto 90
	      else                                      !subt=absolute
	        call lib$addx(result1.date,total.date,total.date)	!total=delta
	      endif
	    else					!total is absolute
	      if(result1.date(2) .lt. 0) then           !subt=delta
	        call lib$addx(total.date,result1.date,total.date)       !result=delta
	      else                                      !subt=abso
	        call lib$subx(total.date,result1.date,total.date)	!both abs
	        if(total.date(2) .ge. 0) goto 90
	      endif
	    endif
	    istat = 1
	  else
	    istat = %loc(dix_msg_invmixdate)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_decimal) then
	  if(result1.type .eq. symb_typ_decimal) then
c
c Subtracting = aadding with minus sign
c
	    signs = 1-result1.sign
	    call dix_eval_init_char(addfunc)
	    istat = str$add(
     1             total.sign,  total.exponent,  total.strdes,
     1             signs     ,result1.exponent,result1.strdes,
     1             sign,exponent,addfunc)
	    call dix_eval_copy_char_dyn(addfunc,total.strdes)
	    total.exponent = exponent
	    total.sign     = sign
	    call dix_util_free_descr(addfunc)
	  else
	    istat = %loc(dix_msg_invmixdeci)	!assume problem
	  endif
	else
c
c Other types are illegal
c
	  istat = %loc(dix_msg_invtype)
	endif
	if(overflow) istat = %loc(dix_msg_aroverfl)
90	dix_eval_sub = istat
	return
	end
	function dix_eval_mul(control,total,result1)
	implicit none
c
c Total must be multiplied by Result1
c check for the types
c
	include 'dix_def.inc'
	record /control/ control
	record /value/ total		!:io: total
	record /value/ result1		!:i: multiplicant
	integer*4 dix_eval_mul		!:f: function result
c#
	integer*4 istat	,nkar,k
c
	external dix_msg_invmixrc
	external dix_msg_invoperc
	external dix_msg_invmixdeci
	external dix_msg_invtype
	external dix_msg_aroverfl
	external dix_eval_overflow
	integer*4 dix_eval_i8_oper
	integer*4 dix_eval_cvt_to_decimal
	integer*4 str$mul
	logical overflow
	volatile overflow
	common /dix_eval_overflow_common/ overflow
	record /strdef/ mulfunc
	integer*4 exponent,sign
c
	real*16 dix_eval_int_real
	real*16 xval
c
	character kar
c
	overflow = .false.
	call lib$establish(dix_eval_overflow)
	istat = 1
c
c
	if(result1.type .eq. symb_typ_decimal .and. 
     1     total.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,total.type)
	  if(.not. istat) goto 90
	endif	  
	if(total.type .eq. symb_typ_decimal .and. 
     1     result1.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,result1.type)
	  if(.not. istat) goto 90
	endif	  
c
	if(total.type .eq. symb_typ_int) then
c
c TOTAL is INT
c
	  if(result1.type .eq. symb_typ_int) then
	    if(control.integer_size .eq. 8) then
	      overflow = .not. dix_Eval_i8_oper(total.i8val,
     1              result1.i8val,total.i8val,'*')
	    else
	      total.ival = total.ival * result1.ival
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
c
c multiplicant is real, convert TOTAL to REAL
c
	    xval = dix_eval_int_real(total.ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      total.rval8 = xval * result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = xval * result1.rval16
	    else
	      total.rval = xval * result1.rval
	    endif
	    total.type = symb_typ_real
	  elseif(result1.type .eq. symb_typ_char) then
c
c multiplicant is char, insert total*"the first char"
c  convert TOTAL to CHAR
c
	    nkar = 0
	    call str$left(kar,result1.strdes,1)
	    k = total.ival
	    call str$dupl_char(total.strdes,k,ichar(kar))
	    total.type = symb_typ_char
	  else
	    istat = %loc(dix_msg_invtype)
	  endif
	elseif(total.type .eq. symb_typ_real) then
c
c TOTAL is real
c
	  if(result1.type .eq. symb_typ_int) then
	    xval = dix_eval_int_real(result1.ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      total.rval8 = total.rval8 * xval 
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 * xval
	    else
	      total.rval = total.rval * xval
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
	    if(control.real_size .eq. 8) then
	      total.rval8  = total.rval8 * result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 * result1.rval16
	    else
	      total.rval = total.rval * result1.rval
	    endif
	  elseif(result1.type .eq. symb_typ_char) then
	    istat = %loc(dix_msg_invmixrc)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_char) then
c
c TOTAL is CHAR
c
	  if(result1.type .eq. symb_typ_int) then
c
c "A"*10 delivers AAAAAAAAA
c
	    call str$left(kar,total.strdes,1)
	    call str$free1_dx(total.strdes)
	    call str$dupl_char(total.strdes,result1.ival,ichar(kar))
	    total.type = symb_typ_char
	  else
	    istat = %loc(dix_msg_invoperc)
	  endif
	  goto 90
	elseif(total.type .eq. symb_typ_decimal) then
	  if(result1.type .eq. symb_typ_decimal) then
	    call dix_eval_init_char(mulfunc)
	    istat = str$mul(
     1             total.sign,  total.exponent,  total.strdes,
     1             result1.sign,result1.exponent,result1.strdes,
     1             sign,exponent,mulfunc)
	    call dix_eval_copy_char_dyn(mulfunc,total.strdes)
	    total.exponent = exponent
	    total.sign     = sign
	    call dix_util_free_descr(mulfunc)
	  else
	    istat = %loc(dix_msg_invmixdeci)	!assume problem
	  endif
	else
	  istat = %loc(dix_msg_invtype)
	endif	
	if(overflow) istat = %loc(dix_msg_aroverfl)
90	dix_eval_mul = istat
	return
	end
	function dix_eval_div(control,total,result1)
	implicit none
c
c Totalm must be divided by Result1
c check for the types
c
	include 'dix_def.inc'
	record /control/ control
	record /value/ total		!:io: total
	record /value/ result1		!:i: divisor
	integer*4 dix_eval_div		!:f: function result
c#
	integer*4 istat,ipos,nk,ndig1,ndig2,ndig
c
	external dix_msg_invmixic
	external dix_msg_invmixdeci
	external dix_msg_invmixrc
	external dix_msg_invtype
	external dix_msg_invoperc
	external dix_msg_aroverfl
	external dix_eval_overflow
	integer*4 str$divide
c
	integer*4 dix_eval_cvt_to_decimal,sign,exponent,trunc
	logical overflow
	volatile overflow
	common /dix_eval_overflow_common/ overflow
c
	record /strdef/ zero_string,divfunc
c
	integer*4 str$position
	integer*4 dix_Eval_i8_oper
c
	real*16 dix_eval_int_real
	real*16 xval
c
	overflow = .false.
	call lib$establish(dix_eval_overflow)
	istat = 1
c
c
	if(result1.type .eq. symb_typ_decimal .and. 
     1     total.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,total.type)
	  if(.not. istat) goto 90
	endif	  
	if(total.type .eq. symb_typ_decimal .and. 
     1     result1.type   .ne. symb_typ_decimal) then
	  istat = dix_eval_cvt_to_decimal(control,result1.type)
	  if(.not. istat) goto 90
	endif	  
c
	if(total.type .eq. symb_typ_int) then
c
c TOTAL is INT
c
	  if(result1.type .eq. symb_typ_int) then
c
c Both parts integer, this result in integer division
c
	    if(control.integer_size .eq. 8) then
	      overflow = .not. dix_Eval_i8_oper(total.i8val,
     1              result1.i8val,total.i8val,'+')
	    else
	      total.ival = total.ival / result1.ival
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
c 
c Divisor is real, conver to type REAL
c
	    xval = dix_eval_int_real(total.ival,control.integer_size)
c
	    if(control.real_size .eq. 8) then
	      total.rval8 = xval / result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = xval / result1.rval16
	    else
	      total.rval = xval / result1.rval
	    endif
	    total.type = symb_typ_real
	  else
	    istat = %loc(dix_msg_invmixic)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_real) then
c
c TOTAL is REAL
c
	  if(result1.type .eq. symb_typ_int) then
	    xval = dix_eval_int_real(result1.ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      total.rval8 = total.rval8 / xval
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 / xval
	    else
	      total.rval = total.rval / xval
	    endif
	  elseif(result1.type .eq. symb_typ_real) then
	    if(control.real_size .eq. 8) then
	      total.rval8 = total.rval8 / result1.rval8
	    elseif(control.real_size .eq. 16) then
	      total.rval16 = total.rval16 / result1.rval16
	    else
	      total.rval = total.rval / result1.rval
	    endif
	  else
	    istat = %loc(dix_msg_invmixrc)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_char) then
c
c TOTAL is CHAR
c  it result1 is also char , all occurences of result1 are removed from TOTAL
c
	  if(result1.type .eq. symb_typ_char) then
	    if(zext(result1.strdes.dsc$w_maxstrlen) .gt. 0) then
	      call dix_eval_init_char(zero_string)	!make zero length string
c
45	      ipos = str$position(total.strdes,result1.strdes)
	      if(ipos .ne. 0) then
	        nk = zext(result1.strdes.dsc$w_maxstrlen)
	        call str$replace(total.strdes,total.strdes,ipos,ipos+nk-1,
     1                 zero_string)
	        goto 45
	      end if
	    endif
	  else
	    istat = %loc(dix_msg_invoperc)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_decimal) then
	  if(result1.type .eq. symb_typ_decimal) then
	    ndig1 = zext(total.strdes.dsc$w_maxstrlen)+total.exponent
	    ndig2 = zext(result1.strdes.dsc$w_maxstrlen)+result1.exponent
c
c We want at last 10 significant digits
c	    
	    ndig = max(0,control.decimal_ndig)
	    call dix_eval_init_char(divfunc)
	    trunc = 0
	    if(control.decimal_round) trunc = 1
	    istat = str$divide(
     1             total.sign,  total.exponent,  total.strdes,
     1             result1.sign,result1.exponent,result1.strdes,
     1             ndig,trunc,sign,  exponent,  divfunc)
	    call dix_eval_copy_char_dyn(divfunc,total.strdes)
	    total.exponent = exponent
	    total.sign     = sign
	    call dix_util_free_descr(divfunc)
	  else
	    istat = %loc(dix_msg_invmixdeci)	!assume problem
	  endif
	else
	  istat = %loc(dix_msg_invtype)
	endif
	if(overflow) istat = %loc(dix_msg_aroverfl)
90	dix_eval_div = istat
	return
	end
	function dix_eval_and(total,result1)
	implicit none
c
c Result1 must be anded tot total
c check for the types
c
	include 'dix_def.inc'
	record /value/ total		!:io: total
	record /value/ result1		!:i: and value
	integer*4 dix_eval_and		!:f: funciotn result
c#
	integer*4 istat
c
	external dix_msg_invmixand
	external dix_msg_invtype
c
	istat = 1
	if(total.type .eq. symb_typ_log) then
c
c TOTAL is LOG, result1 may be LOG or INT
c
	  if(result1.type .eq. symb_typ_log) then
	    total.lval = total.lval .and. result1.lval
	  elseif(result1.type .eq. symb_typ_int) then
	    total.lval = total.lval .and. result1.ival
	  else
	    istat = %loc(dix_msg_invmixand)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_int) then
c
c TOTAL is INT, result1 may be LOG or INT
c 
	  if(result1.type .eq. symb_typ_log) then
	    total.lval = total.ival .and. result1.lval
	    total.type = symb_typ_log
	  elseif(result1.type .eq. symb_typ_int) then
	    total.lval = total.ival .and. result1.ival
	    total.type = symb_typ_log
	  else
	    istat = %loc(dix_msg_invmixand)
	    goto 90
	  endif
	else
	  istat = %loc(dix_msg_invtype)
	  goto 90
	endif	      
90	dix_eval_and = istat
	return
	end
	function dix_eval_or(total,result1)
	implicit none
c
c Result1 must be ored tot total
c check for the types
c
	include 'dix_def.inc'
	record /value/ total		!:io: total
	record /value/ result1		!:i: or value
	integer*4 dix_eval_or		!:f: function result
c#
	integer*4 istat
	external dix_msg_invmixor
	external dix_msg_invtype
c
	istat = 1
	if(total.type .eq. symb_typ_log) then
c
c TOTAL is LOG, result1 van be INT or LOG
c
	  if(result1.type .eq. symb_typ_log) then
	    total.lval = total.lval .or. result1.lval
	  elseif(result1.type .eq. symb_typ_int) then
	    total.lval = total.lval .or. result1.ival
	  else
	    istat = %loc(dix_msg_invmixor)
	    goto 90
	  endif
	elseif(total.type .eq. symb_typ_int) then
c
c TOTAL is INT, result1 van be INT or LOG
c
	  if(result1.type .eq. symb_typ_log) then
	    total.lval = total.ival .or. result1.lval
	    total.type = symb_typ_log
	  elseif(result1.type .eq. symb_typ_int) then
	    total.lval = total.ival .or. result1.ival
	    total.type = symb_typ_log
	  else
	    istat = %loc(dix_msg_invmixor)
	    goto 90
	  endif
	else
	  istat = %loc(dix_msg_invtype)
	  goto 90
	endif	      
90	dix_eval_or = istat
	return
	end

        function dix_eval_overflow(sigargs) !,mechargs)
        implicit none
c
c OVerflow detectoin routine
c
        integer*4 sigargs(*)		!:i: sinnal arguments
c       integer*4 mechargs(*)
        integer*4 dix_eval_overflow	!:f: result
c#
        include '($ssdef)'
        include '($mthdef)'
c
	integer*4 overflow
	common /dix_eval_overflow_common/ overflow
c
        integer*4 signal
c
        signal = sigargs(2)
c
        if(signal .eq. ss$_intovf .or.
     1     signal .eq. ss$_intdiv .or.
     1     signal .eq. ss$_fltovf .or.
     1     signal .eq. ss$_fltdiv .or.
     1     signal .eq. ss$_hparith .or.
     1     signal .eq. mth$_floovemat) then
c
c These are traps. Just set the overflow flag and continue
c
          overflow = .true.
          dix_eval_overflow = ss$_continue
        elseif(
     1     signal .eq. ss$_fltovf_f .or.
     1     signal .eq. ss$_fltdiv_f) then
c
c These are faults. Normally the execution would be restarted
c and result in the same overflow. To prevent this we unwind the 
c stack call frame
c
          overflow = .true.
          dix_eval_overflow = ss$_continue
          call sys$unwind(,)
        else
c
c I don't know, exit normally (resignal)
c
          dix_eval_overflow = ss$_resignal
        end if
        return
        end
	function dix_eval_func(control,funcnam,narg,args,result,
     1               err_arg,set_dep)
	implicit none
c
c evaluate functions
c  the name is in funcnam, the args in ars(*) 
c this function returns
c  1       : it was a function and is correctly handled
c  invfunc : is was not a recognized function name
c   else   : error when evaluating function
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	character*(*)funcnam		!:i: function name
	integer*4 narg			!:i: #arguments
	record /value/ args(*)		!:i: arguments
	record /value/ result		!:o: result value
	character*(*) err_arg		!:o: error argument
	logical set_dep			!:i: set dependancy for refs
	logical*4 dix_eval_func		!:f: function result
c#
	record /des_rec_fil/ des_rec_fil
	pointer (p_des_rec_fil,des_rec_fil)
c
	record /des_expanded/ des_expanded
	pointer (p_des_expanded,des_expanded)
c
	record /des_info/ des_info
	pointer (p_des_info,des_info)
c
	record /file_info/ file_info
	pointer (p_file_info,file_info)
c
	include '($libdtdef)'
	include '($jpidef)'
c
	integer*4 max_faol_size
	parameter (max_faol_size=100)
c
	integer*4 k,bpos,epos,istat,argval,this_time(2),wl,nk,iel,nk1
	integer*4 nk_mask,ndim,idx,nk_tab,flag,descr(2),pos,siz,pnt,ptr
	integer*4 ptr_file,iha,keynr,ndig,wildcard_flag,sign,exponent
	integer*2 numtim(7)
	character*(max_line_length) action,mask,table,mode,option,what
	character*(max_line_length) argvals
	character*(max_str_len) work,work1
	character*(max_short_line_length) short_string
	character kar
	integer*4 nk_work,nk_work1,arglist(max_faol_size),test_date(2)
	record /des_rec/ des_rec
	record /value/ symbval
	logical case_sens,is_min,hex
	real*4 real4_work
	real*16 xval
	logical*4 overflow
	common /dix_eval_overflow_common/ overflow
	external dix_eval_overflow
c
	integer*4 dix_util_get_len_fu
	integer*4 str$element
	integer*4 dix_util_checksum
	integer dix_eval_check_arg
	integer dix_symbol_find
	integer dix_des_find_field
	integer*4 dix_util_get_len
	integer*4 dix_eval_trnlnm
	integer*4 dix_eval_getdvi
	integer*4 dix_eval_strfun
	integer*4 lib$convert_date_string
	integer*4 dix_eval_set_file
	integer*4 dix_eval_set_des
	integer*4 vms_vers
	integer*4 sys$faol
	real*16 dix_eval_int_real
	integer*4 dix_con_type_ascint
c
	integer*4 lib$extzv
	integer*4 lib$extv
	integer*4 str$pos_extr
	integer*4 str$trim
	integer*4 str$left
	integer*4 str$upcase	
c
	external dix_msg_aroverfl
	external dix_msg_wrargcnt
	external dix_msg_wrargtyp
	external dix_msg_wrargval
	external dix_msg_invfunc
	external dix_msg_nofilopen
	external dix_msg_fldnotf
	external dix_msg_symbnotf
	external dix_msg_filnotf
	external dix_msg_desnotf
	external dix_msg_invmixdatd
	external dix_msg_notindex
	external dix_msg_illkeyna
	external dix_msg_segmerr
	external dix_msg_invdeci
c
	logical dix_util_match
	integer*4 dix_rms_get_keyinfo
	integer*4 dix_util_find_string_wild
	logical dix_util_match_string_wild
	integer*4 dix_eval_check_num
	integer*4 dix_con_value_intasc
	integer*4 dix_inter_set_ver
c
	record /key_info/ key_info
	pointer (p_key_info,key_info)
c
	record /rfa/ rfa
c
	overflow = .false.
	call lib$establish(dix_eval_overflow)
c
	argvals = ' '
c
	call dix_eval_init_char(symbval.strdes)
	istat = 1
	if(dix_util_match(funcnam,'AND')) then
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  result.type = symb_typ_int
	  if(control.integer_size .eq. 8) then
	    call dix_eval_i8_oper(
     1               args(1).i8val,args(2).i8val,result.i8val,'&')
	  else
	    result.ival = args(1).ival .and. args(2).ival
	  endif
	elseif(dix_util_match(funcnam,'OR')) then
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  result.type = symb_typ_int
	  if(control.integer_size .eq. 8) then
	    call dix_eval_i8_oper(
     1               args(1).i8val,args(2).i8val,result.i8val,'|')
	  else
	    result.ival = args(1).ival .or. args(2).ival
	  endif
	elseif(dix_util_match(funcnam,'NOT')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .eq. symb_typ_log) then
	    result.type = symb_typ_log
	    result.lval = .not. args(1).lval
	  elseif(args(1).type .eq. symb_typ_int) then
	    result.i8val(1) = .not. args(1).i8val(1)
	    result.i8val(2) = .not. args(1).i8val(2)
	  else
	    goto 31
	  endif
	elseif(dix_util_match(funcnam,'EVEN')) then
c
c i*8 and i*4 overlap
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  result.type = symb_typ_log
	  result.lval = .not. btest(args(1).ival,0)
	elseif(dix_util_match(funcnam,'ODD')) then
c
c i*8 and i*4 overlap
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  result.type = symb_typ_log
	  result.lval = btest(args(1).ival,0)
	elseif(dix_util_match(funcnam,'LSHI|FT')) then
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  result.type = symb_typ_int
	  if(control.integer_size .eq. 8) then
	    call dix_eval_i8_oper(
     1               args(1).i8val,args(2).i8val,result.i8val,'L')
	  else
	    result.ival = ishft(args(1).ival,args(2).ival)
	  endif
	elseif(dix_util_match(funcnam,'RSHI|FT')) then
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  result.type = symb_typ_int
	  if(control.integer_size .eq. 8) then
	    call dix_eval_i8_oper(
     1               args(1).i8val,args(2).i8val,result.i8val,'R')
	  else
	    result.ival = ishft(args(1).ival,-args(2).ival)
	  endif
	elseif(dix_util_match(funcnam,'MOD')) then
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  result.type = symb_typ_int
	  if(control.integer_size .eq. 8) then
	    call dix_eval_i8_oper(
     1               args(1).i8val,args(2).i8val,result.i8val,'M')
	  else
	    result.ival = mod(args(1).ival,args(2).ival)
	  endif
	elseif(dix_util_match(funcnam,'MAX') .or.
     1         dix_util_match(funcnam,'MIN')) then
	  is_min = funcnam(2:2) .eq. 'I'
	  result = args(1)
	  do k=1,narg
	    iha = k
	    if(result.type .eq. symb_typ_real) then
c
c Result is real
c
	      if(args(k).type .eq. symb_typ_int) then
	        xval = dix_eval_int_real(args(k).ival,control.integer_size)
	        if(is_min) then
	          if(control.real_size .eq. 8) then
	            if(xval .lt. result.rval8) result.rval8  = xval
	          elseif(control.real_size .eq. 16) then
	            if(xval .lt. result.rval16) result.rval16  = xval
	          else
	            if(xval .lt. result.rval) result.rval  = xval  !changes type to real
	          endif
	        else
	          if(control.real_size .eq. 8) then
	            if(xval .gt. result.rval8) result.rval8 = xval 
	          elseif(control.real_size .eq. 16) then
	            if(xval .gt. result.rval16) result.rval16 = xval
	          else
	            if(xval .gt. result.rval) result.rval = xval
	          endif
	        endif
	      elseif(args(k).type .eq. symb_typ_real) then
	        if(is_min) then
	          if(control.real_size .eq. 8) then
	            result.rval8 = min(result.rval8,args(k).rval8)
	          elseif(control.real_size .eq. 16) then
	            result.rval16 = min(result.rval16,args(k).rval16)
	          else
	            result.rval = min(result.rval,args(k).rval)
	          endif
	        else
	          if(control.real_size .eq. 8) then
	            result.rval8 = max(result.rval8,args(k).rval8)
	          elseif(control.real_size .eq. 16) then
	            result.rval16 = max(result.rval16,args(k).rval16)
	          else
	            result.rval = max(result.rval,args(k).rval)
	          endif
	        endif
	      else
	        goto 38
	      endif
	    elseif(result.type .eq. symb_typ_int) then
c
c Result is int
c
	      if(args(k).type .eq. symb_typ_int) then
	        if(is_min) then
	          if(control.integer_size .eq. 8) then
	             call dix_eval_i8_oper(
     1                  result.i8val,args(k).i8val,result.i8val,'v')
	          else
	            result.ival = min(result.ival,args(k).ival)
	          endif
	        else
	          if(control.integer_size .eq. 8) then
	             call dix_eval_i8_oper(
     1                  result.i8val,args(k).i8val,result.i8val,'^')
	          else
	            result.ival = max(result.ival,args(k).ival)
	          endif
	        endif
	      elseif(args(k).type .eq. symb_typ_real) then
	        xval = dix_eval_int_real(result.ival,control.integer_size)
	        if(is_min) then
	          if(control.real_size .eq. 8) then
	            if(args(k).rval8 .lt. xval) result = args(k)
	          elseif(control.real_size .eq. 16) then
	            if(args(k).rval16 .lt. xval) result = args(k) 
	          else
	            if(args(k).rval .lt. xval) result = args(k)
	          endif
	        else
	          if(control.real_size .eq. 8) then
	            if(args(k).rval8 .gt. xval) result = args(k) 
	          elseif(control.real_size .eq. 16) then
	            if(args(k).rval16 .gt. xval) result = args(k)
	          else
	            if(args(k).rval .gt. xval) result = args(k) 
	          endif
	        endif
	      else
                goto 38
	      endif
	    elseif(result.type .eq. symb_typ_date) then
c
c  Result is date, now all elements must be of the same date type (abs or delta)
c 
	      if(args(k).type .ne. symb_typ_date) goto 38
	      istat = %loc(dix_msg_invmixdatd)		!aassume problems
	      if(result.date(2) .ge. 0) then
	        if(args(k).date(2) .lt. 0) goto 90
	      else
	        if(args(k).date(2) .ge. 0) goto 90
	      endif
	      istat = 1
	      call lib$subx(result.date,args(k).date,test_date)	
	      if(is_min) then
	        if(test_date(2) .ge. 0) result = args(k)
	      else
	        if(test_date(2) .lt. 0) result = args(k)
	      endif
	    endif
	  end do
	elseif(dix_util_match(funcnam,'REAL')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .eq. symb_typ_int) then
	    xval = dix_eval_int_real(args(1).ival,control.integer_size)
	    if(control.real_size .eq. 8) then
	      result.rval8 = xval
	    elseif(control.real_size .eq. 16) then
	      result.rval16 = xval
	    else
	      result.rval = xval
	    endif
	    result.type = symb_typ_real
	  elseif(args(1).type .eq. symb_typ_real) then
	    result = args(1)
	  else
	    goto 31
	  endif	  
	elseif(dix_util_match(funcnam,'STRING')) then
c
c COnvert to string
c string(value[,hex])
c
	  if(narg .gt. 2) goto 20
	  hex = des_flag_translate_nor
	  if(narg .eq. 2) then
	    if(args(2).type .eq. symb_typ_log) then
	      if(args(2).lval) hex = des_flag_translate_hex
	    elseif(args(2).type .eq. symb_typ_none) then
	    else
	      goto 32
	    endif
	  endif
	  if(args(1).type .eq. symb_typ_none) goto 31
c
	  call dix_con_value_intasc(control,args(1),work,nk_work,hex)
c
	  call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'LOGI|CAL')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .eq. symb_typ_int) then
	    result.lval = args(1).lval
	    result.type = symb_typ_log
	  elseif(args(1).type .eq. symb_typ_log) then
	    result = args(1)
	  else 
	    goto 31
	  endif
	elseif(dix_util_match(funcnam,'INT')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .eq. symb_typ_char) then
	    istat = dix_con_type_ascint(args(1).strdes,
     1                 control.integer_size*bits_per_byte,
     1                 result.ival,enttyp_int,control,k)
	    if(.not. istat) goto 41
	    result.type = symb_typ_int
	  elseif(args(1).type .eq. symb_typ_real) then
c
	    if(control.integer_size .eq. 8) then
	      call dix_eval_real_int(result.i8val,args(1),
     1            control.real_size,funcnam)
	    else
	      if(control.real_size .eq. 8) then
 	        result.ival = int(args(1).rval8)
	      elseif(control.real_size .eq. 16) then
	        result.ival = int(args(1).rval16)
	      else
	        result.ival = int(args(1).rval)
	      endif
	    endif
	    if(overflow) then
	      err_arg = 'INT(REAL)'
	      istat = %loc(dix_msg_aroverfl)
	      goto 50
	    endif
	    result.type = symb_typ_int
	  elseif(args(1).type .eq. symb_typ_int) then
	    result = args(1)
	  else
	    goto 31
	  endif	  
	elseif(dix_util_match(funcnam,'NINT')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .eq. symb_typ_char) then
	    istat = dix_con_type_ascint(args(1).strdes,
     1                 control.integer_size*bits_per_byte,
     1                 result.ival,enttyp_int,control,k)
	    if(.not. istat) goto 41
	    result.type = symb_typ_int
	  elseif(args(1).type .eq. symb_typ_int) then
	    result = args(1)
	  elseif(args(1).type .eq. symb_typ_real) then
c
	    if(control.integer_size .eq. 8) then
	      call dix_eval_real_int(result.i8val,args(1),
     1            control.real_size,funcnam)
	    else
	      if(control.real_size .eq. 8) then
	        result.ival = nint(args(1).rval8)
	      elseif(control.real_size .eq. 16) then
	        result.ival = nint(args(1).rval16)
	      else
	        result.ival = nint(args(1).rval)
	      endif
	    endif
	    if(overflow) then
	      err_arg = 'NINT(REAL)'
	      istat = %loc(dix_msg_aroverfl)
	      goto 50
	    endif
	    result.type = symb_typ_int
	  else
	    goto 31
	  endif	  
	elseif(dix_util_match(funcnam,'HEX')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .eq. symb_typ_char) then
	    call dix_eval_copy_char_fix(args(1).strdes,work1,nk_work1)
	    nk_work = 0
	    do k=1,nk_work1
	      write(work(nk_work+1:nk_work+3),4000) ichar(work1(k:k))
4000	      format(z2.2,1x)
	      nk_work = nk_work + 3
	    end do
	    if(nk_work .gt. 0) nk_work = nk_work - 1 
	  elseif(args(1).type .eq. symb_typ_int) then
	    write(work(1:8),4001) args(1).ival
	    nk_work = 8
	    if(control.integer_size .eq. 8) then
	      write(work(9:16),4001) args(1).i8val(2)
	      nk_work = 16
	    endif
4001	    format(z8.8)
	  elseif(args(1).type .eq. symb_typ_real) then
c
c Do the real via moves to "l"
c
	    ptr = %loc(args(1).rval)	!all reals overlap
	    nk_work = 0
	    do k=1,control.real_size/4
	      call lib$movc3(4,%val(ptr),k)
	      write(work(nk_work+1:nk_work+8),4001) k
	      nk_work = nk_work + 8     !8 more chars
	      ptr = ptr + 4			!next 4 bytes
	    end do	      
	  elseif(args(1).type .eq. symb_typ_log) then
	    write(work(1:8),4001) args(1).lval
	     nk_work = 8
	  elseif(args(1).type .eq. symb_typ_date) then
	    write(work(1:8),4002) args(1).date
4002	    format(z8.8,' ',z8.8)
	    nk_work = 17
	  endif
	  call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'BTEST')) then
c
c BTEST(ival,bitnr) : return true if bit 'bitnr' is set
c
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
c
	  if(args(2).ival .lt. 0) goto 42
	  if(args(2).ival .ge. control.integer_size*bits_per_byte) goto 42
	  if(control.integer_size .eq. 8) then
	    if(args(2).i8val(2) .ne. 0) goto 42
	  endif
	  if(args(2).ival .le. 31) then
	    result.lval = btest(args(1).i8val(1),args(2).ival)
	  else
	    result.lval = btest(args(1).i8val(2),args(2).ival-32)
	  endif
	  result.type = symb_typ_log
	elseif(dix_util_match(funcnam,'IBSET')) then
c
c IBTEST(ival,bitnr) : return ival with bit 'bitnr' set
c
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
c
	  if(args(2).ival .lt. 0) goto 42
	  if(args(2).ival .ge. control.integer_size*bits_per_byte) goto 42
	  if(control.integer_size .eq. 8) then
	    if(args(2).i8val(2) .ne. 0) goto 42
	  endif
	  if(args(2).ival .le. 31) then
	    result.i8val(1) = ibset(args(1).i8val(1),args(2).ival)
	  else
	    result.i8val(2) = ibset(args(1).i8val(2),args(2).ival-32)
	  endif
	  result.type = symb_typ_int
	elseif(dix_util_match(funcnam,'IBCLR')) then
c
c IBCLR(ival,bitnr) : return ival with bit 'bitnr' cleared
c
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
c
	  if(args(2).ival .lt. 0) goto 42
	  if(args(2).ival .ge. control.integer_size*bits_per_byte) goto 42
	  if(control.integer_size .eq. 8) then
	    if(args(2).i8val(2) .ne. 0) goto 42
	  endif
	  if(args(2).ival .le. 31) then
	    result.i8val(1) = ibclr(args(1).i8val(1),args(2).ival)
	  else
	    result.i8val(2) = ibclr(args(1).i8val(2),args(2).ival-32)
	  endif
	  result.type = symb_typ_int
	elseif(dix_util_match(funcnam,'FILEC|OUNT')) then
	  if(narg .gt. 0) goto 20
	  p_file_info = control.top_file
	  result.ival = 0
	  do while(p_file_info .ne. 0) 
	    result.ival = result.ival + 1
	    p_file_info = file_info.link.forw
	  end do
	  result.type = symb_typ_int
          call dix_eval_sign_extend(result)
	elseif(dix_util_match(funcnam,'F$MODE')) then
c
c Return the mode of the process
c  this can be useful in scripting
c
	  if(narg .gt. 0) goto 20
	  call lib$getjpi(jpi$_mode,,,,what)
	  nk = dix_util_get_len(what)
	  call dix_eval_fill_char(result.strdes,what(1:nk))
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$DECI|MAL')) then
c
c Convert an integer or character string to decimal 
c  f$deci(intvalue[,sign],[exponent])
c    sign = "+/-"		!default +
c    exponent = exponent value  !default 0
c
c  f$deci(realvalue)
c  f$deci(strvalue)
c
c
	  if(args(1).type .eq. symb_typ_int) then
c
c Integer type
c
	    if(narg .gt. 3) goto 20
	    if(narg .gt. 1) then
c
c more than one argument only for integer type
c
	      sign = 0		!positive
	      if(args(2).type .eq. symb_typ_char) then
	        call dix_eval_copy_char_fix(args(2).strdes,work,nk_work)
	        argvals='+|-'
	        istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	        if(.not. istat) goto 50
	        if(work(1:1) .eq. '-') sign = 1	    !negative
	      elseif(args(2).type .ne. symb_typ_none) then
	      else
	        goto 32
	      endif
c
	      exponent = 0
	      if(narg .gt. 2) then
	        if(args(3).type .eq. symb_typ_int) then
	          exponent = args(3).ival
	        elseif(args(3).type .ne. symb_typ_none) then
	        else
	          goto 33
	       endif
	      end if
	    endif
c
	    nk_work = 0
	    if(control.integer_size .eq. 8) then
	      call sys$fao('!@UX',nk_work,work,args(1).i8val)
	    else	  
	      call sys$fao('!UL',nk_work,work,%val(args(1).ival))
	    endif
	    call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  elseif(args(1).type .eq. symb_typ_char) then
c
c Convert ascii to "decimal"
c
	    if(narg .gt. 1) goto 20
	    istat = dix_eval_check_num(args(1).strdes,sign,exponent,
     1             result.strdes)
	    if(istat .eq. 0) istat = %loc(dix_msg_invdeci)
c
	  elseif(args(1).type .eq. symb_typ_real) then
c
c  Convert real value to ascii
c
	    if(narg .gt. 1) goto 20
c
c Get the current real type (depending on platform)
c
	    call dix_con_cvt_float_type(control,control.real_size,k)
	    call dix_con_type_intasc(control.real_size,args(1).rval,
     1              k,work,nk_work,control)
c
c Convert ascii to "decimal"
c
	    istat = dix_eval_check_num(work(1:nk_work),sign,exponent,
     1             result.strdes)
	    if(istat .eq. 0) istat = %loc(dix_msg_invdeci)
	  else
	    goto 31		!illegl type
	  endif	  
c
c We have all things
c
	  result.sign  = sign
	  result.exponent = exponent
	  result.type = symb_typ_decimal
	elseif(dix_util_match(funcnam,'F$RAD|IX')) then
c
c f$radix, convert to any radix
c  f$radix(integer,radix[,separator])
c
	  if(narg .ge. 4) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  nk_work1 = 0
	  if(narg .gt. 2) then
	    if(args(3).type .eq. symb_typ_none) then
	    elseif(args(3).type .eq. symb_typ_char) then
	      call dix_eval_copy_char_fix(args(3).strdes,work1,nk_work1)
	    else
	      goto 33
	    endif
	  endif
c
c If we run out of "digits"  and the user has not specified a separator
c  use the . char
c
	  if(args(2).ival .gt. 36) then
	    if(nk_work1 .eq. 0) then
	      nk_work1 = 1
	      work1(1:1)='.'
	    endif
	  endif
	  call dix_eval_radix(control,args(1),args(2),
     1           work1(1:nk_work1),work,nk_work)
	  call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$ADD') .or.
     1         dix_util_match(funcnam,'F$SUB|') .or.
     1         dix_util_match(funcnam,'F$MUL|') .or.
     1         dix_util_match(funcnam,'F$DIV|IDE')) then
c
c We expect at least 2 arguments type string
c  the third/fourth argument are optional but must of of type integer
c
	  if(narg .gt. 4) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  if(args(2).type .ne. symb_typ_char) goto 31
	  siz = 0
c
	  if(narg .ge. 3) then
	    if(args(3).type .ne. symb_typ_none) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      siz = args(3).ival  !assume 32 bits is enough
	    endif
	  endif
c
          ndig = control.decimal_ndig
          if(narg .ge. 4) then
            if(args(4).type .ne. symb_typ_none) then
              if(args(4).type .ne. symb_typ_int) goto 34
              ndig = args(4).ival !assume 32 bits is enough
            endif
          endif
c
	  istat = dix_eval_strfun(control,
     1           funcnam(3:3),args(1).strdes,
     1           args(2).strdes,result.strdes,siz,ndig)
c
c Result is a character string
c
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$EXTZ|V') .or.
     1         dix_util_match(funcnam,'F$EXTV|')) then
	  if(narg .ne. 3) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
c
	  pos = args(1).ival	!assume 32 bits is enough	  
	  siz = args(2).ival    !assume 32 bits is enough
c
	  if(args(3).type .eq. symb_typ_int) then
	    pnt = %loc(args(3).ival)
	    k = bits_per_byte*control.integer_size
	  elseif(args(3).type .eq. symb_typ_real) then
	    pnt = %loc(args(3).rval)	!rval/rval8/rval16 overlap
	    k = bits_per_byte*control.real_size
	  elseif(args(3).type .eq. symb_typ_log) then
	    pnt = %loc(args(3).lval)
	    k = 32
	  elseif(args(3).type .eq. symb_typ_char) then
	    pnt = args(3).strdes.dsc$a_pointer
	    k = bits_per_byte*args(3).strdes.dsc$w_maxstrlen
	  elseif(args(3).type .eq. symb_typ_date) then
	    pnt = %loc(args(3).date)
	    k = 64
	  else
	    goto 33
	  endif
	  if(pos .lt. 0) goto 41
	  if(siz .lt. 1 .or. siz .gt. control.integer_size) goto 42
	  if(pos+siz .gt. k) goto 41
c	  
	  if(control.integer_size .eq. 8) then
	    result.i8val(1) = lib$extv(pos,siz,%val(pnt))
	    if(funcnam(6:6) .eq. 'Z' .or. funcnam(6:6) .eq. 'z') then
	      result.i8val(2) = lib$extzv(pos+32,siz,%val(pnt))
	    els e
	      result.i8val(2) = lib$extv(pos+32,siz,%val(pnt))
	    endif
	  else
	    if(funcnam(6:6) .eq. 'Z' .or. funcnam(6:6) .eq. 'z') then
	      result.ival = lib$extzv(pos,siz,%val(pnt))
	    els e
	      result.ival = lib$extv(pos,siz,%val(pnt))
	    endif
	  endif
c
	  result.type = symb_typ_int
	elseif(dix_util_match(funcnam,'F$INS|V')) then
	  if(narg .ne. 4) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  if(args(3).type .ne. symb_typ_int) goto 33
	  pos = args(2).ival		!assume 32 bits is enough
	  siz = args(3).ival            !assume 32 bits is enough
c
	  if(args(4).type .eq. symb_typ_int) then
	    result = args(4)
	    pnt = %loc(result.ival)
	    k = control.integer_size*bits_per_byte		!integers are max 32 bits
	  elseif(args(4).type .eq. symb_typ_real) then
	    result = args(4)
	    pnt = %loc(result.rval)	!rval/rval8/rval16 overlap
	    k = control.real_size*bits_per_byte     !reals are "current resl size"*8
	  elseif(args(4).type .eq. symb_typ_log) then
	    result = args(4)
	    pnt = %loc(result.lval)     
	    k = 32                      !logical are max 32 bits
	  elseif(args(4).type .eq. symb_typ_char) then
	    call dix_eval_copy_char_fix(args(4).strdes,work,nk_work)
	    pnt = %loc(work)
	    k = bits_per_byte*nk_work		!limit of the bas string
	  elseif(args(4).type .eq. symb_typ_date) then
	    result = args(4)
	    pnt = %loc(result.date)
	    k = 64			!dates are 64 bit
	  else
	    goto 34
	  endif
	  if(pos+siz .lt. 0) goto 41	!not before the base
	  if(pos+siz .gt. k) goto 41    !not beyond base
c
c lib$insv only copies 32 bits, do it piece by piece (max 32 bits)
c
	  do while(siz .ge. 0)
	    call lib$insv(args(1).ival,pos,min(siz,32),%val(pnt))
	    pos = pos + 32
	    siz = siz - 32
	  end do
c
	  if(args(4).type .eq. symb_typ_char) then 
	    call dix_eval_fill_char(result.strdes,work(1:nk_work))
	    result.type = symb_typ_char
	  endif
c
	elseif(dix_util_match(funcnam,'F$ENV|IRONMENT')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
c
	  call dix_eval_copy_char_fix(args(1).strdes,work,nk_work)
	  argvals='DEPTH|MESSAGE|ON_SEVERITY|ON_ACTION|'//
     1            'PROCEDURE|INTERACTIVE|PROMPT|PRCNAM|STRICT|VERIFY'
	  istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	  if(.not. istat) goto 50
	  call dix_eval_envi(control,work(1:nk_work),result)
	elseif(dix_util_match(funcnam,'F$RAND|OM')) then
	  if(narg .gt. 1) goto 20
	  if(narg .eq. 0) then
	    args(1).type = symb_typ_real
	    if(control.real_size .eq. 8) then
	      args(1).rval8  = 1.0
	    elseif(control.real_size .eq. 16) then
	      args(1).rval16 = 1.0
	    else
	      args(1).rval   = 1.0
	    endif
	  endif
	  if(args(1).type .eq. symb_typ_int) then
	    if(args(1).ival .le. 1) goto 41
	    result.ival = int(args(1).ival * ran(control.ran_seed))
	    result.type = symb_typ_int
            call dix_eval_sign_extend(result)
	  elseif(args(1).type .eq. symb_typ_real) then
	    if(control.real_size .eq. 8) then
	      if(args(1).rval8 .le. 0.0) goto 41
	      result.rval8 = args(1).rval8 * ran(control.ran_seed)
	    elseif(control.real_size .eq. 16) then
	      if(args(1).rval16 .le. 0.0) goto 41
	      result.rval16 = args(1).rval16 * ran(control.ran_seed)
	    else
	      if(args(1).rval .le. 0.0) goto 41
	      result.rval = args(1).rval * ran(control.ran_seed)
	    endif
	    result.type = symb_typ_real
	  else
	    goto 31
	  endif 
	elseif(dix_util_match(funcnam,'F$GETD|VI')) then
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  if(args(2).type .ne. symb_typ_char) goto 32
c
	  call dix_eval_copy_char_fix(args(2).strdes,work,nk_work)
	  argvals = 'MAXBLOCK|MAXFILES|EXISTS|BLNRFILE'
	  istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	  if(.not. istat) goto 50
c
	  istat = dix_eval_getdvi(args(1).strdes,work(1:nk_work),result)
	elseif(dix_util_match(funcnam,'F$EDIT')) then
c
c F$edit(string,"what,what")
c
	  if(narg .ne. 2) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  if(args(2).type .ne. symb_typ_char) goto 32
c
	  call dix_eval_copy_value(args(1),result)
	  call dix_eval_copy_char_fix(args(2).strdes,work1,nk_work1)
	  iel = 0
	  do while(str$element(work,iel,',',work1(1:nk_work1)))
	    nk_work = dix_util_get_len(work)
	    argvals = 'COLLAPSE|COMPRESS|TRIM|UPPERCASE|LOWERCASE|UNCOMMENT'
	    istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	    action = work(1:nk_work)
c
	    nk_work = -1
	    if(action(1:3) .eq. 'COL') then
	      call dix_eval_copy_char_fix(result.strdes,work,nk_work)
	      call dix_util_compress_Line(work,nk_work,.true.)
	    elseif(action(1:3) .eq. 'COM') then
	      call dix_eval_copy_char_fix(result.strdes,work,nk_work)
	      call dix_util_compress_line(work,nk_work,.false.)
	    elseif(action(1:1) .eq. 'T') then
	      call str$trim(result.strdes,result.strdes)
	    elseif(action(1:2) .eq. 'UP') then
	      call str$upcase(result.strdes,result.strdes)
	    elseif(action(1:1) .eq. 'L') then
	      call dix_util_case_line(result.strdes,.false.)
	    elseif(action(1:2) .eq. 'UN') then
	      call dix_eval_copy_char_fix(result.strdes,work,nk_work)
	      call dix_util_remove_comment(nk_work,work)
	    endif
	    if(nk_work .ge. 0) then
	      call dix_eval_copy_char_dyn(work(1:nk_work),result.strdes)
	    endif
	    iel = iel + 1
	  enddo                         
	elseif(dix_util_match(funcnam,'F$FAO')) then
	  if(narg .eq. 0 .or. narg .gt. max_faol_size) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  do k=1,max_faol_size
	    arglist(k) = 0
	  enddo
	  do k=2,narg
	    if(args(k).type .eq. symb_typ_int) then
	      arglist(k-1) = args(k).ival
	    elseif(args(k).type .eq. symb_typ_char) then
	      arglist(k-1) = %loc(args(k).strdes)
	    elseif(args(k).type .eq. symb_typ_date) then
	      arglist(k-1) = %loc(args(k).date)
	    else
	      iha = k
	      goto 38
	    endif
	  end do
	  nk_work = 0
	  istat = sys$faol(args(1).strdes,nk_work,work,arglist)
	  if(.not. istat) goto 90	  
	  result.type = symb_typ_char
	  call dix_eval_copy_char_dyn(work(1:nk_work),result.strdes)
	elseif(dix_util_match(funcnam,'F$DATE')) then
c
c F$DATE(datestring)
c F$DATE(value,what)
c
	  argvals = 'WEEKS|DAYS|HOURS|MINUTES|SECONDS|HUNDREDTH|CPUTICKS'
	  if(args(1).type .eq. symb_typ_char) then
	    if(narg .ne. 1) goto 20
c
	    istat = lib$convert_date_string(args(1).strdes,result.date)
	    call dix_eval_copy_char_fix(args(1).strdes,argvals,nk)
	    if(.not. istat) goto  50
	  elseif(args(1).type .eq. symb_typ_int) then
	    if(narg .ne. 2) goto 20
	    if(args(1).ival .lt. 0) goto 41	!invalid value
c
	    if(args(2).type .ne. symb_typ_char) goto 32
	    call dix_eval_copy_char_fix(args(2).strdes,work,nk_work)
	    istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	    flag = -1
	    if(work(1:1) .eq. 'W') then
	      flag = lib$k_delta_weeks
	    elseif(work(1:1) .eq. 'D') then
	      flag = lib$k_delta_days
	    elseif(work(1:2) .eq. 'HO') then
	      flag = lib$k_delta_hours
	    elseif(work(1:1) .eq. 'M') then
	      flag = lib$k_delta_minutes
	    elseif(work(1:1) .eq. 'S') then
	      flag = lib$k_delta_seconds
	    elseif(work(1:2) .eq. 'HU' .or. work(1:1) .eq. 'C') then
	      call lib$emul(-10*1000*10,args(1).ival,-1,result.date)	      
	      flag = 0
	    endif
	    if(flag .ne. 0) then
	      call lib$cvt_to_internal_time(flag,args(1).ival,result.date)
	    endif
	  elseif(args(1).type .eq. symb_typ_real) then
	    if(narg .ne. 2) goto 20
c
c Make the real to real*4
c
	    call dix_con_cvt_float_real_f(control,args(1).rval,
     1                  real4_work,overflow)
c
	    if(overflow) then
	      err_arg = 'Converting to real*4'
	      goto 65
	    endif
c
	    if(args(2).type .ne. symb_typ_char) goto 32
	    call dix_eval_copy_char_fix(args(2).strdes,work,nk_work)
	    istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
c
	    if(work(1:1) .eq. 'W') then
	      flag = lib$k_delta_weeks_f
	    elseif(work(1:1) .eq. 'D') then
	      flag = lib$k_delta_days_f
	    elseif(work(1:2) .eq. 'HO') then
	      flag = lib$k_delta_hours_f
	    elseif(work(1:1) .eq. 'M') then
	      flag = lib$k_delta_minutes_f
	    elseif(work(1:1) .eq. 'S') then
	      flag = lib$k_delta_seconds_f
	    elseif(work(1:2) .eq. 'HU' .or. work(1:1) .eq. 'C') then
	      flag = lib$k_delta_seconds_f
	      real4_work = real4_work/100.0
	    endif
	    call lib$cvtf_to_internal_time(flag,real4_work,result.date)
	  else
	    goto 31
	  endif	  
	  result.type = symb_typ_date
	elseif(dix_util_match(funcnam,'F$TIME')) then
c
c F$TIME(what[,date)
c
	  if(narg .gt. 2) goto 20
	  call sys$gettim(this_time)
	  if(args(2).type .eq. symb_typ_date) then
	    call lib$movc3(8,args(2).date,this_time)
	  elseif(args(2).type .eq. symb_typ_char) then
	    istat = lib$convert_date_string(args(2).strdes,this_time)
	    if(.not. istat) goto 90
	  elseif(args(2).type .ne. symb_typ_none) then
	    goto 32
	  endif
	  nk_work = 0
c
c Take default case, full date/time
c Make the string not too long, THe vax has a 
c  problem if the string length is >32767, take a subset  
c
	  call sys$asctim(nk_work,work(1:30),this_time,)
	  call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  call sys$numtim(numtim,this_time)
	  if(this_time(2) .lt. 0) then
	    call str$prefix(result.strdes,'       ')
	  endif
	  result.type = symb_typ_char
	  if(args(1).type .eq. symb_typ_none) then
c
c Default case, the date/time
c
	  elseif(args(1).type .eq. symb_typ_char) then
c
c Char case, check for argument
c
	    call dix_eval_copy_char_fix(args(1).strdes,work,nk_work)
	    if(work(1:nk_work) .ne. ' ') then
c
c Something specified, check for value
c
	      argvals = 'DATE|TIME|YEAR|MONTHASC|DAY|HOUR|'//
     1         'MINUTE|SECOND|HUNDREDTH'
	      istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	      if(.not. istat) goto 50
c
	      if(work(1:nk_work) .eq. 'DATE') then
	        if(this_time(2).lt. 0) then	!delta time
	          istat = str$pos_extr(result.strdes,result.strdes,8,11)
	          if(.not. istat) call lib$signal(%val(istat))
	        else
	          istat = str$pos_extr(result.strdes,result.strdes,1,11)
	          if(.not. istat) call lib$signal(%val(istat))
	        endif
	      elseif(work(1:1) .eq. 'T') then
	        istat = str$pos_extr(result.strdes,result.strdes,13,23)
	        if(.not. istat) call lib$signal(%val(istat))
	      elseif(work(1:1) .eq. 'Y') then
	        result.ival = numtim(1)
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      elseif(work(1:6) .eq. 'MONTH ') then
	        result.ival = numtim(2)
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      elseif(work(1:6) .eq. 'MONTHA') then
	        istat = str$pos_extr(result.strdes,result.strdes,4,6)
	        if(.not. istat) call lib$signal(%val(istat))
	      elseif(work(1:1) .eq. 'D') then
	        result.ival = numtim(3)
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      elseif(work(1:2) .eq. 'HO') then
	        result.ival = numtim(4)
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      elseif(work(1:2) .eq. 'MI') then
	        result.ival = numtim(5)
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      elseif(work(1:1) .eq. 'S') then
	        result.ival = numtim(6)
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      elseif(work(1:2) .eq. 'HU') then
	        result.ival = numtim(7)
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      endif
	    endif
	  else
c
c All other illegal
c
	    goto 31
	  endif
	elseif(dix_util_match(funcnam,'F$CHEC|KSUM')) then
c
c Syntax
c  f$checksum(begpos,endpos,[size],[method],[file])
c size   = byte/word/longword
c method = sum/xor
c file   = filetag
c
	  if(narg .gt. 5) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
c
c Parse size
c
	  wl = 1		!assume bytes
	  if(args(3).type .ne. symb_typ_none) then		    
	    if(args(3).type .ne. symb_typ_char) goto 33
	    call dix_eval_copy_char_fix(args(3).strdes,work,nk_work)
	    argvals = 'BYTE|WORD|LONGWORD'
	    istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	    wl = 0
	    if(work(1:1) .eq. 'B') wl = 1
	    if(work(1:1) .eq. 'W') wl = 2
	    if(work(1:1) .eq. 'L') wl = 4
	  endif	  
c
c Parse method
c
	  work(1:1) = 'S'
	  if(args(4).type .ne. symb_typ_none) then		    
	    if(args(4).type .ne. symb_typ_char) goto 34
	    call dix_eval_copy_char_fix(args(4).strdes,work,nk_work)
	    argvals = 'XOR|SUM'
	    istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	  endif
c
c Parse file
c
	  istat = dix_eval_set_file(control,args(5),ptr_file,
     1                  err_arg,.false.)
	  if(istat .eq. %loc(dix_msg_wrargtyp)) goto 35
	  if(.not. istat) goto 90
	  p_file_info = ptr_file
c
	  args(1).ival = min(file_info.data.nb_data,args(1).ival)
	  args(2).ival = min(file_info.data.nb_data,args(2).ival)
	  result.ival = dix_util_checksum(wl,file_info.data.data_rec,
     1            args(1).ival,args(2).ival,work(1:1))
	  result.type = symb_typ_int
	  call dix_eval_sign_extend(result)
	elseif(dix_util_match(funcnam,'F$ENUM|ERATE')) then
	  if(narg .gt. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_none) then
	    if(args(2).type .ne. symb_typ_char) goto 32
	    call dix_eval_upcase(args(2).strdes,mask,nk_mask)
	  else
	    mask = '*'
	    nk_mask = 1
	  endif	    
	  call dix_des_get_fieldname(control,args(1).ival,mask(1:nk_mask),
     1          work,nk_work)
	  call dix_eval_copy_char_dyn(work(1:nk_work),result.strdes)
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$TRIM')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  result.type = symb_typ_char
	  istat = str$trim(result.strdes,args(1).strdes)
	  if(.not. istat) call lib$signal(%val(istat))
	elseif(dix_util_match(funcnam,'F$LENG|TH')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  result.ival = zext(args(1).strdes.dsc$w_maxstrlen)
	  result.type = symb_typ_int
          call dix_eval_sign_extend(result)
	elseif(dix_util_match(funcnam,'F$TRNL|NM')) then
	  if(narg .lt. 1 .or. narg .gt. 6) goto 20

	  if(args(1).type .ne. symb_typ_char) goto 31
c
c Arg2 must be (if there) a string (tablename)
c
	  table = 'LNM$FILE_DEV'
	  nk_tab = 12
	  if(args(2).type .ne. symb_typ_none) then
	    if(args(2).type .ne. symb_typ_char) goto 32
	    call dix_eval_copy_char_fix(args(2).strdes,table,nk_tab)
	  endif
c
c Arg3 (if there) must be integer (index)
c
	  idx = 0
	  if(args(3).type .ne. symb_typ_none) then
	    if(args(3).type .ne. symb_typ_int) goto 33
	    idx = args(3).ival		!32 bits are enough
	  endif
c
c Arg4 (if there) must be mode
c
	  mode = ' '
	  if(args(4).type .ne. symb_typ_none) then
	    if(args(4).type .ne. symb_typ_char) goto 34
	    call dix_eval_copy_char_fix(args(4).strdes,work,nk_work)
	    istat=dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	    mode = work(1:nk_work)
	  endif
c
c Arg5 (if there) must be
c
	  option = ' '
	  if(args(5).type .ne. symb_typ_none) then
	    if(args(5).type .ne. symb_typ_char) goto 35
	    k = 0
	    nk1 = 0
	    argvals = 'CASE_SENSITIVE'
	    if(vms_vers() .gt. 720) argvals = 'INTERLOCKED|'//argvals
	    do while(str$element(work,k,',',args(5).strdes))
	      nk_work = dix_util_get_len(work)
	      istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	      if(.not. istat) goto 50
	      k = k + 1
	      option = option(1:nk1)//','//work(1:nk_work)
	      nk1 = nk1 + 1 + nk_work
	    enddo
	  endif
c
c Arg6 (if there) must be a string 
c
	  what = 'VALUE'
	  if(args(6).type .ne. symb_typ_none) then
	    if(args(6).type .ne. symb_typ_char) goto 36
	    work(1:10) = ' '
	    call dix_eval_copy_char_fix(args(6).strdes,work,nk_work)
	    nk_work = 10
	    argvals = 'ACCESS_MODE|CONCEALED|CONFINE|CRELOG|'//
     1        'MAX_INDEX|NO_ALIAS|TABLE|TERMINAL|VALUE|LENGTH|EXISTS|'//
     1        'TABLE_NAME'
	    if(vms_vers() .gt. 720) argvals = 'CLUSTERWIDE|'//argvals
	    istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	    what = work(1:nk_work)
	  endif
c
c Now we have it all, create the service
c
	  istat = dix_eval_trnlnm(args(1).strdes,
     1         table(1:nk_tab),idx,mode,option,what,result)
c
	elseif(dix_util_match(funcnam,'F$DES|CRIPTION')) then
	  nk = 0
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  k = args(1).ival		!32 bits are enough
	  p_des_info = control.top_descr
	  do while(p_des_info .ne. 0)
	    k = k-1
	    if(k .eq. 0) then
	      nk = des_info.nk_fnam
	      work(1:nk) = des_info.fnam(1:nk)
	      p_des_info = 0
	    else
	      p_des_info = des_info.link.forw
	    end if
	  end do
	  call dix_eval_fill_char(result.strdes,work(1:nk))
	  result.type = symb_typ_char	!assume no result
	elseif(dix_util_match(funcnam,'F$FILE')) then
c
c F$file(what,fileidx)
c f$file("DES",fileidx,"DESWHAT",desidx)
c fileidx and desidx can be either numbers or tags
c
	  if(narg .lt. 1) goto 20
	  if(narg .gt. 4) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
c
c	  
	  call dix_eval_copy_char_fix(args(1).strdes,work,nk_work)
	  argvals = 'ORG|NAME|NOK|KEY|KVAL|KSTRING|KASCENDING'//
     1              '|KNAME|TAG|KLENGTH|KSEG|KSPOS|KSSIZE|KTYPE'//
     1              '|DESCRIPTION|RFA'
	  istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	  if(.not. istat) goto 50
c
	  result.type = symb_typ_char	!assume no result
c
c Check for arg 2, the file index
c
	  istat = dix_eval_set_file(control,args(2),ptr_file,
     1                              err_arg,.true.)
	  if(istat .eq. %loc(dix_msg_wrargtyp)) goto 32
	  if(.not. istat) goto 90
C#
	  if(ptr_file .eq. 0) goto 431
C#
	  p_file_info = ptr_file
c
	  if(work(1:1) .eq. 'O') then
c
c Organization
c
	    if(narg .gt. 2) goto 20
	    if(file_info.block_size .ne. 0) then
	      call dix_eval_fill_char(result.strdes,'BLK')
	    else
	      if(file_info.indexed) then
	        call dix_eval_fill_char(result.strdes,'IDX')
	      elseif(file_info.relative) then
	        call dix_eval_fill_char(result.strdes,'REL')
	      else
	        call dix_eval_fill_char(result.strdes,'SEQ')
	      endif
	    endif
	    result.type = symb_typ_char
	  elseif(work(1:1) .eq. 'D') then
c
c Th description option, option name/tag
c Only for descriptors the third and fourth parameter are allowed
c
	    if(narg .gt. 4) goto 20
c
c Expand parameter 4, must be an integer indicating the n'th description
c                     or a string for the tag of the description
c
	    istat = dix_eval_set_des(args(4),file_info,k,.true.)
	    iha = 4
	    if(istat .eq. %loc(dix_msg_wrargtyp)) goto 34	      
	    if(.not. istat) goto 85
	    if(k .eq. 0) goto 431
	    p_des_expanded = k
c
c
c Process the third argument, a string NAME or TAG
c
	    if(args(3).type .ne. symb_typ_none) then
	      if(args(3).type .ne. symb_typ_char) goto 33
	      call dix_eval_copy_char_fix(args(3).strdes,work1,nk_work1)
	      argvals = 'NAME|TAG'
	      istat = dix_eval_check_arg(work1(1:nk_work1),argvals,err_arg)
	      if(.not. istat) goto 50
	    else
	      work1(1:1) = 'N'		!assume name wanted
	    endif
c
c Now we have all, go process
c
	    if(work1(1:1) .eq. 'N') then
c
c The name
c
	      p_des_info = des_expanded.p_des_info
	      call dix_eval_fill_char(result.strdes,
     1                 des_info.fnam(1:des_info.nk_fnam))
	    elseif(work1(1:1) .eq. 'T') then
c
c Tha tag
c
	      call dix_eval_fill_char(result.strdes,
     1                 des_expanded.handle(1:des_expanded.nk_handle))
	    endif
	    result.type = symb_typ_char
	  elseif(work(1:2) .eq. 'NA') then
	    if(narg .gt. 2) goto 20
c
c The name option
c
	    call dix_eval_fill_char(result.strdes,
     1              file_info.fnam(1:file_info.nk_fnam))
	    result.type = symb_typ_char
	  elseif(work(1:1) .eq. 'T') then
	    if(narg .gt. 2) goto 20
c
c The tag option
c
	    call dix_eval_fill_char(result.strdes,
     1                      file_info.handle(1:file_info.nk_handle))
	    result.type = symb_typ_char
	  elseif(work(1:2) .eq. 'NO') then
	    if(narg .gt. 2) goto 20
c
c The NOK option (number of keys)
c
	    result.ival = file_info.nkey
	    result.type = symb_typ_int
            call dix_eval_sign_extend(result)
	  elseif(work(1:2) .eq. 'KE') then
c
c Option KEY , the current key
c 
	    if(narg .gt. 2) goto 20
	    result.ival = file_info.cur_key
	    result.type = symb_typ_int
            call dix_eval_sign_extend(result)
	  elseif(work(1:2) .eq. 'KV') then
c 
c The KVAL, the key value option, the value of the key
c   either string or number
c
	    if(narg .gt. 3) goto 20
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival		!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
c
c Now thew file_info.keypos(*) and file_info.keysiz(*) are set for this key
c
	    nk1 = 0
	    do k=1,8
	      if(key_info.keysiz(k) .gt. 0) then
c
c Still in record ?
c
	        bpos = key_info.keypos(1) + 1
	        epos = min(bpos+key_info.keysiz(k)-1,
     1                     file_info.data.nb_data)
	        if(epos .ge. bpos) then
	          nk = epos-bpos + 1
	          call lib$movc3(nk,file_info.data.data_rec(bpos),
     1                   %ref(work1(nk1+1:nk1+1)))
	          nk1 = nk1 + nk
	        endif
	      endif
	    end do	 
	    call dix_eval_fill_char(result.strdes,work1(1:nk1))
	    result.type = symb_typ_char
c
c Reset key info
c
	  elseif(work(1:3) .eq. 'KST') then
	    if(narg .gt. 3) goto 20
c 
c The KSTRING, the key string option, the current key index
c   the type of the key, string or not
c
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival	!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
c
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
	    result.lval = key_info.string
	    result.type = symb_typ_log
	  elseif(work(1:2) .eq. 'KT') then
	    if(narg .gt. 3) goto 20
c 
c The KTYPE, THe key type
c
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival	!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
c
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
	    call dix_rms_cvt_keytype(key_info.data_type,short_string)
	    result.type = symb_typ_char
	    k = dix_util_get_len(short_string)
	    call dix_eval_fill_char(result.strdes,short_string(1:k))
	  elseif(work(1:2) .eq. 'KN') then
	    if(narg .gt. 3) goto 20
c 
c The KNAME, the key name option, the current key index
c   the name 
c
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival	!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
	    k = dix_util_get_len_fu(key_info.name)
	    call dix_eval_fill_char(result.strdes,key_info.name(1:k))
	    result.type = symb_typ_char
	  elseif(work(1:2) .eq. 'KL') then
	    if(narg .gt. 3) goto 20
c 
c The KLENGTH, the key length option, the current key index
c
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival	!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
	    result.ival = key_info.length
	    result.type = symb_typ_int
            call dix_eval_sign_extend(result)
	  elseif(work(1:2) .eq. 'KA') then
c 
c The KASCENDING, the key ascending, the current key index
c   the type of the key, ascending flag
c
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival	!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
	    result.lval = key_info.ascending
	    result.type = symb_typ_log
	  elseif(work(1:3) .eq. 'KSE') then
c
c #segements
c
	    if(narg .gt. 4) goto 20
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival	!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
	    result.ival = 0
	    do k=1,8
	      if(key_info.keysiz(k) .gt. 0) result.ival = result.ival + 1
	    enddo
	    result.type = symb_typ_int
            call dix_eval_sign_extend(result)
c
	  elseif(work(1:3) .eq. 'KSP') then
	    if(narg .gt. 4) goto 20
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival	!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
c
	    if(narg .gt. 3) then
	      if(args(4).type .ne. symb_typ_int) goto 34
	      k = args(4).ival	!32 bits are enough
	      if(k .lt. 1 .or. k .gt. 8) goto 62
	    else
	      k = 1
	    endif
	    result.ival = key_info.keypos(k)
	    result.type = symb_typ_int
            call dix_eval_sign_extend(result)
	  elseif(work(1:3) .eq. 'KSS') then
	    if(narg .gt. 4) goto 20
	    keynr = file_info.cur_key
	    if(narg .gt. 2) then
	      if(args(3).type .ne. symb_typ_int) goto 33
	      keynr = args(3).ival		!32 bits are enough
	    endif
	    if(keynr .lt. 0 .or. keynr .ge. file_info.nkey) goto 60
	    if(.not. file_info.indexed) goto 61
	    call dix_rms_get_keyinfo(file_info,keynr,k)
	    p_key_info = k
	    if(narg .gt. 3) then
	      if(args(4).type .ne. symb_typ_int) goto 34
	      k = args(4).ival		!32 bits are enough
	      if(k .lt. 1 .or. k .gt. 8) goto 62
	    else
	      k = 1
	    endif
	    result.ival = key_info.keysiz(k)
	    result.type = symb_typ_int
            call dix_eval_sign_extend(result)
	  elseif(work(1:1) .eq. 'R') then
	    if(narg .gt. 2) goto 20
c
c Now get the rab
c
	    call dix_rms_return_rfa(file_info,rfa)
	    call sys$fao('(!UL,!UW)',nk1,work1,
     1             %val(rfa.bbnr),%val(rfa.offset))
	    call dix_eval_fill_char(result.strdes,work1(1:nk1))
	    result.type = symb_typ_char
	  endif
431	  continue
	elseif(dix_util_match(funcnam,'F$COLL|APSE')) then
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  call dix_eval_copy_char_fix(args(1).strdes,work,nk_work)
	  result.type = symb_typ_char
	  nk_work1 = 0
	  do k=1,nk_work
	    if(work(k:k) .ne. ' ') then
	      nk_work1 = nk_work1 + 1
	      work(nk_work1:nk_work1) = work(k:k)
	    endif
	  enddo
	  call dix_eval_copy_char_dyn(work(1:nk_work1),result.strdes)
	elseif(dix_util_match(funcnam,'F$ELEM|ENT')) then
	  if(narg .ne. 3) goto 20
	  if(args(1).type .ne. symb_typ_int)  goto 31
	  if(args(2).type .ne. symb_typ_char) goto 32
	  if(args(3).type .ne. symb_typ_char) goto 33
	  istat = str$left(kar,args(2).strdes,1)
	  if(.not. istat) call lib$signal(%val(istat))
	  if(args(1).ival .lt. 0) then	!32 bits are enough
	    k = 0
	    do while(str$element(work,k,kar,args(3).strdes))
	      k = k + 1
	    end do
	    k = k + args(1).ival
	  else
	    k = args(1).ival
	  endif
	  if(.not. str$element(result.strdes,k,kar,args(3).strdes)) then
	    call dix_eval_fill_char(result.strdes,kar)
	  endif
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$EXTR|ACT')) then
	  if(narg .ne. 3) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_int) goto 32
	  if(args(3).type .ne. symb_typ_char) goto 33
	  result.type = symb_typ_char
	  bpos = args(1).ival	!32 bits are enough
	  if(bpos .ge. 0) then
	    bpos = bpos + 1
	  else
	    bpos = zext(args(3).strdes.dsc$w_maxstrlen) + bpos + 1
	  endif
	  if(args(2).ival .lt. 0) then	!32 bits are enough
	    epos = zext(args(3).strdes.dsc$w_maxstrlen)
	  else
	    epos = min(args(2).ival + bpos - 1,    !32 bits are enough
     1            zext(args(3).strdes.dsc$w_maxstrlen))
	  endif
c	  call dix_eval_init_char(result.strdes)
	  if(bpos .ge. 1 .and. bpos .le. 
     1          zext(args(3).strdes.dsc$w_maxstrlen)) then
	    istat = str$pos_extr(result.strdes,args(3).strdes,bpos,epos)
	  endif
	elseif(dix_util_match(funcnam,'F$MESS|AGE')) then
	  if(narg .gt. 2) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(2).type .ne. symb_typ_none) then
	    if(args(2).type .ne. symb_typ_int) goto 32
	    argval = args(2).ival		!32 bits are enough
	    if(argval .lt. 0 .or. argval .gt. 15) goto 42
	  else
	    argval = control.msgmask
	  endif
	  result.type = symb_typ_char
	  call sys$getmsg(%val(args(1).ival),nk_work,work,%val(argval),)
	  call dix_eval_fill_char(result.strdes,work(1:nk_work))
	elseif(dix_util_match(funcnam,'F$MATC|HWILD')) then
c
c F$MATCH(cadidate,pattern,[standard/extended],[nocase_sens/case_sens])
c
	  if(narg .lt. 2 .or. narg .gt. 4) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  if(args(2).type .ne. symb_typ_char) goto 32
c
	  work(1:1) = 'V'	    
	  if(args(3).type .ne. symb_typ_none) then
	    if(args(3).type .ne. symb_typ_char) goto 33
	    call dix_eval_copy_char_fix(args(3).strdes,work,nk_work)
	    argvals = 'STANDARD|EXTENDED'
	    istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	  endif
	  wildcard_flag = wildcard_flag_standard
	  if(work(1:1) .eq. 'E') wildcard_flag = wildcard_flag_extended
c
	  work(1:1) = 'N'	    
	  if(args(4).type .ne. symb_typ_none) then
	    if(args(4).type .ne. symb_typ_char) goto 34
	    call dix_eval_copy_char_fix(args(3).strdes,work,nk_work)
	    argvals = 'CASE_SENSITIVE|NOCASE_SENSITIVE'
	    istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	  endif
	  case_sens = work(1:1) .eq. 'C'
c
	  result.lval = dix_util_match_string_wild(args(1).strdes,
     1             args(2).strdes,case_sens,wildcard_flag)
	  result.type = symb_typ_log
	elseif(dix_util_match(funcnam,'F$UPCA|SE')) then
c
c F$UPCASE(STRING)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  istat = str$upcase(result.strdes,args(1).strdes)
	  if(.not. istat) call lib$signal(%val(istat))
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$LOCAS|E')) then
c
c F$LOCASE(STRING)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  call dix_eval_fill_char(result.strdes,args(1).strdes)
	  call dix_util_case_line(result.strdes,.false.)
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$LOCAT|E')) then
c
c F$LOCATE(string,substring,[STANDARD/EXTENDED],[case_sens/nocase_sens])
c
	  if(narg .lt. 2 .or. narg .gt. 4) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  if(args(2).type .ne. symb_typ_char) goto 32
	  work(1:1) = 'V'	    
	  if(args(3).type .ne. symb_typ_none) then
	    if(args(3).type .ne. symb_typ_char) goto 33
	    call dix_eval_copy_char_fix(args(3).strdes,work,nk_work)
	    argvals = 'STANDARD|EXTENDED'
	    istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	  endif
	  wildcard_flag = wildcard_flag_standard
	  if(work(1:1) .eq. 'E') wildcard_flag = wildcard_flag_extended
c
	  work(1:1) = 'N'	    
	  if(args(4).type .ne. symb_typ_none) then
	    if(args(4).type .ne. symb_typ_char) goto 34
	    call dix_eval_copy_char_fix(args(3).strdes,work,nk_work)
	    argvals = 'CASE_SENSITIVE|NOCASE_SENSITIVE'
	    istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	  endif
	  case_sens = work(1:1) .eq. 'C'
c
	  result.ival = dix_util_find_string_wild(args(1).strdes,
     1                         args(2).strdes,case_sens,wildcard_flag,k)
	  if(result.ival .eq. 0) then
	    result.ival = zext(args(1).strdes.dsc$w_maxstrlen)
	  else
	    result.ival = result.ival - 1
	  endif
	  result.type = symb_typ_int
          call dix_eval_sign_extend(result)
	elseif(dix_util_match(funcnam,'F$CHAR')) then
c
c F$CHAR(int)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_int) goto 31
	  if(args(1).ival .lt. 0 .or. args(1).ival .gt. 255)goto 41
	  kar = char(args(1).ival)
	  call dix_eval_fill_char(result.strdes,kar)
	  result.type = symb_typ_char
	elseif(dix_util_match(funcnam,'F$EXIS|TS')) then
C
C F$EXIST
C 
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31	
	  call dix_eval_upcase(args(1).strdes,work,nk_work)
	  result.type = symb_typ_log
	  result.lval = dix_symbol_find(control,work(1:nk_work),symbval)
	elseif(dix_util_match(funcnam,'F$FIEL|D')) then
c
c F$FIELD(fieldname,what)
c
	  if(narg .gt. 3) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  if(args(2).type .ne. symb_typ_char) goto 32	
	  if(args(3).type .ne. symb_typ_none) then
	    if(args(3).type .ne. symb_typ_int) goto 33	
	  endif
c
	  call dix_eval_copy_char_fix(args(2).strdes,work,nk_work)
	  argvals= 'EXISTS|TYPE|OFFSET|SIZE|BITOFFSET|'//
     1         'FIELD|NDIM|LOWDIM|HIGHDIM'
	  istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	  if(.not. istat) goto 50
c
c See if we can find the field
c
	  istat = dix_des_find_field(control,args(1).strdes,des_rec,
     1              set_dep,ptr,.false.)
c
c Now act on resut of find_field
c for exists just report the status
c
	  if(work(1:1) .eq. 'E') then
	    if(narg .ne. 2) goto 20
	    result.type = symb_typ_log
	    result.lval = istat
	    istat = 1
	  else
c
c For all other items, istat must be .true.
c
	    if(istat) then
c
c Field was found, get the info
c
	      if(work(1:1) .eq. 'T') then
	        if(narg .ne. 2) goto 20
	        call dix_util_get_type_name(des_rec.ent_type,
     1                         work1,nk_work1,flag)
	        if((des_rec.flags .and. des_flag_is_field) .ne.0) then
	          call sys$fao('*!UL.!UL',k,work1(nk_work1+1:),
     1                     %val(des_rec.size/8),
     1                     %val(mod(des_rec.size,8)))
	        else
	          call sys$fao('*!UL'    ,k, ,k,work1(nk_work1+1:),
     1                     %val(des_rec.size/8))
	        endif
	        call dix_eval_fill_char(result.strdes,work1(1:nk_work1))
	        result.type = symb_typ_char
	      elseif(work(1:1) .eq. 'B') then   !bit offset
	        if(narg .ne. 2) goto 20
	        result.type = symb_typ_int
	        result.ival = des_rec.bit_offset
                call dix_eval_sign_extend(result)
	      elseif(work(1:1) .eq. 'O') then   !byte offset
	        if(narg .ne. 2) goto 20
	        result.type = symb_typ_int
	        result.ival = des_rec.bit_offset/8
                call dix_eval_sign_extend(result)
	      elseif(work(1:1) .eq. 'F') then   !is bit_field
	        if(narg .ne. 2) goto 20
	        result.type = symb_typ_log
	        result.lval = (des_rec.flags .and. des_flag_is_field) .ne.0
	      elseif(work(1:1) .eq. 'S') then	!size in bits
	        if(narg .ne. 2) goto 20
	        result.type = symb_typ_int
	        result.ival = des_rec.size
                call dix_eval_sign_extend(result)
	      elseif(work(1:1) .eq. 'N') then	!#dimensions
	        if(narg .ne. 2) goto 20
	        p_des_rec_fil = des_rec.link_back
	        ndim = 0
	        do k=1,max_dimension
	          if(des_rec_fil.rep.dim(k).high .gt. 
     1               des_rec_fil.rep.dim(k).low) then
	            ndim = k
	          endif
	        end do
	        result.ival = ndim
	        result.type = symb_typ_int
                call dix_eval_sign_extend(result)
	      elseif(work(1:1) .eq. 'L' .or. work(1:1) .eq. 'H') then	!low-highdim 
	        p_des_rec_fil = des_rec.link_back
	        do k=1,max_dimension
	          if(des_rec_fil.rep.dim(k).high .gt. 
     1               des_rec_fil.rep.dim(k).low) then
	            ndim = k
	          endif
	        end do
	        if(args(3).ival .lt. 1 .or. args(3).ival .gt. ndim) goto 43
	        if(work(1:1) .eq. 'L') then
	          result.ival = des_rec_fil.rep.dim(args(3).ival).low
	        else
	          result.ival = des_rec_fil.rep.dim(args(3).ival).high
	        endif
	        result.type = symb_typ_int	        
                call dix_eval_sign_extend(result)
	      endif	    
	    else
	      call dix_eval_copy_char_fix(args(1).strdes,err_arg,nk_work)
	      istat = %loc(dix_msg_fldnotf)
	      goto 50
	    endif
	  endif
	elseif(dix_util_match(funcnam,'F$FEXI|STS')) then
c
c F$FEXISTS(fieldname)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  call dix_eval_upcase(args(1).strdes,work,nk_work)
	  result.type = symb_typ_log
	  result.lval = dix_des_find_field(control,work(1:nk_work),
     1             des_rec,set_dep,ptr,.false.)
	elseif(dix_util_match(funcnam,'F$TYPE')) then
c
c F$TYPE(symbolname)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31	
	  call dix_eval_upcase(args(1).strdes,work,nk_work)
	  if(dix_symbol_find(control,work(1:nk_work),symbval)) then
	    call dix_symbol_type(symbval,work,nk_work,.false.,.true.)
	    call dix_eval_fill_char(result.strdes,work(1:nk_work))
	    result.type = symb_typ_char
	  else
	    call dix_eval_copy_char_fix(args(1).strdes,err_arg,nk_work)
	    istat = %loc(dix_msg_symbnotf)
	    goto 50
	  endif
	elseif(dix_util_match(funcnam,'F$VER|IFY')) then
c
c f$verify()
c f$verify(1), f$verify(true)
c f$verify(0), f$verify(false)
c Get old verify mode, and optionally set it
c  this function has an intended side effect  (changing verify)
c
	  if(narg .gt. 1) goto 20
	  k = -1		!assume not there
	  if(narg .eq. 1) then
	    if(args(1).type .eq. symb_typ_int) then
	      k = 0
	      if(args(1).ival) k = 1
	    elseif(args(1).type .eq. symb_typ_log) then
	      k = 0
	      if(args(1).lval) k = 1
	    elseif(args(1).type .eq. symb_typ_none) then
c
c Do not change
c
	    else
	      goto 31
	    endif
	  endif
	  result.lval = dix_inter_set_ver(control,k)
	  result.type = symb_typ_log
	elseif(dix_util_match(funcnam,'F$FTYP|E')) then
c
c F$FTYPE(fielaneme)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  call dix_eval_upcase(args(1).strdes,work,nk_work)
	  if(dix_des_find_field(control,work(1:nk_work),des_rec,
     1                    set_dep,ptr,.false.)) then
	    call dix_util_get_type_name(des_rec.ent_type,work1,nk_work1,flag)
	    if((des_rec.flags .and. des_flag_is_field) .ne.0) then
	      call sys$fao('*!UL.!UL',k,work1(nk_work1+1:),
     1                     %val(des_rec.size/8),
     1                     %val(mod(des_rec.size,8)))
	    else
	      call sys$fao('*!UL'    ,k,work1(nk_work1+1:),
     1                     %val(des_rec.size/8))
	    endif
	    nk_work1 = nk_work1 + 1
	    call dix_eval_fill_char(result.strdes,work1(1:nk_work1))
	    result.type = symb_typ_char
	  else
	    call dix_eval_copy_char_fix(args(1).strdes,err_arg,nk_work)
	    istat = %loc(dix_msg_fldnotf)
	    goto 50
	  endif
	elseif(dix_util_match(funcnam,'%DATA')) then
c
c %DATA(type,file)
c
	  if(narg .gt. 2) goto 20
	  istat = dix_eval_set_file(control,args(2),ptr_file,err_arg,.false.)
	  if(istat .eq. %loc(dix_msg_wrargtyp)) goto 32
	  if(.not. istat) goto 90
	  p_file_info = ptr_file
c
	  work(1:1) = 'D'
	  if(args(1).type .ne. symb_typ_none) then
	    if(args(1).type .ne. symb_typ_char) goto 31
	    call dix_eval_copy_char_fix(args(1).strdes,work,nk_work)
	    argvals = 'DATA|SAVE|VFC'
	    istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	  endif
c
	  if(    work(1:1) .eq. 'D') then
	    descr(1) = file_info.data.nb_data
	    descr(2) = %loc(file_info.data.data_rec)
	  elseif(work(1:1) .eq. 'S') then
	    if(file_info.modify) then
c
c Data may be changed
c
	      descr(1) = file_info.data.nb_sav
	      descr(2) = %loc(file_info.data.data_sav)
	    else
c
c Data was not changed, take from normal record
c
	      descr(1) = file_info.data.nb_data
	      descr(2) = %loc(file_info.data.data_rec)
	    endif
	  elseif(work(1:1) .eq. 'V') then
	    descr(1) = file_info.data.nb_vfc
	    descr(2) = %loc(file_info.data.vfc_data)
	  endif
	  result.type = symb_typ_char	  
	  call dix_eval_copy_char_dyn(descr,result.strdes)
	elseif(dix_util_match(funcnam,'%RECORDNUMBER')) then
c
c %RECORDNUMBER([file])
c               
	  if(narg .gt. 1) goto 20
	  istat = dix_eval_set_file(control,args(1),ptr_file,err_arg,.false.)
	  if(istat .eq. %loc(dix_msg_wrargtyp)) goto 32
	  if(.not. istat) goto 90
	  p_file_info = ptr_file
	  result.ival = file_info.rec_nr
	  result.type = symb_typ_int
          call dix_eval_sign_extend(result)
	elseif(dix_util_match(funcnam,'%RECORDSIZE')) then
c
c %RECORDSIZE([what],[file])
c
	  if(narg .gt. 2) goto 20
	  istat= dix_eval_set_file(control,args(2),ptr_file,err_arg,.false.)
	  if(istat .eq. %loc(dix_msg_wrargtyp)) goto 32
	  if(.not. istat) goto 90
	  p_file_info = ptr_file
c
	  work(1:1) = 'D'
	  if(args(1).type .ne. symb_typ_none) then
	    if(args(1).type .ne. symb_typ_char) goto 31
	    call dix_eval_copy_char_fix(args(1).strdes,work,nk_work)
	    argvals = 'DATA|SAVE|VFC'
	    istat = dix_eval_check_arg(work(1:nk_work),argvals,err_arg)
	    if(.not. istat) goto 50
	  endif
	  if(    work(1:1) .eq. 'D') then
	    result.ival = file_info.data.nb_data
	  elseif(work(1:1) .eq. 'S') then
	    result.ival = file_info.data.nb_sav
	  elseif(work(1:1) .eq. 'V') then
	    result.ival = file_info.data.nb_vfc
	  endif
	  result.type = symb_typ_int
          call dix_eval_sign_extend(result)
	elseif(dix_util_match(funcnam,'%LOC') .or.
     1         dix_util_match(funcnam,'%BLOC')) then
c
c %LOC(fieldname), %BLOC(fieldname)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  call dix_eval_upcase(args(1).strdes,work,nk_work)
	  if(.not. dix_des_find_field(control,work(1:nk_work),
     1             des_rec,set_dep,ptr,.false.)) then
	    istat = %loc(dix_msg_fldnotf)
	    err_arg = work(1:nk_work)
	    goto 50	  
	  endif
	  result.ival = des_rec.bit_offset
	  if(funcnam(2:2) .ne. 'B') result.ival = result.ival /8
	  result.type = symb_typ_int
          call dix_eval_sign_extend(result)
	elseif(dix_util_match(funcnam,'F$ICHA|R')) then
c
c F$ICHAR(string)
c
	  if(narg .ne. 1) goto 20
	  if(args(1).type .ne. symb_typ_char) goto 31
	  if(zext(args(1).strdes.dsc$w_maxstrlen) .ne. 1) goto 41
	  istat = str$left(kar,args(1).strdes,1)
	  result.ival = ichar(kar)
	  result.type = symb_typ_int
          call dix_eval_sign_extend(result)
	else
	  err_arg = funcnam
	  istat = %loc(dix_msg_invfunc)
	  goto 90
	endif
	goto 90
20	err_arg = funcnam
	istat = %loc(dix_msg_wrargcnt)
  	goto 90
c
c Wrarg type 1,2,3
c
31	iha = 1
	goto 38
32	iha = 2
	goto 38
33	iha = 3
	goto 38
34	iha = 4
	goto 38
35	iha = 5
	goto 38
36	iha = 6
38	istat = %loc(dix_msg_wrargtyp)
	goto 49
c
c Wrong argument values
c
41	iha = 1
	goto 48
42	iha = 2
	goto 48
43	iha = 3
	goto 48
48	istat = %loc(dix_msg_wrargval)
49	call sys$fao('!AS argument !UL',nk,err_arg,funcnam,%val(iha))
	if(nk .lt. len(err_arg)) err_arg(nk+1:) = ' '
	goto 90
c
50	k = dix_util_get_len_fu(err_arg)
	err_arg(k+1:) = ' for '//funcnam
	k = dix_util_get_len_fu(err_arg)
	nk1 = dix_util_get_len_fu(argvals)
	if(nk1 .gt. 0) then
	  err_arg(k+1:) = '(valid are '//argvals(1:nk1)//')'
	endif
	goto 90
c
60	call sys$fao('!UL, it must be >=0 and <!UL',nk,err_arg,
     1            %val(keynr),%val(file_info.nkey))
	err_arg(nk+1:) = ' '
	istat = %loc(dix_msg_illkeyna)
	goto 90
61	istat = %loc(dix_msg_notindex)
	err_arg = file_info.fnam
	goto 90
62	istat = %loc(dix_msg_segmerr)
	call sys$fao('!UL',nk,err_arg,%val(k))
	err_arg(nk+1:) = ' '
	goto 90
c
65	istat = %loc(dix_msg_aroverfl)
	goto 90
c
85	call dix_eval_copy_char_fix(args(iha).strdes,err_arg,k)
	if(k .lt. len(err_arg)) err_arg(k+1:) = ' '
	istat = %loc(dix_msg_desnotf)
	goto 90
c
90	call dix_util_free_descr(symbval.strdes)
	dix_eval_func = istat
	return
	end
	function dix_eval_set_file(control,arg,ptr_file,err_arg,quiet)
	implicit none
c
c  Try to set a file pointer to an argument the
c   user has given.
c   the argument may be integer: the n'th file
c                    or char   : the tag of the file
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	record /value/ arg		!:i: the argument
	integer*4 ptr_file   		!:o: the ptr or 0
	character*(*) err_arg	        !:o: error text
	logical quiet			!:i: do not signal not found
	integer*4 dix_eval_set_file	!:f: result
c#
	record /file_info/ file_info
	pointer (p_file_info,file_info)
c
	integer*4 k,nk_name,istat
	character*(max_handle_name_length) name
c
	external dix_msg_wrargtyp
	external dix_msg_filnotf
c
c Assume current
c
	p_file_info = control.cur_file
	istat = 1
c
	if(arg.type .eq. symb_typ_int) then
	  p_file_info = control.top_file
	  k = arg.ival
	  do while(p_file_info .ne. 0)
	    k = k - 1
	    if(k .eq. 0) goto 90
	    p_file_info = file_info.link.forw
	  end do
	  call sys$fao('!UL',k,err_arg,%val(arg.ival))
	  goto 80
c
	elseif(arg.type .eq. symb_typ_char) then
          call dix_eval_copy_char_fix(arg.strdes,name,nk_name)
          call str$upcase(name(1:nk_name),name(1:nk_name))
          p_file_info = control.top_file
          do while(p_file_info .ne. 0)
            if(file_info.handle .eq. name(1:nk_name)) goto 90
            p_file_info = file_info.link.forw
          enddo
	  call dix_eval_copy_char_fix(arg.strdes,err_arg,k)
	  goto 80
c
c Not found
c
	elseif(arg.type .eq. symb_typ_none) then
	  goto 90
	elseif(arg.type .ne. symb_typ_none) then
	  istat = %loc(dix_msg_wrargtyp)
        endif
80	if(arg.type .eq. symb_typ_int .and. quiet) then
	  p_file_info = 0
	  istat = 1
	else
	  if(k .lt. len(err_arg)) err_arg(k+1:) = ' '
	  istat = %loc(dix_msg_filnotf)
	endif
	goto 90
c
90	ptr_file = p_file_info
	dix_eval_set_file = istat
	return
	end
	function dix_eval_set_des(arg,file,p_des,quiet)
	implicit none
c
c Try to set the description to athe value the user gave
c
	include 'dix_def.inc'
	record /value/ arg		!:i: the argument
	record /file_info/ file		!:i: the file
	integer*4 p_des			!:o: pointer to description
	logical quiet			!:i: singal error
	integer*4 dix_eval_set_des	!:f: result
c#
	record /des_expanded/ des_expanded
	pointer (p_des_expanded,des_expanded)
	character*(max_line_length) what
c
	external dix_msg_wrargtyp
	external dix_msg_desnotf
c
	integer*4 nk_what,k,istat
c
	p_des_expanded = file.top_des
	istat = 1
c
	if(arg.type .eq. symb_typ_int) then
	  k = arg.ival
	  do while(p_des_expanded .ne. 0)
	    k = k - 1
	    if(k .eq. 0) goto 90
	    p_des_expanded = des_expanded.link.forw
	  end do
	  goto 50
	elseif(arg.type .eq. symb_typ_char) then
	  call dix_eval_copy_char_fix(arg.strdes,what,nk_what)
	  call str$upcase(what(1:nk_what),what(1:nk_what))
	  do while(p_des_expanded .ne. 0)
	    if(des_expanded.handle .eq. what(1:nk_what)) goto 90
	    p_des_expanded = des_expanded.link.forw
	  enddo
	  goto 50
	elseif(arg.type .eq. symb_typ_none) then
	  p_des_expanded = file.cur_des		!take the current des
	else
	  istat = %loc(dix_msg_wrargtyp)
	  p_des_expanded = 0
	endif
	goto 90	
50	if(quiet) then
	  istat = 1
	else
	  istat = %loc(dix_msg_desnotf)
	endif
	p_des_expanded = 0
c
90	p_des = p_des_expanded
	dix_eval_set_des = istat
	return
	end
	function dix_eval_check_arg(arg,allowed,err_arg)
	implicit none
c
c Check arg if it is a known value
c  arg    = input value
c allowed = a | separated string with allowed options
c
	character*(*) arg		!:io: the user argument (updated)
	character*(*) allowed		!:i: allowed options
	character*(*) err_arg		!:i: error argument
	integer dix_eval_check_arg	!:f: function result
c#
	logical dix_util_check_field
c
	integer*4 k,istat,nk,nk1
c
	integer*4 dix_util_get_len
c
	call str$upcase(arg,arg)
	nk1 = dix_util_get_len(arg)
	nk = dix_util_get_len(allowed)
	istat = dix_util_check_field(arg(1:nk1),allowed(1:nk),k)
	if(istat) then
	  call str$element(arg,k,'|',allowed)
	else
	  err_arg = arg
	endif
	dix_Eval_check_arg = istat
	return
	end
	function dix_eval_trnlnm(lognam,table,idx,mode,option,
     1         what,result)
	implicit none
c
cEvaluate if lognam is a logical
c
	include 'dix_def.inc'
	character*(*) lognam		!:i: logical-name
	character*(*) table		!:i: table name
	integer*4 idx			!:i: index of translation
	character*(*) mode		!:i: trans mode (U,S,E,K)
	character*(*) option		!:i: How (interlocked?)
	character*(*) what		!:i: what do we want
	record /value/ result		!:o: result value
	integer*4 dix_eval_trnlnm	!:f: function result
c#
	character*(max_line_length) work
	integer*4 nk_work
c
	structure /item/
	  integer*2 buflen
	  integer*2 opcode
	  integer*4 bufadr
	  integer*4 retadr
	end structure
	record /item/ items(4)
c
	logical got_attr
	integer*4 attr,nit,ival,istat
	byte accmode
c
	volatile ival,work,nk_work
c
	include '($psldef)'
	include '($lnmdef)'
c
c Some parameters not valid for older vms versions
c
        PARAMETER MYLNM$M_CLUSTERWIDE = '00020000'X
        PARAMETER MYLNM$M_INTERLOCKED = '04000000'X
c
c
	integer*4 sys$trnlnm
	external ss$_nolognam
c
	attr = lnm$m_case_blind
	if(index(option,',C') .ne. 0) attr = 0
	if(index(option,',I') .ne. 0) attr = attr .or. MYlnm$m_interlocked
	nit = 0
	got_attr = .false.
	nk_work = 0
c
	if(what(1:4) .eq. 'VALU' .or. what(1:4) .eq. 'LENG' .or. 
     1     what(1:6) .eq. 'TABLE_') then
c
c Values
c
	  if(idx .gt. 0) then
	    nit = nit + 1
	    items(nit).opcode= lnm$_index
	    items(nit).buflen = 4
	    items(nit).bufadr = %loc(idx)
	    items(nit).retadr = 0
	  endif
	  nit = nit + 1
	  if(what(1:4) .eq. 'VALU') then
	    items(nit).opcode= lnm$_string
	    items(nit).buflen = len(work)
	    items(nit).bufadr = %loc(work)
	    items(nit).retadr = %loc(nk_work)
	    result.type = symb_typ_char
	  elseif(what(1:6) .eq. 'TABLE_') then
	    items(nit).opcode= lnm$_table
	    items(nit).buflen = len(work)
	    items(nit).bufadr = %loc(work)
	    items(nit).retadr = %loc(nk_work)
	    result.type = symb_typ_char
	  else
	    items(nit).opcode= lnm$_length
	    items(nit).buflen = 4
	    items(nit).bufadr = %loc(result.ival)
	    items(nit).retadr = 0
	    result.type = symb_typ_int
	  endif
	elseif(what(1:4) .eq. 'MAX_') then
	  nit = nit + 1
	  items(nit).opcode= lnm$_max_index
	  items(nit).buflen = 4
	  items(nit).bufadr = %loc(ival)
	  items(nit).retadr = 0
	  result.type = symb_typ_int
	elseif(what(1:4) .eq. 'ACCE') then
	  nit = nit + 1
	  items(nit).opcode= lnm$_acmode
	  items(nit).buflen = 4
	  items(nit).bufadr = %loc(ival)
	  items(nit).retadr = 0
	else
	  got_attr = .true.
	  nit = nit + 1
	  items(nit).opcode= lnm$_attributes
	  items(nit).buflen = 4
	  items(nit).bufadr = %loc(ival)
	  items(nit).retadr = 0
	  result.type = symb_typ_int
	endif		 
	nit = nit + 1
	items(nit).opcode = 0
	items(nit).buflen = 0
c
	if(mode .eq. ' ') then
	  istat = sys$trnlnm(attr,table,lognam,,items)
	else
	  if(mode(1:1) .eq. 'U') accmode = psl$c_user
	  if(mode(1:1) .eq. 'S') accmode = psl$c_super
	  if(mode(1:1) .eq. 'E') accmode = psl$c_exec
	  if(mode(1:1) .eq. 'K') accmode = psl$c_kernel
	  istat = sys$trnlnm(attr,table,lognam,accmode,items)
	endif
	if(istat .eq. %loc(ss$_nolognam)) then
	  istat = 1
	  call dix_util_free_descr(result.strdes)
	  result.type = symb_typ_char
	  goto 90
	endif
	if(istat) then
	  if(what(1:4) .eq. 'ACCE') then
	    result.type = symb_typ_char
	    if(ival .eq. psl$c_user)   work = 'USER'
	    if(ival .eq. psl$c_super)  work = 'SUPERVISOR'
	    if(ival .eq. psl$c_exec)   work = 'EXECUTIVE'
	    if(ival .eq. psl$c_kernel) work = 'KERNEL'
	    nk_work = index(work,' ')-1
	    call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  elseif(what(1:4) .eq. 'VALU') then
	    if(work(1:1) .eq. ESCAPE .and. work(2:2) .eq. NULL) then	!luns
	      work = work(5:nk_work)
	      nk_work = nk_work - 4
	    endif	   
	    call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  elseif(what(1:6) .eq. 'TABLE_') then
	    call dix_eval_fill_char(result.strdes,work(1:nk_work))
	  elseif(got_attr) then
	    result.type = symb_typ_log
	    if(    what(1:4) .eq. 'CONF') then
	      result.lval = (ival .and. lnm$m_confine)   .ne. 0
	    elseif(what(1:4) .eq. 'CONC') then
	      result.lval = (ival .and. lnm$m_concealed) .ne. 0
	    elseif(what(1:4) .eq. 'EXIS') then
	      result.lval = (ival .and. lnm$m_exists)    .ne. 0
	    elseif(what(1:4) .eq. 'CREL') then
	      result.lval = (ival .and. lnm$m_crelog)    .ne. 0
	    elseif(what(1:4) .eq. 'NO_A') then
	      result.lval = (ival .and. lnm$m_no_alias)  .ne. 0
	    elseif(what(1:6) .eq. 'TABLE ') then
	      result.lval = (ival .and. lnm$m_table)      .ne. 0
	    elseif(what(1:4) .eq. 'CLUS') then
	      result.lval = (ival .and. MYlnm$m_clusterwide).ne. 0
	    elseif(what(1:4) .eq. 'TERM') then
	      result.lval = (ival .and. lnm$m_terminal)   .ne. 0
	    endif
	  endif
	endif
c
c Do sign extension, (may not be needed, if int size=4)
c 
	if(result.type .eq. symb_typ_int) then
	  call dix_Eval_sign_extend(result)
	endif
90	dix_eval_trnlnm = istat
	return
	end
	function dix_eval_getdvi(devnam,what,result)
	implicit none
c
c Getdvi function
c
	include 'dix_def.inc'
c
	character*(*) devnam		!:i: devicename
	character*(*) what		!:i: what do we want
	record /value/ result		!:o: result value
	integer*4 dix_eval_getdvi	!:f: function result
c#
	structure /item/
	  integer*2 buflen
	  integer*2 opcode
	  integer*4 bufadr
	  integer*4 retadr
	end structure
	record /item/ items(4)
c
        include '($dvidef)'
c
	character*(max_filename_length) work
	logical*4 opened
	integer*4 istat,lun,nk_work
	integer*4 sys$getdviw
	integer*4 lib$getdvi
c
	volatile result,nk_work,work
c
	structure /homeblock/
	  union
	    map
	      byte data(512)
	    end map
	    map
              integer*4 homelbn
              integer*4 alt_homelbn
              integer*4 alt_idxlbn
              byte struclev(2)
              integer*2 cluster
              integer*2 homevbn
              integer*2 althomevbn
              integer*2 altidxvbn
              integer*2 ibmapvbn
              integer*4 ibmaplbn
              integer*4 maxfiles
	      integer*2 ibmapsize
	    end map
	  end union
	end structure
	record /homeblock/ homeblock
c
c
	if(what(1:4) .eq. 'MAXF') then
	  items(1).buflen = 4
	  items(1).opcode = dvi$_maxfiles
	  items(1).bufadr = %loc(result.ival)
	  result.type = symb_typ_int
	elseif(what(1:4) .eq. 'MAXB') then
	  items(1).buflen = 4
	  items(1).opcode = dvi$_maxblock
	  items(1).bufadr = %loc(result.ival)
	  result.type = symb_typ_int
	elseif(what(1:4) .eq. 'VOLN') then
	  items(1).buflen = len(work)
	  items(1).opcode = dvi$_volnam
	  items(1).bufadr = %loc(work)
	  items(1).retadr = %loc(nk_work)
	  result.type = symb_typ_char
	elseif(what(1:4) .eq. 'EXIS') then
	  items(1).buflen = 4
	  items(1).opcode = dvi$_devchar
	  items(1).bufadr = %loc(result.lval)
	  result.type = symb_typ_log
	elseif(what(1:4) .eq. 'BLNR') then
	  call lib$get_lun(lun)
	  nk_work = 0
	  opened = .false.
	  istat = lib$getdvi(dvi$_devnam,,devnam,,work,nk_work)
	  if(istat) then
	    call dix_append(nk_work,work,'[000000]indexf.sys;1')
	    open(lun,file=work(1:nk_work),
     1         access='direct',
     1         form='unformatted',
     1         status='old',
     1         shared,readonly,
     1         err=12)
	    opened = .true.
	    read(lun,rec=2,err=12) homeblock
	    result.ival = zext(homeblock.ibmapvbn)+zext(homeblock.ibmapsize)-1
	    result.type = symb_typ_int
	    istat = 1
	    goto 14
12	    call errsns(,istat)
14	    if(opened) close(lun)
	  endif
	  call lib$free_lun(lun)
	  goto 90
	endif
c
	istat = sys$getdviw(,,devnam,items,,,,)
	goto 90
c
c
90	if(what(1:4) .eq. 'EXIS') then
	  result.ival = istat
	  istat = 1
	endif
	if(result.type .eq. symb_typ_char) then
	  call dix_eval_fill_char(result.strdes,work(1:nk_work))
	endif
c
c Do sign extension, (may not be needed, if int size=4)
c 
	if(result.type .eq. symb_typ_int) then
	  call dix_Eval_sign_extend(result)
	endif
	dix_eval_getdvi = istat
	return
	end	  
	subroutine dix_eval_envi(control,what,result)
	implicit none
c
c the F$ENVIRONMENT funciton
c
	include 'dix_def.inc'
	record /control/ control	!:i: control block
	character*(*) what		!:i: what do we want
	record /value/ result		!:o: value result
c#
	include '($stsdef)'
	include '($jpidef)'
c
	character*(max_filename_length) line
	integer*4 nk
	logical*4 dix_inter_set_ver
c
	if(what(1:1) .eq. 'D') then
c
c Depth
c
	  result.type = symb_typ_int
	  result.ival = control.depth
	elseif(what(1:1) .eq. 'M') then
c
c Message flag
c
	  result.type = symb_typ_char
	  call dix_inter_conv_msg(control.msgmask,line,nk)	
	elseif(what(1:4) .eq. 'ON_S') then
c
c On severity
c
	  result.type = symb_typ_char
	  call dix_inter_get_file_level_info(control,'OS',nk,line)
	elseif(what(1:4) .eq. 'ON_A') then
c
c On action (what to do)
c
	  result.type = symb_typ_char
	  call dix_inter_get_file_level_info(control,'OA',nk,line)
	elseif(what(1:4) .eq. 'PROC') then
c
c Procedure
c
	  result.type = symb_typ_char
	  call dix_inter_get_file_level_info(control,'PR',nk,line)
	elseif(what(1:4) .eq. 'PROM') then
c
c Prompt
c
	  result.type = symb_typ_char
	  nk = control.nk_prompt
	  line = control.prompt
	elseif(what(1:3) .eq. 'PRC') then
c
c Processname
c
	  call lib$getjpi(jpi$_prcnam,,,,line,nk)
	  result.type = symb_typ_char
	elseif(what(1:1) .eq. 'I') then
c
c Interactive mode
c
	  result.type = symb_typ_log
	  result.lval = control.is_term
	elseif(what(1:1) .eq. 'S') then
c
c Strict setting
c
	  result.type = symb_typ_char
	  call dix_inter_conv_strict(control.strict_mode,line,nk)	
	elseif(what(1:1) .eq. 'V') then
c
c Verify setting
c
	  result.lval = dix_inter_set_ver(control,-1)	!do not change
	  result.type = symb_typ_log
	endif
	if(result.type .eq. symb_typ_char) then
	  call dix_eval_copy_char_dyn(line(1:nk),result.strdes)
	endif
c
c Do sign extension, (may not be needed, if int size=4)
c 
	if(result.type .eq. symb_typ_int) then
	  call dix_Eval_sign_extend(result)
	endif
	return
	end	
	subroutine dix_eval_cvt_float(control,real_val,rval,ent_type,
     1                                overflow,real_size)
	implicit none
c
c Convert the real in real_val (in various formats) to the 
c  real "rval". 
c
c
	include 'dix_def.inc'
c
	record /control/ control!:i: control block
	integer*2 real_val(*)	!:i: the real value in float_* format
	real*4 rval		!:o: the real in float_s or float_f value
	integer*4 real_size	!:i: the real size wanted (4,8,16)
	integer*4 ent_type	!:i: the type of real_val
	logical*4 overflow	!:o: true if overflow detected
c
	integer*4 format
c
c Convert to the native floating point format
c  for 32 bits : vax real_f alpha real_f ipf real_s
c      64 bits : vax real_d alpha real_g ipf real_t
c     128 bits : vax real_h alpha real_x ipf real_x
c
	call dix_con_cvt_float_type(control,real_size,format)
c
	call dix_con_cvt_float(control,real_val,ent_type,
     1                         rval,format,overflow)
	return
	end
	function dix_eval_strfun(control,oper,s1,s2,res,size,ndig)
	implicit none
c
c Operate a string type mathematical function
c  str$add, str$div, str$,mul
c
	include 'dix_def.inc'
	include '($dscdef)'
c
	record /control/ control!:i: control block
	character oper		!:i: operation A,S,M,D
	character*(*) s1        !:i: source string1
	character*(*) s2        !:i: source string2
	record /strdef/ res	!:o: dest string
	integer*4 size		!:i: width of size
c				!    <0, means zero filled
c				!    >0, means blank filled
	integer*4 ndig		!:i: divide fraction digits
	integer*4 dix_eval_strfun
c
	integer*4 sign1,expon1,trunc
	integer*4 sign2,expon2
c
	integer*4 exponr,signr
c
	integer*4 istat,nk
c
	record /strdef/ str1,str2,strr,expdesc
	record /strdef/ descr1,descr2
c
	integer*4 dix_eval_check_num
	integer*4 str$add
	integer*4 str$mul
	integer*4 str$divide
	integer*4 str$dupl_char
	integer*4 str$concat
	integer*4 str$append
c	integer*4 str$len_extr
c	integer*4 str$copy_dx
c
	call dix_eval_init_char(strr)
	call dix_eval_init_char(expdesc)
c
	call dix_eval_init_char(str1)
	call dix_eval_init_char(str2)
c
	istat = dix_eval_check_num(s1,sign1,expon1,str1)
	if(.not.istat) goto 90
c
	istat = dix_eval_check_num(s2,sign2,expon2,str2)
	if(.not.istat) goto 90
c
c Now locate the .
c
	if(oper .eq. 'A' .or. oper .eq. 'S') then
	  if(oper .eq. 'S') sign2 = 1 - sign2
	  
	  istat = str$add(sign1,expon1,str1,
     1                    sign2,expon2,str2,
     1                    signr,exponr,strr)
	elseif(oper .eq. 'D') then
	  trunc = 0
	  if(control.decimal_round) trunc = 1
	  istat = str$divide(sign1,expon1,str1,
     1                       sign2,expon2,str2,
     1                       ndig,trunc,
     1                       signr,exponr,strr)
	elseif(oper .eq. 'M') then
	  istat = str$mul(sign1,expon1,str1,
     1                    sign2,expon2,str2,
     1                    signr,exponr,strr)
	endif
	if(.not. istat) goto 90
c
	if(exponr .gt. 0) then
c
c Add trailing zero's if exponr>0
c
	  istat = str$dupl_char(expdesc,exponr,ichar('0'))
	  if(.not. istat) goto 90
	  istat = str$append(strr,expdesc)
	  if(.not. istat) goto 90
	elseif(exponr .lt. 0) then
c
c Now we need to insert a dot at pos -expon from the end
c the string contains 12345
c  and expon = -2
c we need the return 123.45
c
	  nk = strr.dsc$w_maxstrlen
c
c Take the part upto the .
c  we could use str$len_extr, but this moves memory around
c  and we do not need that
c
	  call dix_util_clear_descr(descr1,.false.)
          descr1.dsc$a_pointer   = strr.dsc$a_pointer
	  descr1.dsc$w_maxstrlen = nk+exponr
c
c Take the part after the dot
c
	  call dix_util_clear_descr(descr2,.false.)
          descr2.dsc$a_pointer   = strr.dsc$a_pointer + nk+exponr
	  descr2.dsc$w_maxstrlen = -exponr
c
	  istat = str$concat(strr,descr1,%descr('.'),descr2)
	  if(.not. istat) goto 90
	endif
c
c Now strr contains the resulting text, only the minus sign needs to be insert
c check for the size
c
	if(size .ne. 0) then
c
c Fixed size, see about the length
c
	  nk = strr.dsc$w_maxstrlen
	  if(signr .ne. 0) nk = nk + 1		!for the sign
	  if(nk .gt. iabs(size)) then
c
c Does not fit
c
	    istat = str$dupl_char(res,iabs(size),ichar('*'))
	    goto 90
	  endif
c
c Compute the number of chars to insert to make the size iabs(size)
c
	  nk = iabs(size) - nk
	  if(size .lt. 0) then
	    istat = str$dupl_char(expdesc,nk,ichar('0'))
	    if(.not. istat) goto 90
	  elseif(size .gt. 0) then
	    istat = str$dupl_char(expdesc,nk,ichar(' '))
	    if(.not. istat) goto 90
	  endif	    
	else
c
c Make an empty string
c
	  istat = str$dupl_char(expdesc,0,ichar(' '))
	  if(.not. istat) goto 90
	endif
c
c Now merge all in
c
	if(signr .ne. 0) then
c
c There was a minus sign
c
	  if(size .lt. 0) then
c
c Return -0000nnnn
c
	    istat = str$concat(res,%descr('-'),expdesc,strr)
	  else
c
c Return bbbb-nnnn
c
	    istat = str$concat(res,expdesc,%descr('-'),strr)
	  endif
	  if(.not. istat) goto 90
	else
c
c There was no minus sign
c
	  istat = str$concat(res,expdesc,strr)
	  if(.not. istat) goto 90
	endif
c
c
c Now append exponent part (if present)
c	  
90 	call str$free1_dx(strr)
 	call str$free1_dx(expdesc)
 	call str$free1_dx(str1)
 	call str$free1_dx(str2)
c
	dix_eval_strfun = istat
	return
	end
	function dix_eval_check_num(s,sign,expon,str)
	implicit none
c
c Check the  validity of the s string for a decimal number operation
c  Allow [sign]dddd[.ddd][[sign]Eddd]
c Return str   : only the digits (no exponent, no sign, and no fraction)
c        sign  : 0 for a positive (or zero) value, 1 for negative
c        expon : the exponent
c
c   so the value =  str*e**expon  (if sign=0) or
c                  -str*e**expon  (ig sign=1)
c 
	include 'dix_def.inc'
	character*(*) s		!:i: the string
	integer*4 expon		!:o: the exponent (if a dot found)
	integer*4 sign		!:o: the sign (1 for minue, 0 for positiv)
	record /strdef/ str	!:o: the resulting string without +/-/.
	integer*4 dix_eval_check_num  !:f: function result
c
	integer*4 k,bpos,epos,dpos,istat,exponent,exp_pos,exp_sign,epos1,iexp
c
	integer*4 str$copy_dx
	integer*4 str$concat
c
	bpos  = 0
	epos  = 0
	sign  = -1
	dpos  = 0
	exponent = 0
	exp_pos = 0
	exp_sign = -1
c
	istat = 0
c
	do k=1,len(s)
	  if(s(k:k) .eq. ' ') then
c
c Leading spaces are allowed, trailing not
c
	    if(bpos .ne. 0) goto 90
	  elseif(s(k:k) .eq. '-') then
c
c if already a -, error
c
	    if(exp_pos .eq. 0) then
	      if(bpos .ne. 0) goto 90	!only at begin
	      if(sign .ge. 0) goto 90	!only one sign
	      sign = 1
	    else
	      if(k .ne. exp_pos+1) goto 90 !only after E
	      exp_sign = 1
	    endif
	  elseif(s(k:k) .eq. '+') then
	    if(exp_pos .eq. 0) then
	      if(bpos .ne. 0) goto 90	!only at begin
	      if(sign .ge. 0) goto 90	!only one sign
	      sign = 0
	    else
	      if(k .ne. exp_pos+1) goto 90 !only after E
	      exp_sign = 0
	    endif
	  elseif(s(k:k) .eq. '.') then
	    if(exp_pos .ne. 0) goto 90	!not in exponent part
	    if(dpos .ne. 0) goto 90	!only one dot
	    dpos = k
	    if(bpos .eq. 0) bpos = k
	  elseif(s(k:k) .ge. '0' .and. s(k:k) .le. '9') then
c
c Valid digit
c
	    if(bpos .eq. 0) then
c
c If leading 0, skip
c
	      if(s(k:k) .ne. '0' .or. dpos .ne. 0) bpos = k
	    endif
	    if(exp_pos .eq. 0) then
c
c Skip trailing 0 (after the dot)
c
	      if(s(k:k) .ne. '0' .or. dpos .eq. 0) epos = k	    
	    endif
	    epos1 = k
	  elseif(s(k:k) .eq. 'E' .or. s(k:k) .eq. 'e') then
c
c Start of epos
c
	    if(exp_pos .ne. 0) goto 90
	    exp_pos = k
	  else
c
c Illegal char
c
	    goto 90
	  endif
	enddo
c
	if(sign .lt. 0) sign= 0
c
	expon = 0		!assume no fraction
c
	if(dpos .eq. 0) then
c
c No dot found
c 
 	  istat = str$copy_dx(str,s(bpos:epos))
	else
c
c We have a dot, 
c
	  if(epos .lt. dpos) then
c
c either no digits after the . or only "0"'s
c
 	    istat = str$copy_dx(str,s(bpos:epos))
	  else
	    istat = str$concat(str,s(bpos:dpos-1),s(dpos+1:epos))
	    expon = dpos-epos
	  endif
	endif
c
c Now see if there is an explicit exponent
c
	if(exp_pos .ne. 0) then
c
c The sign will also be converted, 
c
	  read(s(exp_pos+1:epos1),2000,err=90) iexp
2000	  format(bn,i10)
	  expon = expon + iexp
	endif
c
90	dix_eval_check_num = istat
	return
	end
	subroutine dix_eval_sign_extend(value)
	implicit none
c
c sign extend i*8 values
c
	include 'dix_def.inc'
	record /value/ value
c
	if(value.type .eq. symb_typ_int) then
	  call dix_util_sign_extend(value.i8val)
	endif
	return
	end
	subroutine dix_eval_radix(control,value,radix,separator,result,nk)
	implicit none
c
c Just for fun, convert an integer to a radix number
c
	include 'dix_def.inc'
	record /control/ control
	record /value/ value
	record /value/ radix	
	character*(*) separator
	character*(*) result
	integer*4 nk
c
	record /value/ resval
c
	character sign
	integer*4 nk1,rem
	character*(max_line_length) temp
c
	nk = 0
	sign = ' '
	if(control.integer_size .eq. 4) then
	  if(value.ival .eq. 0) then
	    nk = 1
	    result(1:1) = '0'
	    goto 90
	  endif
	  if(value.ival .lt. 0) then
	    value.ival = -value.ival
	    sign = '-'
	  endif
	else
	  if(value.i8val(1) .eq. 0 .and. value.i8val(2) .eq. 0) then
	    nk = 1
	    result(1:1) = '0'
	    goto 90
	  endif
	  if(value.i8val(2) .lt. 0) then
	    call dix_eval_i8_oper(value.i8val,0,value.i8val,'N')
	    sign = '-'
	  endif
	endif	    
c
	nk1 = 0
10	if(control.integer_size .eq. 4) then
	  if(value.ival .eq. 0) goto 90
	  rem = mod(value.ival,radix.ival)
	  value.ival = value.ival/radix.ival
	else
	  if(value.i8val(1) .eq. 0 .and. value.i8val(2) .eq. 0) goto 90
	  call dix_eval_i8_oper(value.i8val,radix.i8val,resval.i8val,'M')
	  call dix_eval_i8_oper(value.i8val,radix.i8val,value.i8val,'/')
	  rem = resval.ival	!assume 32 bits is enough
	endif
	if(separator .ne. ' ') then
c
c Include the separatoir *not in the begin)
c
	  if(nk .gt. 0) then
	    result(1:nk+len(separator)) = separator//result(1:nk)
	    nk = nk + len(separator)
	  endif
c
c And include the "digit" (as decimal number)
c
	  call sys$fao('!UL',nk1,temp,%val(rem))
	else
c
c include the "digit" as one character
c
	  nk1 = 1
	  if(rem .gt. 9) then
	    temp(1:1) = char(rem-10+ichar('A'))
	  else
	    temp(1:1) = char(rem+ichar('0'))
	  endif
	endif
	result(1:nk+nk1) = temp(1:nk1)//result(1:nk)
	nk = nk + nk1
	goto 10
c
90	if(sign .ne. ' ') then
	  result(1:nk+1) = sign//result(1:nk)
	  nk = nk + 1
	endif
	return
	end
	function dix_eval_cvt_to_decimal(control,value)
	implicit none
c
c Try to convert a type to decimal type 
c
	include 'dix_def.inc'
	record /control/ control
	record /value/ value
	integer*4 dix_eval_cvt_to_decimal
c
	character*(max_line_length) line,line1
	integer*4 nk,sign,k,exponent,istat
	integer*4 dix_eval_check_num
	integer*4 dix_util_get_len
c
	external dix_msg_invmixdeci
c
c The following types van be converted
c int,real,string
c
	if(value.type .eq. symb_typ_Int) then
	  sign = 0
	  if(control.integer_size .eq. 4) then
c
c Int*4
c
	    if(value.ival .lt. 0) then
	      sign = 1
	      value.ival = -value.ival
	    endif
	    call sys$fao('!UL',nk,line,%val(value.ival))
	  else
c
c Int*8
c
	    if(value.i8val(2) .lt. 0) then
	      sign = 1
	      call dix_eval_i8_oper(value,value,value,'N')
	    endif
	    call sys$fao('!@UX',nk,line,value.i8val)
c
	  endif
	  istat = 1
	  exponent = 0
	elseif(value.type .eq. symb_typ_char) then
c
c Convert ascii to "decimal"
c
	  istat = dix_eval_check_num(value.strdes,sign,exponent,line)
	  if(istat .eq. 0) istat = %loc(dix_msg_invmixdeci)
	  nk = dix_util_get_len(line)
c
	elseif(value.type .eq. symb_typ_real) then
c
c Get th current real type
c
	  call dix_con_cvt_float_type(control,control.real_size,k)
	  call dix_con_type_intasc(control.real_size,value.rval,
     1              k,line1,nk,control)
c
c Convert ascii to "decimal"
c
	  istat = dix_eval_check_num(line1(1:nk),sign,exponent,line)
	  if(istat .eq. 0) istat = %loc(dix_msg_invmixdeci)
	  nk = dix_util_get_len(line)
	else
	  istat = %loc(dix_msg_invmixdeci)
	endif
	if(istat) then
	  call dix_eval_fill_char(value.strdes,line(1:nk))
	  value.type = symb_typ_decimal
	  value.sign     = sign	  
	  value.exponent = exponent
	endif
	dix_eval_cvt_to_decimal = istat
	return
	end