upgrade to more recent version of pl-file.c (not complete).

packages/PLStream/Makefile.in

@@ -40,6 +40,7 @@ HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h  \
 	$(srcdir)/pl-mswchar.h \
 	$(srcdir)/pl-opts.h  \
 	$(srcdir)/pl-os.h \
+	$(srcdir)/pl-privit.h \
 	$(srcdir)/pl-stream.h \
 	$(srcdir)/pl-table.h \
 	$(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \
@@ -47,6 +48,7 @@ HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h  \
 C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
 	$(srcdir)/pl-error.c  $(srcdir)/pl-feature.c  \
 	$(srcdir)/pl-file.c   $(srcdir)/pl-os.c \
+	$(srcdir)/pl-privit.c \
 	$(srcdir)/pl-stream.c $(srcdir)/pl-string.c \
 	$(srcdir)/pl-table.c \
 	$(srcdir)/pl-text.c $(srcdir)/pl-utf8.c \

packages/PLStream/pl-privitf.c

@@ -0,0 +1,176 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@uva.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 2008, University of Amsterdam
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#include "pl-incl.h"
+#undef LD
+#define LD LOCAL_LD
+
+#define setHandle(h, w)		(*valTermRef(h) = (w))
+#define valHandleP(h)		valTermRef(h)
+
+#define valHandle(r) valHandle__LD(r PASS_LD)
+
+static inline word
+valHandle__LD(term_t r ARG_LD)
+{ Word p = valTermRef(r);
+
+  deRef(p);
+  return *p;
+}
+
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+This module defines extensions to pl-fli.c that are used internally, but
+not exported to the SWI-Prolog user. Most   of them are too specific for
+the public interface.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+
+		 /*******************************
+		 *     CHARACTER GET/UNIFY	*
+		 *******************************/
+
+/** PL_get_char(term_t c, int *p, int eof)
+
+Get a character code from a term and   store  in over p. Returns TRUE if
+successful. On failure it returns a  type   error.  If  eof is TRUE, the
+integer -1 or the atom end_of_file can used to specify and EOF character
+code.
+*/
+
+int
+PL_get_char(term_t c, int *p, int eof)
+{ GET_LD
+  int chr;
+  atom_t name;
+  PL_chars_t text;
+
+  if ( PL_get_integer(c, &chr) )
+  { if ( chr >= 0 )
+    { *p = chr;
+      return TRUE;
+    }
+    if ( eof && chr == -1 )
+    { *p = chr;
+      return TRUE;
+    }
+  } else if ( PL_get_text(c, &text, CVT_ATOM|CVT_STRING|CVT_LIST) &&
+	      text.length == 1 )
+  { *p = text.encoding == ENC_ISO_LATIN_1 ? text.text.t[0]&0xff
+					  : text.text.w[0];
+    return TRUE;
+  } else if ( eof && PL_get_atom(c, &name) && name == ATOM_end_of_file )
+  { *p = -1;
+    return TRUE;
+  }
+
+  return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_character, c);
+}
+
+
+/** PL_unify_char(term_t chr, int c, int how)
+
+Unify a character.  Try to be as flexible as possible, only binding a
+variable `chr' to a code or one-char-atom.  E.g., this succeeds:
+
+    PL_unify_char('a', 97, PL_CODE)
+*/
+
+int
+PL_unify_char(term_t chr, int c, int how)
+{ GET_LD
+  int c2 = -1;
+
+  if ( PL_is_variable(chr) )
+  { switch(how)
+    { case PL_CHAR:
+      { atom_t a = (c == -1 ? ATOM_end_of_file : codeToAtom(c));
+
+	return PL_unify_atom(chr, a);
+      }
+      case PL_CODE:
+      case PL_BYTE:
+      default:
+	return PL_unify_integer(chr, c);
+    }
+  } else if ( PL_get_char(chr, &c2, TRUE) )
+    return c == c2;
+
+  return FALSE;
+}
+
+
+		 /*******************************
+		 *	  LIST BUILDING		*
+		 *******************************/
+
+int
+allocList(size_t maxcells, list_ctx *ctx)
+{ GET_LD
+  ctx->lp = ctx->gstore = allocGlobal(1+maxcells*3);
+
+  return TRUE;
+}
+
+int
+unifyList(term_t term, list_ctx *ctx)
+{ GET_LD
+  Word a;
+
+  ctx->gstore[0] = ATOM_nil;
+  gTop = &ctx->gstore[1];
+
+  a = valTermRef(term);
+  deRef(a);
+  if ( !unify_ptrs(a, ctx->lp PASS_LD) )
+  { gTop = ctx->lp;
+    return FALSE;
+  }
+
+  return TRUE;
+}
+
+int
+unifyDiffList(term_t head, term_t tail, list_ctx *ctx)
+{ GET_LD
+  Word a;
+
+  setVar(ctx->gstore[0]);
+  gTop = &ctx->gstore[1];
+
+  a = valTermRef(head);
+  deRef(a);
+  if ( !unify_ptrs(a, ctx->lp PASS_LD) )
+  { gTop = ctx->lp;
+    return FALSE;
+  }
+  a = valTermRef(tail);
+  deRef(a);
+  if ( !unify_ptrs(a, ctx->gstore PASS_LD) )
+  { gTop = ctx->lp;
+    return FALSE;
+  }
+
+  return TRUE;
+}

