home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / library / dld.c < prev    next >
C/C++ Source or Header  |  1992-05-26  |  5KB  |  199 lines
  1. /*  @(#) pl_dld.c 1.0.0 (UvA SWI) Thu Sep 13 13:56:45 1990
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: linking dld to SWI-Prolog
  7. */
  8.  
  9. #include <stdio.h>
  10. #include "../include/SWI-Prolog.h"
  11. #include "../include/dld.h"
  12.  
  13. static char *
  14. dld_string_error()
  15. { switch(dld_errno)
  16.   { case DLD_ENOFILE:      return "cannot open file";
  17.     case DLD_EBADMAGIC:      return "bad magic number";
  18.     case DLD_EBADHEADER:  return "failure reading header";
  19.     case DLD_ENOTEXT:      return "premature eof in text section";
  20.     case DLD_ENOSYMBOLS:  return "premature end of file in symbols";
  21.     case DLD_ENOSTRINGS:  return "bad string table";
  22.     case DLD_ENOTXTRELOC: return "premature eof in text relocation";
  23.     case DLD_ENODATA:      return "premature eof in data section";
  24.     case DLD_ENODATRELOC: return "premature eof in data relocation";
  25.     case DLD_EMULTDEFS:      return "multiple definitions of symbol";
  26.     case DLD_EBADLIBRARY: return "malformed library archive";
  27.     case DLD_EBADCOMMON:  return "common block not supported";
  28.     case DLD_EBADOBJECT:  return "malformed input file (not rel or archive)";
  29.     case DLD_EBADRELOC:      return "bad relocation info";
  30.     case DLD_ENOMEMORY:      return "virtual memory exhausted";
  31.     case DLD_EUNDEFSYM:      return "undefined symbol";
  32.     default:          return "unknown dld error";
  33.   }
  34. }
  35.  
  36.  
  37. static foreign_t
  38. dld_error(name, arity)
  39. char *name;
  40. int arity;
  41. { PL_warning("%s/%d: %s", name, arity, dld_string_error());
  42.  
  43.   PL_fail;
  44. }
  45.  
  46.  
  47. static int
  48. dld_initialise(debug)
  49. int debug;
  50. { static dld_initialised = FALSE;
  51.  
  52.   if ( dld_initialised == FALSE )
  53.   { if ( dld_init(PL_query(PL_QUERY_SYMBOLFILE), debug) != 0 )
  54.     { dld_error("dld_initialise", 0);
  55.       return FALSE;
  56.     }
  57.     
  58.     dld_initialised = TRUE;
  59.   }
  60.  
  61.   return TRUE;
  62. }
  63.  
  64.  
  65. static char *
  66. get_char_p(name, arity, atom)
  67. char *name;
  68. int arity;
  69. term atom;
  70. { if ( PL_type(atom) != PL_ATOM )
  71.   { PL_warning("%s/%d: instantiation fault");
  72.     return NULL;
  73.   }
  74.   
  75.   return PL_atom_value(PL_atomic(atom));
  76. }
  77.  
  78.  
  79. static foreign_t
  80. pl_dld_link(name)
  81. term name;
  82. { char *path;
  83.  
  84.   if ( dld_initialise(FALSE) == FALSE )
  85.     PL_fail;
  86.  
  87.   if ( (path = get_char_p("dld_link", 1, name)) == NULL )
  88.     PL_fail;
  89.  
  90.   if ( dld_link(path) != 0 )
  91.     return dld_error("dld_link", 1);
  92.  
  93.   PL_succeed;
  94. }
  95.  
  96.  
  97. static foreign_t
  98. pl_dld_unlink(name)
  99. term name;
  100. { char *path;
  101.  
  102.   if ( dld_initialise(FALSE) == FALSE )
  103.     PL_fail;
  104.  
  105.   if ( (path = get_char_p("dld_unlink", 1, name)) == NULL )
  106.     PL_fail;
  107.  
  108.   if ( dld_unlink_by_file(path) != 0 )
  109.     return dld_error("dld_unlink", 1);
  110.  
  111.   PL_succeed;
  112. }
  113.  
  114.  
  115. typedef void (*Func)();
  116.  
  117. static foreign_t
  118. pl_dld_call(name)
  119. term name;
  120. { char *func_name;
  121.   Func func;
  122.  
  123.   if ( dld_initialise() == FALSE )
  124.     PL_fail;
  125.  
  126.   if ( (func_name = get_char_p("dld_call", 1, name)) == NULL )
  127.     PL_fail;
  128.  
  129.   if ( dld_function_executable_p(func_name) == 0 )
  130.     return PL_warning("dld_call/1: %s is not executable: %s",
  131.               func_name, dld_string_error());
  132.  
  133.   if ( (func = (Func) dld_get_func(func_name)) == 0 )
  134.     return dld_error("dld_call", 1);
  135.  
  136.   (*func)();
  137.  
  138.   PL_succeed;
  139. }
  140.  
  141.  
  142. static foreign_t
  143. pl_dld_list_undefined()
  144. { if ( dld_initialise(FALSE) == FALSE )
  145.     PL_fail;
  146.  
  147.   if ( dld_list_undefined() == 0 )
  148.     PL_succeed;
  149.  
  150.   PL_fail;
  151. }
  152.  
  153.  
  154. pl_dld_initialise(debug)
  155. term debug;
  156. { if ( PL_type(debug) != PL_INTEGER )
  157.     return PL_warning("dld_initialise/2: intantiation fault");
  158.   
  159.   if ( dld_initialise(PL_integer_value(PL_atomic(debug))) == FALSE )
  160.     PL_fail;
  161.  
  162.   PL_succeed;
  163. }
  164.  
  165.  
  166. pl_dld_function(name, address)
  167. term name, address;
  168. { if ( PL_type(name) == PL_ATOM )
  169.   { char *fn = PL_atom_value(PL_atomic(name));
  170.     long addr;
  171.     
  172.     if ( (addr = dld_get_func(fn)) == FALSE )
  173.       PL_fail;
  174.  
  175.     return PL_unify_atomic(address, PL_new_integer(addr));
  176.   } else if ( PL_type(address) == PL_INTEGER )
  177.   { long addr = PL_integer_value(PL_atomic(address));
  178.     char *fn;
  179.     int perc;
  180.  
  181.     fn = dld_find_function(addr, &perc);
  182.  
  183.     return PL_unify_atomic(name, PL_new_atom(fn));
  184.   } else
  185.     return PL_warning("dld_function/2: intantiation fault");
  186. }
  187.  
  188.  
  189. dld_start()
  190. { PL_register_foreign("dld_initialise",        1, pl_dld_initialise,    0);
  191.   PL_register_foreign("dld_link",           1, pl_dld_link,           0);
  192.   PL_register_foreign("dld_unlink",         1, pl_dld_unlink,         0);
  193.   PL_register_foreign("dld_call",           1, pl_dld_call,           0);
  194.   PL_register_foreign("dld_list_undefined", 0, pl_dld_list_undefined,   0);
  195.   PL_register_foreign("dld_function",          2, pl_dld_function,        0);
  196.  
  197.   PL_succeed;
  198. }
  199.