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

small bugs, especiall in error processing

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-12-05 14:50:04 -06:00
parent 6a4dbd91ec
commit 4f423dc16a
13 changed files with 275 additions and 188 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
C/arith1.c
View File

@ -20,9 +20,9 @@ static char SccsId[] = "%W% %G%";
/** /**
@file arith1.c @file arith1.c
@addtogroup arithmetic_operators @addtogroup arithmetic_operators
- <b>exp( _X_) [ISO]</b><p> @anchor exp_1 - <b>exp( _X_) [ISO]</b><p> @anchor exp_1
Natural exponential. Natural exponential.
@ -109,7 +109,7 @@ static char SccsId[] = "%W% %G%";
- <b>integer( _X_)</b><p> @anchor integer_1_op - <b>integer( _X_)</b><p> @anchor integer_1_op
If _X_ evaluates to a float, the integer between the value of _X_ and 0 closest to the value of _X_, else if _X_ evaluates to an If _X_ evaluates to a float, the integer between the value of _X_ and 0 closest to the value of _X_, else if _X_ evaluates to an
integer, the value of _X_. integer, the value of _X_.
- <b>float( _X_) [ISO]</b><p> @anchor float_1_op - <b>float( _X_) [ISO]</b><p> @anchor float_1_op
@ -178,7 +178,7 @@ A = 3602879701896397 rdiv 36028797018963968
Convert the expression _X_ to a rational number or integer. The function is Convert the expression _X_ to a rational number or integer. The function is
similar to [rational/1](@ref rational_1), but the result is only accurate within the similar to [rational/1](@ref rational_1), but the result is only accurate within the
rounding error of floating point numbers, generally producing a much rounding error of floating point numbers, generally producing a much
smaller denominator. smaller denominator.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog
?- A is rationalize(0.25). ?- A is rationalize(0.25).
@ -298,24 +298,24 @@ get_float(Term t) {
#else #else
static static
double my_rint(double x) double my_rint(double x)
{ {
double y, z; double y, z;
Int n; Int n;
if (x >= 0) { if (x >= 0) {
y = x + 0.5; y = x + 0.5;
z = floor(y); z = floor(y);
n = (Int) z; n = (Int) z;
if (y == z && n % 2) if (y == z && n % 2)
return(z-1); return(z-1);
} else { } else {
y = x - 0.5; y = x - 0.5;
z = ceil(y); z = ceil(y);
n = (Int) z; n = (Int) z;
if (y == z && n % 2) if (y == z && n % 2)
return(z+1); return(z+1);
} }
return(z); return(z);
} }
#endif #endif
@ -412,7 +412,7 @@ eval1(Int fi, Term t USES_REGS) {
{ {
#ifdef USE_GMP #ifdef USE_GMP
Int i = IntegerOfTerm(t); Int i = IntegerOfTerm(t);
if (i == Int_MIN) { if (i == Int_MIN) {
return Yap_gmp_neg_int(i); return Yap_gmp_neg_int(i);
} }
@ -745,7 +745,7 @@ eval1(Int fi, Term t USES_REGS) {
if (dbl < 0.0) if (dbl < 0.0)
RBIG_FL(ceil(dbl)); RBIG_FL(ceil(dbl));
else else
RBIG_FL(floor(dbl)); RBIG_FL(floor(dbl));
} }
case op_float: case op_float:
switch (ETypeOfTerm(t)) { switch (ETypeOfTerm(t)) {
@ -967,7 +967,7 @@ Yap_NameOfUnaryOp(int i)
return Yap_LookupAtom(InitUnTab[i].OpName); return Yap_LookupAtom(InitUnTab[i].OpName);
} }
static Int static Int
p_unary_is( USES_REGS1 ) p_unary_is( USES_REGS1 )
{ /* X is Y */ { /* X is Y */
Term t = Deref(ARG2); Term t = Deref(ARG2);
@ -1017,7 +1017,7 @@ p_unary_is( USES_REGS1 )
return(FALSE); return(FALSE);
} }
static Int static Int
p_unary_op_as_integer( USES_REGS1 ) p_unary_op_as_integer( USES_REGS1 )
{ /* X is Y */ { /* X is Y */
Term t = Deref(ARG1); Term t = Deref(ARG1);
@ -1075,4 +1075,3 @@ Yap_ReInitUnaryExps(void)
{ {
return TRUE; return TRUE;
} }

24
C/cmppreds.c
View File

@ -83,7 +83,7 @@ static Int a_gen_ge(Term, Term);
#define rfloat(X) (X > 0.0 ? 1 : (X == 0.0 ? 0 : -1)) #define rfloat(X) (X > 0.0 ? 1 : (X == 0.0 ? 0 : -1))
static int cmp_atoms(Atom a1, Atom a2) { static int cmp_atoms(Atom a1, Atom a2) {
return strcmp(RepAtom(a1)->StrOfAE, RepAtom(a2)->StrOfAE); return strcmp(RepAtom(a1)->StrOfAE, RepAtom(a2)->StrOfAE);
} }
static Int compare_complex(register CELL *pt0, register CELL *pt0_end, static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
@ -382,7 +382,7 @@ inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */
if (f != FunctorDot) if (f != FunctorDot)
return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE); return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE);
else { else {
return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2) ); return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2));
} }
} }
} }
@ -595,10 +595,12 @@ inline static Int flt_cmp(Float dif) {
static Int a_cmp(Term t1, Term t2 USES_REGS) { static Int a_cmp(Term t1, Term t2 USES_REGS) {
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_ThrowError( INSTANTIATION_ERROR, t1, 4, "while doing arithmetic comparison" ); Yap_ArithError(INSTANTIATION_ERROR, t1,
"while doing arithmetic comparison");
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Yap_ThrowError( INSTANTIATION_ERROR, t1, 4, "while doing arithmetic comparison" ); Yap_ArithError(INSTANTIATION_ERROR, t2,
"while doing arithmetic comparison");
} }
if (IsFloatTerm(t1) && IsFloatTerm(t2)) { if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2)); return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2));
@ -621,7 +623,8 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f2 = FloatOfTerm(t2); Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f2)) { if (isnan(f2)) {
Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" ); Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
} }
#endif #endif
return flt_cmp(i1 - f2); return flt_cmp(i1 - f2);
@ -636,7 +639,8 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f1 = FloatOfTerm(t1); Float f1 = FloatOfTerm(t1);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f1)) { if (isnan(f1)) {
Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t1, 4, "trying to evaluate nan" ); Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t1,
"trying to evaluate nan");
} }
#endif #endif
t2 = Yap_Eval(t2); t2 = Yap_Eval(t2);
@ -652,8 +656,9 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f2 = FloatOfTerm(t2); Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f2)) { if (isnan(f2)) {
Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" ); Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
} "trying to evaluate nan");
}
#endif #endif
return flt_cmp(f1 - f2); return flt_cmp(f1 - f2);
#ifdef USE_GMP #ifdef USE_GMP
@ -674,7 +679,8 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) {
Float f2 = FloatOfTerm(t2); Float f2 = FloatOfTerm(t2);
#if HAVE_ISNAN #if HAVE_ISNAN
if (isnan(f2)) { if (isnan(f2)) {
Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" ); Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t2,
"trying to evaluate nan");
} }
#endif #endif
return Yap_gmp_cmp_big_float(t1, f2); return Yap_gmp_cmp_big_float(t1, f2);

