#include <stdio.h>
#include <string.h>
#include <sys/types.h>
#include <sys/param.h>
#include <nlist.h>
#include <dlfcn.h>

#define stProc 2

typedef double (*dblfunc) ();

#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif

static void *handle;
static char *dlerrstr;

extern char *getcwd();

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 (handle != (void *)NULL)
			dlclose(handle);
	}
	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 (rtnes[rti].n_type == stProc) {
				sym[rti]->u.ptr = (dblfunc)dlsym(handle, rtnes[rti].n_name);
				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);
				dlerrstr = dlerror();
				if (dlerrstr != NULL)
					fprintf(stderr, "dlerror report: %s\n", dlerrstr);
				retval = ERRR;
			}
		}
		else {
			fprintf(stderr, "%s: %s: No such symbol.\n", cmd->fname,
			rtnes[rti].n_name);
			dlerrstr = dlerror();
			if (dlerrstr != NULL)
				fprintf(stderr, "dlerror report: %s\n", dlerrstr);
			retval = ERRR;
		}
		if (sym[rti]->type == UNDEFVAR)
			free(sym[rti]->size.vals);
	}

	return(retval);
}

int Ft_initdl(void)
{
	return(0);
}

int
dl_loadmod_mult(char *binary, char *module, struct nlist *nl)
{
	int i, n, rv;
	char p[MAXPATHLEN];
	char *path;
	char *p1;
	int opened = 0;

/*
** SVR4 search rules require absolute pathnames to shared objects ot that
** they be located in the LD_LIBRARY_PATH
**
** If leading char of module is a / then assume absolute path otherwise
** it may be in the LD_LIBRARY_PATH else prepend the full path of the
** current working directory.
*/

	strcpy(path, module);

	if (module[0] == '/')
	{
		if ((handle = dlopen(path, RTLD_LAZY)) != (void *)NULL)
			opened = 1;
	}

	if (!opened)
	{
		if ((handle = dlopen(path, RTLD_LAZY)) != (void *)NULL)
			opened = 1;
	}

	if (!opened)
	{
		p1 = getcwd((char *)NULL, MAXPATHLEN-2);

		strcat(p1, "/");
		strcat(p1, module);
		strcpy(path, p1);

		if ((handle = dlopen(path, RTLD_LAZY)) != (void *)NULL)
			opened = 1;
	}

	if (!opened)
	{
		fprintf(stderr, "Failed to dlopen %s\n", path);
		dlerrstr = dlerror();
		if (dlerrstr != NULL)
			fprintf(stderr, "dlerror report: %s\n", dlerrstr);
		return 0;
	}

	rv = nlist(path, nl);
	if ( rv < 0 ) {
   		fprintf(stderr,"No valid name list in %s", path);
   		return 0;
	}

	n = 0;

	for (i=0; nl[i].n_name; i++) {
		if ( nl[0].n_type ) n++;
	}

	return n;
}
