#!/bin/sh
# Usage: Splus make.init chapter file/dir [tmp_work_dir]
# file is name of the .Data directory containing Splus functions
#   or the name of a file containing the function definitions
# tmp_work_dir is a directory to be used in /tmp for the operations
# called with one (ignored) arg for creating the basic Splus S_ld_init.c file

. $SHOME/adm/cmd/DIRNAMES

case $1 in
"")	echo "Syntax: Splus make.init chapter file tmp_work_dir"; exit 1;;
esac
echo "This takes a while ... be patient and watch the dots (one per object)"

chapter=$1
here=`pwd`

input=${2-$SHOME/s/${FUNS_DIR}}

case $input in
/*) ;;	# full path
*) input=$here/$input
esac
if test ! -r $input
then
	echo "make.init: Could not open input file $input"
	exit 1
fi

tmpdir=${TMPDIR:-/tmp}
cd $tmpdir
case $2 in
"")	dir=load.dir;;
*)	dir=${3-load.dir$$}
esac
rm -fr $dir
mkdir $dir
cd $dir
mkdir $DATA_DIR
# ln -s /dev/null ${DATA_DIR}/${AUDIT_FILE} >/dev/null 2>&1

# if input is a file, source in the definitions from the file
if test -f $input
then
	Splus < $input || { echo "make.init: Problem with Splus functions in file $input"; exit 1 ; }
	input=./${DATA_DIR}
fi

Splus <<EOF
	where <- "$input"
	chapt <- "$chapter"
EOF

case $2 in
"")
	Splus <<"EOF"
	mainsymbols <- c("S_interface","Default_pgm")  # .Fortran, .C, .Program
EOF
;;
*)
	Splus <<"EOF"
	mainsymbols <- character(0)
EOF
esac

Splus <<"EOF"	|| exit 1
"make.load"<-
function(symbols, Sfile = "S_ld_init.c")
{
	II <- symbols$I
	CC <- symbols$C
	FF <- symbols$F
	if(length(symbols$S)>0)
		SS <- paste("z", substring(symbols$S, 1, 5), sep = "")
	else SS <- character(0)
	cat(sep = "\n", file = Sfile,
		"#include \"S.h\"",
		"#include \"cdefs.h\"",
		"#if defined(IRIS4D) || defined(DECSTATION) /* ( */",
		"#define void long",
		"/* Because Mips C compiler doesn't like void to long coercion. */",
		"#endif /* ) */")
	if(length(II)>0) cat(sep="\n",file=Sfile,append=T,
		paste("extern vector *", II, "();", sep = ""))
	if(length(CC)>0) cat(sep="\n",file=Sfile,append=T,
		paste("extern void ", CC, "();", sep = ""))
	if(length(FF)>0) cat(sep="\n",file=Sfile,append=T,
		paste("extern void F77_SUB(", FF, ")();", sep = ""))
	if(length(SS)>0) cat(sep="\n",file=Sfile,append=T,
		paste("extern int F77_SUB(", SS, ")();", sep = ""))
	cat(sep="\n",file=Sfile,append=T,
		paste( "x_h ", chapt, "_init[]  = {", sep=""))
	if(length(II)>0) cat(sep="\n",file=Sfile,append=T,
		paste("{SYMBOL(", II, "),(long)",  II, ",NULL},", sep = ""))
	if(length(CC)>0) cat(sep="\n",file=Sfile,append=T,
		paste("{SYMBOL(", CC, "),(long)",  CC, ",NULL},", sep = ""))
	if(length(FF)>0) cat(sep="\n",file=Sfile,append=T,
		paste("{FSYMBOL(", FF, "),(long)F77_SUB(", FF, "),NULL},", sep = ""))
	if(length(SS)>0) cat(sep="\n",file=Sfile,append=T,
		paste("{FSYMBOL(", SS, "),(long)F77_SUB(", SS, "),NULL},", sep = ""))
	cat(sep="\n",file=Sfile,append=T,
		"{NULL,0L,NULL} };")
}
"all.symbols"<-
function(names,pos=2)
{
	csymbols <- fsymbols <- ssymbols <- character(0)
	isymbols <- mainsymbols
	looking.for <- c(".Internal",".C",".Fortran",".S","plot.xy","marks.xy")
	m <- 1:4	# force testing for all symbols
	for(i in names) {
		cat(".")
		obj <- get(i,where=pos)
		m <- match(all.names(obj,unique=T),looking.for,nomatch=0)
		if(any(m)){
			obj <- obj[[length(obj)]]
			if(any(m==1)) isymbols <- c(isymbols, I.symb(obj))
			if(any(m==2)) csymbols <- c(csymbols, C.symb(obj))
			if(any(m==3)) fsymbols <- c(fsymbols, F.symb(obj))
			if(any(m>3))  ssymbols <- c(ssymbols, S.symb(obj))
		}
	}
	cat("\007\n")
	if(length(csymbols)>0) csymbols <- sort(unique(csymbols))
	if(length(isymbols)>0) isymbols <- sort(unique(isymbols))
	if(length(fsymbols)>0) fsymbols <- sort(unique(fsymbols))
	if(length(ssymbols)>0) ssymbols <- sort(unique(ssymbols))
	list(C = csymbols, I = isymbols, F = fsymbols, S = ssymbols)
}
"I.symb"<-
function(obj)
{
	symb <- character(0)
	if(!(is.recursive(obj) && (is.language(obj) || is.function(obj))))
		return(symb)
	if(mode(obj)=="internal")
		symb <- name.or.char(obj, 2)
	for(i in obj)
		symb <- c(symb, I.symb(i))
	symb
}
"C.symb"<-
function(obj)
{
	symb <- character(0)
	if(!(is.recursive(obj) && (is.language(obj) || is.function(obj))))
		return(symb)
	if(mode(obj)=="call" && deparse(obj[[1]]) == ".C")
		symb <- name.or.char(obj, 2)
	for(i in obj)
		symb <- c(symb, C.symb(i))
	symb
}
"F.symb"<-
function(obj)
{
	symb <- character(0)
	if(!(is.recursive(obj) && (is.language(obj) || is.function(obj))))
		return(symb)
	if(mode(obj) == "call" && deparse(obj[[1]]) == ".Fortran")
		symb <- name.or.char(obj, 2)
	for(i in obj)
		symb <- c(symb, F.symb(i))
	symb
}
"S.symb"<-
function(obj)
{
	symb <- character(0)
	if(!(is.recursive(obj) && (is.language(obj) || is.function(obj))))
		return(symb)
	switch(mode(obj),
		S.call = symb <- name.or.char(obj, 2),
		call = {
			what <- deparse(obj[[1]])
			if(what == "marks.xy" || what == "plot.xy")
				symb <- obj[[length(obj)]]
		}
		)
	for(i in obj)
		symb <- c(symb, S.symb(i))
	symb
}
"name.or.char"<-
function(obj, i)
{
	nn <- names(obj)[i]
	if(is.null(nn) || nn == "")
		as.character(obj[[i]])
	else nn
}
pos <- length(search())+1
attach(where,pos=100)	# at end of search list

invisible(switch(.C("S_platform",
		character(1))[[1]],
	DOS386 = {
		xx.audit.file <- "_Audit"
		xx.help.dir <- "_Help"
		xx.cat.help.dir <- "_Cat_Help"
	}
	,
	{
		xx.audit.file <- ".Audit"
		xx.help.dir <- ".Help"
		xx.cat.help.dir <- ".Cat.Help"
	}
	))
# kludge; there is no _Cat_Help on DOS.

all.objects <- objects(pos)
all.objects <- all.objects[is.na(
	match(all.objects, c(xx.audit.file, xx.help.dir,".C",".Fortran",
		xx.cat.help.dir))
	)]
my.symbols <- all.symbols(all.objects,pos=pos)
make.load(my.symbols)
EOF

# now clean up
case $2 in
"")	;;
*)	chapter=`echo $chapter|sed "s/\(..........\).*/\1/"`
	rm -f $here/${chapter}_i.c
	mv S_ld_init.c $here/${chapter}_i.c
	cd; rm -fr $tmpdir/$dir
esac