1
C/exec.c
View File

@ -1446,7 +1446,6 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
/* must be done here, otherwise siglongjmp will clobber all the /* must be done here, otherwise siglongjmp will clobber all the
* registers * registers
*/ */
Yap_Error(LOCAL_Error_TYPE, TermNil, NULL);
/* reset the registers so that we don't have trash in abstract /* reset the registers so that we don't have trash in abstract
* machine */ * machine */
Yap_set_fpu_exceptions( Yap_set_fpu_exceptions(

220
C/scanner.c
View File

@ -1143,17 +1143,17 @@ Term Yap_scan_num(StreamDesc *inp, bool error_on) {
out = 0; out = 0;
} }
#if HAVE_ISWSPACE #if HAVE_ISWSPACE
while (iswspace(ch = getchr(inp))) while (iswspace(ch = getchr(inp)))
; ;
#else #else
while (isspace(ch = getchr(inp))) while (isspace(ch = getchr(inp)))
; ;
#endif #endif
if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) { if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) {
Yap_clean_tokenizer(old_tr, NULL, NULL); Yap_clean_tokenizer(old_tr, NULL, NULL);
if (error_on) if (error_on)
Yap_Error(SYNTAX_ERROR, ARG2, "converting number"); Yap_Error(SYNTAX_ERROR, ARG2, "converting number");
return 0; return 0;
} }
return out; return out;
} }
@ -1172,85 +1172,84 @@ Term Yap_scan_num(StreamDesc *inp, bool error_on) {
} }
Term Yap_tokRep(void *tokptre) { Term Yap_tokRep(void *tokptre) {
CACHE_REGS CACHE_REGS
TokEntry *tokptr = tokptre; TokEntry *tokptr = tokptre;
Term info = tokptr->TokInfo; Term info = tokptr->TokInfo;
switch (tokptr->Tok) { switch (tokptr->Tok) {
case Name_tok: case Name_tok:
if (!info) { if (!info) {
info = TermNil; info = TermNil;
}
return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info);
case QuasiQuotes_tok:
info = MkAtomTerm(Yap_LookupAtom("<QQ>"));
return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info);
case Number_tok:
return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info);
break;
case Var_tok: {
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
if ((t[0]= varinfo->VarAdr) == TermNil) {
t[0] = varinfo->VarAdr = MkVarTerm();
}
t[1] = MkAtomTerm((Atom)(varinfo->VarRep));
return Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
}
case String_tok:
return Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info);
case BQString_tok:
return Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info);
case Error_tok:
return MkAtomTerm(AtomError);
case eot_tok:
return MkAtomTerm(Yap_LookupAtom("EOT"));
case Ponctuation_tok:
return info;
} }
return TermDot; return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info);
case QuasiQuotes_tok:
info = MkAtomTerm(Yap_LookupAtom("<QQ>"));
return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info);
case Number_tok:
return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info);
break;
case Var_tok: {
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
if ((t[0] = varinfo->VarAdr) == TermNil) {
t[0] = varinfo->VarAdr = MkVarTerm();
}
t[1] = MkAtomTerm((Atom)(varinfo->VarRep));
return Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
}
case String_tok:
return Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info);
case BQString_tok:
return Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info);
case Error_tok:
return MkAtomTerm(AtomError);
case eot_tok:
return MkAtomTerm(Yap_LookupAtom("EOT"));
case Ponctuation_tok:
return info;
}
return TermDot;
} }
const char *Yap_tokText(void *tokptre) {
CACHE_REGS
TokEntry *tokptr = tokptre;
Term info = tokptr->TokInfo;
const char * Yap_tokText(void *tokptre) { switch (tokptr->Tok) {
CACHE_REGS case eot_tok:
TokEntry *tokptr = tokptre; return "EOT";
Term info = tokptr->TokInfo; case Ponctuation_tok:
case Error_tok:
switch (tokptr->Tok) { case BQString_tok:
case eot_tok: case String_tok:
return "EOT"; case Name_tok:
case Ponctuation_tok: return AtomOfTerm(info)->StrOfAE;
case Error_tok: case QuasiQuotes_tok:
case BQString_tok: return "<QQ>";
case String_tok: case Number_tok:
case Name_tok: if (IsIntegerTerm(info)) {
return AtomOfTerm(info)->StrOfAE; char *s = Malloc(36);
case QuasiQuotes_tok: snprintf(s, 35, Int_FORMAT, IntegerOfTerm(info));
return "<QQ>"; return s;
case Number_tok: } else if (IsFloatTerm(info)) {
if (IsIntegerTerm(info)) { char *s = Malloc(64);
char *s = Malloc(36); snprintf(s, 63, "%6g", FloatOfTerm(info));
snprintf(s, 35, Int_FORMAT, IntegerOfTerm(info)); return s;
return s; } else {
}else if (IsFloatTerm(info)) { size_t len = Yap_gmp_to_size(info, 10);
char *s = Malloc( 64); char *s = Malloc(len + 2);
snprintf(s, 63, "%6g", FloatOfTerm(info)); return Yap_gmp_to_string(info, s, len + 1, 10);
return s;
} else {
size_t len = Yap_gmp_to_size(info,10);
char *s = Malloc(len+2);
return Yap_gmp_to_string(info,s, len+1,10);
}
break;
case Var_tok:
if (info == 0) return "[]";
return ((Atom)info)->StrOfAE;
} }
return "."; break;
case Var_tok:
if (info == 0)
return "[]";
return ((Atom)info)->StrOfAE;
}
return ".";
} }
static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) { static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) {
CELL *h0 = HR; CELL *h0 = HR;
HR += 5; HR += 5;
@ -1311,7 +1310,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
int solo_flag = TRUE; int solo_flag = TRUE;
int32_t ch, och; int32_t ch, och;
struct qq_struct_t *cur_qq = NULL; struct qq_struct_t *cur_qq = NULL;
int sign = 1; int sign = 1;
InitScannerMemory(); InitScannerMemory();
LOCAL_VarTable = NULL; LOCAL_VarTable = NULL;
@ -1424,7 +1423,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
Atom ae; Atom ae;
/* don't do this in iso */ /* don't do this in iso */
ae = Yap_ULookupAtom(TokImage); ae = Yap_ULookupAtom(TokImage);
Free(TokImage); Free(TokImage);
if (ae == NIL) { if (ae == NIL) {
return CodeSpaceError(t, p, l); return CodeSpaceError(t, p, l);
} }
@ -1434,7 +1433,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
t->Tok = Ord(kind = Name_tok); t->Tok = Ord(kind = Name_tok);
} else { } else {
VarEntry *ve = Yap_LookupVar((const char *)TokImage); VarEntry *ve = Yap_LookupVar((const char *)TokImage);
Free(TokImage); Free(TokImage);
t->TokInfo = Unsigned(ve); t->TokInfo = Unsigned(ve);
if (cur_qq) { if (cur_qq) {
ve->refs++; ve->refs++;
@ -1444,14 +1443,14 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
} break; } break;
case NU: { case NU: {
int cherr; int cherr;
int cha; int cha;
sign = 1; sign = 1;
scan_number: scan_number:
cha = ch; cha = ch;
cherr = 0; cherr = 0;
CHECK_SPACE(); CHECK_SPACE();
if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, sign)) == 0L) { if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, sign)) == 0L) {
if (p) { if (p) {
@ -1480,8 +1479,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
case 'e': case 'e':
case 'E': case 'E':
och = cherr; och = cherr;
TokImage = Malloc(1024 PASS_REGS); TokImage = Malloc(1024 PASS_REGS);
goto scan_name; goto scan_name;
break; break;
case '=': case '=':
case '_': case '_':
@ -1513,13 +1512,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
{ {
TokEntry *e2; TokEntry *e2;
if (chtype(ch) == NU) { if (chtype(ch) == NU) {
if (och == '-') if (och == '-')
sign = -1; sign = -1;
else else
sign = 1; sign = 1;
goto scan_number; goto scan_number;
} }
t->Tok = Name_tok; t->Tok = Name_tok;
if (ch == '(') if (ch == '(')
solo_flag = FALSE; solo_flag = FALSE;
@ -1567,9 +1566,9 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
LOCAL_ErrorMessage = "layout character \n inside quotes"; LOCAL_ErrorMessage = "layout character \n inside quotes";
break; break;
} }
if (ch == EOFCHAR) { if (ch == EOFCHAR) {
break; break;
} }
if (ch == quote) { if (ch == quote) {
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
if (ch != quote) if (ch != quote)
@ -1638,16 +1637,16 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
break; break;
case SY: { case SY: {
int pch; int pch;
if (ch == '.' && (pch = Yap_peek(inp_stream - GLOBAL_Stream)) && if (ch == '.' && (pch = Yap_peek(inp_stream - GLOBAL_Stream)) &&
(chtype(pch) == BS || chtype(pch) == EF || pch == '%')) { (chtype(pch) == BS || chtype(pch) == EF || pch == '%')) {
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
// consume... // consume...
if (pch == '%') { if (pch == '%') {
t->TokInfo = TermNewLine; t->TokInfo = TermNewLine;
return l; return l;
}
return l;
} }
return l;
}
if (ch == '`') if (ch == '`')
goto quoted_string; goto quoted_string;
och = ch; och = ch;
@ -1668,7 +1667,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
return l; return l;
} }
} }
if (och == '/' && ch == '*') { if (och == '/' && ch == '*') {
if (store_comments) { if (store_comments) {
CHECK_SPACE(); CHECK_SPACE();
open_comment('/', inp_stream PASS_REGS); open_comment('/', inp_stream PASS_REGS);
@ -1925,7 +1924,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
qq->end.byteno = fseek(inp_stream->file, 0, 0); qq->end.byteno = fseek(inp_stream->file, 0, 0);
} else { } else {
qq->end.byteno = inp_stream->charcount - 1; qq->end.byteno = inp_stream->charcount - 1;
} }
qq->end.lineno = inp_stream->linecount; qq->end.lineno = inp_stream->linecount;
qq->end.linepos = inp_stream->linepos - 1; qq->end.linepos = inp_stream->linepos - 1;
qq->end.charno = inp_stream->charcount - 1; qq->end.charno = inp_stream->charcount - 1;
@ -1972,7 +1971,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
return (l); return (l);
} }
void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
VarEntry *anonvartable) { VarEntry *anonvartable) {
CACHE_REGS CACHE_REGS

3
H/ATOMS
View File

@ -294,6 +294,7 @@ A PastEndOfStream N "past_end_of_stream"
A PermissionError N "permission_error" A PermissionError N "permission_error"
A Pi N "pi" A Pi N "pi"
A Pipe N "pipe" A Pipe N "pipe"
A Priority N "priority"
A Plus N "+" A Plus N "+"
A Pointer N "pointer" A Pointer N "pointer"
A Portray F "portray" A Portray F "portray"
@ -546,11 +547,13 @@ F NBQueue Queue 4
F Not Not 1 F Not Not 1
F Obj Obj 1 F Obj Obj 1
F Or Semic 2 F Or Semic 2
F Output Output 1
F PermissionError PermissionError 3 F PermissionError PermissionError 3
F Plus Plus 2 F Plus Plus 2
F Portray Portray 1 F Portray Portray 1
F PrintMessage PrintMessage 2 F PrintMessage PrintMessage 2
F Procedure Procedure 5 F Procedure Procedure 5
F Priority Priority 1
F PrologConstraint Prolog 2 F PrologConstraint Prolog 2
F ProtectStack ProtectStack 4 F ProtectStack ProtectStack 4
F Query Query 1 F Query Query 1

2
H/YapFlags.h
View File

@ -204,7 +204,7 @@ typedef struct x_el {
} xarg; } xarg;
typedef struct struct_param { typedef struct struct_param {
char *name; const char *name;
flag_func type; flag_func type;
int id; int id;
} param_t; } param_t;

4
H/absmi.h
View File

@ -2452,10 +2452,10 @@ extern yamop *headoftrace;
ENDD(d0); ENDD(d0);
#endif #endif
#define Yap_AsmError(e, d) \ #define Yap_AsmError(e, d) \
{ \ { \
saveregs(); \ saveregs(); \
Yap_ThrowError(e, d, 4, ""); \ Yap_ThrowError(e, d, "while exwcuting inlined built-in"); \
setregs(); \ setregs(); \
} }

2
H/eval.h
View File

@ -407,7 +407,7 @@ yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number, Term,
...); ...);
#define Yap_ArithError(id, t, ...) \ #define Yap_ArithError(id, t, ...) \
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, 2, __VA_ARGS__) Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
#define Yap_BinError(id) \ #define Yap_BinError(id) \
Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "") Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
#define Yap_AbsmiError(id) \ #define Yap_AbsmiError(id) \

