diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more bug fixes:

Browse Source 
- make readline use packages, not old YAP code
- fix ! over backtrack cps
- fix write list
This commit is contained in:
ubu32
2011-02-15 05:54:19 -08:00
parent 140318ff16
commit 57f5ef8cfc
18 changed files with 341 additions and 403 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
C/adtdefs.c
View File

@@ -1177,6 +1177,8 @@ Yap_StringToDiffList(char *s, Term t)
t = Yap_Globalise(t);
while (cp > (unsigned char *)s) {
if (ASP < H+1024)
return (CELL)0;
t = MkPairTerm(MkIntTerm(*--cp), t);
}
return t;

15
C/c_interface.c
View File

@@ -333,7 +333,6 @@
#include <stdlib.h>
#include "Yap.h"
#include "clause.h"
#include "SWI-Stream.h"
#include "yapio.h"
#include "attvar.h"
#if HAVE_STDARG_H
@@ -474,7 +473,6 @@ X_API void STD_PROTO(YAP_SetOutputMessage, (void));
X_API int STD_PROTO(YAP_StreamToFileNo, (Term));
X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void));
X_API void STD_PROTO(YAP_FlushAllStreams,(void));
X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int));
X_API Int STD_PROTO(YAP_CurrentSlot,(void));
X_API Int STD_PROTO(YAP_NewSlots,(int));
X_API Int STD_PROTO(YAP_InitSlot,(Term));
@@ -3027,19 +3025,6 @@ YAP_FlushAllStreams(void)
RECOVER_H();
}
X_API Term
YAP_OpenStream(void *fh, char *name, Term nm, int flags)
{
Term retv;
BACKUP_H();
retv = Yap_OpenStream((FILE *)fh, name, nm, flags);
RECOVER_H();
return retv;
}
X_API void
YAP_Throw(Term t)
{

115
C/iopreds.c
View File

@@ -27,7 +27,6 @@ static char SccsId[] = "%W% %G%";
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "SWI-Stream.h"
#include "yapio.h"
#include "eval.h"
#include <stdlib.h>
@@ -140,55 +139,6 @@ DefaultEncoding(void)
return ENC_ISO_ANSI;
}
static int
GetFreeStreamD(void)
{
int sno;
for (sno = 0; sno < MaxStreams; ++sno) {
LOCK(Stream[sno].streamlock);
if (Stream[sno].status & Free_Stream_f) {
break;
}
UNLOCK(Stream[sno].streamlock);
}
if (sno == MaxStreams) {
return -1;
}
Stream[sno].encoding = DefaultEncoding();
return sno;
}
int
Yap_GetFreeStreamD(void)
{
return GetFreeStreamD();
}
/* used from C-interface */
int
Yap_GetFreeStreamDForReading(void)
{
int sno = GetFreeStreamD();
StreamDesc *s;
if (sno < 0) return sno;
s = Stream+sno;
s->status |= User_Stream_f|Input_Stream_f;
s->charcount = 0;
s->linecount = 1;
s->linepos = 0;
s->stream_wgetc = get_wchar;
s->encoding = DefaultEncoding();
if (CharConversionTable != NULL)
s->stream_wgetc_for_read = ISOWGetc;
else
s->stream_wgetc_for_read = s->stream_wgetc;
UNLOCK(s->streamlock);
return sno;
}
static void
unix_upd_stream_info (StreamDesc * s)
{
@@ -267,6 +217,25 @@ p_always_prompt_user(void)
return(TRUE);
}
static int
GetFreeStreamD(void)
{
int sno;
for (sno = 0; sno < MaxStreams; ++sno) {
LOCK(Stream[sno].streamlock);
if (Stream[sno].status & Free_Stream_f) {
break;
}
UNLOCK(Stream[sno].streamlock);
}
if (sno == MaxStreams) {
return -1;
}
Stream[sno].encoding = DefaultEncoding();
return sno;
}
static int
is_same_tty(YP_File f1, YP_File f2)
{
@@ -1826,6 +1795,51 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf));
}
Term
Yap_StringToTerm(char *s,Term *tp)
{
IOSTREAM *sno = Sopenmem(&s, NULL, "r");
Term t;
TokEntry *tokstart;
tr_fr_ptr TR_before_parse;
Term tpos = TermNil;
if (sno == NULL)
return FALSE;
TR_before_parse = TR;
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
if (tokstart == NIL || tokstart->Tok == Ord (eot_tok)) {
if (tp) {
*tp = MkAtomTerm(AtomEOFBeforeEOT);
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
Sclose(sno);
return FALSE;
} else if (Yap_ErrorMessage) {
if (tp) {
*tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage));
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
Sclose(sno);
return FALSE;
}
t = Yap_Parse();
TR = TR_before_parse;
if (!t && !Yap_ErrorMessage) {
if (tp) {
t = MkVarTerm();
*tp = syntax_error(tokstart, sno, &t);
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
Sclose(sno);
return FALSE;
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
Sclose(sno);
return t;
}
Int
Yap_FirstLineInParse (void)
{
@@ -2674,7 +2688,6 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$has_readline", 0, p_has_readline, SafePredFlag|HiddenPredFlag);
Yap_InitReadUtil ();
InitPlIO ();
#if HAVE_LIBREADLINE && HAVE_READLINE_READLINE_H
InitReadline();

193
C/readutil.c
View File

@@ -1,193 +0,0 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: readutil.c *
* Last rev: 2/8/06 *
* mods: *
* comments: readutil library support *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "iopreds.h"
static Int
rl_to_codes(Term TEnd, int do_as_binary, int arity)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
Int status;
UInt max_inp, buf_sz, sz;
char *buf;
int binary_stream;
if (sno < 0)
return FALSE;
status = Stream[sno].status;
binary_stream = Stream[sno].status & Binary_Stream_f;
if (status & Eof_Stream_f) {
UNLOCK(Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
}
max_inp = (ASP-H)/2-1024;
buf = (char *)TR;
buf_sz = (char *)Yap_TrailTop-buf;
while (TRUE) {
if ( buf_sz > max_inp ) {
buf_sz = max_inp;
}
if (do_as_binary && !binary_stream)
Stream[sno].status |= Binary_Stream_f;
sz = Stream[sno].stream_gets(sno, buf_sz, buf);
if (do_as_binary && !binary_stream)
Stream[sno].status &= ~Binary_Stream_f;
if (sz == -1 || sz == 0) {
if (Stream[sno].status & Eof_Stream_f) {
UNLOCK(Stream[sno].streamlock);
return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof));
}
UNLOCK(Stream[sno].streamlock);
return FALSE;
}
if (Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) {
/* we're done */
Term end;
if (!(do_as_binary || Stream[sno].status & Eof_Stream_f)) {
UNLOCK(Stream[sno].streamlock);
/* handle CR before NL */
if (sz-2 >= 0 && buf[sz-2] == 13)
buf[sz-2] = '\0';
else
buf[sz-1] = '\0';
} else {
UNLOCK(Stream[sno].streamlock);
}
if (arity == 2)
end = TermNil;
else
end = Deref(XREGS[arity]);
return Yap_unify(ARG2, Yap_StringToDiffList((char *)TR, end)) ;
}
buf += (buf_sz-1);
max_inp -= (buf_sz-1);
if (max_inp <= 0) {
UNLOCK(Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_line_to_codes/%d", arity);
return FALSE;
}
}
}
static Int
p_rl_to_codes(void)
{
return rl_to_codes(TermNil, FALSE, 2);
}
static Int
p_rl_to_codes2(void)
{
return rl_to_codes(TermNil, TRUE, 3);
}
static Int
p_stream_to_codes(void)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
CELL *HBASE = H;
CELL *h0 = &ARG4;
if (sno < 0)
return FALSE;
while (!(Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
Int ch = Stream[sno].stream_getc(sno);
Term t;
if (ch == EOFCHAR)
break;
t = MkIntegerTerm(ch);
h0[0] = AbsPair(H);
*H = t;
H+=2;
h0 = H-1;
if (H >= ASP-1024) {
RESET_VARIABLE(h0);
ARG4 = AbsPair(HBASE);
ARG5 = (CELL)h0;
if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3");
return FALSE;
}
/* build a legal term again */
h0 = (CELL *)ARG5;
HBASE = RepPair(ARG4);
}
}
UNLOCK(Stream[sno].streamlock);
if (H == HBASE)
return Yap_unify(ARG2,ARG3);
RESET_VARIABLE(H-1);
Yap_unify(H[-1],ARG3);
return Yap_unify(AbsPair(HBASE),ARG2);
}
static Int
p_stream_to_terms(void)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
Term t = Deref(ARG3), tpos = TermNil;
if (sno < 0)
return FALSE;
while (!(Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
TokEntry *tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos);
if (!Yap_ErrorMessage)
{
Term th = Yap_Parse();
if (H >= ASP-1024) {
UNLOCK(Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_terms/3");
return FALSE;
}
if (!th || Yap_ErrorMessage)
break;
if (th == MkAtomTerm (AtomEof)) {
UNLOCK(Stream[sno].streamlock);
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
return Yap_unify(t,ARG2);
} else {
t = MkPairTerm(th,t);
}
}
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
}
UNLOCK(Stream[sno].streamlock);
return Yap_unify(t,ARG2);
}
void
Yap_InitReadUtil(void)
{
Term cm = CurrentModule;
CurrentModule = READUTIL_MODULE;
Yap_InitCPred("read_line_to_codes", 2, p_rl_to_codes, SyncPredFlag);
Yap_InitCPred("read_line_to_codes", 3, p_rl_to_codes2, SyncPredFlag);
Yap_InitCPred("read_stream_to_codes", 3, p_stream_to_codes, SyncPredFlag);
Yap_InitCPred("read_stream_to_terms", 3, p_stream_to_terms, SyncPredFlag);
CurrentModule = cm;
}

2
C/save.c
View File

@@ -1753,6 +1753,8 @@ Restore(char *s, char *lib_dir)
}
Yap_ReOpenLoadForeign();
/* restore SWI IO */
initIO ();
Yap_InitPlIO();
/* reset time */
Yap_ReInitWallTime();

22
C/stdpreds.c
View File

@@ -727,18 +727,6 @@ strtod(s, pe)
#endif
static char *cur_char_ptr;
static int
get_char_from_string(int s)
{
if (cur_char_ptr[0] == '\0')
return -1;
cur_char_ptr++;
return cur_char_ptr[-1];
}
#ifndef INFINITY
#define INFINITY (1.0/0.0)
#endif
@@ -751,9 +739,9 @@ static Term
get_num(char *t)
{
Term out;
cur_char_ptr = t;
out = Yap_scan_num(get_char_from_string);
IOSTREAM *smem = Sopenmem(&t, NULL, "r");
out = Yap_scan_num(smem);
Sclose(smem);
/* not ever iso */
if (out == TermNil && yap_flags[LANGUAGE_MODE_FLAG] != 1) {
int sign = 1;
@@ -779,10 +767,12 @@ get_num(char *t)
}
}
}
/*
if (cur_char_ptr[0] == '\0')
return(out);
else
return(TermNil);
*/
return(out);
}
static UInt