more fixes to SWI emulation
integrate in main binary
This commit is contained in:
Vitor Santos Costa
parent
841f6eb1e5
commit
3fe9b923cb
@ -528,6 +528,8 @@ X_API int STD_PROTO(YAP_SetYAPFlag,(yap_flag_t, int));
|
||||
X_API Int STD_PROTO(YAP_VarSlotToNumber,(Int));
|
||||
X_API Term STD_PROTO(YAP_ModuleUser,(void));
|
||||
X_API Int STD_PROTO(YAP_NumberOfClausesForPredicate,(PredEntry *));
|
||||
X_API int STD_PROTO(YAP_MaxOpPriority,(Atom, Term));
|
||||
X_API int STD_PROTO(YAP_OpInfo,(Atom, Term, int, int *, int *));
|
||||
|
||||
static int (*do_getf)(void);
|
||||
|
||||
@ -3348,3 +3350,82 @@ Int YAP_NumberOfClausesForPredicate(PredEntry *pe) {
|
||||
return pe->cs.p_code.NOfClauses;
|
||||
}
|
||||
|
||||
int YAP_MaxOpPriority(Atom at, Term module)
|
||||
{
|
||||
AtomEntry *ae = RepAtom(at);
|
||||
OpEntry *info;
|
||||
WRITE_LOCK(ae->ARWLock);
|
||||
info = Yap_GetOpPropForAModuleHavingALock(ae, module);
|
||||
if (!info) {
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
return 0;
|
||||
}
|
||||
int ret = info->Prefix;
|
||||
if (info->Infix > ret)
|
||||
ret = info->Infix;
|
||||
if (info->Posfix > ret)
|
||||
ret = info->Posfix;
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
return ret;
|
||||
}
|
||||
|
||||
int YAP_OpInfo(Atom at, Term module, int opkind, int *yap_type, int *prio)
|
||||
{
|
||||
AtomEntry *ae = RepAtom(at);
|
||||
OpEntry *info;
|
||||
int n;
|
||||
|
||||
WRITE_LOCK(ae->ARWLock);
|
||||
info = Yap_GetOpPropForAModuleHavingALock(ae, module);
|
||||
if (!info) {
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
return 0;
|
||||
}
|
||||
if (opkind == PREFIX_OP) {
|
||||
SMALLUNSGN p = info->Prefix;
|
||||
if (!p) {
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
return FALSE;
|
||||
}
|
||||
if (p & DcrrpFlag) {
|
||||
n = 6;
|
||||
*prio = (p ^ DcrrpFlag);
|
||||
} else {
|
||||
n = 7;
|
||||
*prio = p;
|
||||
}
|
||||
} else if (opkind == INFIX_OP) {
|
||||
SMALLUNSGN p = info->Infix;
|
||||
if (!p) {
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
return FALSE;
|
||||
}
|
||||
if ((p & DcrrpFlag) && (p & DcrlpFlag)) {
|
||||
n = 1;
|
||||
*prio = (p ^ (DcrrpFlag | DcrlpFlag));
|
||||
} else if (p & DcrrpFlag) {
|
||||
n = 3;
|
||||
*prio = (p ^ DcrrpFlag);
|
||||
} else if (p & DcrlpFlag) {
|
||||
n = 2;
|
||||
*prio = (p ^ DcrlpFlag);
|
||||
} else {
|
||||
n = 4;
|
||||
*prio = p;
|
||||
}
|
||||
} else {
|
||||
SMALLUNSGN p = info->Posfix;
|
||||
if (p & DcrlpFlag) {
|
||||
n = 4;
|
||||
*prio = (p ^ DcrlpFlag);
|
||||
} else {
|
||||
n = 5;
|
||||
*prio = p;
|
||||
}
|
||||
}
|
||||
*yap_type = n;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
1
C/init.c
1
C/init.c
@ -1310,7 +1310,6 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
|
||||
/* Init signal handling and time */
|
||||
/* also init memory page size, required by later functions */
|
||||
Yap_InitSysbits ();
|
||||
|
||||
if (Heap < MinHeapSpace)
|
||||
Heap = MinHeapSpace;
|
||||
Heap = AdjustPageSize(Heap * K);
|
||||
|
||||
@ -4045,6 +4045,10 @@ Yap_InitBackCPreds(void)
|
||||
#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
|
||||
Yap_InitBackMYDDAS_SharedPreds();
|
||||
#endif
|
||||
{
|
||||
extern void initIO(void);
|
||||
initIO();
|
||||
}
|
||||
}
|
||||
|
||||
typedef void (*Proc)(void);
|
||||
|
||||
110
Makefile.in
110
Makefile.in
@ -106,6 +106,7 @@ MYDDAS_VERSION=MYDDAS-0.9.1
|
||||
#
|
||||
|
||||
INTERFACE_HEADERS = \
|
||||
$(IOLIB_HEADERS) \
|
||||
$(srcdir)/include/c_interface.h \
|
||||
$(srcdir)/include/clause_list.h \
|
||||
$(srcdir)/include/dswiatoms.h \
|
||||
@ -116,6 +117,21 @@ INTERFACE_HEADERS = \
|
||||
$(srcdir)/include/SWI-Prolog.h \
|
||||
$(srcdir)/include/SWI-Stream.h
|
||||
|
||||
IOLIB_HEADERS=$(srcdir)/packages/PLStream/atoms.h $(srcdir)/packages/PLStream/pl-buffer.h \
|
||||
$(srcdir)/packages/PLStream/pl-ctype.h \
|
||||
$(srcdir)/packages/PLStream/pl-codelist.h \
|
||||
$(srcdir)/packages/PLStream/pl-dtoa.h $(srcdir)/dtoa.c \
|
||||
$(srcdir)/packages/PLStream/pl-incl.h \
|
||||
$(srcdir)/packages/PLStream/pl-mswchar.h \
|
||||
$(srcdir)/packages/PLStream/pl-option.h \
|
||||
$(srcdir)/packages/PLStream/pl-opts.h \
|
||||
$(srcdir)/packages/PLStream/pl-os.h \
|
||||
$(srcdir)/packages/PLStream/pl-privitf.h \
|
||||
$(srcdir)/packages/PLStream/pl-stream.h \
|
||||
$(srcdir)/packages/PLStream/pl-table.h \
|
||||
$(srcdir)/packages/PLStream/pl-text.h $(srcdir)/pl-utf8.h \
|
||||
$(srcdir)/packages/PLStream/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/packages/PLStream/uxnt/dirent.h $(srcdir)/packages/PLStream/uxnt/utf8.h $(srcdir)/packages/PLStream/pl-utf8.c $(srcdir)/packages/PLStream/uxnt/uxnt.h
|
||||
|
||||
HEADERS = \
|
||||
$(srcdir)/H/TermExt.h \
|
||||
$(srcdir)/H/Atoms.h \
|
||||
@ -178,7 +194,26 @@ HEADERS = \
|
||||
$(srcdir)/MYDDAS/myddas_statistics_structs.h \
|
||||
$(srcdir)/MYDDAS/myddas_wkb.h $(srcdir)/MYDDAS/myddas_wkb2prolog.h
|
||||
|
||||
IOLIB_SOURCES=$(srcdir)/packages/PLStream/pl-buffer.c $(srcdir)/packages/PLStream/pl-ctype.c \
|
||||
$(srcdir)/packages/PLStream/pl-codelist.c \
|
||||
$(srcdir)/packages/PLStream/pl-dtoa.c \
|
||||
$(srcdir)/packages/PLStream/pl-error.c \
|
||||
$(srcdir)/packages/PLStream/pl-file.c \
|
||||
$(srcdir)/packages/PLStream/pl-files.c \
|
||||
$(srcdir)/packages/PLStream/pl-fmt.c \
|
||||
$(srcdir)/packages/PLStream/pl-glob.c \
|
||||
$(srcdir)/packages/PLStream/pl-option.c \
|
||||
$(srcdir)/packages/PLStream/pl-os.c \
|
||||
$(srcdir)/packages/PLStream/pl-privitf.c \
|
||||
$(srcdir)/packages/PLStream/pl-stream.c $(srcdir)/packages/PLStream/pl-string.c \
|
||||
$(srcdir)/packages/PLStream/pl-table.c \
|
||||
$(srcdir)/packages/PLStream/pl-text.c \
|
||||
$(srcdir)/packages/PLStream/pl-util.c \
|
||||
$(srcdir)/packages/PLStream/pl-write.c \
|
||||
$(srcdir)/packages/PLStream/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/packages/PLStream/popen.c $(srcdir)/packages/PLStream/uxnt/uxnt.c
|
||||
|
||||
C_SOURCES= \
|
||||
$(IOLIB_SOURCES) \
|
||||
$(srcdir)/C/absmi.c $(srcdir)/C/adtdefs.c \
|
||||
$(srcdir)/C/agc.c $(srcdir)/C/alloc.c \
|
||||
$(srcdir)/C/amasm.c $(srcdir)/C/analyst.c \
|
||||
@ -284,6 +319,15 @@ PL_SOURCES= \
|
||||
YAPDOCS=$(srcdir)/docs/yap.tex $(srcdir)/docs/chr.tex \
|
||||
$(srcdir)/docs/clpr.tex $(srcdir)/docs/swi.tex
|
||||
|
||||
IOLIB_OBJECTS=pl-buffer.o pl-codelist.o pl-ctype.o pl-dtoa.o pl-error.o \
|
||||
pl-file.o pl-files.o pl-fmt.o \
|
||||
pl-glob.o pl-option.o \
|
||||
pl-os.o pl-privitf.o \
|
||||
pl-stream.o pl-string.o pl-table.o \
|
||||
pl-text.o pl-util.o pl-utf8.o \
|
||||
pl-write.o \
|
||||
pl-yap.o @ENABLE_WINCONSOLE@ uxnt.o
|
||||
|
||||
ENGINE_OBJECTS = \
|
||||
agc.o absmi.o adtdefs.o alloc.o amasm.o analyst.o arrays.o \
|
||||
arith0.o arith1.o arith2.o attvar.o \
|
||||
@ -301,7 +345,7 @@ ENGINE_OBJECTS = \
|
||||
udi.o rtree.o rtree_udi.o\
|
||||
unify.o userpreds.o utilpreds.o \
|
||||
write.o \
|
||||
blobs.o swi.o ypsocks.o ypstdio.o @MPI_OBJS@
|
||||
blobs.o swi.o ypsocks.o ypstdio.o $(IOLIB_OBJECTS) @MPI_OBJS@
|
||||
|
||||
C_INTERFACE_OBJECTS = \
|
||||
load_foreign.o load_dl.o load_dld.o load_dyld.o \
|
||||
@ -505,6 +549,66 @@ pl-ntconsole.o: $(srcdir)/console/LGPL/pl-ntconsole.c config.h
|
||||
pl-ntmain.o: $(srcdir)/console/LGPL/pl-ntmain.c config.h
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/console/LGPL/pl-ntmain.c -o $@
|
||||
|
||||
pl-buffer.o: $(srcdir)/packages/PLStream/pl-buffer.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-buffer.c -o $@
|
||||
|
||||
pl-codelist.o: $(srcdir)/packages/PLStream/pl-codelist.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-codelist.c -o $@
|
||||
|
||||
pl-ctype.o: $(srcdir)/packages/PLStream/pl-ctype.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-ctype.c -o $@
|
||||
|
||||
pl-dtoa.o: $(srcdir)/packages/PLStream/pl-dtoa.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-dtoa.c -o $@
|
||||
|
||||
pl-error.o: $(srcdir)/packages/PLStream/pl-error.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-error.c -o $@
|
||||
|
||||
pl-file.o: $(srcdir)/packages/PLStream/pl-file.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-file.c -o $@
|
||||
|
||||
pl-files.o: $(srcdir)/packages/PLStream/pl-files.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-files.c -o $@
|
||||
|
||||
pl-fmt.o: $(srcdir)/packages/PLStream/pl-fmt.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-fmt.c -o $@
|
||||
|
||||
pl-glob.o: $(srcdir)/packages/PLStream/pl-glob.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-glob.c -o $@
|
||||
|
||||
pl-option.o: $(srcdir)/packages/PLStream/pl-option.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-option.c -o $@
|
||||
|
||||
pl-os.o: $(srcdir)/packages/PLStream/pl-os.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-os.c -o $@
|
||||
|
||||
pl-privitf.o: $(srcdir)/packages/PLStream/pl-privitf.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-privitf.c -o $@
|
||||
|
||||
pl-stream.o: $(srcdir)/packages/PLStream/pl-stream.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-stream.c -o $@
|
||||
|
||||
pl-string.o: $(srcdir)/packages/PLStream/pl-string.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-string.c -o $@
|
||||
|
||||
pl-table.o: $(srcdir)/packages/PLStream/pl-table.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-table.c -o $@
|
||||
|
||||
pl-text.o: $(srcdir)/packages/PLStream/pl-text.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-text.c -o $@
|
||||
|
||||
pl-utf8.o: $(srcdir)/packages/PLStream/pl-utf8.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-utf8.c -o $@
|
||||
|
||||
pl-util.o: $(srcdir)/packages/PLStream/pl-util.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-util.c -o $@
|
||||
|
||||
pl-write.o: $(srcdir)/packages/PLStream/pl-write.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-write.c -o $@
|
||||
|
||||
pl-yap.o: $(srcdir)/packages/PLStream/pl-yap.c
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-yap.c -o $@
|
||||
|
||||
# default rule
|
||||
%.o : $(srcdir)/C/%.c config.h
|
||||
$(CC) -c $(CFLAGS) $< -o $@
|
||||
@ -526,7 +630,6 @@ mycb: $(srcdir)/mycb.c
|
||||
$(CC) $(CFLAGS) $(srcdir)/mycb.c -o mycb
|
||||
|
||||
all: startup.yss
|
||||
@INSTALL_DLLS@ (cd packages/PLStream; $(MAKE))
|
||||
@INSTALL_DLLS@ (cd library/lammpi; $(MAKE))
|
||||
@INSTALL_MATLAB@ (cd library/matlab; $(MAKE))
|
||||
@INSTALL_DLLS@ (cd library/matrix; $(MAKE))
|
||||
@ -586,7 +689,6 @@ install_unix: startup.yss libYap.a
|
||||
$(INSTALL) $(srcdir)/README $(DESTDIR)$(DOCSDIR)
|
||||
$(INSTALL) $(srcdir)/COPYING $(DESTDIR)$(DOCSDIR)
|
||||
for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
|
||||
@INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) install)
|
||||
@INSTALL_DLLS@ (cd library/lammpi; $(MAKE) install)
|
||||
@INSTALL_DLLS@ (cd library/matrix; $(MAKE) install)
|
||||
@INSTALL_DLLS@ (cd library/random; $(MAKE) install)
|
||||
@ -645,7 +747,6 @@ install_win32: startup.yss
|
||||
@ENABLE_WINCONSOLE@ (cd LGPL/swi_console; $(MAKE) install)
|
||||
@INSTALL_MATLAB@ (cd library/matlab; $(MAKE) install)
|
||||
(cd library/tries; $(MAKE) install)
|
||||
(cd packages/PLStream; $(MAKE) install)
|
||||
(cd packages/tai; $(MAKE) install)
|
||||
(cd packages/clib; $(MAKE) install)
|
||||
(cd packages/plunit; $(MAKE) install)
|
||||
@ -693,7 +794,6 @@ depend: $(HEADERS) $(C_SOURCES)
|
||||
|
||||
clean: clean_docs
|
||||
rm -f *.o *~ *.BAK *.a
|
||||
@INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) clean)
|
||||
@INSTALL_DLLS@ (cd library/lammpi; $(MAKE) clean)
|
||||
@INSTALL_MATLAB@ (cd library/matlab; $(MAKE) clean)
|
||||
@INSTALL_DLLS@ (cd library/matrix; $(MAKE) clean)
|
||||
|
||||
@ -287,9 +287,9 @@ typedef struct foreign_context *control_t;
|
||||
#define CTX_ARITY PL__ac
|
||||
|
||||
#define BeginPredDefs(id) \
|
||||
PL_extension PL_predicates_from_ ## id[] = {
|
||||
const PL_extension PL_predicates_from_ ## id[] = {
|
||||
#define PRED_DEF(name, arity, fname, flags) \
|
||||
{ name, arity, pl_ ## fname ## _va, (flags)|PL_FA_VARARGS },
|
||||
{ "swi_" name, arity, pl_ ## fname ## _va, (flags)|PL_FA_VARARGS },
|
||||
#define EndPredDefs \
|
||||
{ NULL, 0, NULL, 0 } \
|
||||
};
|
||||
@ -310,7 +310,8 @@ typedef struct foreign_context *control_t;
|
||||
#define ForeignContextPtr(h) ((void *)(h)->context)
|
||||
#define ForeignEngine(h) ((h)->engine)
|
||||
|
||||
#define FRG(n, a, f, flags) { n, a, f, flags }
|
||||
#define FRG(n, a, f, flags) { "swi_" n, a, f, flags }
|
||||
#define LFRG(n, a, f, flags) { n, a, f, flags }
|
||||
|
||||
/* end from pl-itf.h */
|
||||
|
||||
@ -530,6 +531,8 @@ extern X_API void PL_register_atom(atom_t);
|
||||
extern X_API void PL_unregister_atom(atom_t);
|
||||
extern X_API predicate_t PL_pred(functor_t, module_t);
|
||||
extern X_API predicate_t PL_predicate(const char *, int, const char *);
|
||||
#define GP_NAMEARITY 0x100 /* or'ed mask */
|
||||
extern X_API int PL_unify_predicate(term_t head, predicate_t pred, int how);
|
||||
extern X_API void PL_predicate_info(predicate_t, atom_t *, int *, module_t *);
|
||||
extern X_API qid_t PL_open_query(module_t, int, predicate_t, term_t);
|
||||
extern X_API int PL_next_solution(qid_t);
|
||||
@ -705,7 +708,7 @@ PL_EXPORT(void) PL_register_blob_type(PL_blob_t *type);
|
||||
PL_EXPORT(PL_blob_t*) PL_find_blob_type(const char* name);
|
||||
PL_EXPORT(PL_blob_t*) YAP_find_blob_type(YAP_Atom at);
|
||||
PL_EXPORT(int) PL_unregister_blob_type(PL_blob_t *type);
|
||||
PL_EXPORT(int) PL_raise(int sig);
|
||||
PL_EXPORT(int) PL_raise(int sig);
|
||||
|
||||
|
||||
#if USE_GMP
|
||||
@ -714,6 +717,7 @@ PL_EXPORT(int) PL_get_mpz(term_t t, mpz_t mpz);
|
||||
PL_EXPORT(int) PL_unify_mpz(term_t t, mpz_t mpz);
|
||||
PL_EXPORT(int) PL_get_mpq(term_t t, mpq_t mpz);
|
||||
PL_EXPORT(int) PL_unify_mpq(term_t t, mpq_t mpz);
|
||||
|
||||
#endif
|
||||
|
||||
extern X_API const char *PL_cwd(void);
|
||||
|
||||
@ -537,6 +537,12 @@ extern X_API YAP_Term PROTO(YAP_ModuleUser,(void));
|
||||
/* Int YAP_NumberOfClausesForPredicate() */
|
||||
extern X_API YAP_Int PROTO(YAP_NumberOfClausesForPredicate,(YAP_PredEntryPtr));
|
||||
|
||||
/* int YAP_MaxOpPriority(Atom, Term) */
|
||||
extern X_API int PROTO(YAP_MaxOpPriority,(YAP_Atom, YAP_Term));
|
||||
|
||||
/* int YAP_OpInfo(Atom, Term, int, int *, int *) */
|
||||
extern X_API int PROTO(YAP_OpInfo,(YAP_Atom, YAP_Term, int, int *, int *));
|
||||
|
||||
#define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
|
||||
|
||||
__END_DECLS
|
||||
|
||||
@ -95,7 +95,8 @@ PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
|
||||
PL_EXPORT(void)
|
||||
PL_register_blob_type(PL_blob_t *type)
|
||||
{
|
||||
fprintf(stderr,"PL_register_blob_type not implemented yet\n");
|
||||
type->next = SWI_Blobs;
|
||||
SWI_Blobs = type;
|
||||
}
|
||||
|
||||
PL_EXPORT(PL_blob_t*)
|
||||
|
||||
@ -47,6 +47,14 @@
|
||||
|
||||
#include "swi.h"
|
||||
|
||||
extern X_API Atom YAP_AtomFromSWIAtom(atom_t at);
|
||||
|
||||
X_API extern Atom
|
||||
YAP_AtomFromSWIAtom(atom_t at)
|
||||
{
|
||||
return SWIAtomToAtom(at);
|
||||
}
|
||||
|
||||
extern X_API Int YAP_PLArityOfSWIFunctor(functor_t at);
|
||||
|
||||
/* This is silly, but let's keep it like that for now */
|
||||
@ -2295,44 +2303,33 @@ X_API predicate_t PL_predicate(const char *name, int arity, const char *m)
|
||||
return YAP_Predicate((YAP_Atom)at, arity, mod);
|
||||
}
|
||||
|
||||
X_API int PL_unify_predicate(term_t head, predicate_t *pred, const char *m)
|
||||
X_API int PL_unify_predicate(term_t head, predicate_t pred, int how)
|
||||
{
|
||||
Term mod;
|
||||
Atom at;
|
||||
Term t;
|
||||
Int arity;
|
||||
Functor fun;
|
||||
|
||||
if (m == NULL) {
|
||||
mod = CurrentModule;
|
||||
if (!mod) mod = USER_MODULE;
|
||||
PredEntry *pe = (PredEntry *)pred;
|
||||
Term ts[2], nt;
|
||||
if (!pe->ModuleOfPred) {
|
||||
ts[0] = pe->ModuleOfPred;
|
||||
} else {
|
||||
Atom at;
|
||||
while (!(at = Yap_LookupAtom((char *)m))) {
|
||||
if (!Yap_growheap(FALSE, 0L, NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
mod = MkAtomTerm(at);
|
||||
ts[0] = TermProlog;
|
||||
}
|
||||
t = Yap_GetFromSlot(head);
|
||||
if (IsAtomTerm(t)) {
|
||||
at = AtomOfTerm(t);
|
||||
arity = 0;
|
||||
} else if (IsApplTerm(t)) {
|
||||
Functor f;
|
||||
f = FunctorOfTerm(t);
|
||||
if (IsExtensionFunctor(fun)) {
|
||||
return 0;
|
||||
if (how == GP_NAMEARITY) {
|
||||
Term nts[2];
|
||||
nts[1] = MkIntegerTerm(pe->ArityOfPE);
|
||||
if (pe->ArityOfPE) {
|
||||
nts[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
|
||||
} else {
|
||||
nts[0] = MkAtomTerm((Atom)pe->FunctorOfPred);
|
||||
}
|
||||
at = NameOfFunctor(f);
|
||||
arity = ArityOfFunctor(f);
|
||||
} else
|
||||
return 0;
|
||||
|
||||
*pred = YAP_Predicate((YAP_Atom)at, arity, mod);
|
||||
return pred != NULL;
|
||||
ts[1] = Yap_MkApplTerm(FunctorSlash, 2, nts);
|
||||
} else {
|
||||
if (pe->ArityOfPE) {
|
||||
ts[1] = Yap_MkNewApplTerm(pe->FunctorOfPred, pe->ArityOfPE);
|
||||
} else {
|
||||
ts[1] = MkAtomTerm((Atom)pe->FunctorOfPred);
|
||||
}
|
||||
}
|
||||
nt = Yap_MkApplTerm(FunctorModule, 2, ts);
|
||||
return Yap_unify(Yap_GetFromSlot(head),nt);
|
||||
}
|
||||
|
||||
X_API void PL_predicate_info(predicate_t p,atom_t *name, int *arity, module_t *m)
|
||||
|
||||
@ -313,6 +313,9 @@ fileNameStream(IOSTREAM *s)
|
||||
return name;
|
||||
}
|
||||
|
||||
#if __YAP_PROLOG__
|
||||
static void init_yap(void);
|
||||
#endif
|
||||
|
||||
void
|
||||
initIO()
|
||||
@ -323,6 +326,7 @@ initIO()
|
||||
streamAliases = newHTable(16);
|
||||
streamContext = newHTable(16);
|
||||
PL_register_blob_type(&stream_blob);
|
||||
init_yap();
|
||||
#ifdef __unix__
|
||||
{ int fd;
|
||||
|
||||
@ -4654,3 +4658,74 @@ BeginPredDefs(file)
|
||||
PRED_DEF("$pop_input_context", 0, pop_input_context, 0)
|
||||
PRED_DEF("$size_stream", 2, size_stream, 0)
|
||||
EndPredDefs
|
||||
|
||||
#if __YAP_PROLOG__
|
||||
|
||||
static const PL_extension foreigns[] = {
|
||||
FRG("nl", 0, pl_nl, ISO),
|
||||
FRG("write_canonical", 1, pl_write_canonical, ISO),
|
||||
FRG("write_term", 2, pl_write_term, ISO),
|
||||
FRG("write_term", 3, pl_write_term3, ISO),
|
||||
FRG("write", 1, pl_write, ISO),
|
||||
FRG("writeq", 1, pl_writeq, ISO),
|
||||
FRG("print", 1, pl_print, 0),
|
||||
FRG("nl", 1, pl_nl1, ISO),
|
||||
|
||||
FRG("write", 2, pl_write2, ISO),
|
||||
FRG("writeq", 2, pl_writeq2, ISO),
|
||||
FRG("print", 2, pl_print2, 0),
|
||||
FRG("write_canonical", 2, pl_write_canonical2, ISO),
|
||||
FRG("format", 3, pl_format3, META),
|
||||
|
||||
FRG("format_predicate", 2, pl_format_predicate, META),
|
||||
FRG("current_format_predicate", 2, pl_current_format_predicate,
|
||||
META|NDET),
|
||||
/* DO NOT ADD ENTRIES BELOW THIS ONE */
|
||||
LFRG((char *)NULL, 0, NULL, 0)
|
||||
};
|
||||
|
||||
static int
|
||||
get_stream_handle_no_errors(term_t t, int read, int write, IOSTREAM **s)
|
||||
{ GET_LD
|
||||
if ( t == 0 )
|
||||
{ if (write) *s = getStream(Scurout);
|
||||
else *s = getStream(Scurin);
|
||||
return TRUE;
|
||||
}
|
||||
return get_stream_handle(t, s, SH_ALIAS);
|
||||
}
|
||||
|
||||
static int
|
||||
get_stream_position(IOSTREAM *s, term_t t)
|
||||
{ GET_LD
|
||||
return stream_position_prop(s, t);
|
||||
}
|
||||
|
||||
static void
|
||||
init_yap(void)
|
||||
{
|
||||
swi_io_struct swiio;
|
||||
|
||||
swiio.f = FUNCTOR_dstream1;
|
||||
swiio.get_c = Sfgetc;
|
||||
swiio.put_c = Sputc;
|
||||
swiio.get_w = Sgetcode;
|
||||
swiio.put_w = Sputcode;
|
||||
swiio.flush_s = Sflush;
|
||||
swiio.close_s = closeStream;
|
||||
swiio.get_stream_handle = get_stream_handle_no_errors;
|
||||
swiio.get_stream_position = get_stream_position;
|
||||
PL_YAP_InitSWIIO(&swiio);
|
||||
initCharTypes();
|
||||
initFiles();
|
||||
PL_register_extensions(PL_predicates_from_ctype);
|
||||
PL_register_extensions(PL_predicates_from_file);
|
||||
PL_register_extensions(PL_predicates_from_files);
|
||||
PL_register_extensions(PL_predicates_from_glob);
|
||||
PL_register_extensions(PL_predicates_from_write);
|
||||
PL_register_extensions(foreigns);
|
||||
fileerrors = TRUE;
|
||||
SinitStreams();
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
@ -1,6 +1,10 @@
|
||||
|
||||
#include "config.h"
|
||||
|
||||
#if USE_GMP
|
||||
#define O_GMP 1
|
||||
#endif
|
||||
|
||||
#define PL_KERNEL 1
|
||||
|
||||
#ifdef __MINGW32__
|
||||
@ -218,6 +222,28 @@ typedef struct
|
||||
} nv_options;
|
||||
|
||||
|
||||
/*******************************
|
||||
* GET-PROCEDURE *
|
||||
*******************************/
|
||||
|
||||
#define GP_FIND 0 /* find anywhere */
|
||||
#define GP_FINDHERE 1 /* find in this module */
|
||||
#define GP_CREATE 2 /* create (in this module) */
|
||||
#define GP_DEFINE 4 /* define a procedure */
|
||||
#define GP_RESOLVE 5 /* find defenition */
|
||||
|
||||
#define GP_HOW_MASK 0x0ff
|
||||
#define GP_NAMEARITY 0x100 /* or'ed mask */
|
||||
#define GP_HIDESYSTEM 0x200 /* hide system module */
|
||||
#define GP_TYPE_QUIET 0x400 /* don't throw errors on wrong types */
|
||||
#define GP_EXISTENCE_ERROR 0x800 /* throw error if proc is not found */
|
||||
#define GP_QUALIFY 0x1000 /* Always module-qualify */
|
||||
|
||||
/* get_functor() */
|
||||
#define GF_EXISTING 1
|
||||
#define GF_PROCEDURE 2 /* check for max arity */
|
||||
|
||||
|
||||
/*******************************
|
||||
* LIST BUILDING *
|
||||
*******************************/
|
||||
@ -603,6 +629,13 @@ typedef struct PL_local_data {
|
||||
int _current_buffer_id;
|
||||
} fli;
|
||||
|
||||
#ifdef O_GMP
|
||||
struct
|
||||
{
|
||||
int persistent; /* do persistent operations */
|
||||
} gmp;
|
||||
#endif
|
||||
|
||||
} PL_local_data_t;
|
||||
|
||||
#define usedStack(D) 0
|
||||
@ -1060,3 +1093,9 @@ setInteger(int *flag, term_t old, term_t new)
|
||||
succeed;
|
||||
}
|
||||
|
||||
extern const PL_extension PL_predicates_from_ctype[];
|
||||
extern const PL_extension PL_predicates_from_file[];
|
||||
extern const PL_extension PL_predicates_from_files[];
|
||||
extern const PL_extension PL_predicates_from_glob[];
|
||||
extern const PL_extension PL_predicates_from_write[];
|
||||
|
||||
|
||||
@ -3,6 +3,9 @@
|
||||
|
||||
#include <stdio.h>
|
||||
#include "pl-incl.h"
|
||||
#if HAVE_MATH_H
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
#define Quote_illegal_f 1
|
||||
#define Ignore_ops_f 2
|
||||
@ -319,7 +322,7 @@ PL_get_number(term_t l, number *n) {
|
||||
#ifdef O_GMP
|
||||
} else {
|
||||
n->type = V_MPZ;
|
||||
n->value.mpz = YAP_BigNumOfTerm(t);
|
||||
YAP_BigNumOfTerm(t, &n->value.mpz);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
@ -420,13 +423,62 @@ outOfCore()
|
||||
int
|
||||
priorityOperator(Module m, atom_t atom)
|
||||
{
|
||||
return 0;
|
||||
YAP_Term mod = (YAP_Term)m;
|
||||
if (!m)
|
||||
mod = YAP_CurrentModule();
|
||||
return YAP_MaxOpPriority(YAP_AtomFromSWIAtom(atom), mod);
|
||||
}
|
||||
|
||||
int
|
||||
currentOperator(Module m, atom_t name, int kind, int *type, int *priority)
|
||||
{
|
||||
return 0;
|
||||
YAP_Term mod = (YAP_Term)m;
|
||||
YAP_Atom at;
|
||||
int opkind, yap_type;
|
||||
|
||||
if (!m)
|
||||
mod = YAP_CurrentModule();
|
||||
at = YAP_AtomFromSWIAtom(name);
|
||||
switch (kind) {
|
||||
case OP_PREFIX:
|
||||
opkind = 2;
|
||||
break;
|
||||
case OP_INFIX:
|
||||
opkind = 0;
|
||||
break;
|
||||
case OP_POSTFIX:
|
||||
default:
|
||||
opkind = 1;
|
||||
}
|
||||
if (!YAP_OpInfo(YAP_AtomFromSWIAtom(name), mod, opkind, &yap_type, priority))
|
||||
return FALSE;
|
||||
switch(yap_type) {
|
||||
case 1:
|
||||
*type = OP_XFX;
|
||||
break;
|
||||
case 2:
|
||||
*type = OP_XFY;
|
||||
break;
|
||||
case 3:
|
||||
*type = OP_YFX;
|
||||
break;
|
||||
case 4:
|
||||
*type = OP_XFX;
|
||||
break;
|
||||
case 5:
|
||||
*type = OP_XF;
|
||||
break;
|
||||
case 6:
|
||||
*type = OP_YF;
|
||||
break;
|
||||
case 7:
|
||||
*type = OP_FX;
|
||||
break;
|
||||
default:
|
||||
*type = OP_FY;
|
||||
break;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
int
|
||||
@ -438,25 +490,64 @@ numberVars(term_t t, nv_options *opts, int n ARG_LD) {
|
||||
* PROMOTION *
|
||||
*******************************/
|
||||
|
||||
#ifdef O_GMP
|
||||
void
|
||||
clearGMPNumber(Number n)
|
||||
{ switch(n->type)
|
||||
{ case V_MPZ:
|
||||
if ( n->value.mpz->_mp_alloc )
|
||||
mpz_clear(n->value.mpz);
|
||||
static int
|
||||
check_float(double f)
|
||||
{
|
||||
#ifdef HAVE_FPCLASSIFY
|
||||
switch(fpclassify(f))
|
||||
{ case FP_NAN:
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
||||
break;
|
||||
case V_MPQ:
|
||||
if ( mpq_numref(n->value.mpq)->_mp_alloc )
|
||||
mpz_clear(mpq_numref(n->value.mpq));
|
||||
if ( mpq_denref(n->value.mpq)->_mp_alloc )
|
||||
mpz_clear(mpq_denref(n->value.mpq));
|
||||
break;
|
||||
default:
|
||||
case FP_INFINITE:
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
||||
break;
|
||||
}
|
||||
}
|
||||
#else
|
||||
#ifdef HAVE_FPCLASS
|
||||
switch(fpclass(f))
|
||||
{ case FP_SNAN:
|
||||
case FP_QNAN:
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
||||
break;
|
||||
case FP_NINF:
|
||||
case FP_PINF:
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
||||
break;
|
||||
case FP_NDENORM: /* pos/neg denormalized non-zero */
|
||||
case FP_PDENORM:
|
||||
case FP_NNORM: /* pos/neg normalized non-zero */
|
||||
case FP_PNORM:
|
||||
case FP_NZERO: /* pos/neg zero */
|
||||
case FP_PZERO:
|
||||
break;
|
||||
}
|
||||
#else
|
||||
#ifdef HAVE__FPCLASS
|
||||
switch(_fpclass(f))
|
||||
{ case _FPCLASS_SNAN:
|
||||
case _FPCLASS_QNAN:
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
||||
break;
|
||||
case _FPCLASS_NINF:
|
||||
case _FPCLASS_PINF:
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
||||
break;
|
||||
}
|
||||
#else
|
||||
#ifdef HAVE_ISNAN
|
||||
if ( isnan(f) )
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
|
||||
#endif
|
||||
#ifdef HAVE_ISINF
|
||||
if ( isinf(f) )
|
||||
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
|
||||
#endif
|
||||
#endif /*HAVE__FPCLASS*/
|
||||
#endif /*HAVE_FPCLASS*/
|
||||
#endif /*HAVE_FPCLASSIFY*/
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
promoteToFloatNumber(Number n)
|
||||
@ -629,7 +720,7 @@ PL_w32thread_raise(DWORD id, int sig)
|
||||
#endif /*__WINDOWS__*/
|
||||
|
||||
|
||||
int
|
||||
X_API int
|
||||
PL_raise(int sig)
|
||||
{ GET_LD
|
||||
|
||||
|
||||
@ -103,6 +103,7 @@ valHandle(term_t tt)
|
||||
}
|
||||
|
||||
YAP_Int YAP_PLArityOfSWIFunctor(functor_t f);
|
||||
YAP_Atom YAP_AtomFromSWIAtom(atom_t at);
|
||||
PL_blob_t* YAP_find_blob_type(YAP_Atom at);
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user