fixes for modules, buffering, YP_*, live vars for gc, and nth(0).

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@20 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/compiler.c

@@ -2318,7 +2318,7 @@ copy_live_temps_bmap(int max)
       *ptr = 0L;
     }
     /* set the register live bit */
-    if (Uses[i]) {
+    if (Contents[i]) {
       int j = i%(8*CellSize);
       *ptr |= (1<<j);
     }
@@ -2535,7 +2535,7 @@ c_layout(void)
 	cpc = icpc;
 	max = 0;
 	for (i = 1; i < MaxCTemps; ++i) {
-	  if (Uses[i]) max = i;
+	  if (Contents[i]) max = i;
 	}
 	emit(label_op, ++labelno, Zero);
 	mycpc->rnd1 = labelno;

C/exec.c

@@ -1245,7 +1245,12 @@ p_clean_ifcp(void) {
 #else
   choiceptr pt0 = (choiceptr)(LCL0-IntOfTerm(Deref(ARG1)));
 #endif
-  pt0->cp_ap = (yamop *)TRUSTFAILCODE;
+  if (pt0 == B) {
+    B = B->cp_b;
+    HB = B->cp_h;
+  } else {
+    pt0->cp_ap = (yamop *)TRUSTFAILCODE;
+  }
   return(TRUE);
 }
 

C/heapgc.c

@@ -1168,7 +1168,23 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 #endif /* TABLING_SCHEDULING */
 #endif
 
-/* #define CHECK_CHOICEPOINTS 1*/
+#ifdef DEBUG
+#define CHECK_CHOICEPOINTS 1
+#endif
+
+#ifdef CHECK_CHOICEPOINTS
+#ifndef ANALYST
+
+static char *op_names[_std_top + 1] =
+{
+#define OPCODE(OP,TYPE) #OP
+#include "YapOpcodes.h"
+#undef  OPCODE
+};
+
+#endif
+#endif
+
 
 static void 
 mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)

C/init.c

@@ -205,7 +205,7 @@ int
 DebugPutc(int sno, int ch)
 {
   if (Option['l' - 96])
-    (void) YP_putc(ch, logfile);
+    (void) putc(ch, logfile);
   return (YP_putc(ch, YP_stderr));
 }
 
@@ -236,13 +236,13 @@ InTTYLine(char *line)
 void 
 DebugSetIFile(char *fname)
 {
-	if (curfile)
+  if (curfile)
-		YP_fclose(curfile);
+    YP_fclose(curfile);
-	curfile = YP_fopen(fname, "r");
+  curfile = YP_fopen(fname, "r");
-	if (curfile == Nill) {
+  if (curfile == Nill) {
-		curfile = YP_stdin;
+    curfile = stdin;
-		YP_fprintf(YP_stderr,"[ Warning: can not open %s for input]\n", fname);
+    YP_fprintf(YP_stderr,"[ Warning: can not open %s for input]\n", fname);
-	}
+  }
 }
 
 void 
@@ -257,22 +257,22 @@ static       int   eolflg = 1;
 int 
 DebugGetc()
 {
-	int             ch;
+  int             ch;
-	if (eolflg) {
+  if (eolflg) {
-		if (curfile != Nill) {
+    if (curfile != Nill) {
-			if (YP_fgets(my_line, 200, curfile) == 0)
+      if (YP_fgets(my_line, 200, curfile) == 0)
-				curfile = Nill;
+	curfile = Nill;
-		}
+    }
-		if (curfile == Nill)
+    if (curfile == Nill)
-			YP_fgets(my_line, 200, YP_stdin);
+      YP_fgets(my_line, 200, stdin);
-		eolflg = 0;
+    eolflg = 0;
-		lp = my_line;
+    lp = my_line;
-	}
+  }
-	if ((ch = *lp++) == 0)
+  if ((ch = *lp++) == 0)
-		ch = '\n', eolflg = 1;
+    ch = '\n', eolflg = 1;
-	if (Option['l' - 96])
+  if (Option['l' - 96])
-		YP_putc(ch, logfile);
+    putc(ch, logfile);
-	return (ch);
+  return (ch);
 }
 
 #endif

C/iopreds.c

@@ -30,6 +30,9 @@ static char SccsId[] = "%W% %G%";
 #include "yapio.h"
 
 #include <stdlib.h>
+#if HAVE_STDARG_H
+#include <stdarg.h>
+#endif
 #if HAVE_SYS_TIME_H
 #include <sys/time.h>
 #endif
