This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/load_foreign.c

283 lines
7.4 KiB
C
Raw Normal View History

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: load_foreign.c *
* comments: dynamic loader of external routines *
* *
*************************************************************************/
#ifdef SCCS
2017-10-17 00:13:09 +01:00
static char SccsId[] = "%W% %G%.2";
#endif
#include "Yap.h"
#include "YapHeap.h"
2013-12-08 19:12:24 +00:00
#include "YapText.h"
2017-10-17 00:13:09 +01:00
#include "Yatom.h"
#include "yapio.h"
#include <stdlib.h>
#if HAVE_STRING_H
#include <string.h>
#endif
#include "Foreign.h"
#if _WIN32 || defined(__CYGWIN__)
2013-10-29 12:43:31 +00:00
#ifndef SO_EXT
#define SO_EXT "dll"
#endif
#endif
2017-10-17 00:13:09 +01:00
Int p_load_foreign(USES_REGS1);
2017-10-17 00:13:09 +01:00
Int p_load_foreign(USES_REGS1) {
StringList ofiles = NULL;
StringList libs = NULL;
char *InitProcName;
YapInitProc InitProc = NULL;
Term t, t1;
StringList new;
bool returncode = FALSE;
yhandle_t CurSlot = Yap_StartSlots();
2015-07-23 01:27:29 +01:00
// Yap_DebugPlWrite(ARG1); printf("%s\n", " \n");
2017-10-17 00:13:09 +01:00
// Yap_DebugPlWrite(ARG2); printf("%s\n", " \n");
// ap_DebugPlWrite(ARG3); printf("%s\n", " \n");
/* collect the list of object files */
t = Deref(ARG1);
2017-10-17 00:13:09 +01:00
while (1) {
if (t == TermNil)
break;
t1 = HeadOfTerm(t);
t = TailOfTerm(t);
2017-10-17 00:13:09 +01:00
new = (StringList)Yap_AllocCodeSpace(sizeof(StringListItem));
new->next = ofiles;
new->name = AtomOfTerm(t1);
ofiles = new;
}
/* collect the list of library files */
t = Deref(ARG2);
2017-10-17 00:13:09 +01:00
while (1) {
if (t == TermNil)
break;
t1 = HeadOfTerm(t);
t = TailOfTerm(t);
2017-10-17 00:13:09 +01:00
new = (StringList)Yap_AllocCodeSpace(sizeof(StringListItem));
new->next = libs;
new->name = AtomOfTerm(t1);
libs = new;
}
/* get the initialization function name */
t1 = Deref(ARG3);
2015-09-21 23:05:36 +01:00
InitProcName = (char *)RepAtom(AtomOfTerm(t1))->StrOfAE;
// verify if it was waiting for initialization
2017-10-17 00:13:09 +01:00
if (Yap_LateInit(InitProcName)) {
returncode = true;
} else
/* call the OS specific function for dynamic loading */
if (Yap_LoadForeign(ofiles, libs, InitProcName, &InitProc) ==
LOAD_SUCCEEDED) {
if (InitProc == NULL) {
char *f;
if (ofiles) {
f = RepAtom(ofiles->name)->StrOfAE;
} else {
f = RepAtom(libs->name)->StrOfAE;
}
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG3,
"Foreign module %s does not have initialization function %s", f,
InitProcName);
return false;
}
Yap_StartSlots();
(*InitProc)();
2015-02-03 02:36:51 +00:00
Yap_CloseSlots(CurSlot);
returncode = true;
}
2017-10-17 00:13:09 +01:00
/* I should recover space if load foreign fails */
if (returncode == TRUE) {
ForeignObj *f_code = (ForeignObj *)Yap_AllocCodeSpace(sizeof(ForeignObj));
f_code->objs = ofiles;
f_code->libs = libs;
2012-06-11 22:11:30 +01:00
f_code->f = AtomOfTerm(t1);
f_code->next = ForeignCodeLoaded;
f_code->module = CurrentModule;
2010-04-12 17:21:50 +01:00
ForeignCodeLoaded = f_code;
} else {
while (ofiles) {
new = ofiles->next;
Yap_FreeCodeSpace((ADDR)ofiles);
ofiles = new;
}
while (libs) {
new = libs->next;
Yap_FreeCodeSpace((ADDR)libs);
libs = new;
}
}
return returncode;
}
2017-10-17 00:13:09 +01:00
static Int p_open_shared_object(USES_REGS1) {
Term t = Deref(ARG1);
Term tflags = Deref(ARG2);
char *s;
void *handle;
if (IsVarTerm(t)) {
2017-10-17 00:13:09 +01:00
Yap_Error(INSTANTIATION_ERROR, t, "open_shared_object/3");
return FALSE;
2017-10-17 00:13:09 +01:00
}
if (!IsAtomTerm(t)) {
2017-10-17 00:13:09 +01:00
Yap_Error(TYPE_ERROR_ATOM, t, "open_shared_object/3");
return FALSE;
}
2017-10-17 00:13:09 +01:00
if (IsVarTerm(tflags)) {
2017-10-17 00:13:09 +01:00
Yap_Error(INSTANTIATION_ERROR, tflags, "open_shared_object/3");
return FALSE;
2017-10-17 00:13:09 +01:00
}
if (!IsIntegerTerm(tflags)) {
2017-10-17 00:13:09 +01:00
Yap_Error(TYPE_ERROR_INTEGER, tflags, "open_shared_object/3");
return FALSE;
}
2017-10-17 00:13:09 +01:00
2015-09-21 23:05:36 +01:00
s = (char *)RepAtom(AtomOfTerm(t))->StrOfAE;
2017-10-17 00:13:09 +01:00
if ((handle = Yap_LoadForeignFile(s, IntegerOfTerm(tflags))) == NULL) {
Yap_Error(EXISTENCE_ERROR_SOURCE_SINK, t,
"open_shared_object_failed for %s"
" with %s\n",
s, LOCAL_ErrorMessage);
return FALSE;
} else {
2017-10-17 00:13:09 +01:00
return Yap_unify(MkIntegerTerm((Int)handle), ARG3);
}
}
2017-10-17 00:13:09 +01:00
static Int p_close_shared_object(USES_REGS1) {
Term t = Deref(ARG1);
void *handle;
if (IsVarTerm(t)) {
2017-10-17 00:13:09 +01:00
Yap_Error(INSTANTIATION_ERROR, t, "close_shared_object/1");
return FALSE;
2017-10-17 00:13:09 +01:00
}
if (!IsIntegerTerm(t)) {
2017-10-17 00:13:09 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t, "close_shared_object/1");
return FALSE;
}
handle = (char *)IntegerOfTerm(t);
2017-10-17 00:13:09 +01:00
return Yap_CloseForeignFile(handle);
}
2017-10-17 00:13:09 +01:00
static Int p_call_shared_object_function(USES_REGS1) {
Term t = Deref(ARG1);
Term tfunc = Deref(ARG2);
Term tmod;
void *handle;
Term OldCurrentModule = CurrentModule;
Int res;
tmod = CurrentModule;
2017-10-17 00:13:09 +01:00
restart:
if (IsVarTerm(t)) {
2017-10-17 00:13:09 +01:00
Yap_Error(INSTANTIATION_ERROR, t, "call_shared_object_function/2");
return FALSE;
} else if (IsApplTerm(t)) {
2017-10-17 00:13:09 +01:00
Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t);
2017-10-17 00:13:09 +01:00
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t, "call_shared_object_function/2");
return FALSE;
}
2017-10-17 00:13:09 +01:00
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "call_shared_object_function/2");
return FALSE;
}
t = ArgOfTerm(2, t);
goto restart;
}
} else if (!IsIntegerTerm(t)) {
2017-10-17 00:13:09 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t, "call_shared_object_function/2");
return FALSE;
}
handle = (void *)IntegerOfTerm(t);
if (IsVarTerm(tfunc)) {
2017-10-17 00:13:09 +01:00
Yap_Error(INSTANTIATION_ERROR, t, "call_shared_object_function/2");
return FALSE;
2017-10-17 00:13:09 +01:00
}
if (!IsAtomTerm(tfunc)) {
2017-10-17 00:13:09 +01:00
Yap_Error(TYPE_ERROR_ATOM, t, "call_shared_object_function/2/3");
return FALSE;
}
CurrentModule = tmod;
2017-10-17 00:13:09 +01:00
res =
Yap_CallForeignFile(handle, (char *)RepAtom(AtomOfTerm(tfunc))->StrOfAE);
CurrentModule = OldCurrentModule;
return res;
}
2017-10-17 00:13:09 +01:00
static Int p_obj_suffix(USES_REGS1) {
return Yap_unify(Yap_CharsToListOfCodes(SO_EXT, ENC_ISO_LATIN1 PASS_REGS),
ARG1);
}
2017-10-17 00:13:09 +01:00
static Int p_open_shared_objects(USES_REGS1) {
2013-10-29 12:43:31 +00:00
#ifdef SO_EXT
2010-06-14 22:43:15 +01:00
return TRUE;
#else
return FALSE;
#endif
}
2017-10-17 00:13:09 +01:00
void Yap_InitLoadForeign(void) {
Yap_InitCPred("$load_foreign_files", 3, p_load_foreign,
SafePredFlag | SyncPredFlag);
2012-10-19 18:10:48 +01:00
Yap_InitCPred("$open_shared_objects", 0, p_open_shared_objects, SafePredFlag);
Yap_InitCPred("$open_shared_object", 3, p_open_shared_object, SyncPredFlag);
2017-10-17 00:13:09 +01:00
Yap_InitCPred("close_shared_object", 1, p_close_shared_object,
SyncPredFlag | SafePredFlag);
/** @pred close_shared_object(+ _Handle_)
2014-09-11 20:06:57 +01:00
2017-10-17 00:13:09 +01:00
Detach the shared object identified by _Handle_.
2014-09-11 20:06:57 +01:00
2017-10-17 00:13:09 +01:00
*/
Yap_InitCPred("$call_shared_object_function", 2,
p_call_shared_object_function, SyncPredFlag);
2012-10-19 18:10:48 +01:00
Yap_InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag);
}
2017-10-17 00:13:09 +01:00
void Yap_ReOpenLoadForeign(void) {
CACHE_REGS
ForeignObj *f_code = ForeignCodeLoaded;
Term OldModule = CurrentModule;
while (f_code != NULL) {
2010-12-07 18:21:10 +00:00
YapInitProc InitProc = NULL;
CurrentModule = f_code->module;
2017-10-17 00:13:09 +01:00
if (Yap_ReLoadForeign(f_code->objs, f_code->libs,
(char *)RepAtom(f_code->f)->StrOfAE,
&InitProc) == LOAD_SUCCEEDED) {
if (InitProc)
2017-10-17 00:13:09 +01:00
(*InitProc)();
}
f_code = f_code->next;
}
CurrentModule = OldModule;
}