more fixes to SWI emulation

integrate in main binary

C/c_interface.c

@@ -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;
+}
+
+
+

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);

C/stdpreds.c

@@ -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);

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)

include/SWI-Prolog.h

@@ -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);

include/YapInterface.h

@@ -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

library/dialect/swi/fli/blobs.c

@@ -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*)	

library/dialect/swi/fli/swi.c

@@ -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;
+  PredEntry *pe = (PredEntry *)pred;
-  Atom at;
+  Term ts[2], nt;
-  Term t;
+  if (!pe->ModuleOfPred) {
-  Int arity;
+    ts[0] = pe->ModuleOfPred;
-  Functor fun;
-
-  if (m == NULL) {
-    mod = CurrentModule;
-    if (!mod) mod = USER_MODULE;
   } else {
-    Atom at;
+    ts[0] = TermProlog;
-    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);
   }
-  t = Yap_GetFromSlot(head);
+  if (how == GP_NAMEARITY) {
-  if (IsAtomTerm(t)) {
+    Term nts[2];
-    at = AtomOfTerm(t);
+    nts[1] = MkIntegerTerm(pe->ArityOfPE);
-    arity = 0;
+    if (pe->ArityOfPE) {
-  } else if (IsApplTerm(t)) {
+      nts[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
-    Functor f;
+    } else {
-    f = FunctorOfTerm(t);
+      nts[0] = MkAtomTerm((Atom)pe->FunctorOfPred);
-    if (IsExtensionFunctor(fun)) {
-      return 0;
     }
-    at = NameOfFunctor(f);
+    ts[1] = Yap_MkApplTerm(FunctorSlash, 2, nts);
-    arity = ArityOfFunctor(f);
+  } else {
-  } else
+    if (pe->ArityOfPE) {
-    return 0;
+      ts[1] = Yap_MkNewApplTerm(pe->FunctorOfPred, pe->ArityOfPE);
-     
+    } else {
-  *pred =  YAP_Predicate((YAP_Atom)at, arity, mod);
+      ts[1] = MkAtomTerm((Atom)pe->FunctorOfPred);
-  return pred != NULL;
+    }
+  }
+  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)

packages/PLStream/pl-file.c

@@ -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
+

packages/PLStream/pl-incl.h

@@ -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[];
+

packages/PLStream/pl-yap.c

@@ -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
+static int
-void
+check_float(double f)
-clearGMPNumber(Number n)
+{
-{ switch(n->type)
+#ifdef HAVE_FPCLASSIFY
-  { case V_MPZ:
+  switch(fpclassify(f))
-      if ( n->value.mpz->_mp_alloc )
+  { case FP_NAN:
-	mpz_clear(n->value.mpz);
+      return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
       break;
-    case V_MPQ:
+    case FP_INFINITE:
-      if ( mpq_numref(n->value.mpq)->_mp_alloc )
+      return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
-	mpz_clear(mpq_numref(n->value.mpq));
-      if ( mpq_denref(n->value.mpq)->_mp_alloc )
-	mpz_clear(mpq_denref(n->value.mpq));
-      break;
-    default:
       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
 

packages/PLStream/pl-yap.h

@@ -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);