diff --git a/C/load_aix.c b/C/load_aix.c index dd05a4173..a8051bb72 100644 --- a/C/load_aix.c +++ b/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 diff --git a/C/load_aout.c b/C/load_aout.c index f127438c5..c6ad6b8cb 100644 --- a/C/load_aout.c +++ b/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 diff --git a/C/load_coff.c b/C/load_coff.c index a0f4bd7ca..f64ed7669 100644 --- a/C/load_coff.c +++ b/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 diff --git a/C/load_dl.c b/C/load_dl.c index f785c359d..86cf354f7 100644 --- a/C/load_dl.c +++ b/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; diff --git a/C/load_dld.c b/C/load_dld.c index 6ee2ed370..288cfd882 100644 --- a/C/load_dld.c +++ b/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 diff --git a/C/load_dll.c b/C/load_dll.c index 49a2e0e14..676386f71 100755 --- a/C/load_dll.c +++ b/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 diff --git a/C/load_dyld.c b/C/load_dyld.c index da93f4014..088089524 100644 --- a/C/load_dyld.c +++ b/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 diff --git a/C/load_foreign.c b/C/load_foreign.c index c3c079d01..434e55f82 100755 --- a/C/load_foreign.c +++ b/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); } diff --git a/C/load_none.c b/C/load_none.c index 515d21c51..45aeb5c54 100644 --- a/C/load_none.c +++ b/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) diff --git a/C/load_shl.c b/C/load_shl.c index 109680d76..43b6721b1 100644 --- a/C/load_shl.c +++ b/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 diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index 963138431..07d3b3527 100644 --- a/pl/load_foreign.yap +++ b/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). +