	subroutine make_fvi(lunin)
c
c  create function variable interface (fvi) for FORTRAN
c input contains a list of subroutine/function names
c
c  - first part: function type
c        sys_ifun_  integer function
c        sys_rfun_  real function
c        sys_dfun_  double function
c        sys_call_  for subroutine
c  - subsequent letters:
c        i          integer argument
c        r          real argument
c        d          double argument
c        c          character(*) argument
c        e          external argument
c  if the argument list is empty, 0 is used
c
c 
c usage examples:
c
c   subroutine test1(cc, rr, ii)
c   character cc*(*)
c   real rr
c   integer ii
c   ...
c   end
c
c   integer function test2()
c   ...
c   end
c 
c   program test
c   ...
c   external test1, test2
c   integer*8 cod1, cod2
c   integer sys_ifun_0 ! function
c   character c8
c   real r
c   integer i
c   
c   ...

c   call sys_funadr(test1, cod1)
c   call sys_funadr(test2, cod2)
c   ...
c   call sys_call_cri(test1, c, r, i)
c   i=sys_ifun0(test2)
c   ...
c   end
c
	integer lunin

	character line*80, typ*8, system*16
	integer i,l,lc,lt, phase, iostat, lunout, typno
	integer underscores
	integer descriptor

	lunout=2
	if (lunout .eq. lunin) then
	  print *,'lun mismatch'
	  stop 'error in MAKE_FVI'
	endif
	call sys_check_system(system)
	call sys_fortran_interface(underscores, descriptor)
	call sys_open(lunout, 'sys_fvi.c', 'wo', iostat)
	if (iostat .ne. 0) then
	  print *,'cannot write sys_fvi.c'
	  stop 'error in MAKE_FVI'
	endif
	if (system .eq. 'VMS') then
	  system='Alpha VMS'
	elseif (system .eq. 'TRU64') then
	  system='Alpha Unix'
	elseif (system .eq. 'GNU') then
	  system='GNU (g77/gcc)'
	else
	  system = 'strange system'
	endif
	write(lunout,'(2a)')
	1 '/* FORTRAN function variable interface for ',system
	write(lunout,'(a)')
	1 ' * this file is created by fvi and should not be modified */'
	write(lunout,'(a)')
	1 '#include "fvi.c"'
	typno=1964
1	read(lunin,'(a)',end=99) line
	if (line(1:1) .eq. '!') goto 1
	do i=1,len(line)
	  if (line(i:i) .lt. 'a') then
	    if (line(i:i) .le. ' ') then
	      l=i-1
	      goto 10
	    endif
	    if (line(i:i) .ge. 'A' .and. line(i:i) .le. 'Z')
	1      line(i:i)=char(ichar(line(i:i))+32)
	  endif
	enddo
	print *,line
	stop 'too many arguments'