packages/PLStream/pl-privitf.h

@@ -0,0 +1,92 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@uva.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 1985-2008, University of Amsterdam
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#ifndef PL_PRIVITF_H_INCLUDED
+#define PL_PRIVITF_H_INCLUDED
+
+COMMON(int) 	PL_get_char(term_t c, int *p, int eof);
+COMMON(int) 	PL_unify_char(term_t chr, int c, int mode);
+COMMON(int)	PL_unify_predicate(term_t head, predicate_t pred, int how);
+
+
+
+		 /*******************************
+		 *	    LIST BUILDING	*
+		 *******************************/
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+Quickly create a list on the stack. This   is for creating lists were we
+can give an upperbound to the length  in advance. By allocation upfront,
+we know there are no garbage  collections   or  stack-shifts  and we can
+avoid using term-references to address the list.
+
+    * allocList(size_t maxcells, list_ctx *ctx)
+    Allocate enough space on the stack for a list of maxcells elements.
+    The final list may be shorter!
+
+    * addSmallIntList(list_ctx *ctx, int value)
+    Add a small integer to the list
+
+    * unifyList(term_t term, list_ctx *ctx);
+    Unify term with the created list.  This closes the list and adjusts
+    the top of the stack.
+
+    * unifyDiffList(term_t head, term_t tail, list_ctx *ctx);
+    Represent the list as Head\Tail.  This adjusts the top of the stack.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+#if __YAP_PROLOG__
+
+typedef struct list_ctx
+{ Word lp;
+  Word gstore;
+} list_ctx;
+
+static inline void
+addSmallIntList(list_ctx *ctx, int value)
+{
+ ctx->gstore = YAP_AddSmallIntToList(value);
+}
+
+#else
+
+typedef struct list_ctx
+{ Word lp;
+  Word gstore;
+} list_ctx;
+
+static inline void
+addSmallIntList(list_ctx *ctx, int value)
+{ ctx->gstore[0] = consPtr(&ctx->gstore[1], TAG_COMPOUND|STG_GLOBAL);
+  ctx->gstore[1] = FUNCTOR_dot2;
+  ctx->gstore[2] = consInt(value);
+  ctx->gstore += 3;
+}
+#endif
+
+COMMON(int)	allocList(size_t maxcells, list_ctx *ctx);
+COMMON(int)	unifyList(term_t term, list_ctx *ctx);
+COMMON(int)	unifyDiffList(term_t head, term_t tail, list_ctx *ctx);
+
+#endif /*PL_PRIVITF_H_INCLUDED*/