@@ -161,6 +164,7 @@ STATIC_PROTO (Int p_put, (void));
 STATIC_PROTO (Int p_put_byte, (void));
 STATIC_PROTO (Int p_skip, (void));
 STATIC_PROTO (Int p_flush, (void));
+STATIC_PROTO (Int p_flush_all_streams, (void));
 STATIC_PROTO (Int p_write_depth, (void));
 STATIC_PROTO (Int p_open_null_stream, (void));
 STATIC_PROTO (Int p_user_file_name, (void));
@@ -211,6 +215,10 @@ StreamDesc Stream[MaxStreams];
 #endif
 #define InMemory_Stream_f	0x020000
 
+int YP_stdin = 0;
+int YP_stdout = 1;
+int YP_stderr = 2;
+
 int c_input_stream, c_output_stream;
 
 #if EMACS
@@ -234,6 +242,45 @@ static int parser_error_style = FAIL_ON_PARSER_ERROR;
 extern int YP_sockets_io;
 #endif
 
+/* note: fprintf may be called from anywhere, so please don't try
+   to be smart and allocate stack from somewhere else */
+int
+YP_fprintf(int sno, char *format,...)
+{
+  va_list ap;
+  char buf[512], *ptr = buf;
+  int r = 0;
+
+  va_start(ap,format);
+#ifdef HAVE_VSNPRINTF
+  vsnprintf(buf,512,format,ap);
+#else
+  vsprintf(buf,format,ap);
+#endif
+  va_end(ap);
+
+  while (*ptr) {
+    Stream[sno].stream_putc(sno, *ptr++);
+    r++;
+  }
+  return r;
+}
+
+int
+YP_putc(int ch, int sno)
+{
+  Stream[sno].stream_putc(sno, ch);
+  return(ch);
+}
+
+int
+YP_fflush(int sno)
+{
+  if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f|Socket_Stream_f))
+    return(0);
+  return(fflush(Stream[sno].u.file.file));
+}
+
 static void
 unix_upd_stream_info (StreamDesc * s)
 {
@@ -270,8 +317,7 @@ unix_upd_stream_info (StreamDesc * s)
   {
     int filedes; /* visualc */
     filedes = YP_fileno (s->u.file.file);
-    if (isatty (filedes))
+    if (isatty (filedes)) {
-      {
 	char *ttys = ttyname(filedes);
 	if (ttys == NULL)
 	  s->u.file.name = LookupAtom("tty");
@@ -279,7 +325,7 @@ unix_upd_stream_info (StreamDesc * s)
 	  s->u.file.name = LookupAtom(ttys);
 	s->status |= Tty_Stream_f|Reset_Eof_Stream_f|Promptable_Stream_f;
 	return;
-      }
+    }
   }
 #endif /* HAVE_ISATTY */
 #endif /* _MSC_VER */
@@ -366,7 +412,7 @@ InitStdStream (int sno, SMALLUNSGN flags, YP_File file, Atom name)
   if ((s->status & Tty_Stream_f) && file == stdin)
     /* make sure input is unbuffered if it comes from stdin, this
        makes life simpler for interrupt handling */
-    YP_setbuf (YP_stdin, NULL); 
+    YP_setbuf (stdin, NULL); 
 #endif /* HAVE_SETBUF */
 
 }
@@ -376,11 +422,12 @@ void
 InitPlIO (void)
 {
   Int i;
+
   for (i = 0; i < MaxStreams; ++i)
     Stream[i].status = Free_Stream_f;
-  InitStdStream (StdInStream, Input_Stream_f, YP_stdin, AtomUsrIn);
+  InitStdStream (StdInStream, Input_Stream_f, stdin, AtomUsrIn);
-  InitStdStream (StdOutStream, Output_Stream_f, YP_stdout, AtomUsrOut);
+  InitStdStream (StdOutStream, Output_Stream_f, stdout, AtomUsrOut);
-  InitStdStream (StdErrStream, Output_Stream_f, YP_stderr, AtomUsrErr);
+  InitStdStream (StdErrStream, Output_Stream_f, stderr, AtomUsrErr);
   c_input_stream = StdInStream;
   c_output_stream = StdOutStream;
   /* alloca alias array */
@@ -424,9 +471,9 @@ count_output_char(int ch, StreamDesc *s, int sno)
 		       StdErrStream) &&
 	  !(s->status & Null_Stream_f))
 	{
-	  YP_putc (MPWSEP, s->u.file.file);
+	  putc (MPWSEP, s->u.file.file);
 	  if (!(Stream[c_output_stream].status & Null_Stream_f))
-	    YP_fflush (YP_stdout);
+	    fflush (stdout);
 	}
 #endif
       /* Inform that we have written a newline */
