diff --git a/C/compiler.c b/C/compiler.c index 1fa6f08be..a00fb0f54 100644 --- a/C/compiler.c +++ b/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<rnd1 = labelno; diff --git a/C/exec.c b/C/exec.c index 7524334b0..f386ec599 100644 --- a/C/exec.c +++ b/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); } diff --git a/C/heapgc.c b/C/heapgc.c index aed9e7641..f478dd8dd 100644 --- a/C/heapgc.c +++ b/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) diff --git a/C/init.c b/C/init.c index 9d9852e7d..9c12e4026 100644 --- a/C/init.c +++ b/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) - YP_fclose(curfile); - curfile = YP_fopen(fname, "r"); - if (curfile == Nill) { - curfile = YP_stdin; - YP_fprintf(YP_stderr,"[ Warning: can not open %s for input]\n", fname); - } + if (curfile) + YP_fclose(curfile); + curfile = YP_fopen(fname, "r"); + if (curfile == Nill) { + curfile = stdin; + 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; - if (eolflg) { - if (curfile != Nill) { - if (YP_fgets(my_line, 200, curfile) == 0) - curfile = Nill; - } - if (curfile == Nill) - YP_fgets(my_line, 200, YP_stdin); - eolflg = 0; - lp = my_line; - } - if ((ch = *lp++) == 0) - ch = '\n', eolflg = 1; - if (Option['l' - 96]) - YP_putc(ch, logfile); - return (ch); + int ch; + if (eolflg) { + if (curfile != Nill) { + if (YP_fgets(my_line, 200, curfile) == 0) + curfile = Nill; + } + if (curfile == Nill) + YP_fgets(my_line, 200, stdin); + eolflg = 0; + lp = my_line; + } + if ((ch = *lp++) == 0) + ch = '\n', eolflg = 1; + if (Option['l' - 96]) + putc(ch, logfile); + return (ch); } #endif diff --git a/C/iopreds.c b/C/iopreds.c index d51dd43da..c4504e799 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -30,6 +30,9 @@ static char SccsId[] = "%W% %G%"; #include "yapio.h" #include +#if HAVE_STDARG_H +#include +#endif #if HAVE_SYS_TIME_H #include #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 (StdOutStream, Output_Stream_f, YP_stdout, AtomUsrOut); - InitStdStream (StdErrStream, Output_Stream_f, YP_stderr, AtomUsrErr); + InitStdStream (StdInStream, Input_Stream_f, stdin, AtomUsrIn); + InitStdStream (StdOutStream, Output_Stream_f, stdout, AtomUsrOut); + 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_outstream = YP_stderr; + rl_instream = stdin; + 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); diff --git a/C/tracer.c b/C/tracer.c index 057959896..1aefe0d28 100644 --- a/C/tracer.c +++ b/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 diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 3330b7386..373930028 100644 --- a/H/YapOpcodes.h +++ b/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_y ,y), + OPCODE(p_float_x ,x), + OPCODE(p_float_y ,y), OPCODE(p_db_ref_x ,x), OPCODE(p_db_ref_y ,y), OPCODE(p_cut_by_x ,x), diff --git a/H/amidefs.h b/H/amidefs.h index 29f324434..52a4e271e 100644 --- a/H/amidefs.h +++ b/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, diff --git a/H/compile.h b/H/compile.h index 4ceedb827..d8a91d2e0 100644 --- a/H/compile.h +++ b/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, diff --git a/H/yapio.h b/H/yapio.h index 9f8f2e408..5a824c518 100644 --- a/H/yapio.h +++ b/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 -#define YP_stdout stdout -#define YP_stderr stderr +extern int YP_stdin; +extern int YP_stdout; +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 diff --git a/changes4.3.html b/changes4.3.html index 7a261f300..cc957b92e 100644 --- a/changes4.3.html +++ b/changes4.3.html @@ -6,6 +6,14 @@

Yap-4.3.19:

    +
  • FIXED: don't allow importing from the module itself. +
  • FIXED: force line buffering for text stream. +
  • FIXED: force no buffering for user_error. +
  • FIXED: flush all streams before writing answer.. +
  • FIXED: YP_std* are now streams, so that yap_flag(user_*) + will change them too. +
  • FIXED: nth/3 and nth0/3 would leave one extra choice-point. +
  • FIXED: use Contents instead of Uses to determine live variables.
  • FIXED: cputime was actually walltime in WIN32, ugh (report from Steve Moyle).
  • FIXED: regexp library would not compile on recent versions diff --git a/config.h.in b/config.h.in index e8d07518b..de4abecc0 100644 --- a/config.h.in +++ b/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 diff --git a/configure b/configure index 82b8264c6..28b9eb9da 100755 --- a/configure +++ b/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 < +/* 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 <&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 < 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 diff --git a/configure.in b/configure.in index 564f26987..2f56e250e 100644 --- a/configure.in +++ b/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) diff --git a/library/lists.yap b/library/lists.yap index a5c305b48..9015b1912 100644 --- a/library/lists.yap +++ b/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. diff --git a/pl/boot.yap b/pl/boot.yap index aedbbb441..a7b7d6f6e 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -493,8 +493,7 @@ repeat :- '$repeat'. % the arguments. % '$present_answer'(_,_):- - flush_output(user_output), - flush_output(user_error), + '$flush_all_streams', fail. '$present_answer'((?-), Answ) :- nl(user_error), @@ -522,8 +521,7 @@ repeat :- '$repeat'. '$another'. '$write_answer'(_,_,_) :- - flush_output(user_output), - flush_output(user_error), + '$flush_all_streams', 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(_,_,_)),