3
H/generated/iatoms.h
View File

@ -289,6 +289,7 @@
AtomPermissionError = Yap_LookupAtom("permission_error"); TermPermissionError = MkAtomTerm(AtomPermissionError); AtomPermissionError = Yap_LookupAtom("permission_error"); TermPermissionError = MkAtomTerm(AtomPermissionError);
AtomPi = Yap_LookupAtom("pi"); TermPi = MkAtomTerm(AtomPi); AtomPi = Yap_LookupAtom("pi"); TermPi = MkAtomTerm(AtomPi);
AtomPipe = Yap_LookupAtom("pipe"); TermPipe = MkAtomTerm(AtomPipe); AtomPipe = Yap_LookupAtom("pipe"); TermPipe = MkAtomTerm(AtomPipe);
AtomPriority = Yap_LookupAtom("priority"); TermPriority = MkAtomTerm(AtomPriority);
AtomPlus = Yap_LookupAtom("+"); TermPlus = MkAtomTerm(AtomPlus); AtomPlus = Yap_LookupAtom("+"); TermPlus = MkAtomTerm(AtomPlus);
AtomPointer = Yap_LookupAtom("pointer"); TermPointer = MkAtomTerm(AtomPointer); AtomPointer = Yap_LookupAtom("pointer"); TermPointer = MkAtomTerm(AtomPointer);
AtomPortray = Yap_FullLookupAtom("portray"); TermPortray = MkAtomTerm(AtomPortray); AtomPortray = Yap_FullLookupAtom("portray"); TermPortray = MkAtomTerm(AtomPortray);
@ -541,11 +542,13 @@
FunctorNot = Yap_MkFunctor(AtomNot,1); FunctorNot = Yap_MkFunctor(AtomNot,1);
FunctorObj = Yap_MkFunctor(AtomObj,1); FunctorObj = Yap_MkFunctor(AtomObj,1);
FunctorOr = Yap_MkFunctor(AtomSemic,2); FunctorOr = Yap_MkFunctor(AtomSemic,2);
FunctorOutput = Yap_MkFunctor(AtomOutput,1);
FunctorPermissionError = Yap_MkFunctor(AtomPermissionError,3); FunctorPermissionError = Yap_MkFunctor(AtomPermissionError,3);
FunctorPlus = Yap_MkFunctor(AtomPlus,2); FunctorPlus = Yap_MkFunctor(AtomPlus,2);
FunctorPortray = Yap_MkFunctor(AtomPortray,1); FunctorPortray = Yap_MkFunctor(AtomPortray,1);
FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2); FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2);
FunctorProcedure = Yap_MkFunctor(AtomProcedure,5); FunctorProcedure = Yap_MkFunctor(AtomProcedure,5);
FunctorPriority = Yap_MkFunctor(AtomPriority,1);
FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2); FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2);
FunctorProtectStack = Yap_MkFunctor(AtomProtectStack,4); FunctorProtectStack = Yap_MkFunctor(AtomProtectStack,4);
FunctorQuery = Yap_MkFunctor(AtomQuery,1); FunctorQuery = Yap_MkFunctor(AtomQuery,1);

