shared_object routines support: SWI compatibility and more flexibility.

C/load_aix.c

@@ -32,6 +32,26 @@ Yap_FindExecutable(char *name)
 }
 
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  /* not implemented */
+  return NULL;
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  return FALSE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return -1;
+}
+
+
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
  * code files and libraries and locates an initialization routine

C/load_aout.c

@@ -100,6 +100,25 @@ Yap_FindExecutable(char *name)
 	  "cannot find file being executed");
 }
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  /* not implemented */
+  return NULL;
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  return FALSE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return -1;
+}
+
 
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign

C/load_coff.c

@@ -99,6 +99,25 @@ Yap_FindExecutable(char *name)
 }
 
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  /* not implemented */
+  return NULL;
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  return FALSE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return -1;
+}
+
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
  * code files and libraries and locates an initialization routine

C/load_dl.c

@@ -34,6 +34,39 @@ Yap_FindExecutable(char *name)
 {
 }
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  int dlflag;
+
+  if (flags &  EAGER_LOADING)
+    dlflag = RTLD_NOW;
+  else
+    dlflag = RTLD_LAZY;
+  if (flags &  GLOBAL_LOADING)
+    dlflag |= RTLD_GLOBAL;
+  else 
+    dlflag |= RTLD_LOCAL;
+  
+  return (void *)dlopen(file,dlflag);
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  YapInitProc proc = (YapInitProc) dlsym(handle, f);
+  if (!proc)
+    return FALSE;
+  (*proc) ();
+  return TRUE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return dlclose(handle);
+}
+
 
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
@@ -58,7 +91,6 @@ LoadForeign(StringList ofiles, StringList libs,
 #endif
     {
       strcpy(Yap_ErrorSay,dlerror());
-    fprintf(stderr,"f=%s\n",Yap_ErrorSay);
       return LOAD_FAILLED;
     }
     libs = libs->next;

C/load_dld.c

@@ -40,6 +40,25 @@ Yap_FindExecutable(char *name)
 }
 
 
+static void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  /* not implemented */
+  return NULL;
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  return FALSE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return -1;
+}
+
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
  * code files and libraries and locates an initialization routine

C/load_dll.c

@@ -32,6 +32,27 @@ Yap_FindExecutable(char *name)
 {
 }
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  return (void *)LoadLibrary(file);
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  YapInitProc proc = (YapInitProc)GetProcAddress((HMODULE)handle, f);
+  if (!proc)
+    return FALSE;
+  (*proc)();
+  return TRUE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return FreeLibrary((HMODULE)handle);
+}
 
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign

C/load_dyld.c

@@ -109,6 +109,29 @@ mydlclose(void *handle)
   return TRUE;
 } 
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  return (void *)mydlopen(file);
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  YapInitProc proc = (YapInitProc) mydlsym(f);
+  if (!proc)
+    return FALSE;
+  (*proc)();
+  return TRUE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return mydlclose(handle);
+}
+
+
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
  * code files and libraries and locates an initialization routine

C/load_foreign.c

@@ -109,6 +109,119 @@ p_load_foreign(void)
   return returncode;
 }
 
