diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more changes to support SWI Input/Output. Now it compiles, which does

Browse Source 
not mean it would work!
This commit is contained in:
Vítor Santos Costa 2008-12-22 12:03:14 +00:00
parent 60b899ee4d
commit 43e70f2003
13 changed files with 208 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
C/c_interface.c
View File

@ -1065,6 +1065,18 @@ YAP_PutInSlot(long slot, Term t)
} }
typedef enum
{ FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */
} frg_code;
typedef struct context
{ int * context; /* context value */
frg_code control; /* FRG_* action */
struct PL_local_data *engine; /* invoking engine */
} scontext ;
typedef Int (*CPredicate1)(long); typedef Int (*CPredicate1)(long);
typedef Int (*CPredicate2)(long,long); typedef Int (*CPredicate2)(long,long);
typedef Int (*CPredicate3)(long,long,long); typedef Int (*CPredicate3)(long,long,long);
@ -1073,10 +1085,17 @@ typedef Int (*CPredicate5)(long,long,long,long,long);
typedef Int (*CPredicate6)(long,long,long,long,long,long); typedef Int (*CPredicate6)(long,long,long,long,long,long);
typedef Int (*CPredicate7)(long,long,long,long,long,long,long); typedef Int (*CPredicate7)(long,long,long,long,long,long,long);
typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long); typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long);
typedef Int (*CPredicateV)(Int,Int,struct context *);
Int Int
YAP_Execute(PredEntry *pe, CPredicate exec_code) YAP_Execute(PredEntry *pe, CPredicate exec_code)
{ {
if (pe->PredFlags & CArgsPredFlag) {
CPredicateV codev = exec_code;
struct context ctx;
return ((codev)((&ARG1)-LCL0,0,&ctx));
}
if (pe->PredFlags & CArgsPredFlag) { if (pe->PredFlags & CArgsPredFlag) {
switch (pe->ArityOfPE) { switch (pe->ArityOfPE) {
case 0: case 0:

1
C/init.c
View File

@ -1317,6 +1317,7 @@ InitCodes(void)
Yap_heap_regs->functor_clist = Yap_MkFunctor(Yap_FullLookupAtom("$when"), 4); Yap_heap_regs->functor_clist = Yap_MkFunctor(Yap_FullLookupAtom("$when"), 4);
Yap_heap_regs->functor_comma = Yap_MkFunctor(AtomComma, 2); Yap_heap_regs->functor_comma = Yap_MkFunctor(AtomComma, 2);
Yap_heap_regs->functor_csult = Yap_MkFunctor(AtomCsult, 1); Yap_heap_regs->functor_csult = Yap_MkFunctor(AtomCsult, 1);
Yap_heap_regs->functor_dot = Yap_MkFunctor(AtomDot, 2);
Yap_heap_regs->functor_eq = Yap_MkFunctor(AtomEq, 2); Yap_heap_regs->functor_eq = Yap_MkFunctor(AtomEq, 2);
Yap_heap_regs->functor_execute_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_in_mod"), 2); Yap_heap_regs->functor_execute_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_in_mod"), 2);
Yap_heap_regs->functor_execute2_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_wo_mod"), 2); Yap_heap_regs->functor_execute2_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_wo_mod"), 2);

1
C/tracer.c
View File

@ -396,7 +396,6 @@ volatile int vsc_wait;
static Int p_vsc_wait(void) static Int p_vsc_wait(void)
{ {
fprintf(stderr,"attach %d\n",(int)getpid());
while (!vsc_wait); while (!vsc_wait);
vsc_wait=1; vsc_wait=1;
return(TRUE); return(TRUE);

2
H/Heap.h
View File

@ -463,6 +463,7 @@ typedef struct various_codes {
functor_creep, functor_creep,
functor_csult, functor_csult,
functor_cut_by, functor_cut_by,
functor_dot,
functor_eq, functor_eq,
functor_execute_in_mod, functor_execute_in_mod,
functor_execute2_in_mod, functor_execute2_in_mod,
@ -778,6 +779,7 @@ extern struct various_codes *Yap_heap_regs;
#define FunctorCreep Yap_heap_regs->functor_creep #define FunctorCreep Yap_heap_regs->functor_creep
#define FunctorCsult Yap_heap_regs->functor_csult #define FunctorCsult Yap_heap_regs->functor_csult
#define FunctorCutBy Yap_heap_regs->functor_cut_by #define FunctorCutBy Yap_heap_regs->functor_cut_by
#define FunctorDot Yap_heap_regs->functor_dot
#define FunctorEq Yap_heap_regs->functor_eq #define FunctorEq Yap_heap_regs->functor_eq
#define FunctorExecuteInMod Yap_heap_regs->functor_execute_in_mod #define FunctorExecuteInMod Yap_heap_regs->functor_execute_in_mod
#define FunctorExecute2InMod Yap_heap_regs->functor_execute2_in_mod #define FunctorExecute2InMod Yap_heap_regs->functor_execute2_in_mod

1
H/Yatom.h
View File

@ -665,6 +665,7 @@ typedef enum
ProfiledPredFlag = 0x00000010L, /* pred is being profiled */ ProfiledPredFlag = 0x00000010L, /* pred is being profiled */
MyddasPredFlag = 0x00000008L, /* Myddas Imported pred */ MyddasPredFlag = 0x00000008L, /* Myddas Imported pred */
ModuleTransparentPredFlag = 0x00000004L, /* ModuleTransparent pred */ ModuleTransparentPredFlag = 0x00000004L, /* ModuleTransparent pred */
SWIEnvPredFlag = 0x00000002L /* new SWI interface */
} pred_flag; } pred_flag;
/* profile data */ /* profile data */

1
H/rheap.h
View File

@ -904,6 +904,7 @@ restore_codes(void)
Yap_heap_regs->functor_comma = FuncAdjust(Yap_heap_regs->functor_comma); Yap_heap_regs->functor_comma = FuncAdjust(Yap_heap_regs->functor_comma);
Yap_heap_regs->functor_creep = FuncAdjust(Yap_heap_regs->functor_creep); Yap_heap_regs->functor_creep = FuncAdjust(Yap_heap_regs->functor_creep);
Yap_heap_regs->functor_csult = FuncAdjust(Yap_heap_regs->functor_csult); Yap_heap_regs->functor_csult = FuncAdjust(Yap_heap_regs->functor_csult);
Yap_heap_regs->functor_dot = FuncAdjust(Yap_heap_regs->functor_dot);
Yap_heap_regs->functor_eq = FuncAdjust(Yap_heap_regs->functor_eq); Yap_heap_regs->functor_eq = FuncAdjust(Yap_heap_regs->functor_eq);
Yap_heap_regs->functor_execute_in_mod = FuncAdjust(Yap_heap_regs->functor_execute_in_mod); Yap_heap_regs->functor_execute_in_mod = FuncAdjust(Yap_heap_regs->functor_execute_in_mod);
Yap_heap_regs->functor_execute2_in_mod = FuncAdjust(Yap_heap_regs->functor_execute2_in_mod); Yap_heap_regs->functor_execute2_in_mod = FuncAdjust(Yap_heap_regs->functor_execute2_in_mod);

1
Makefile.in
View File

@ -572,6 +572,7 @@ mycb: $(srcdir)/mycb.c
$(CC) $(CFLAGS) $(srcdir)/mycb.c -o mycb $(CC) $(CFLAGS) $(srcdir)/mycb.c -o mycb
all: startup all: startup
(cd LGPL/PLStream; $(MAKE))
@INSTALL_DLLS@ (cd library/random; $(MAKE)) @INSTALL_DLLS@ (cd library/random; $(MAKE))
@INSTALL_DLLS@ (cd library/regex; $(MAKE)) @INSTALL_DLLS@ (cd library/regex; $(MAKE))
@INSTALL_DLLS@ (cd library/rltree; $(MAKE)) @INSTALL_DLLS@ (cd library/rltree; $(MAKE))

4
config.h.in
View File

@ -61,6 +61,7 @@
#undef HAVE_IEEEFP_H #undef HAVE_IEEEFP_H
#undef HAVE_IO_H #undef HAVE_IO_H
#undef HAVE_LIMITS_H #undef HAVE_LIMITS_H
#undef HAVE_LOCALE_H
#undef HAVE_MACH_O_DYLD_H #undef HAVE_MACH_O_DYLD_H
#undef HAVE_MALLOC_H #undef HAVE_MALLOC_H
#undef HAVE_MATH_H #undef HAVE_MATH_H
@ -70,6 +71,7 @@
#undef HAVE_NETDB_H #undef HAVE_NETDB_H
#undef HAVE_NETINET_IN_H #undef HAVE_NETINET_IN_H
#undef HAVE_PTHREAD_H #undef HAVE_PTHREAD_H
#undef HAVE_PWD_H
#undef HAVE_READLINE_READLINE_H #undef HAVE_READLINE_READLINE_H
#undef HAVE_REGEX_H #undef HAVE_REGEX_H
#undef HAVE_SIGINFO_H #undef HAVE_SIGINFO_H
@ -91,6 +93,7 @@
#undef HAVE_SYS_TYPES_H #undef HAVE_SYS_TYPES_H
#undef HAVE_SYS_UCONTEXT_H #undef HAVE_SYS_UCONTEXT_H
#undef HAVE_SYS_UN_H #undef HAVE_SYS_UN_H
#undef HAVE_SYS_WAIT_H
#undef HAVE_TIME_H #undef HAVE_TIME_H
#undef HAVE_UNISTD_H #undef HAVE_UNISTD_H
#undef HAVE_WCTYPE_H #undef HAVE_WCTYPE_H
@ -156,6 +159,7 @@
#undef HAVE_FETESTEXCEPT #undef HAVE_FETESTEXCEPT
#undef HAVE_FGETPOS #undef HAVE_FGETPOS
#undef HAVE_FINITE #undef HAVE_FINITE
#undef HAVE_FTIME
#undef HAVE_GETCWD #undef HAVE_GETCWD
#undef HAVE_GETENV #undef HAVE_GETENV
#undef HAVE_GETHOSTBYNAME #undef HAVE_GETHOSTBYNAME

18
configure vendored
View File

@ -8284,7 +8284,8 @@ done
for ac_header in malloc.h math.h memory.h mpi.h
for ac_header in locale.h malloc.h math.h memory.h mpi.h
do do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
@ -8426,7 +8427,8 @@ done
for ac_header in netdb.h netinet/in.h regex.h
for ac_header in netdb.h netinet/in.h pwd.h regex.h
do do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
@ -9279,7 +9281,8 @@ done
for ac_header in sys/ucontext.h sys/un.h
for ac_header in sys/ucontext.h sys/un.h sys/wait.h
do do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
@ -14257,7 +14260,8 @@ done
for ac_func in fesettrapenable fgetpos finite getcwd getenv
for ac_func in fesettrapenable fgetpos finite ftime getcwd getenv
do do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
{ echo "$as_me:$LINENO: checking for $ac_func" >&5 { echo "$as_me:$LINENO: checking for $ac_func" >&5
@ -16209,12 +16213,13 @@ mkdir -p LGPL/JPL/src
mkdir -p LGPL/clp mkdir -p LGPL/clp
mkdir -p LGPL/chr mkdir -p LGPL/chr
mkdir -p LGPL/swi_console mkdir -p LGPL/swi_console
mkdir -p LGPL/PLStream
mkdir -p GPL mkdir -p GPL
mkdir -p GPL/clpqr mkdir -p GPL/clpqr
mkdir -p GPL/http mkdir -p GPL/http
mkdir -p cplint mkdir -p cplint
ac_config_files="$ac_config_files Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile" ac_config_files="$ac_config_files Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile LGPL/PLStream/Makefile"
cat >confcache <<\_ACEOF cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure # This file is a shell script that caches the results of configure
@ -16796,6 +16801,7 @@ do
"GPL/http/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/http/Makefile" ;; "GPL/http/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/http/Makefile" ;;
"GPL/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/Makefile" ;; "GPL/Makefile") CONFIG_FILES="$CONFIG_FILES GPL/Makefile" ;;
"cplint/Makefile") CONFIG_FILES="$CONFIG_FILES cplint/Makefile" ;; "cplint/Makefile") CONFIG_FILES="$CONFIG_FILES cplint/Makefile" ;;
"LGPL/PLStream/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/PLStream/Makefile" ;;
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;} echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
@ -17449,4 +17455,4 @@ fi
make depend make depend
(cd LGPL/PLStream; make depend; cd ../..)

13
configure.in
View File

@ -1020,14 +1020,14 @@ AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS(arpa/inet.h ctype.h direct.h dirent.h dlfcn.h) AC_CHECK_HEADERS(arpa/inet.h ctype.h direct.h dirent.h dlfcn.h)
AC_CHECK_HEADERS(errno.h fcntl.h) AC_CHECK_HEADERS(errno.h fcntl.h)
AC_CHECK_HEADERS(fenv.h fpu_control.h ieeefp.h io.h limits.h) AC_CHECK_HEADERS(fenv.h fpu_control.h ieeefp.h io.h limits.h)
AC_CHECK_HEADERS(malloc.h math.h memory.h mpi.h) AC_CHECK_HEADERS(locale.h malloc.h math.h memory.h mpi.h)
AC_CHECK_HEADERS(netdb.h netinet/in.h regex.h) AC_CHECK_HEADERS(netdb.h netinet/in.h pwd.h regex.h)
AC_CHECK_HEADERS(siginfo.h signal.h stdarg.h string.h stropts.h) AC_CHECK_HEADERS(siginfo.h signal.h stdarg.h string.h stropts.h)
AC_CHECK_HEADERS(sys/conf.h sys/file.h) AC_CHECK_HEADERS(sys/conf.h sys/file.h)
AC_CHECK_HEADERS(sys/mman.h sys/param.h sys/resource.h sys/select.h) AC_CHECK_HEADERS(sys/mman.h sys/param.h sys/resource.h sys/select.h)
AC_CHECK_HEADERS(sys/shm.h sys/socket.h sys/stat.h) AC_CHECK_HEADERS(sys/shm.h sys/socket.h sys/stat.h)
AC_CHECK_HEADERS(sys/time.h sys/times.h sys/types.h) AC_CHECK_HEADERS(sys/time.h sys/times.h sys/types.h)
AC_CHECK_HEADERS(sys/ucontext.h sys/un.h) AC_CHECK_HEADERS(sys/ucontext.h sys/un.h sys/wait.h)
AC_CHECK_HEADERS(time.h unistd.h wctype.h winsock.h winsock2.h) AC_CHECK_HEADERS(time.h unistd.h wctype.h winsock.h winsock2.h)
AC_CHECK_HEADERS(mach-o/dyld.h) AC_CHECK_HEADERS(mach-o/dyld.h)
if test "$yap_cv_gmp" != "no" if test "$yap_cv_gmp" != "no"
@ -1290,7 +1290,7 @@ fi
dnl Checks for library functions. dnl Checks for library functions.
AC_TYPE_SIGNAL AC_TYPE_SIGNAL
AC_CHECK_FUNCS(acosh asinh atanh chdir ctime dlopen dup2) AC_CHECK_FUNCS(acosh asinh atanh chdir ctime dlopen dup2)
AC_CHECK_FUNCS(fesettrapenable fgetpos finite getcwd getenv) AC_CHECK_FUNCS(fesettrapenable fgetpos finite ftime getcwd getenv)
AC_CHECK_FUNCS(gethostbyname gethostid gethostname) AC_CHECK_FUNCS(gethostbyname gethostid gethostname)
AC_CHECK_FUNCS(gethrtime getpwnam getrusage gettimeofday getwd) AC_CHECK_FUNCS(gethrtime getpwnam getrusage gettimeofday getwd)
AC_CHECK_FUNCS(isatty isnan kill labs link lgamma) AC_CHECK_FUNCS(isatty isnan kill labs link lgamma)
@ -1450,12 +1450,13 @@ mkdir -p LGPL/JPL/src
mkdir -p LGPL/clp mkdir -p LGPL/clp
mkdir -p LGPL/chr mkdir -p LGPL/chr
mkdir -p LGPL/swi_console mkdir -p LGPL/swi_console
mkdir -p LGPL/PLStream
mkdir -p GPL mkdir -p GPL
mkdir -p GPL/clpqr mkdir -p GPL/clpqr
mkdir -p GPL/http mkdir -p GPL/http
mkdir -p cplint mkdir -p cplint
AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile) AC_OUTPUT(Makefile library/matrix/Makefile library/matlab/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/Makefile LGPL/chr/Makefile CLPBN/Makefile LGPL/clp/Makefile GPL/clpqr/Makefile library/lammpi/Makefile library/tries/Makefile library/rltree/Makefile LGPL/swi_console/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap GPL/http/Makefile GPL/Makefile cplint/Makefile LGPL/PLStream/Makefile)
make depend make depend
(cd LGPL/PLStream; make depend; cd ../..)