3
H/generated/ratoms.h
View File

@ -289,6 +289,7 @@
AtomPermissionError = AtomAdjust(AtomPermissionError); TermPermissionError = MkAtomTerm(AtomPermissionError); AtomPermissionError = AtomAdjust(AtomPermissionError); TermPermissionError = MkAtomTerm(AtomPermissionError);
AtomPi = AtomAdjust(AtomPi); TermPi = MkAtomTerm(AtomPi); AtomPi = AtomAdjust(AtomPi); TermPi = MkAtomTerm(AtomPi);
AtomPipe = AtomAdjust(AtomPipe); TermPipe = MkAtomTerm(AtomPipe); AtomPipe = AtomAdjust(AtomPipe); TermPipe = MkAtomTerm(AtomPipe);
AtomPriority = AtomAdjust(AtomPriority); TermPriority = MkAtomTerm(AtomPriority);
AtomPlus = AtomAdjust(AtomPlus); TermPlus = MkAtomTerm(AtomPlus); AtomPlus = AtomAdjust(AtomPlus); TermPlus = MkAtomTerm(AtomPlus);
AtomPointer = AtomAdjust(AtomPointer); TermPointer = MkAtomTerm(AtomPointer); AtomPointer = AtomAdjust(AtomPointer); TermPointer = MkAtomTerm(AtomPointer);
AtomPortray = AtomAdjust(AtomPortray); TermPortray = MkAtomTerm(AtomPortray); AtomPortray = AtomAdjust(AtomPortray); TermPortray = MkAtomTerm(AtomPortray);
@ -541,11 +542,13 @@
FunctorNot = FuncAdjust(FunctorNot); FunctorNot = FuncAdjust(FunctorNot);
FunctorObj = FuncAdjust(FunctorObj); FunctorObj = FuncAdjust(FunctorObj);
FunctorOr = FuncAdjust(FunctorOr); FunctorOr = FuncAdjust(FunctorOr);
FunctorOutput = FuncAdjust(FunctorOutput);
FunctorPermissionError = FuncAdjust(FunctorPermissionError); FunctorPermissionError = FuncAdjust(FunctorPermissionError);
FunctorPlus = FuncAdjust(FunctorPlus); FunctorPlus = FuncAdjust(FunctorPlus);
FunctorPortray = FuncAdjust(FunctorPortray); FunctorPortray = FuncAdjust(FunctorPortray);
FunctorPrintMessage = FuncAdjust(FunctorPrintMessage); FunctorPrintMessage = FuncAdjust(FunctorPrintMessage);
FunctorProcedure = FuncAdjust(FunctorProcedure); FunctorProcedure = FuncAdjust(FunctorProcedure);
FunctorPriority = FuncAdjust(FunctorPriority);
FunctorPrologConstraint = FuncAdjust(FunctorPrologConstraint); FunctorPrologConstraint = FuncAdjust(FunctorPrologConstraint);
FunctorProtectStack = FuncAdjust(FunctorProtectStack); FunctorProtectStack = FuncAdjust(FunctorProtectStack);
FunctorQuery = FuncAdjust(FunctorQuery); FunctorQuery = FuncAdjust(FunctorQuery);