+static Int
+p_open_shared_object(void) {
+  StringList ofiles = NULL;
+  Term t = Deref(ARG1);
+  Term tflags = Deref(ARG2);
+  void *ptr;
+
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"open_shared_object/3");
+    return FALSE;
+  } 
+  if (!IsAtomTerm(t)) {
+    Yap_Error(TYPE_ERROR_ATOM,t,"open_shared_object/3");
+    return FALSE;
+  }
+  
+  if (IsVarTerm(tflags)) {
+    Yap_Error(INSTANTIATION_ERROR,tflags,"open_shared_object/3");
+    return FALSE;
+  } 
+  if (!IsIntTerm(tflags)) {
+    Yap_Error(TYPE_ERROR_INTEGER,tflags,"open_shared_object/3");
+    return FALSE;
+  }
+  
+  ofiles = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
+  ofiles->next = ofiles;
+  ofiles->s = RepAtom(AtomOfTerm(t))->StrOfAE;
+  if ((ptr = Yap_LoadForeignFile(ofiles->s, IntOfTerm(tflags)))==NULL) {
+      return FALSE;
+  } else {
+    ForeignObj *f_code = (ForeignObj *)Yap_AllocCodeSpace(sizeof(ForeignObj));
+    ofiles->handle = ptr;
+
+    f_code->objs = ofiles;
+    f_code->libs = NULL;
+    f_code->f = NULL;
+    f_code->next = ForeignCodeLoaded;
+    f_code->module = CurrentModule;
+    ForeignCodeLoaded = f_code;
+
+    return Yap_unify(MkIntegerTerm((Int)f_code),ARG3);
+  }
+}
+
+static Int
+p_close_shared_object(void) {
+  Term t = Deref(ARG1);
+  ForeignObj *f, *f0 = NULL, *fi = ForeignCodeLoaded;
+  void *handle;
+
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"open_shared_object/3");
+    return FALSE;
+  } 
+  if (!IsIntegerTerm(t)) {
+    Yap_Error(TYPE_ERROR_INTEGER,t,"open_shared_object/3");
+    return FALSE;
+  }
+  f = (ForeignObj *)IntegerOfTerm(t);
+ 
+  while (fi != f && fi) {
+    f0 = fi;
+    fi = f->next;
+  }
+  if (!fi)
+    return FALSE;
+  if (f0) {
+    f0->next = f->next;
+  } else {
+    ForeignCodeLoaded->next = f->next;
+  }
+  handle = f->objs->handle;
+  Yap_FreeCodeSpace((ADDR)f->objs);
+  Yap_FreeCodeSpace((ADDR)f);
+  return Yap_CloseForeignFile(f->f);
+}
+
+static Int
+p_call_shared_object_function(void) {
+  Term t = Deref(ARG1);
+  Term tfunc = Deref(ARG2);
+  ForeignObj *f, *f0 = NULL, *fi = ForeignCodeLoaded;
+  void *handle;
+
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"open_shared_object/3");
+    return FALSE;
+  } 
+  if (!IsIntegerTerm(t)) {
+    Yap_Error(TYPE_ERROR_INTEGER,t,"open_shared_object/3");
+    return FALSE;
+  }
+  f = (ForeignObj *)IntegerOfTerm(t);
+  if (IsVarTerm(tfunc)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"open_shared_object/3");
+    return FALSE;
+  } 
+  if (!IsAtomTerm(tfunc)) {
+    Yap_Error(TYPE_ERROR_ATOM,t,"open_shared_object/3");
+    return FALSE;
+  }
+ 
+  while (fi != f && fi) {
+    f0 = fi;
+    fi = f->next;
+  }
+  if (!fi)
+    return FALSE;
+  handle = f->objs->handle;
+  return Yap_CallForeignFile(handle, RepAtom(AtomOfTerm(tfunc))->StrOfAE);
+}
+
 static Int
 p_obj_suffix(void) {
   return Yap_unify(Yap_StringToList(YAP_SHLIB_SUFFIX),ARG1);
@@ -132,6 +245,9 @@ Yap_InitLoadForeign(void)
     Yap_FindExecutable(Yap_argv[0]);
   Yap_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$open_shared_objects", 0, p_open_shared_objects, SafePredFlag|HiddenPredFlag);
+  Yap_InitCPred("$open_shared_object", 3, p_open_shared_object, SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred("close_shared_object", 1, p_close_shared_object, SyncPredFlag|SafePredFlag);
+  Yap_InitCPred("call_shared_object_function", 2, p_call_shared_object_function, SyncPredFlag);
   Yap_InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag|HiddenPredFlag);
 }
 

C/load_none.c

@@ -44,6 +44,26 @@ LoadForeign(StringList ofiles, StringList libs,
   return LOAD_FAILLED;
 }
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  /* not implemented */
+  return NULL;
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  return FALSE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return -1;
+}
+
+
 Int
 Yap_LoadForeign(StringList ofiles, StringList libs,
 	    char *proc_name, YapInitProc *init_proc)

C/load_shl.c

@@ -21,6 +21,26 @@ void Yap_FindExecutable(char *name)
 }
 
 
+void *
+Yap_LoadForeignFile(char *file, int flags)
+{
+  /* not implemented */
+  return NULL;
+}
+
+int
+Yap_CallForeignFile(void *handle, char *f)
+{
+  return FALSE;
+}
+
+int
+Yap_CloseForeignFile(void *handle)
+{
+  return -1;
+}
+
+
 /*
  * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
  * code files and libraries and locates an initialization routine

pl/load_foreign.yap

@@ -87,6 +87,27 @@ load_foreign_files(Objs,Libs,Entry) :-
 '$check_entry_for_load_foreign_files'(Entry,G) :-
 	'$do_error'(type_error(atom,Entry),G).
 
+open_shared_object(File, Handle) :-
+	'$open_shared_object'(File, 0, Handle).
 
+open_shared_object(File, Opts, Handle) :-
+	'$open_shared_opts'(Opts, open_shared_object(File, Opts, Handle), OptsI),
+	'$open_shared_object'(File, OptsI, Handle).
 
+'$open_shared_opts'(Opts, G, OptsI) :-
+	var(Opts), !,
+	'$do_error'(instantiation_error,G).
+'$open_shared_opts'([], _, 0) :- !.
+'$open_shared_opts'(Opt.Opts, G, V) :-
+	'$open_shared_opts'(Opts, G, V0),
+	'$open_shared_opt'(Opt, G, OptV),
+	V0 is V \/ OptV.
+	
+'$open_shared_opt'(Opt, G, _) :-
+	var(Opt), !,
+	'$do_error'(instantiation_error,G).
+'$open_shared_opt'(now, __, 1) :- !.
+'$open_shared_opt'(global, __, 2) :- !.
+'$open_shared_opt'(Opt, Goal, _) :-
+	'$do_error'(domain_error(open_shared_object_option,Opt),Goal).