@@ -455,9 +502,9 @@ console_count_output_char(int ch, StreamDesc *s, int sno)
 		       StdErrStream) &&
 	  !(s->status & Null_Stream_f))
 	{
-	  YP_putc (MPWSEP, s->u.file.file);
+	  putc (MPWSEP, s->u.file.file);
 	  if (!(Stream[c_output_stream].status & Null_Stream_f))
-	    YP_fflush (YP_stdout);
+	    fflush (stdout);
 	}
 #endif
       ++s->charcount;
@@ -489,7 +536,13 @@ FilePutc(int sno, int ch)
       ch = '\n';
     }
 #endif
-  YP_putc(ch, s->u.file.file);
+  putc(ch, s->u.file.file);
+#if MAC || _MSC_VER
+  if (ch == 10)
+    {
+      fflush(s->u.file.file);
+    }
+#endif
   count_output_char(ch,s,sno);
   return ((int) ch);
 }
@@ -603,7 +656,7 @@ ConsolePutc (int sno, int ch)
       ch = '\n';
     }
 #endif
-  YP_putc (ch, s->u.file.file);
+  putc (ch, s->u.file.file);
   console_count_output_char(ch,s,sno);
   return ((int) ch);
 }
@@ -668,8 +721,8 @@ ReadlineGetc(int sno)
     /* Only sends a newline if we are at the start of a line */
     if (_line != (char *) NULL && _line != (char *) EOF)
       free (_line);
