/* (C) Copyright International Business Machines Corporation 8 May */
/* 1991.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
#ifndef lint
static char sccsinfo[] = "@(#)link_process.c	1.7 2/17/92";
#endif

#include <stdio.h>
#include <sys/file.h>
#ifdef sun
#include <sys/types.h>
#include <sys/stat.h>
#endif
#include "li.h"
#include "accessors.h"
#include "interpform.cd"
#include "storage.h"
#include <errno.h>
extern char * sys_errlist[];

#ifdef DLOAD
#ifdef sun
#include <dlfcn.h>
#include <string.h>
#endif

static
void load_error(kind,obj)
char *kind;
char *obj;
{
  fprintf(stderr, "link_process: %s Error: %s - %s\n", kind, obj,
          sys_errlist[errno]
  );
#ifdef DEBUGDL
#ifdef AIX
  {
    char *buffer[1024];

    buffer[0] = "execerror";
    buffer[1] = obj;
    loadquery(L_GETMESSAGES, &buffer[2], sizeof buffer - 8);
    execvp("/etc/execerror", buffer);
  }
#endif
#endif
}

#ifdef _AIX
#include <sys/ldr.h>

int static_data = 0;
#endif

#endif

void *link_process(prog)
valcell prog;
{
#ifdef DLOAD

  char *name;
  char *object_name; 
  char *object_code;
  char *path = nil;
  static char *linkpath = nil;
  char *hmchbindir(), *getenv(), *pathfind();
  flag remove = FALSE;

  void *interpreter;

#ifdef sun
  void *handle;
  char *err;
#endif

  if ( vdot(prog, prog__handle).integer == 0 ) {
    name = vstringval(vdot(prog, prog__name));
    object_name = vstringval(vdot(prog, prog__path));

    if (vdot(prog, prog__path).table->size isnt 0) {
      if (linkpath is nil)
	if ((linkpath = getenv("HCOBJPATH")) is nil) {
	  /* no path, use system default */
	  linkpath = (char *) getmain(strlen(hmchbindir()) + 3);
	  if (linkpath is nil) {
	    nilerror("link_process", "Unable to create default link path");
	    abort_nili("link_process");
	  }
	  strcpy(linkpath, ".:");
	  strcat(linkpath, hmchbindir());
	}
      path = pathfind(linkpath, object_name, R_OK);
    }
    if (path is nil) {		/* no object-name or file not found */
      if (vdot(prog, prog__object).table->size isnt 0) {
	/* try using the object code saved with the li prog */
	FILE *f;

	object_code = vstringval(vdot(prog, prog__object));
	path = tmpnam(nil);
	if ((f = fopen(path,"w")) is nil) {
	  load_error("Creating tmp object file", path);
	  return(FALSE);
	}
	if (fwrite(object_code, sizeof(char),
		   vdot(prog, prog__object).table->size, f)
	    isnt vdot(prog, prog__object).table->size) {
	  load_error("Creating tmp object file", path);
	  unlink(path);
	  return(FALSE);
	}
	remove = TRUE;
      }
    }
    if (path is nil) {
      fprintf("link_process: object code not available for %s\n", name);
      return(FALSE);
    }
    if (debug_level(5))
      fprintf(stderr,"Dynamically loading %s\n", path);
#ifdef _AIX
    if (! (interpreter = (void *)load(path, 1, NULL))) {
      load_error("Open", object_name);
      return(FALSE);
    };
    if (loadbind(0, &static_data, interpreter)) {
      load_error("Binding", object_name);
      return(FALSE);
    };
#endif

#ifdef sun
    handle = dlopen(path, RTLD_LAZY);
    err = dlerror();
    if (err) {
      fprintf(stderr, "link_process: dlopen(%s) - %s\n", object_name, err);
      return(FALSE);
    };
    {
      char * chname;

      chname = (char *) malloc(strlen(name) + 4);
      if (chname == NULL) {
	fprintf(stderr, "link_process: malloc failure - %s\n", name);
	return(FALSE);
      };
      interpreter = dlsym(handle, strcat(strcpy(chname, "CH_"), name));
      free(chname);
    };
    err = dlerror();
    if (err) {
      fprintf(stderr, "link_process: dlsym(%s, %s) - %s\n",
	      err, object_name, name
	      );
      return(FALSE);
    };
    { struct stat buf;
      void refix_sun_dl();
      extern int zero_fd;
      if (fstat(zero_fd, &buf) != 0)
	refix_sun_dl();
    }
#endif

    vdot(prog, prog__handle).integer = (int) interpreter;
  }
  else
    interpreter  = (void *) vdot(prog, prog__handle).integer;
  return(interpreter);

#else
  return(FALSE);
#endif
}

void delink_process(prog)
valcell prog;
{
#ifdef DLOAD
/* dlclose doesn't work correctly on SUN OS4.1, and nothing works on AIX,
   so for now, this is a no-op */
#endif
}