5
H/generated/tatoms.h
View File

@ -289,6 +289,7 @@ EXTERNAL Atom AtomPastEndOfStream; EXTERNAL Term TermPastEndOfStream;
EXTERNAL Atom AtomPermissionError; EXTERNAL Term TermPermissionError; EXTERNAL Atom AtomPermissionError; EXTERNAL Term TermPermissionError;
EXTERNAL Atom AtomPi; EXTERNAL Term TermPi; EXTERNAL Atom AtomPi; EXTERNAL Term TermPi;
EXTERNAL Atom AtomPipe; EXTERNAL Term TermPipe; EXTERNAL Atom AtomPipe; EXTERNAL Term TermPipe;
EXTERNAL Atom AtomPriority; EXTERNAL Term TermPriority;
EXTERNAL Atom AtomPlus; EXTERNAL Term TermPlus; EXTERNAL Atom AtomPlus; EXTERNAL Term TermPlus;
EXTERNAL Atom AtomPointer; EXTERNAL Term TermPointer; EXTERNAL Atom AtomPointer; EXTERNAL Term TermPointer;
EXTERNAL Atom AtomPortray; EXTERNAL Term TermPortray; EXTERNAL Atom AtomPortray; EXTERNAL Term TermPortray;
@ -645,6 +646,8 @@ EXTERNAL Functor FunctorObj;
EXTERNAL Functor FunctorOr; EXTERNAL Functor FunctorOr;
EXTERNAL Functor FunctorOutput;
EXTERNAL Functor FunctorPermissionError; EXTERNAL Functor FunctorPermissionError;
EXTERNAL Functor FunctorPlus; EXTERNAL Functor FunctorPlus;
@ -655,6 +658,8 @@ EXTERNAL Functor FunctorPrintMessage;
EXTERNAL Functor FunctorProcedure; EXTERNAL Functor FunctorProcedure;
EXTERNAL Functor FunctorPriority;
EXTERNAL Functor FunctorPrologConstraint; EXTERNAL Functor FunctorPrologConstraint;
EXTERNAL Functor FunctorProtectStack; EXTERNAL Functor FunctorProtectStack;