-    rl_instream = YP_stdin;
+    rl_instream = stdin;
-    rl_outstream = YP_stderr;
+    rl_outstream = stderr;
     /* window of vulnerability opened */
     in_readline = TRUE;
     if (newline) {
@@ -1236,9 +1289,9 @@ p_open (void)
   opts = IntOfTerm(topts);
 #ifdef _WIN32
   if (st->status & Binary_Stream_f) {
-	  strncat(io_mode, "b", 8);
+    strncat(io_mode, "b", 8);
   } else {
-	  strncat(io_mode, "t", 8);
+    strncat(io_mode, "t", 8);
   }
 #endif
   if ((st->u.file.file = YP_fopen (FileNameBuf, io_mode)) == YAP_ERROR ||
@@ -1598,7 +1651,25 @@ SetAlias (Atom arg, int sno)
 
   while (aliasp < aliasp_max) {
     if (aliasp->name == arg) {
+      Int alno = aliasp-FileAliases;
       aliasp->alias_stream = sno;
+      switch(alno) {
+      case 0:
+	YP_stdin = sno;
+	break;
+      case 1:
+	YP_stdout = sno;
+	break;
+      case 2:
+	YP_stderr = sno;
+#if HAVE_SETBUF
+	if (!(Stream[sno].status &
+	      (Null_Stream_f|InMemory_Stream_f|Socket_Stream_f)))
+	  YP_setbuf (Stream[sno].u.file.file, NULL); 
+#endif /* HAVE_SETBUF */
+	break;
+      default:
+      }
       return;
     }
     aliasp++;
@@ -1621,7 +1692,20 @@ PurgeAlias (int sno)
     if (aliasp->alias_stream == sno) {
       if (aliasp - FileAliases < 3) {
 	/* get back to std streams, but keep alias around */
-	new_aliasp->alias_stream = aliasp-FileAliases;
+	Int alno = aliasp-FileAliases;
+	new_aliasp->alias_stream = alno;
+	switch(alno) {
+	case 0:
+	  YP_stdin = 0;
+	  break;
+	case 1:
+	  YP_stdout = 1;
+	  break;
+	case 2:
+	  YP_stderr = 2;
+	  break;
+	default:
+	}
 	new_aliasp++;
       } else {
 	NOfFileAliases--;
@@ -3812,7 +3896,14 @@ p_flush (void)
   if (sno < 0)
     return (FALSE);
   if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f)))
-    YP_fflush (Stream[sno].u.file.file);
+    YP_fflush (sno);
+  return (TRUE);
+}
+
+static Int
+p_flush_all_streams (void)
+{				/* $flush_all_streams          */
+  fflush (NULL);
   return (TRUE);
 }
 
@@ -4174,6 +4265,7 @@ InitIOPreds(void)
   InitCPred ("$close", 1, p_close, SafePredFlag|SyncPredFlag);
   InitCPred ("peek_mem_write_stream", 3, p_peek_mem_write_stream, SyncPredFlag);
   InitCPred ("flush_output", 1, p_flush, SafePredFlag|SyncPredFlag);
+  InitCPred ("$flush_all_streams", 0, p_flush_all_streams, SafePredFlag|SyncPredFlag);
   InitCPred ("$get", 2, p_get, SafePredFlag|SyncPredFlag);
   InitCPred ("$get0", 2, p_get0, SafePredFlag|SyncPredFlag);
   InitCPred ("$get0_line_codes", 2, p_get0_line_codes, SafePredFlag|SyncPredFlag);

C/tracer.c

@@ -32,7 +32,7 @@ static int do_trace_primitives = TRUE;
  int
 TracePutchar(int sno, int ch)
 {
-  return(YP_putc(ch, stderr)); /* use standard error stream, which is supposed to be 2*/
+  return(YP_putc(ch, YP_stderr)); /* use standard error stream, which is supposed to be 2*/
 }
 
 static void

H/YapOpcodes.h

@@ -290,8 +290,8 @@
     OPCODE(p_var_y                 ,y),			
     OPCODE(p_compound_x            ,x),			
     OPCODE(p_compound_y            ,y),			
-    OPCODE(p_float_x	            ,x),			
+    OPCODE(p_float_x	           ,x),			
-    OPCODE(p_float_y	            ,y),			
+    OPCODE(p_float_y	           ,y),			
     OPCODE(p_db_ref_x              ,x),			
     OPCODE(p_db_ref_y              ,y),			
     OPCODE(p_cut_by_x              ,x),			

H/amidefs.h

@@ -54,7 +54,7 @@ typedef enum {
 } op_numbers;
 
 
-#define _std_top	_p_slr_y_cv
+#define _std_top	_p_func2f_yy
 
 typedef enum {
 	_atom,

H/compile.h

@@ -146,7 +146,6 @@ typedef enum compiler_op {
   fetch_args_vc_op,
   f_var_op,
   f_val_op,
-  func2f_op,
   enter_profiling_op,
   retry_profiled_op,
   restore_tmps_op,

H/yapio.h

@@ -25,9 +25,7 @@
 #ifndef YAP_STDIO
 
 #define YP_printf	printf
-#define YP_fprintf      fprintf
 #define YP_putchar	putchar
-#define YP_putc		putc
 #define YP_getc		getc
 #define YP_fgetc	fgetc
 #define YP_getchar	getchar
@@ -38,7 +36,6 @@
 #define YP_fileno	fileno
 #define YP_fopen	fopen
 #define YP_fclose	fclose
-#define YP_fflush	fflush
 #define YP_ftell	ftell
 #define YP_fseek	fseek
 #define YP_setbuf	setbuf
@@ -48,9 +45,13 @@
 #define init_yp_stdio()
 
 #define YP_FILE		FILE
-#define YP_stdin	stdin
+extern int YP_stdin;
-#define YP_stdout	stdout
+extern int YP_stdout;
-#define YP_stderr	stderr
+extern int YP_stderr;
+
+int     STD_PROTO(YP_fprintf,(int, char *, ...));
+int     STD_PROTO(YP_putc,(int, int));
+int     STD_PROTO(YP_fflush,(int));
 
 #else
 

changes4.3.html

@@ -6,6 +6,14 @@
 
 <H2 ALIGN=CENTER>Yap-4.3.19:</H2>
 <UL>
+      <LI> FIXED: don't allow importing from the module itself.
+      <LI> FIXED: force line buffering for text stream.
+      <LI> FIXED: force no buffering for user_error.
+      <LI> FIXED: flush all streams before writing answer..
+      <LI> FIXED: YP_std* are now streams, so that yap_flag(user_*)
+      will change them too.
+      <LI> FIXED: nth/3 and nth0/3 would leave one extra choice-point.
+      <LI> FIXED: use Contents instead of Uses to determine live variables.
       <LI> FIXED: cputime was actually walltime in WIN32, ugh (report
       from Steve Moyle).
       <LI> FIXED: regexp library would not compile on recent versions

config.h.in

@@ -124,6 +124,7 @@
 #undef  HAVE_STAT
 #undef  HAVE_SELECT
 #undef  HAVE_SETBUF
+#undef  HAVE_SETLINEBUF
 #undef  HAVE_SHMAT
 #undef  HAVE_SIGACTION
 #undef  HAVE_SIGGETMASK

configure

@@ -3612,15 +3612,70 @@ else
 fi
 done
 
+for ac_func in setlinebuf
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:3619: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+  echo $ac_n "(cached) $ac_c" 1>&6
+else
+  cat > conftest.$ac_ext <<EOF
+#line 3624 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func(); below.  */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error.  */
+/* We use char because int might match the return type of a gcc2
+    builtin and then its argument prototype would still apply.  */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3647: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=yes"
+else
+  echo "configure: failed program was:" >&5
+  cat conftest.$ac_ext >&5
+  rm -rf conftest*
+  eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+  echo "$ac_t""yes" 1>&6
+    ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+  cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ 
+else
+  echo "$ac_t""no" 1>&6
+fi
+done
+
 
 echo $ac_n "checking for mpz_xor""... $ac_c" 1>&6
-echo "configure:3618: checking for mpz_xor" >&5
+echo "configure:3673: checking for mpz_xor" >&5
 if eval "test \"`echo '$''{'yap_mpz_xor'+set}'`\" = set"; then
   echo $ac_n "(cached) $ac_c" 1>&6
 else
   
 cat > conftest.$ac_ext <<EOF
-#line 3624 "configure"
+#line 3679 "configure"
 #include "confdefs.h"
 #include <gmp.h>
 	void check(mpz_t rop,mpz_t op1,mpz_t op2) {
@@ -3631,7 +3686,7 @@ int main() {
 
 ; return 0; }
 EOF
-if { (eval echo configure:3635: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3690: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
   rm -rf conftest*
   yap_mpz_xor=yes
 else

configure.in

@@ -567,6 +567,7 @@ AC_CHECK_FUNCS(snprintf vsnprintf setbuf system link getpwnam dup2 sigprocmask)
 AC_CHECK_FUNCS(labs strncat tmpnam getenv gettimeofday gethrtime putenv)
 AC_CHECK_FUNCS(strerror socket memmove alarm asinh acosh atanh rint)
 AC_CHECK_FUNCS(stat select fetestexcept finite strncpy mkstemp isnan)
+AC_CHECK_FUNCS(setlinebuf)
 
 dnl check for mpz_xor
 AC_MSG_CHECKING(for mpz_xor)

library/lists.yap

@@ -111,12 +111,11 @@ nextto(X,Y, [_|List]) :-
 nth0(0, [Head|_], Head) :- !.
 
 nth0(N, [_|Tail], Elem) :-
-	nonvar(N),
+	nonvar(N), !,
 	M is N-1,
 	nth0(M, Tail, Elem).
 
 nth0(N,[_|T],Item) :-		% Clause added KJ 4-5-87 to allow mode
-	var(N),			% nth0(-,+,+)
 	nth0(M,T,Item),
 	N is M + 1.
 
@@ -124,12 +123,12 @@ nth0(N,[_|T],Item) :-		% Clause added KJ 4-5-87 to allow mode
 nth(1, [Head|_], Head) :- !.
 
 nth(N, [_|Tail], Elem) :-
-	nonvar(N),
+	nonvar(N), !,
 	M is N-1,			% should be succ(M, N)
 	nth(M, Tail, Elem).
 
 nth(N,[_|T],Item) :-		% Clause added KJ 4-5-87 to allow mode
-	var(N),			% nth(-,+,+)
+				% nth(-,+,+)
 	nth(M,T,Item),
 	N is M + 1.
 

pl/boot.yap

@@ -493,8 +493,7 @@ repeat :- '$repeat'.
 % the arguments.
 %
 '$present_answer'(_,_):-
-	flush_output(user_output),
+        '$flush_all_streams',
-	flush_output(user_error),
 	fail.
 '$present_answer'((?-), Answ) :-
 	nl(user_error),
@@ -522,8 +521,7 @@ repeat :- '$repeat'.
 	'$another'.
 
 '$write_answer'(_,_,_) :-
-	flush_output(user_output),
+        '$flush_all_streams',
-	flush_output(user_error),
 	fail.
 '$write_answer'(Vs, LBlk, LAnsw) :-
 	'$purge_dontcares'(Vs,NVs),
@@ -802,7 +800,9 @@ incore(G) :- '$execute'(G).
 % Called by the abstract machine, if no clauses exist for a predicate
 '$undefp'([M|G]) :-
 	functor(G,F,N),
-	'$recorded'('$import','$import'(S,M,F,N),_), !,
+	'$recorded'('$import','$import'(S,M,F,N),_),
+	S\= M, % can't try importing from the module itself.
+	!,
 	'$exec_with_expansion'(G, S, M).
 '$undefp'([M|G]) :-
 	\+ '$undefined'(user:unknown_predicate_handler(_,_,_)),