YAP updates.

packages/PLStream/dtoa.c

@@ -1725,7 +1725,7 @@ increment(Bigint *b)
 	return b;
 	}
 
- void
+static void
 #ifdef KR_headers
 gethex(sp, rvp, rounding, sign)
 	CONST char **sp; U *rvp; int rounding, sign;
@@ -2256,7 +2256,7 @@ bigcomp
 #endif
 {
 	Bigint *b, *d;
-	int b2, bbits, d2, dd, dig, dsign, i, j, nd, nd0, p2, p5, speccase;
+	int b2, bbits, d2, dd = 0, dig, dsign, i, j, nd, nd0, p2, p5, speccase;
 
 	dsign = bc->dsign;
 	nd = bc->nd;

packages/PLStream/pl-ctype.c

@@ -26,6 +26,36 @@
 #include <ctype.h>
 #include "pl-ctype.h"
 
+#if __YAP_PROLOG__
+
+/* support for blank space handling, stolen from pl-read.c */
+
+#include <pl-umap.c>
+
+		 /*******************************
+		 *     UNICODE CLASSIFIERS	*
+		 *******************************/
+
+#define CharTypeW(c, t, w) \
+	((unsigned)(c) <= 0xff ? (_PL_char_types[(unsigned)(c)] t) \
+			       : (uflagsW(c) & w))
+
+#define PlBlankW(c)	CharTypeW(c, <= SP, U_SEPARATOR)
+#define PlUpperW(c)	CharTypeW(c, == UC, U_UPPERCASE)
+#define PlIdStartW(c)	(c <= 0xff ? (isLower(c)||isUpper(c)||c=='_') \
+				   : uflagsW(c) & U_ID_START)
+#define PlIdContW(c)	CharTypeW(c, >= UC, U_ID_CONTINUE)
+#define PlSymbolW(c)	CharTypeW(c, == SY, 0)
+#define PlPunctW(c)	CharTypeW(c, == PU, 0)
+#define PlSoloW(c)	CharTypeW(c, == SO, 0)
+
+static int 
+unicode_separator(pl_wchar_t c)
+{ return PlBlankW(c);
+}
+
+#endif
+
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 This module defines:
 
@@ -770,12 +800,12 @@ PRED_IMPL("setlocale", 3, setlocale, 0)
 		 *******************************/
 
 BeginPredDefs(ctype)