10	if (line(1:9) .eq. 'sys_ifun_') then
	  typ='int'
	  lt=3
	elseif (line(1:9) .eq. 'sys_rfun_') then
	  lt=5
	  typ='float'
	elseif (line(1:9) .eq. 'sys_dfun_') then
	  typ='double'
	  lt=6
	elseif (line(1:9) .eq. 'sys_call_') then
	  typ='void'
	  lt=4
	else
	  goto 19
	endif
	call fvi_putstr(typ(1:lt+1))
	call fvi_putstr(line(1:l))
	do i=1,underscores
	  call fvi_putstr('_')
	enddo
	call fvi_putstr('(int *funno')
	do phase=1,2
	  lc=0
	  if (line(10:l) .ne. '0') then
	    do i=10,l
	      if (i .ne. 10 .or. phase .eq. 1) then
	        call fvi_putstr(',')
	      endif
	      if (line(i:i) .eq. 'i') then
	        call fvi_putstr('int *a')
	        call fvi_putint(i-9)
	      elseif (line(i:i) .eq. 'r') then
	        call fvi_putstr('float *a')
	        call fvi_putint(i-9)
	      elseif (line(i:i) .eq. 'd') then
	        call fvi_putstr('double *a')
	        call fvi_putint(i-9)
	      elseif (line(i:i) .eq. 'c') then
	        if (descriptor .eq. 1) then
	          call fvi_putstr('void *a') ! descriptor
	        elseif (descriptor .eq. 0) then
	          call fvi_putstr('char *a') ! lengths are passed at end of argument list
	          lc=lc+1
	        else
	          stop 'unknown descriptor code'
	        endif
	        call fvi_putint(i-9)
	      elseif (line(i:i) .eq. 'e') then
	        call fvi_putstr('void (*a')
	        call fvi_putint(i-9)
	        call fvi_putstr(')(void)')
	      else
	        call fvi_putstr('*** error ***')
	        print *,line(1:l),' unknown type: ',line(i:i)
	      endif
	    enddo
	  else if (phase .eq. 2) then
	    call fvi_putstr('void')
	  endif
	  do i=1,lc
	    call fvi_putstr(',int a')
	    call fvi_putint(i+l-9)
	  enddo
	  call fvi_putstr(')')
	  if (phase .eq. 1) then
	    call fvi_putstr(' {')
	    call fvi_putln(lunout)
	    call fvi_putstr('  typedef ')
	    call fvi_putstr(typ(1:lt))
	    call fvi_putstr(' (*R)(')
	  endif
	enddo
	call fvi_putstr(';')
	call fvi_putln(lunout)
	call fvi_putstr('  int no=*funno;')
	call fvi_putln(lunout)
        call fvi_putstr('  if (list[no].t == ')
        call fvi_putint(typno)
        call fvi_putstr(') {')
	call fvi_putln(lunout)
        call fvi_putstr('    ')
        if (typ .ne. 'void') then
          call fvi_putstr('return ')
        endif
	call fvi_putstr('(*(R)list[no].r)(')
	if (line(10:10) .ne. '0') then
	  call fvi_putstr('a1')
	endif
	do i=11,l+lc
	  call fvi_putstr(',')
	  call fvi_putstr('a')
	  call fvi_putint(i-9)
	enddo
	call fvi_putstr(');')
	call fvi_putln(lunout)
	call fvi_putstr('  } else {')
	call fvi_putln(lunout)
	call fvi_putstr('    assert(no == 0 && list[no].t == 0);')
        if (typ .ne. 'void') then
 	  call fvi_putln(lunout)
          call fvi_putstr('    return 0;')
        endif
	call fvi_putln(lunout)
	call fvi_putstr('  }')
	call fvi_putln(lunout)
	call fvi_putstr('}')
	call fvi_putln(lunout)
	call fvi_putstr('int sys_adr')
	if (typ .ne. 'void') then
	  call fvi_putstr(line(5:5))
	endif
	call fvi_putstr('_')
	call fvi_putstr(line(10:l))
	do i=1,underscores
	  call fvi_putstr('_')
	enddo
	call fvi_putstr('(Routine r) {')
	call fvi_putln(lunout)
	call fvi_putstr('  return idx(r, ')
	call fvi_putint(typno)
	call fvi_putstr(');')
	call fvi_putln(lunout)
	call fvi_putstr('}')
	call fvi_putln(lunout)
	typno=typno+1
	goto 1

19	call fvi_putstr('*** error ***')
	call fvi_putln(lunout)
	print *,line(1:l),' < illegal prototype name'
	goto 1

99	close(lunin)
	close(lunout)
	end


	subroutine fvi_putstr(str)

	character str*(*)
	integer n
	integer lun

	character out*132/' '/,num*12
	integer l/0/,i,lunout/2/

	if (l+len(str) .gt. len(out)-12) then  ! let space for an integer number on the same line
	  write(lunout,'(a)') out(1:l)
	  l=0
	endif
	out(l+1:l+len(str))=str
	l=l+len(str)
	return

	entry fvi_putint(n)

	write(num, '(i12)') n
	do i=11,1,-1
	  if (num(i:i) .eq. ' ') then
	    out(l+1:l+12-i)=num(i+1:12)
	    l=l+12-i
	    return
	  endif
	enddo
	stop 'FVI_PUTINT: error'

	entry fvi_putln(lun)

	if (lun .ne. lunout) stop 'MAKE_FVI: lun mismatch'
	if (l .gt. 0) then
	  write(lunout,'(a)') out(1:l)
	  l=0
	endif
	end