40
os/iopreds.c
View File

@ -1,19 +1,19 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: iopreds.c * * File: iopreds.c *
* Last rev: 5/2/88 * * Last rev: 5/2/88 *
* mods: * * mods: *
* comments: Input/Output C implemented predicates * * comments: Input/Output C implemented predicates *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
@ -545,12 +545,14 @@ static int NullPutc(int sno, int ch) {
} }
int ResetEOF(StreamDesc *s) { int ResetEOF(StreamDesc *s) {
s->status &= ~Push_Eof_Stream_f;
if (s->status & Eof_Error_Stream_f) { if (s->status & Eof_Error_Stream_f) {
Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, MkAtomTerm(s->name), Atom name = s->name;
// Yap_CloseStream(s - GLOBAL_Stream);
Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, MkAtomTerm(name),
"GetC"); "GetC");
return FALSE; return FALSE;
} else if (s->status & Reset_Eof_Stream_f) { } else if (s->status & Reset_Eof_Stream_f) {
s->status &= ~Push_Eof_Stream_f;
/* reset the eof indicator on file */ /* reset the eof indicator on file */
if (feof(s->file)) if (feof(s->file))
clearerr(s->file); clearerr(s->file);
@ -654,9 +656,9 @@ int post_process_weof(StreamDesc *s) {
* *
* @return EOF * @return EOF
*/ */
int EOFPeek(int sno) { return EOFGetc(sno); } int EOFPeek(int sno) { return EOFCHAR; }
int EOFWPeek(int sno) { return EOFWGetc(sno); } int EOFWPeek(int sno) { return EOFCHAR; }
/* standard routine, it should read from anything pointed by a FILE *. /* standard routine, it should read from anything pointed by a FILE *.
It could be made more efficient by doing our own buffering and avoiding It could be made more efficient by doing our own buffering and avoiding

109
os/readterm.c
View File

@ -211,19 +211,31 @@ static const param_t read_defs[] = {READ_DEFS()};
static Term add_output(Term t, Term tail) { static Term add_output(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1); Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomOutput, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt)); Yap_unify(t, ArgOfTerm(1, topt));
return MkPairTerm(topt, tail); if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
}
} }
static Term add_names(Term t, Term tail) { static Term add_names(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1); Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt)); Yap_unify(t, ArgOfTerm(1, topt));
return MkPairTerm(topt, tail); if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
}
} }
static Term add_priority(Term t, Term tail) { static Term add_priority(Term t, Term tail) {
Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1); Term topt = Yap_MkNewApplTerm(Yap_MkFunctor(AtomPriority, 1), 1);
Yap_unify(t, ArgOfTerm(1, topt)); Yap_unify(t, ArgOfTerm(1, topt));
return MkPairTerm(topt, tail); if (IsPairTerm(tail) || tail == TermNil) {
return MkPairTerm(topt, tail);
} else {
return MkPairTerm(topt, MkPairTerm(tail, TermNil));
}
} }
/** /**
@ -366,13 +378,14 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
} else { } else {
fe->t0 = 0; fe->t0 = 0;
} }
if (args[READ_MODULE].used) { if (args[READ_MODULE].used) {
fe->cmod = args[READ_MODULE].tvalue; fe->cmod = args[READ_MODULE].tvalue;
} else { } else {
fe->cmod = CurrentModule; fe->cmod = CurrentModule;
if (fe->cmod == TermProlog) if (fe->cmod == TermProlog)
fe->cmod = PROLOG_MODULE; fe->cmod = PROLOG_MODULE;
} if (args[READ_BACKQUOTED_STRING].used) { }
if (args[READ_BACKQUOTED_STRING].used) {
if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) { if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) {
return false; return false;
} }
@ -586,7 +599,7 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v1, v2, v3, vc, tp; Term v1, v2, v3, vc, tp;
if (fe->t0 && !(Yap_unify(fe->t, fe->t0))) if (fe->t0 && fe->t && !(Yap_unify(fe->t, fe->t0)))
return false; return false;
if (fe->t && fe->vp) if (fe->t && fe->vp)
@ -625,7 +638,7 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v_vp, v_vnames, v_comments, v_pos; Term v_vp, v_vnames, v_comments, v_pos;
if (fe->t0 && !Yap_unify(fe->t, fe->t0)) if (fe->t0 & fe->t && !Yap_unify(fe->t, fe->t0))
return false; return false;
if (fe->t && fe->vp) if (fe->t && fe->vp)
v_vp = get_variables(fe, tokstart); v_vp = get_variables(fe, tokstart);
@ -682,6 +695,8 @@ static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
return YAP_PARSING_FINISHED; return YAP_PARSING_FINISHED;
} }
// a :- <eof> // a :- <eof>
if (GLOBAL_Stream[inp_stream].status & Past_Eof_Stream_f)
return YAP_PARSING_ERROR;
/* we need to force the next read to also give end of file.*/ /* we need to force the next read to also give end of file.*/
GLOBAL_Stream[inp_stream].status |= Push_Eof_Stream_f; GLOBAL_Stream[inp_stream].status |= Push_Eof_Stream_f;
LOCAL_ErrorMessage = "end of file found before end of term"; LOCAL_ErrorMessage = "end of file found before end of term";
@ -818,14 +833,11 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS CACHE_REGS
fe->t = 0; fe->t = 0;
if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL || if (LOCAL_Error_TYPE != SYNTAX_ERROR && LOCAL_Error_TYPE != YAP_NO_ERROR) {
LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK ||
LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP ||
LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
return YAP_SCANNING_ERROR; return YAP_SCANNING_ERROR;
} }
Term ParserErrorStyle = re->sy; Term ParserErrorStyle = re->sy;
if (ParserErrorStyle == TermQuiet) { if (ParserErrorStyle == TermQuiet || LOCAL_Error_TYPE == YAP_NO_ERROR) {
/* just fail */ /* just fail */
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED; return YAP_PARSING_FINISHED;
@ -948,7 +960,7 @@ static Int read_term(
if (inp_stream == -1) { if (inp_stream == -1) {
return (FALSE); return (FALSE);
} }
out = Yap_read_term(inp_stream, add_output(ARG1, ARG2), false); out = Yap_read_term(inp_stream, add_output(ARG2, ARG3), false);
UNLOCK(GLOBAL_Stream[inp_stream].streamlock); UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
return out != 0L; return out != 0L;
} }
@ -1404,16 +1416,73 @@ static Int read_term_from_string(USES_REGS1) {
return Yap_unify(rc, ARG2); return Yap_unify(rc, ARG2);
} }
static Int atomic_to_term(USES_REGS1) {
Term t1 = Deref(ARG1);
size_t len;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
return (FALSE);
} else if (!IsAtomicTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3");
return (FALSE);
} else {
Term t = Yap_AtomicToString(t1 PASS_REGS);
const unsigned char *us = UStringOfTerm(t);
len = strlen_utf8(us);
return Yap_BufferToTerm(us, len,
add_output(ARG2, add_names(ARG3, TermNil)));
}
}
static Int atom_to_term(USES_REGS1) {
Term t1 = Deref(ARG1);
size_t len;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
return (FALSE);
} else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3");
return (FALSE);
} else {
Term t = Yap_AtomicToString(t1 PASS_REGS);
const unsigned char *us = UStringOfTerm(t);
len = strlen_utf8(us);
return Yap_BufferToTerm(us, len,
add_output(ARG2, add_names(ARG3, TermNil)));
}
}
static Int string_to_term(USES_REGS1) {
Term t1 = Deref(ARG1);
size_t len;
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
return (FALSE);
} else if (!IsStringTerm(t1)) {
Yap_Error(TYPE_ERROR_STRING, t1, "read_term_from_string/3");
return (FALSE);
} else {
const unsigned char *us = UStringOfTerm(t1);
len = strlen_utf8(us);
return Yap_BufferToTerm(us, len,
add_output(ARG2, add_names(ARG3, TermNil)));
}
}
void Yap_InitReadTPreds(void) { void Yap_InitReadTPreds(void) {
Yap_InitCPred("read", 1, read1, SyncPredFlag);
Yap_InitCPred("read", 2, read2, SyncPredFlag);
Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag); Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag);
Yap_InitCPred("read_term", 3, read_term, SyncPredFlag); Yap_InitCPred("read_term", 3, read_term, SyncPredFlag);
Yap_InitCPred("read", 1, read1, SyncPredFlag);
Yap_InitCPred("read", 2, read2, SyncPredFlag);
Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag); Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag);
Yap_InitCPred("read_clause", 3, read_clause, 0); Yap_InitCPred("read_clause", 3, read_clause, 0);
Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0); Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0);
Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0); Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0);
Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0); Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0);
Yap_InitCPred("atom_to_term", 3, atom_to_term, 0);
Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0);
Yap_InitCPred("string_to_term", 3, string_to_term, 0);
Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag); Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag);
Yap_InitCPred("nofileeleerrors", 0, nofileerrors, SyncPredFlag); Yap_InitCPred("nofileeleerrors", 0, nofileerrors, SyncPredFlag);