-  PRED_DEF("char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
+  PRED_DEF("swi_char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
-  PRED_DEF("code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
+  PRED_DEF("swi_code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
-  PRED_DEF("setlocale", 3, setlocale, 0)
+  PRED_DEF("swi_setlocale", 3, setlocale, 0)
-  PRED_DEF("downcase_atom", 2, downcase_atom, 0)
+  PRED_DEF("swi_downcase_atom", 2, downcase_atom, 0)
-  PRED_DEF("upcase_atom", 2, upcase_atom, 0)
+  PRED_DEF("swi_upcase_atom", 2, upcase_atom, 0)
-  PRED_DEF("normalize_space", 2, normalize_space, 0)
+  PRED_DEF("swi_normalize_space", 2, normalize_space, 0)
 EndPredDefs
 
 

packages/PLStream/pl-error.h

@@ -22,17 +22,6 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */
 
-#ifndef COMMON
-#ifndef SO_LOCAL
-#ifdef HAVE_VISIBILITY_ATTRIBUTE
-#define SO_LOCAL __attribute__((visibility("hidden")))
-#else
-#define SO_LOCAL
-#endif
-#endif
-#define COMMON(type) SO_LOCAL type
-#endif
-
 typedef enum
 { ERR_NO_ERROR = 0,
 				/* Used in os-directory and maybe elsewhere */
@@ -81,30 +70,6 @@ typedef enum
 
 #define MSG_ERRNO		((char *)(-1))
 
-COMMON(int) 		PL_error(const char *pred, int arity, const char *msg,
+int			PL_error(const char *pred, int arity, const char *msg, int id, ...);
-				 PL_error_code id, ...);
+int	 		printMessage(atom_t severity, ...);
-COMMON(char *) 		tostr(char *buf, const char *fmt, ...);
+void			unallocStream(IOSTREAM *s);
-COMMON(int) 		printMessage(atom_t severity, ...);
-COMMON(int) 		PL_get_nchars_ex(term_t t, size_t *len, char **s,
-					 unsigned int flags);
-COMMON(int) 		PL_get_chars_ex(term_t t, char **s, unsigned int flags);
-COMMON(int) 		PL_get_atom_ex(term_t t, atom_t *a);
-#ifdef ARG_LD
-COMMON(int) 		PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD);
-#endif
-COMMON(int) 		PL_get_integer_ex(term_t t, int *i);
-COMMON(int) 		PL_get_long_ex(term_t t, long *i);
-COMMON(int) 		PL_get_int64_ex(term_t t, int64_t *i);
-COMMON(int) 		PL_get_intptr_ex(term_t t, intptr_t *i);
-COMMON(int) 		PL_get_size_ex(term_t t, size_t *i);
-COMMON(int) 		PL_get_bool_ex(term_t t, int *i);
-COMMON(int) 		PL_get_float_ex(term_t t, double *f);
-COMMON(int) 		PL_get_char_ex(term_t t, int *p, int eof);
-COMMON(int) 		PL_get_pointer_ex(term_t t, void **addrp);
-COMMON(int) 		PL_unify_list_ex(term_t l, term_t h, term_t t);
-COMMON(int) 		PL_unify_nil_ex(term_t l);
-COMMON(int) 		PL_get_list_ex(term_t l, term_t h, term_t t);
-COMMON(int) 		PL_get_nil_ex(term_t l);
-COMMON(int) 		PL_unify_bool_ex(term_t t, int val);
-COMMON(int) 		PL_get_arg_ex(int n, term_t term, term_t arg);
-COMMON(int) 		PL_get_module_ex(term_t name, Module *m);

packages/PLStream/pl-file.c

@@ -1058,7 +1058,7 @@ protocol(const char *str, size_t n)
 
 
 static int
-push_input_context()
+push_input_context(void)
 { GET_LD
   InputContext c = allocHeap(sizeof(struct input_context));
 
@@ -1073,7 +1073,7 @@ push_input_context()
 
 
 static int
-pop_input_context()
+pop_input_context(void)
 { GET_LD
   InputContext c = input_context_stack;
 
@@ -1105,7 +1105,7 @@ PRED_IMPL("$pop_input_context", 0, pop_input_context, 0)
 
 
 void
-pushOutputContext()
+pushOutputContext(void)
 { GET_LD
   OutputContext c = allocHeap(sizeof(struct output_context));
 
@@ -1116,7 +1116,7 @@ pushOutputContext()
 
 
 void
-popOutputContext()
+popOutputContext(void)
 { GET_LD
   OutputContext c = output_context_stack;
 
@@ -1341,7 +1341,7 @@ getSingleChar(IOSTREAM *stream, int signals)
   int c;
   ttybuf buf;
 
-  debugstatus.suspendTrace++;
+  //  debugstatus.suspendTrace++; VSC: to be replaced by macro
   Slock(stream);
   Sflush(stream);
   PushTty(stream, &buf, TTY_RAW);	/* just donot prompt */
@@ -1368,7 +1368,7 @@ getSingleChar(IOSTREAM *stream, int signals)
     c = -1;
 
   PopTty(stream, &buf, TRUE);
-  debugstatus.suspendTrace--;
+  // debugstatus.suspendTrace--; VSC: to be replaced by macro
   Sunlock(stream);
 
   return c;
@@ -3107,7 +3107,7 @@ ok:
 }
 
 int
-pl_seen()
+pl_seen(void)
 { GET_LD
   IOSTREAM *s = getStream(Scurin);
 

packages/PLStream/pl-files.c

@@ -914,7 +914,7 @@ has_extension(const char *name, const char *ext)
 
 
 static int
-name_too_long()
+name_too_long(void)
 { return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
 }
 

packages/PLStream/pl-fmt.c

@@ -201,15 +201,17 @@ static int	emit_rubber(format_state *state);
 word
 pl_format_predicate(term_t chr, term_t descr)
 { int c;
-  Procedure proc;
+  predicate_t proc;
   Symbol s;
+  int arity;
 
   if ( !PL_get_char_ex(chr, &c, FALSE) )
     fail;
 
   if ( !get_procedure(descr, &proc, 0, GP_CREATE) )
     fail;
-  if ( proc->definition->functor->arity == 0 )
+  PL_predicate_info(proc, NULL, &arity, NULL);
+  if ( arity == 0 )
     return PL_error(NULL, 0, "arity must be > 0", ERR_DOMAIN,
 		    PL_new_atom("format_predicate"),
 		    descr);
@@ -255,8 +257,7 @@ pl_current_format_predicate(term_t chr, term_t descr, control_t h)
   }
   while( (s=advanceTableEnum(e)) )
   { if ( PL_unify_integer(chr, (intptr_t)s->name) &&
-	 unify_definition(contextModule(LD->environment),
+	 PL_unify_predicate(descr, (predicate_t)s->value, 0) )
-			  descr, ((Procedure)s->value)->definition, 0, 0) )
     { PL_close_foreign_frame(fid);
       ForeignRedoPtr(e);
     }
@@ -419,20 +420,23 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
 					/* Check for user defined format */
 	  if ( format_predicates &&
 	       (s = lookupHTable(format_predicates, (void*)((intptr_t)c))) )
-	  { Procedure proc = (Procedure) s->value;
+	  { predicate_t proc = (predicate_t) s->value;
-	    FunctorDef fdef = proc->definition->functor;
+	    int arity;
-	    term_t av = PL_new_term_refs(fdef->arity);
+	    term_t av;
 	    char buf[BUFSIZE];
 	    char *str = buf;
 	    size_t bufsize = BUFSIZE;
 	    unsigned int i;
 
+	    PL_predicate_info(proc, NULL, &arity, NULL);
+	    av = PL_new_term_refs(arity);
+
 	    if ( arg == DEFAULT )
 	      PL_put_atom(av+0, ATOM_default);
 	    else
 	      PL_put_integer(av+0, arg);
 
-	    for(i=1; i<fdef->arity; i++)
+	    for(i=1; i < arity; i++)
 	    { NEED_ARG;
 	      PL_put_term(av+i, argv);
 	      SHIFT;

packages/PLStream/pl-glob.c

@@ -390,7 +390,7 @@ add_path(const char *path, GlobInfo info)
 }
 
 
-const char *
+static const char *
 expand_str(GlobInfo info, int at)
 { char *s = &fetchBuffer(&info->strings, at, char);
 
@@ -398,7 +398,7 @@ expand_str(GlobInfo info, int at)
 }
 
 
-const char *
+static const char *
 expand_entry(GlobInfo info, int idx)
 { int at = fetchBuffer(&info->files, idx, int);
 

packages/PLStream/pl-os.c

@@ -772,7 +772,7 @@ OsPath(const char *plpath, char *path)
 }
 #endif /* O_HPFS */
 
-#ifdef __unix__
+#if defined(__unix__) || defined(__APPLE__)
 char *
 PrologPath(const char *p, char *buf, size_t len)
 { strncpy(buf, p, len);
@@ -1759,7 +1759,7 @@ PopTty(IOSTREAM *s, ttybuf *buf)
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 static void
-ResetStdin()
+ResetStdin(void)
 { Sinput->limitp = Sinput->bufp = Sinput->buffer;
   if ( !GD->os.org_terminal.read )
     GD->os.org_terminal = *Sinput->functions;
@@ -2517,7 +2517,11 @@ findExecutable(const char *av0, char *buffer)
 #endif /*__WINDOWS__*/
 
 
-#ifdef __unix__
+#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
+#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
+#define PATHSEP ';'
+#else
+/* not Windows, must be a Linux-like thingy */
 static char *
 okToExec(const char *s)
 { statstruct stbuff;
@@ -2530,11 +2534,6 @@ okToExec(const char *s)
     return (char *) NULL;
 }
 #define PATHSEP	':'
-#endif /* __unix__ */
-
-#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
-#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
-#define PATHSEP ';'
 #endif
 
 #ifdef EXEC_EXTENSIONS

packages/PLStream/pl-table.c

@@ -123,7 +123,7 @@ exitTables(int status, void *arg)
 
 
 void
-initTables()
+initTables(void)
 { static int done = FALSE;
 
   if ( !done )

packages/PLStream/pl-table.h

@@ -54,7 +54,7 @@ struct table_enum
   TableEnum	next;		/* More choice points */
 };
 
-COMMON(void) 		initTables();
+COMMON(void) 		initTables(void);
 COMMON(Table) 		newHTable(int size);
 COMMON(void) 		destroyHTable(Table ht);
 COMMON(Symbol) 		lookupHTable(Table ht, void *name);

packages/PLStream/pl-text.c

@@ -202,7 +202,11 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
 	  { term_t culprit = PL_new_term_ref();
 	    atom_t type;
 
+#if __YAP_PROLOG__
+	    YAP_PutInSlot(culprit, result.culprit);
+#else
 	    *valTermRef(culprit) = result.culprit;
+#endif
 	    if ( result.status == CVT_nocode )
 	      type = ATOM_character_code;
 	    else

packages/PLStream/pl-write.c

@@ -25,8 +25,8 @@
 
 #include <math.h>
 #include "pl-incl.h"
-#include "os/pl-dtoa.h"
+#include "pl-dtoa.h"
-#include "os/pl-ctype.h"
+#include "pl-ctype.h"
 #include <stdio.h>			/* sprintf() */
 #ifdef HAVE_LOCALE_H
 #include <locale.h>
@@ -64,6 +64,13 @@ static bool	writeTerm(term_t t, int prec,
 static bool	writeArgTerm(term_t t, int prec,
 			     write_options *options, bool arg) WUNUSED;
 
+#if __YAP_PROLOG__
+static Word
+address_of(term_t t)
+{ GET_LD
+    return YAP_AddressFromSlot(t);			/* non-recursive structure */
+}
+#else
 static Word
 address_of(term_t t)
 { GET_LD
@@ -79,6 +86,7 @@ address_of(term_t t)
       return NULL;			/* non-recursive structure */
   }
 }
+#endif
 
 
 static int
@@ -94,6 +102,18 @@ has_visited(visited *v, Word addr)
 
 char *
 varName(term_t t, char *name)
+#if __YAP_PROLOG__
+{ 
+  YAP_Int adr = YAP_VarSlotToNumber(t);
+
+  if (adr < 0)
+    Ssprintf(name, "_L%ld", -adr);
+  else
+    Ssprintf(name, "_G%ld", adr);
+
+  return name;
+}
+#else
 { GET_LD
   Word adr = valTermRef(t);
 
@@ -106,6 +126,7 @@ varName(term_t t, char *name)
 
   return name;
 }
+#endif
 
 
 #define AT_LOWER	0
@@ -122,8 +143,8 @@ varName(term_t t, char *name)
 static int
 atomType(atom_t a, IOSTREAM *fd)
 { Atom atom = atomValue(a);
-  char *s = atom->name;
+  char *s = atomName(atom);
-  size_t len = atom->length;
+  size_t len = atomLength(atom);
 
   if ( len == 0 )
     return AT_QUOTE;
@@ -442,8 +463,8 @@ writeBlob(atom_t a, write_options *options)
   unsigned char const *s, *e;
 
   TRY(PutString("<#", options->out));
-  s = (unsigned char const *)atom->name;
+  s = (unsigned char const *)atomName(atom);
-  for (e = s + atom->length; s != e; s++)
+  for (e = s + atomLength(atom); s != e; s++)
   { static char *digits = "0123456789abcdef";
 
     TRY(Putc(digits[(*s >> 4) & 0xf], options->out));
@@ -459,7 +480,7 @@ writeAtom(atom_t a, write_options *options)
 { Atom atom = atomValue(a);
 
   if ( (options->flags & PL_WRT_BLOB_PORTRAY) &&
-       false(atom->type, PL_BLOB_TEXT) &&
+       false(atomBlobType(atom), PL_BLOB_TEXT) &&
        GD->cleaning <= CLN_PROLOG )
   { GET_LD
     int rc;
@@ -486,9 +507,9 @@ writeAtom(atom_t a, write_options *options)
       return TRUE;
   }
 
-  if ( atom->type->write )
+  if ( atomBlobType(atom)->write )
-    return (*atom->type->write)(options->out, a, options->flags);
+    return (*atomBlobType(atom)->write)(options->out, a, options->flags);
-  if ( false(atom->type, PL_BLOB_TEXT) )
+  if ( false(atomBlobType(atom), PL_BLOB_TEXT) )
     return writeBlob(a, options);
 
   if ( true(options, PL_WRT_QUOTED) )
@@ -497,7 +518,7 @@ writeAtom(atom_t a, write_options *options)
       case AT_SYMBOL:
       case AT_SOLO:
       case AT_SPECIAL:
-	return PutToken(atom->name, options->out);
+	return PutToken(nameOfAtom(atom), options->out);
       case AT_QUOTE:
       case AT_FULLSTOP:
       default:
@@ -505,14 +526,14 @@ writeAtom(atom_t a, write_options *options)
 
 	TRY(rc=PutOpenToken('\'', options->out));
 	TRY(writeQuoted(options->out,
-			atom->name,
+			nameOfAtom(atom),
-			atom->length,
+			atomLength(atom),
 			'\'', options));
 	return rc;
       }
     }
   } else
-    return PutTokenN(atom->name, atom->length, options->out);
+    return PutTokenN(nameOfAtom(atom), atomLength(atom), options->out);
 }
 
 
@@ -531,8 +552,8 @@ writeAtomToStream(IOSTREAM *s, atom_t atom)
 int
 writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags)
 { Atom a = atomValue(atom);
-  pl_wchar_t *s = (pl_wchar_t*)a->name;
+  pl_wchar_t *s = (pl_wchar_t*)atomName(a);
-  size_t len = a->length/sizeof(pl_wchar_t);
+  size_t len = atomLength(a)/sizeof(pl_wchar_t);
   pl_wchar_t *e = &s[len];
 
   if ( flags & PL_WRT_QUOTED )
@@ -881,7 +902,7 @@ pl_nl1(term_t stream)
 }
 
 word
-pl_nl()
+pl_nl(void)
 { return pl_nl1(0);
 }
 
@@ -898,7 +919,7 @@ callPortray(term_t arg, write_options *options)
 
   portray = _PL_predicate("portray", 1, "user", &GD->procedures.portray);
 
-  if ( portray->definition->definition.clauses )
+  if ( predicateHasClauses(portray) )
   { GET_LD
     wakeup_state wstate;
     IOSTREAM *old = Scurout;
@@ -1045,7 +1066,7 @@ writeTerm2(term_t t, int prec, write_options *options, bool arg)
   }
 
   if ( PL_get_atom(t, &a) )
-  { if ( !arg && prec < 1200 && priorityOperator(NULL, a) > 0 )
+    { if ( !arg && prec < 1200 && priorityOperator((Module)NULL, a) > 0 )
     { if ( PutOpenBrace(out) &&
 	   writeAtom(a, options) &&
 	   PutCloseBrace(out) )
@@ -1318,7 +1339,8 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
 
   options.module = lookupModule(mname);
   if ( charescape == TRUE ||
-       (charescape == -1 && true(options.module, CHARESCAPE)) )
+       //       (charescape == -1 && true(options.module, CHARESCAPE)) )
+       charEscapeWriteOption(options))
     options.flags |= PL_WRT_CHARESCAPES;
   if ( numbervars == -1 )
     numbervars = (portray ? TRUE : FALSE);
@@ -1377,7 +1399,8 @@ do_write2(term_t stream, term_t term, int flags)
     options.flags     = flags;
     options.out	      = s;
     options.module    = MODULE_user;
-    if ( options.module && true(options.module, CHARESCAPE) )
+    //    if ( options.module && true(options.module, CHARESCAPE) )
+    if (charEscapeWriteOption(options))
       options.flags |= PL_WRT_CHARESCAPES;
     if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) )
       options.flags |= PL_WRT_BACKQUOTED_STRING;