/****************************
#include <stdio.h>
#include <string.h>

#include "fudgit.h"
#include "symbol.h"
#include "command.h"
#include "code.h"
#include "math.tab.h"
*******************************/

#if defined(sgi)
#include "dl/dl.h"
#include <symconst.h>
#else
#include "dld/dl/dl.h"
#define stProc 1
#endif

typedef double (*dblfunc) ();

#ifndef NOSTDLIB_H
#include <stdlib.h>
#endif

static int do_install(int argc, char **argv, char *l, Command *cmd)
{
	Symbol *sym[MATHMAXFUNC];
	extern char *Ft_Progname;
	char *locp, *vp, *cp, *tvec;
	char varname[MAXVARNAME];
	int types[MATHMAXFUNC];
	struct nlist rtnes[MATHMAXFUNC];
	int vtype, argno;
	extern int Ft_varcpy(char *, char *);
	int func, rti, retval = 0;

	if (argc < 4 || argc%2)
		return(usage(cmd));
	if (argc > MATHMAXFUNC + 2) {
		fprintf(stderr, "%s: Too many functions.\n", cmd->fname);
		return(ERRR);
	}
	for (func=2,rti=0; func<argc; func+=2,rti++) {
		locp = argv[func];
		while (*locp && *locp != ':' && *locp != '=')
			locp++;
		if (!locp[0] || !locp[1]) {
			fprintf(stderr, "%s: Argument `%s' garbled.\n", cmd->fname,
			argv[func]);
			return(usage(cmd));
		}
		switch(*locp) {
			case ':':
				types[rti] = EPROCSYM;
				break;
			case '=':
				types[rti] = EFUNCSYM;
				break;
			default:
				fprintf(stderr, "%s: Should never be here.\n", cmd->fname);
				return(usage(cmd));
		}
		*locp++ = '\0'; /* this now points to the local routine name */
		if (Ft_varcpy(0, locp) != VAR) {  /* check type */
			fprintf(stderr, "%s: %s: Illegal name.\n", cmd->fname, locp);
			return(ERRR);
		}
		if ((sym[rti] = Ft_lookup(locp)) == 0) {
			sym[rti] = Ft_install(locp, UNDEFVAR, 1);
			if ((sym[rti]->size.vals = (char *)calloc(MATHMAXARG+1,
			sizeof(char))) == (char *)NULL) {
				fprintf(stderr, "%s: Allocation error.\n", cmd->fname);
				return(ERRR);
			}
		}
		else if (sym[rti]->type != types[rti] && sym[rti]->type != UNDEFVAR) {
			fprintf(stderr,
			"%s: %s: Already defined differently. (Must be freed first)\n",
			cmd->fname, locp);
			return(ERRR);
		}
		rtnes[rti].n_name = argv[func];
		rtnes[rti].n_type = 0;
		tvec = sym[rti]->size.vals;
		cp = argv[func+1];
		if (*cp != '(')
			return(usage(cmd));
		cp++;
		for (argno = 0; ;argno++) {
			if (argno >= MATHMAXARG) {
				fprintf(stderr,
				"%s: Too many arguments (%d).\n", cmd->fname, argno);
				return(ERRR);
			}
			while (*cp && (isspace(*cp) || *cp == ','))
				cp++;
			if (!cp[0]) {
				fprintf(stderr, "%s: Garbled argument list `%s'.\n",
				cmd->fname, argv[func+1]);
				return(usage(cmd));
			}
			if (*cp == ')')
				break;
			vp = varname;
			while (*cp && *cp != ' ' && *cp != '\t' && *cp != ',' && *cp != ')')
				*vp++ = *cp++;
			*vp = '\0';
			vtype = Ft_varcpy(0, varname);
			switch(vtype) {
			case VAR:
				*tvec = PROTO_VAL;
				break;
			case VEC:
				if (strcmp(varname, "P") == 0)
					*tvec = PROTO_PAR;
				else
					*tvec = PROTO_VEC;
				break;
			case STRVAR:
				*tvec = PROTO_STR;
				break;
			default:  /* defensive programming */
				fprintf(stderr, "%s: Impossible type in switch.\n", cmd->fname);
				return(ERRR);
			}
			tvec++;
		}
		*tvec-- = PROTO_END;
		cp = sym[rti]->size.vals;
		while (tvec > cp) {   /* invert order */
			char ctmp;

			ctmp = *cp; *cp = *tvec; *tvec = ctmp;
			tvec--; cp++;
		}
	}
	rtnes[rti].n_name = (char *)NULL;
	if (strcmp(cmd->fname, "reinstall") == 0) {
#if defined(sun) || defined(sparc) || defined(ultrix)
		dld_unlink_by_file(argv[1], 0);
#else
		;
#endif
	}
	func = dl_loadmod_mult(Ft_Progname, argv[1], rtnes);
	if (rti != func) {
		fprintf(stderr, "%s: %d symbol(s) not found.\n", cmd->fname,
		(rti-func));
		retval = ERRR;
	}
	for (rti=0;rtnes[rti].n_name != (char *)NULL;rti++) {
		if (rtnes[rti].n_type) {
/* 
 * if your IRIX version is  != 4.0.5 => nlist returns stProc + 1 
 * otherwise (if == 4.0.5) => nlist returns stProc
 *
 * Change the following line according to your OS version.
 * For non-IRIX machines use stProc only.
 */
#if defined(sgi) && !defined(SAME_STPROC)
			/*  IRIX != 4.0.5 */
			if (rtnes[rti].n_type == stProc + 1) {
#else
			/* IRIX  == 4.0.5 and others (ULTRIX, SUNOS) */
            if (rtnes[rti].n_type == stProc) {
#endif
				sym[rti]->u.ptr = (dblfunc) rtnes[rti].n_value;
				sym[rti]->type = types[rti];
				fprintf(stderr, "%s: %s installed as %s %s.\n",
				cmd->fname, rtnes[rti].n_name, 
				(types[rti] == EPROCSYM ? "procedure" : "function"),
				sym[rti]->name);
			}
			else {
				fprintf(stderr, "%s: %s: Not a procedure (%d).\n", cmd->fname,
				rtnes[rti].n_name, rtnes[rti].n_type);
				retval = ERRR;
			}
		}
		else {
			fprintf(stderr, "%s: %s: No such symbol.\n", cmd->fname,
			rtnes[rti].n_name);
			retval = ERRR;
		}
		if (sym[rti]->type == UNDEFVAR)
			free(sym[rti]->size.vals);
	}

	return(retval);
}

int Ft_initdl(void)
{
	void Ft_dlerror(char *str);
	void Ft_dlmessage();

	/*******
	dl_setmessage(dlmessage);
	*********/
	dl_seterror(Ft_dlerror);
	return(0);
}

void Ft_dlerror(char *str)
{
	fprintf(stderr, "Install: %s.\n", str);
	Ft_catcher(ERRR);
}

/***************
void Ft_dlmessage(str)
char *str;
{
	fputs("Install: Loading and linking modules...\n", stderr);
	fputs(str, stderr);
}
******************/