#!/bin/csh -f
#
# Shell script to hack mpf and mpl together
#
# Remember to put:  cmpf mpl your-func     
# as a comment/directive in your Fortran program.
#
# This script generates 1 file:
# <your-func>.m in UPPER CASE ie. YOUR-FUNC.m
# The mpf program is then joined to the mpl program like this:
#
# the real mpf calls --> hacked mpl --> the real mpl
#
# Usage: mplwrap routine-name param-type-1 param-type-2 ...
#
# Parameter types made up of more than one word must be quoted.
# The parameter types should be exactly as they are declared in the 
# mpl function heading. 
#
# Eg:
#  mplwrap void foobar "int *" float "plural double *" 
#
# A pointer argument (a basic type followed by an asterisk)
# indicates that this argument is called by REFERENCE.
# With no such pointer indirection, the argument is called by VALUE.
#
# Warning: Arrays should not be called by value. This will only
# work if the array size is smaller than the MasPar processor grid.
#
# Compiling and linking should go something like this:
#
# mplwrap <return-type> <func> <param1> <param2>...
# mpl  -c <FUNC>.m <your-mpl-prog>.m
# mpfortran -pesize=8 <your-mpf-prog>.f  <your-mpl-prog>.o <FUNC>.o 
#
# Jeremy Cook, Para//ab, 6/8-90
# Petter Bjorstad, Para//ab, 20/11-90 (fixed for release 2)
# Erik Boman, Univ. of Bergen, 31/12-90      
#   (major revision, added call-by-value feature)
# Jeremy Cook, Para//ab, Aug-92
#   Changes for ansi-mpl, now takes extra (1st) parameter for return type.
#
################################################################################
#
#
if ($#argv < 1) then
    echo "Usage: $0 <ret-type> <mpl-routine-name> <param-type-1> <param-type-2> ... "
    exit 1
endif
#
set noglob        # we want no filename expansion
set ret_t = $1
set name = $2
set FNAME = `echo -n $name|tr a-z A-Z`
shift; shift   # set paramlist = ( $argv[3-] )
#
if ($FNAME == $name) then
   echo "Error: At least one character in function name must be lower-case"
   exit (1)
endif
#
#
# Now generate mpl interface :
#
set quote = '"'
set tmp = /tmp/mplwrap$$
cat > ${tmp} << MPL_WRAP_STAGE1
#include <mpl.h>
#include <stdio.h>
#include <stdlib.h>

typedef struct {
	int * addr;		/* base address of array */
	int   rank;		/* rank of array */
        int   onDPU;		/* if base address is FE or BE */
	int   extents[7];	/* extents of the array */
} DopeVector;

MPL_WRAP_STAGE1
#
echo "extern ${ret_t} ${name}( " >> $tmp
echo "#ifdef __STDMPL__">> $tmp
@ i=1
while ($i <= $#argv)
  echo -n "$argv[$i]" >> $tmp
  if ( $i != $#argv ) echo -n ", " >> $tmp
  @ i++
end
echo "">> $tmp
echo "#endif">> $tmp
echo "  );" >> $tmp
echo "$FNAME ( fe, be )" >> $tmp
echo "    int * fe[];        /*  FE(vax) address of FE(vax) arguments */">> $tmp
echo "    DopeVector * be[]; /* a BE(acu) address of BE(acu) dopevectors */" >> $tmp
echo "  {" >> $tmp
@ i=1
set param_type = ( )
while ($i <= $#argv)
  # Scalar or array argument ?
  echo $argv[$i] | grep -s plural
  if ($status) then
     echo $argv[$i] | grep -s '*'
     if (! $status) then
        set param_type = ($param_type 1) # scalar, call-by-reference
     else
        set param_type = ($param_type 2) # scalar, call-by-val
     endif
  else
     echo $argv[$i] | grep -s '*'
     if (! $status) then
        set param_type = ($param_type 3) # array, call-by-reference
     else
        set param_type = ($param_type 4) # array, call-by-value
     endif
  endif
  # strip off '*'s in arguments
  set argv[$i] =  "`echo $argv[$i] | sed -e 's/\*//g'`" 
  echo "    $argv[$i] * var$i;" >> $tmp
  echo "    $argv[$i]   dpuVar$i;" >> $tmp
  @ i++
end
echo "      ">>$tmp
@ i=1
while ($i <= $#argv)
# Scalar or array ?
  if ($param_type[$i] <= 2 ) then   # its a scalar
    echo "      /* copy in scalar argument from front-end */">>$tmp
    echo "      {">>$tmp
    echo "        $argv[$i] * ptr;" >> $tmp
    echo "        var$i = &dpuVar$i;">> $tmp
    echo "        copyIn( (char*)(fe+$i), (char*)(&ptr), sizeof(ptr));">> $tmp
    echo "        if (ptr) " >> $tmp
    echo "           copyIn( (char*)(ptr),(char*)(var$i), sizeof(*var$i));">> $tmp
    echo "        else " >> $tmp
    echo "          {" >> $tmp
    echo "            fprintf(stderr, ${quote}Error in $FNAME.m : No address to FE argument $i \n${quote});" >> $tmp
    echo "            exit(1); " >> $tmp
    echo "          }" >> $tmp
    echo "      }">>$tmp
    echo "      ">>$tmp
  else  # its an array
    echo "    if (be[$i]->onDPU) ">>$tmp
    echo "      var$i = ($argv[$i] *)be[$i]->addr;" >> $tmp
    echo "    else  /* Arrays must be on DPU */" >> $tmp
    echo "      { ">> $tmp
    echo "         fprintf(stderr, ${quote}Error in $FNAME.m : argument $i must be on DPU\n${quote});" >> $tmp
    echo "         exit(1); " >> $tmp
    echo "      }" >> $tmp
    echo "     ">>$tmp
  endif
  @ i++
end
echo "    /* call the mpl function */ " >> $tmp
echo -n "    ${name}( " >> $tmp
@ i=1
while ($i <= $#argv)
  if ($param_type[$i] == 2 || $param_type[$i] == 4) then # call-by-value
     echo -n '*' >> $tmp
  endif
  echo -n "var${i}" >> $tmp
  if ( $i != $#argv ) echo -n ", " >> $tmp
  @ i++
end
echo ");" >> $tmp
# copy arguments back to FE if necessary
@ i=1
while ($i <= $#argv)
  if ($param_type[$i] == 1) then # its a scalar call-by-reference
    echo "      " >>$tmp
    echo "      { /* copy scalar call-by-reference argument back to FE */" >>$tmp
    echo "        $argv[$i] * ptr;" >> $tmp
    echo "        copyIn((char*) (fe+$i),(char*)(&ptr), sizeof(ptr));">> $tmp
    echo "        copyOut((char*)(var$i),(char*)(ptr), sizeof(*var$i));">> $tmp
    echo "      }">>$tmp
  endif
  @ i++
end
echo "  }" >> $tmp
#
cat ${tmp} >! ${FNAME}.m
rm ${tmp}