58
include/SWI-Prolog.h
View File

@ -13,11 +13,6 @@
#ifndef _FLI_H_INCLUDED #ifndef _FLI_H_INCLUDED
#define _FLI_H_INCLUDED #define _FLI_H_INCLUDED
#ifndef __SWI_PROLOG__ /* use this to switch on Prolog dialect */
#define __SWI_PROLOG__ /* normally defined by the plld compiler driver */
#endif
//=== includes =============================================================== //=== includes ===============================================================
#include "config.h" #include "config.h"
#include <YapInterface.h> #include <YapInterface.h>
@ -36,6 +31,46 @@
#endif #endif
#endif #endif
/*******************************
* EXPORT *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
See SWI-Prolog.h, containing the same code for an explanation on this
stuff.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef _PL_EXPORT_DONE
#define _PL_EXPORT_DONE
#if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
#define HAVE_DECLSPEC
#endif
#ifdef HAVE_DECLSPEC
# ifdef PL_KERNEL
#define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void
# else
# ifdef __BORLANDC__
#define PL_EXPORT(type) type _stdcall
#define PL_EXPORT_DATA(type) extern type
# else
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) __declspec(dllimport) type
# endif
#define install_t __declspec(dllexport) void
# endif
#else /*HAVE_DECLSPEC*/
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) extern type
#define install_t void
#endif /*HAVE_DECLSPEC*/
#endif /*_PL_EXPORT_DONE*/
typedef int bool;
typedef unsigned long term_t; typedef unsigned long term_t;
typedef void *module_t; typedef void *module_t;
typedef void *record_t; typedef void *record_t;
@ -83,6 +118,7 @@ typedef void *PL_engine_t;
#define PL_FA_NONDETERMINISTIC (0x04) /* foreign is non-deterministic */ #define PL_FA_NONDETERMINISTIC (0x04) /* foreign is non-deterministic */
#define PL_FA_VARARGS (0x08) /* call using t0, ac, ctx */ #define PL_FA_VARARGS (0x08) /* call using t0, ac, ctx */
#define PL_FA_CREF (0x10) /* Internal: has clause-reference */ #define PL_FA_CREF (0x10) /* Internal: has clause-reference */
#define PL_FA_ISO (0x20) /* Internal: ISO core predicate */
/* begin from pl-itf.h */ /* begin from pl-itf.h */
#define PL_VARIABLE (1) /* nothing */ #define PL_VARIABLE (1) /* nothing */
@ -163,6 +199,13 @@ consistent with the definitions in pl-itf.h, which is included with
users foreign language code. users foreign language code.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define NOTRACE PL_FA_NOTRACE
#define META PL_FA_TRANSPARENT
#define NDET PL_FA_NONDETERMINISTIC
#define VA PL_FA_VARARGS
#define CREF PL_FA_CREF
#define ISO PL_FA_ISO
typedef enum typedef enum
{ FRG_FIRST_CALL = 0, /* Initial call */ { FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */ FRG_CUTTED = 1, /* Context was cutted */
@ -223,6 +266,8 @@ typedef struct foreign_context *control_t;
#define ForeignContextPtr(h) ((void *)(h)->context) #define ForeignContextPtr(h) ((void *)(h)->context)
#define ForeignEngine(h) ((h)->engine) #define ForeignEngine(h) ((h)->engine)
#define FRG(n, a, f, flags) { n, a, f, flags }
/* end from pl-itf.h */ /* end from pl-itf.h */
/******************************* /*******************************
@ -240,9 +285,6 @@ typedef struct foreign_context *control_t;
#define PL_Q_DETERMINISTIC 0x20 /* call was deterministic */ #define PL_Q_DETERMINISTIC 0x20 /* call was deterministic */
#endif #endif
/* copied from old SICStus/SWI interface */
typedef void install_t;
#define PL_fail return FALSE /* fail */ #define PL_fail return FALSE /* fail */
#define PL_succeed return TRUE /* success */ #define PL_succeed return TRUE /* success */

35
include/SWI-Stream.h
View File

@ -2,17 +2,34 @@
#ifndef _PL_STREAM_H #ifndef _PL_STREAM_H
#define _PL_STREAM_H #define _PL_STREAM_H
#ifndef X_API #ifndef _PL_EXPORT_DONE
#if defined(_MSC_VER) && defined(YAP_EXPORTS) #define _PL_EXPORT_DONE
#define X_API __declspec(dllexport)
#else #if (defined(__WINDOWS__) || defined(__CYGWIN__)) && !defined(__LCC__)
#define X_API #define HAVE_DECLSPEC
#endif
#endif #endif
#ifndef PL_EXPORT #ifdef HAVE_DECLSPEC
#define PL_EXPORT(type) extern X_API type # ifdef PL_KERNEL
#endif #define PL_EXPORT(type) __declspec(dllexport) type
#define PL_EXPORT_DATA(type) __declspec(dllexport) type
#define install_t void
# else
# ifdef __BORLANDC__
#define PL_EXPORT(type) type _stdcall
#define PL_EXPORT_DATA(type) extern type
# else
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) __declspec(dllimport) type
# endif
#define install_t __declspec(dllexport) void
# endif
#else /*HAVE_DECLSPEC*/
#define PL_EXPORT(type) extern type
#define PL_EXPORT_DATA(type) extern type
#define install_t void
#endif /*HAVE_DECLSPEC*/
#endif /*_PL_EXPORT_DONE*/
/* This appears to make the wide-character support compile and work /* This appears to make the wide-character support compile and work
on HPUX 11.23. There really should be a cleaner way ... on HPUX 11.23. There really should be a cleaner way ...

125
library/yap2swi/yap2swi.c
View File

@ -52,6 +52,18 @@ SWIAtomToAtom(atom_t at)
return (Atom)at; return (Atom)at;
} }
static inline functor_t
FunctorToSWIFunctor(Functor at)
{
return (functor_t)at;
}
static inline Functor
SWIFunctorToFunctor(functor_t at)
{
return (Functor)at;
}
static void static void
PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m) PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m)
{ {
@ -86,6 +98,23 @@ UserCPredicateWithArgs(char *a, CPredicate def, unsigned long int arity, Term mo
CurrentModule = cm; CurrentModule = cm;
} }
static void
UserCPredicateVarargs(char *a, CPredicate def, unsigned long int arity, Term mod)
{
PredEntry *pe;
Term cm = CurrentModule;
CurrentModule = mod;
Yap_InitCPred(a, arity, def, UserCPredFlag);
if (arity == 0) {
pe = RepPredProp(PredPropByAtom(Yap_LookupAtom(a),mod));
} else {
Functor f = Yap_MkFunctor(Yap_LookupAtom(a), arity);
pe = RepPredProp(PredPropByFunc(f,mod));
}
pe->PredFlags |= SWIEnvPredFlag;
CurrentModule = cm;
}
char buffers[TMP_BUF_SIZE+BUF_SIZE*BUF_RINGS]; char buffers[TMP_BUF_SIZE+BUF_SIZE*BUF_RINGS];
static int buf_index = 0; static int buf_index = 0;
@ -381,7 +410,7 @@ X_API int PL_get_functor(term_t ts, functor_t *f)
if ( IsAtomTerm(t)) { if ( IsAtomTerm(t)) {
*f = t; *f = t;
} else { } else {
*f = (functor_t)YAP_FunctorOfTerm(t); *f = FunctorToSWIFunctor(FunctorOfTerm(t));
} }
return 1; return 1;
} }
@ -669,9 +698,9 @@ X_API functor_t PL_new_functor(atom_t name, int arity)
functor_t f; functor_t f;
Atom at = SWIAtomToAtom(name); Atom at = SWIAtomToAtom(name);
if (arity == 0) { if (arity == 0) {
f = (functor_t)MkAtomTerm(at); f = FunctorToSWIFunctor((Functor)MkAtomTerm(at));
} else { } else {
f = (functor_t)Yap_MkFunctor(at,arity); f = FunctorToSWIFunctor(Yap_MkFunctor(at,arity));
} }
return f; return f;
} }
@ -679,9 +708,9 @@ X_API functor_t PL_new_functor(atom_t name, int arity)
X_API atom_t PL_functor_name(functor_t f) X_API atom_t PL_functor_name(functor_t f)
{ {
if (IsAtomTerm(f)) { if (IsAtomTerm(f)) {
return AtomToSWIAtom(AtomOfTerm(f)); return AtomToSWIAtom(AtomOfTerm((Term)SWIFunctorToFunctor(f)));
} else { } else {
return AtomToSWIAtom(NameOfFunctor((Functor)f)); return AtomToSWIAtom(NameOfFunctor(SWIFunctorToFunctor(f)));
} }
} }
@ -690,7 +719,7 @@ X_API int PL_functor_arity(functor_t f)
if (IsAtomTerm(f)) { if (IsAtomTerm(f)) {
return 0; return 0;
} else { } else {
return YAP_ArityOfFunctor((YAP_Functor)f); return ArityOfFunctor(SWIFunctorToFunctor(f));
} }
} }
@ -703,12 +732,13 @@ X_API void PL_cons_functor(term_t d, functor_t f,...)
va_list ap; va_list ap;
int arity, i; int arity, i;
YAP_Term *tmp = (YAP_CELL *)buffers; YAP_Term *tmp = (YAP_CELL *)buffers;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((YAP_Term)f)) { if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(d, (YAP_Term)f); Yap_PutInSlot(d, (YAP_Term)f);
return; return;
} }
arity = YAP_ArityOfFunctor((YAP_Functor)f); arity = ArityOfFunctor(ff);
if (arity > TMP_BUF_SIZE/sizeof(YAP_CELL)) { if (arity > TMP_BUF_SIZE/sizeof(YAP_CELL)) {
fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity); fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity);
return; return;
@ -718,25 +748,26 @@ X_API void PL_cons_functor(term_t d, functor_t f,...)
tmp[i] = Yap_GetFromSlot(va_arg(ap, term_t)); tmp[i] = Yap_GetFromSlot(va_arg(ap, term_t));
} }
va_end (ap); va_end (ap);
if (arity == 2 && (Functor)f == Yap_MkFunctor(AtomDot,2)) if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(d,YAP_MkPairTerm(tmp[0],tmp[1])); Yap_PutInSlot(d,YAP_MkPairTerm(tmp[0],tmp[1]));
else else
Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)f,arity,tmp)); Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)ff,arity,tmp));
} }
X_API void PL_cons_functor_v(term_t d, functor_t f,term_t a0) X_API void PL_cons_functor_v(term_t d, functor_t f,term_t a0)
{ {
int arity; int arity;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm(f)) { if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(d,(YAP_Term)f); Yap_PutInSlot(d,(Term)ff);
return; return;
} }
arity = YAP_ArityOfFunctor((YAP_Functor)f); arity = ArityOfFunctor(ff);
if (arity == 2 && (Functor)f == Yap_MkFunctor(AtomDot,2)) if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(d,YAP_MkPairTerm(Yap_GetFromSlot(a0),Yap_GetFromSlot(a0+1))); Yap_PutInSlot(d,YAP_MkPairTerm(Yap_GetFromSlot(a0),Yap_GetFromSlot(a0+1)));
else else
Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)f,arity,YAP_AddressFromSlot(a0))); Yap_PutInSlot(d,YAP_MkApplTerm((YAP_Functor)ff,arity,YAP_AddressFromSlot(a0)));
} }
X_API void PL_cons_list(term_t d, term_t h, term_t t) X_API void PL_cons_list(term_t d, term_t h, term_t t)
@ -762,14 +793,16 @@ X_API void PL_put_float(term_t t, double fl)
X_API void PL_put_functor(term_t t, functor_t f) X_API void PL_put_functor(term_t t, functor_t f)
{ {
long int arity; long int arity;
if (IsAtomTerm(f)) { Functor ff = SWIFunctorToFunctor(f);
Yap_PutInSlot(t,f);
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(t,(Term)ff);
} else { } else {
arity = YAP_ArityOfFunctor((YAP_Functor)f); arity = ArityOfFunctor(ff);
if (arity == 2 && (Functor)f == Yap_MkFunctor(AtomDot,2)) if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(t,YAP_MkNewPairTerm()); Yap_PutInSlot(t,YAP_MkNewPairTerm());
else else
Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)f,arity)); Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)ff,arity));
} }
} }
@ -910,11 +943,14 @@ X_API int PL_unify_integer(term_t t, long n)
X_API int PL_unify_functor(term_t t, functor_t f) X_API int PL_unify_functor(term_t t, functor_t f)
{ {
YAP_Term tt = Yap_GetFromSlot(t); YAP_Term tt = Yap_GetFromSlot(t);
Functor ff = SWIFunctorToFunctor(f);
if (YAP_IsVarTerm(tt)) if (YAP_IsVarTerm(tt))
return YAP_Unify(tt, YAP_MkNewApplTerm((YAP_Functor)f,YAP_ArityOfFunctor((YAP_Functor)f))); return YAP_Unify(tt, YAP_MkNewApplTerm((YAP_Functor)ff,YAP_ArityOfFunctor((YAP_Functor)f)));
if (YAP_IsPairTerm(tt))
return ff == FunctorDot;
if (!YAP_IsApplTerm(tt)) if (!YAP_IsApplTerm(tt))
return FALSE; return FALSE;
return f == (functor_t)YAP_FunctorOfTerm(tt); return ff == FunctorOfTerm(tt);
} }
/* SWI: int PL_unify_integer(term_t ?t, long n) /* SWI: int PL_unify_integer(term_t ?t, long n)
@ -1144,18 +1180,19 @@ get_term(arg_types **buf)
functor_t f = ptr->arg.f; functor_t f = ptr->arg.f;
long int arity, i; long int arity, i;
term_t loc; term_t loc;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((YAP_Term)f)) { if (IsAtomTerm((Term)ff)) {
t = (YAP_Term)f; t = (Term)ff;
break; break;
} }
arity = YAP_ArityOfFunctor((YAP_Functor)f); arity = YAP_ArityOfFunctor((YAP_Functor)ff);
loc = Yap_NewSlots(arity); loc = Yap_NewSlots(arity);
ptr++; ptr++;
for (i= 0; i < arity; i++) { for (i= 0; i < arity; i++) {
Yap_PutInSlot(loc+i,get_term(&ptr)); Yap_PutInSlot(loc+i,get_term(&ptr));
} }
t = YAP_MkApplTerm((YAP_Functor)f,arity,YAP_AddressFromSlot(loc)); t = YAP_MkApplTerm((YAP_Functor)ff,arity,YAP_AddressFromSlot(loc));
} }
break; break;
case PL_LIST: case PL_LIST:
@ -1230,9 +1267,10 @@ X_API int PL_unify_term(term_t l,...)
case PL_FUNCTOR: case PL_FUNCTOR:
{ {
functor_t f = va_arg(ap, functor_t); functor_t f = va_arg(ap, functor_t);
Functor ff = SWIFunctorToFunctor(f);
ptr->arg.f = f; ptr->arg.f = f;
if (!IsAtomTerm((YAP_Term)f)) { if (!IsAtomTerm((YAP_Term)ff)) {
nels += YAP_ArityOfFunctor((YAP_Functor)f); nels += YAP_ArityOfFunctor((YAP_Functor)ff);
} }
} }
break; break;
@ -1309,10 +1347,11 @@ X_API int PL_is_compound(term_t ts)
X_API int PL_is_functor(term_t ts, functor_t f) X_API int PL_is_functor(term_t ts, functor_t f)
{ {
YAP_Term t = Yap_GetFromSlot(ts); YAP_Term t = Yap_GetFromSlot(ts);
Functor ff = SWIFunctorToFunctor(f);
if (YAP_IsApplTerm(t)) { if (YAP_IsApplTerm(t)) {
return YAP_FunctorOfTerm(t) == (YAP_Functor)f; return FunctorOfTerm(t) == (Functor)ff;
} else if (YAP_IsPairTerm(t)) { } else if (YAP_IsPairTerm(t)) {
return FunctorOfTerm(t) == Yap_MkFunctor(AtomDot,2); return FunctorOfTerm(t) == FunctorDot;
} else } else
return 0; return 0;
} }
@ -1541,11 +1580,11 @@ X_API atom_t PL_module_name(module_t m)
X_API predicate_t PL_pred(functor_t f, module_t m) X_API predicate_t PL_pred(functor_t f, module_t m)
{ {
if (IsAtomTerm(f)) { Functor ff = SWIFunctorToFunctor(f);
return YAP_Predicate(YAP_AtomOfTerm(f),0,(YAP_Module)m); if (IsAtomTerm((Term)f)) {
return YAP_Predicate(YAP_AtomOfTerm((Term)f),0,(YAP_Module)m);
} else { } else {
YAP_Functor tf = (YAP_Functor)f; return YAP_Predicate((YAP_Atom)NameOfFunctor(ff),ArityOfFunctor(ff),(YAP_Module)m);
return YAP_Predicate(YAP_NameOfFunctor(tf),YAP_ArityOfFunctor(tf),(YAP_Module)m);
} }
} }
@ -1670,7 +1709,9 @@ X_API void PL_register_extensions(PL_extension *ptr)
YAP_Error(0,YAP_MkIntTerm(ptr->flags),"non-implemented flag %x when creating predicates", ptr->flags); YAP_Error(0,YAP_MkIntTerm(ptr->flags),"non-implemented flag %x when creating predicates", ptr->flags);
return; return;
} }
if (ptr->flags & PL_FA_TRANSPARENT) if (ptr->flags & PL_FA_VARARGS)
UserCPredicateVarargs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (ptr->flags & PL_FA_TRANSPARENT)
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,MkAtomTerm(Yap_LookupAtom("prolog"))); UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else else
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule()); UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
@ -1684,12 +1725,14 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
YAP_Error(0,YAP_MkIntTerm(flags),"non-implemented flag %x when creating predicates", flags); YAP_Error(0,YAP_MkIntTerm(flags),"non-implemented flag %x when creating predicates", flags);
return; return;
} }
if (flags & PL_FA_TRANSPARENT) if (flags & PL_FA_VARARGS)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom("prolog"))); UserCPredicateVarargs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (module == NULL) else if (flags & PL_FA_TRANSPARENT)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,YAP_CurrentModule()); UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else else if (module == NULL)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom((char *)module))); UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,YAP_CurrentModule());
else
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom((char *)module)));
} }
X_API void PL_load_extensions(PL_extension *ptr) X_API void PL_load_extensions(PL_extension *ptr)