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

XyMerge /home/vsc/yap

Browse Source
This commit is contained in:
Vítor Santos Costa 2018-10-22 15:31:45 +01:00
commit 0d47af2ad9
14 changed files with 756 additions and 703 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/absmi.c
View File

@ -219,12 +219,12 @@ static int check_alarm_fail_int(int CONT USES_REGS) {
}
static int stack_overflow(PredEntry *pe, CELL *env, yamop *cp,
arity_t nargs USES_REGS) {
arity_t nargs USES_REGS) {
if (Unsigned(YREG) - Unsigned(HR) < StackGap(PASS_REGS1) ||
Yap_get_signal(YAP_STOVF_SIGNAL)) {
S = (CELL *)pe;
if (!Yap_locked_gc(nargs, env, cp)) {
Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
return 0;
}
return 1;
@ -239,7 +239,7 @@ static int code_overflow(CELL *yenv USES_REGS) {
/* do a garbage collection first to check if we can recover memory */
if (!Yap_locked_growheap(false, 0, NULL)) {
Yap_NilError(RESOURCE_ERROR_HEAP, "YAP failed to grow heap: %s",
LOCAL_ErrorMessage);
"malloc/mmap failed");
return 0;
}
CACHE_A1();
@ -689,7 +689,7 @@ static int interrupt_deallocate(USES_REGS1) {
return rc;
}
if (!Yap_locked_gc(0, ENV, YESCODE)) {
Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
}
S = ASP;
S[E_CB] = (CELL)(LCL0 - cut_b);

18
C/absmi_insts.i
View File

@ -1102,7 +1102,7 @@
PP = NULL;
#endif
if (!Yap_gc(3, ENV, CP)) {
Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
FAIL();
}
#if defined(YAPOR) || defined(THREADS)
@ -1226,7 +1226,7 @@
PREG = NEXTOP(PREG,Osbpa);
saveregs();
if (!Yap_gcl(sz, arity, YENV, PREG)) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
FAIL();
} else {
@ -10927,7 +10927,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxx),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11044,7 +11044,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxc),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11154,7 +11154,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG,xxn),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11261,7 +11261,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxx),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11388,7 +11388,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxc),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11516,7 +11516,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxn),Osbpp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed");
setregs();
JMPNext();
} else {
@ -11892,7 +11892,7 @@
/* make sure we have something to show for our trouble */
saveregs();
if (!Yap_gcl((1+d1)*sizeof(CELL), 3, YREG, NEXTOP(NEXTOP(PREG,e),Osbmp))) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK,"stack overflow: gc failed" );
setregs();
JMPNext();
} else {

107
C/errors.c
View File

@ -35,7 +35,7 @@
#define set_key_b(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = t == TermTrue ? true : false; \
i->k = ( t == TermTrue ? true : false); \
return i->k || t == TermFalse; \
}
@ -67,18 +67,18 @@ static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) {
set_key_s(errorFunction, "errorFunction", q, i, t);
set_key_s(errorFile, "errorFile", q, i, t);
set_key_i(prologPredLine, "prologPredLine", q, i, t);
set_key_i(prologPredFirstLine, "prologPredFirstLine", q, i, t);
set_key_i(prologPredLastLine, "prologPredLastLine", q, i, t);
set_key_s(prologPredName, "prologPredName", q, i, t);
set_key_i(prologPredArity, "prologPredArity", q, i, t);
set_key_s(prologPredModule, "prologPredModule", q, i, t);
set_key_s(prologPredFile, "prologPredFile", q, i, t);
set_key_i(prologParserPos, "prologParserPos", q, i, t);
set_key_i(prologParserLine, "prologParserLine", q, i, t);
set_key_i(prologParserFirstLine, "prologParserFirstLine", q, i, t);
set_key_i(prologParserLastLine, "prologParserLastLine", q, i, t);
set_key_s(prologParserText, "prologParserText", q, i, t);
set_key_s(prologParserFile, "prologParserFile", q, i, t);
set_key_i(parserPos, "parserPos", q, i, t);
set_key_i(parserLine, "parserLine", q, i, t);
set_key_i(parserFirstLine, "parserFirstLine", q, i, t);
set_key_i(parserLastLine, "parserLastLine", q, i, t);
set_key_s(parserTextA, "parserTextA", q, i, t);
set_key_s(parserTextB, "parserTextB", q, i, t);
set_key_s(parserFile, "parserFile", q, i, t);
set_key_b(parserReadingCode, "parserReadingcode", q, i, t);
set_key_b(prologConsulting, "prologConsulting", q, i, t);
set_key_s(culprit, "culprit", q, i, t);
set_key_s(errorMsg, "errorMsg", q, i, t);
@ -116,18 +116,18 @@ static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_s(errorFunction, "errorFunction", q, i);
query_key_s(errorFile, "errorFile", q, i);
query_key_i(prologPredLine, "prologPredLine", q, i);
query_key_i(prologPredFirstLine, "prologPredFirstLine", q, i);
query_key_i(prologPredLastLine, "prologPredLastLine", q, i);
query_key_s(prologPredName, "prologPredName", q, i);
query_key_i(prologPredArity, "prologPredArity", q, i);
query_key_s(prologPredModule, "prologPredModule", q, i);
query_key_s(prologPredFile, "prologPredFile", q, i);
query_key_i(prologParserPos, "prologParserPos", q, i);
query_key_i(prologParserLine, "prologParserLine", q, i);
query_key_i(prologParserFirstLine, "prologParserFirstLine", q, i);
query_key_i(prologParserLastLine, "prologParserLastLine", q, i);
query_key_s(prologParserText, "prologParserText", q, i);
query_key_s(prologParserFile, "prologParserFile", q, i);
query_key_i(parserPos, "parserPos", q, i);
query_key_i(parserLine, "parserLine", q, i);
query_key_i(parserFirstLine, "parserFirstLine", q, i);
query_key_i(parserLastLine, "parserLastLine", q, i);
query_key_s(parserTextA, "parserTextA", q, i);
query_key_s(parserTextB, "parserTextB", q, i);
query_key_s(parserFile, "parserFile", q, i);
query_key_b(parserReadingCode, "parserReadingCode", q, i);
query_key_b(prologConsulting, "prologConsulting", q, i);
query_key_t(culprit, "culprit", q, i);
query_key_s(errorMsg, "errorMsg", q, i);
@ -162,18 +162,18 @@ static void printErr(yap_error_descriptor_t *i) {
print_key_s("errorFunction", i->errorFunction);
print_key_s("errorFile", i->errorFile);
print_key_i("prologPredLine", i->prologPredLine);
print_key_i("prologPredFirstLine", i->prologPredFirstLine);
print_key_i("prologPredLastLine", i->prologPredLastLine);
print_key_s("prologPredName", i->prologPredName);
print_key_i("prologPredArity", i->prologPredArity);
print_key_s("prologPredModule", i->prologPredModule);
print_key_s("prologPredFile", i->prologPredFile);
print_key_i("prologParserPos", i->prologParserPos);
print_key_i("prologParserLine", i->prologParserLine);
print_key_i("prologParserFirstLine", i->prologParserFirstLine);
print_key_i("prologParserLastLine", i->prologParserLastLine);
print_key_s("prologParserText", i->prologParserText);
print_key_s("prologParserFile", i->prologParserFile);
print_key_i("parserPos", i->parserPos);
print_key_i("parserLine", i->parserLine);
print_key_i("parserFirstLine", i->parserFirstLine);
print_key_i("parserLastLine", i->parserLastLine);
print_key_s("parserTextA", i->parserTextA);
print_key_s("parserTextB", i->parserTextB);
print_key_s("parserFile", i->parserFile);
print_key_b("parserReadingCode", i->parserReadingCode);
print_key_b("prologConsulting", i->prologConsulting);
print_key_s("culprit", i->culprit);
if (i->errorMsgLen) {
@ -220,18 +220,18 @@ static Term err2list(yap_error_descriptor_t *i) {
o = add_key_s("errorFunction", i->errorFunction, o);
o = add_key_s("errorFile", i->errorFile, o);
o = add_key_i("prologPredLine", i->prologPredLine, o);
o = add_key_i("prologPredFirstLine", i->prologPredFirstLine, o);
o = add_key_i("prologPredLastLine", i->prologPredLastLine, o);
o = add_key_s("prologPredName", i->prologPredName, o);
o = add_key_i("prologPredArity", i->prologPredArity, o);
o = add_key_s("prologPredModule", i->prologPredModule, o);
o = add_key_s("prologPredFile", i->prologPredFile, o);
o = add_key_i("prologParserPos", i->prologParserPos, o);
o = add_key_i("prologParserLine", i->prologParserLine, o);
o = add_key_i("prologParserFirstLine", i->prologParserFirstLine, o);
o = add_key_i("prologParserLastLine", i->prologParserLastLine, o);
o = add_key_s("prologParserText", i->prologParserText, o);
o = add_key_s("prologParserFile", i->prologParserFile, o);
o = add_key_i("parserPos", i->parserPos, o);
o = add_key_i("parserLine", i->parserLine, o);
o = add_key_i("parserFirstLine", i->parserFirstLine, o);
o = add_key_i("parserLastLine", i->parserLastLine, o);
o = add_key_s("parserTextA", i->parserTextA, o);
o = add_key_s("parserTextB", i->parserTextB, o);
o = add_key_s("parserFile", i->parserFile, o);
o = add_key_b("parserReadingCode", i->parserReadingCode, o);
o = add_key_b("prologConsulting", i->prologConsulting, o);
o = add_key_s("culprit", i->culprit, o);
if (i->errorMsgLen) {
@ -317,7 +317,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
if (fmt) {
LOCAL_Error_Size = strlen(tmpbuf);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy(LOCAL_ActiveError->errorMsg, tmpbuf);
strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf);
} else {
LOCAL_Error_Size = 0;
}
@ -334,6 +334,7 @@ bool Yap_PrintWarning(Term twarning) {
Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
LOCAL_ActiveError->errorClass != WARNING &&
(err = LOCAL_ActiveError->errorNo)) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning,
@ -423,9 +424,7 @@ int Yap_SWIHandleError(const char *s, ...) {
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
if (s) {
serr = (char *)s;
}
switch (err) {
@ -575,9 +574,12 @@ static char tmpbuf[YAP_BUF_SIZE];
#include "YapErrors.h"
bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) {
/// add a new error descriptor, either to the top of the stack,
/// or replacing the top;
bool Yap_pushErrorContext(bool link , yap_error_descriptor_t *new_error) {
memset(new_error, 0, sizeof(yap_error_descriptor_t));
new_error->top_error = LOCAL_ActiveError;
if (link)
new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error;
return true;
}
@ -645,6 +647,16 @@ void Yap_ThrowExistingError(void) {
Yap_exit(5);
}
Term Yap_MkFullError(void)
{
yap_error_descriptor_t *i = Yap_local.ActiveError;
i->errorAsText = Yap_errorName( i->errorNo );
i->errorClass = Yap_errorClass( i-> errorNo );
i->classAsText = Yap_errorClassName(i->errorClass);
return mkerrort(i->errorNo, TermNil , MkSysError(i) );
}
bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
const char *function, int lineno, yap_error_number type,
Term where, const char *s) {
@ -656,9 +668,9 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
r->culprit = Yap_TermToBuffer(
where, Quote_illegal_f | Ignore_ops_f);
}
if (LOCAL_consult_level > 0) {
r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
r->prologParserLine = Yap_source_line_no();
if (type != SYNTAX_ERROR && LOCAL_consult_level > 0) {
r->parserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
r->parserLine = Yap_source_line_no();
}
r->errorNo = type;
r->errorAsText = Yap_errorName(type);
@ -670,6 +682,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
LOCAL_PrologMode |= InErrorMode;
Yap_ClearExs();
// first, obtain current location
// sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno,
// function);
// tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf));
@ -694,13 +707,11 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
}
// fprintf(stderr, "warning: ");
if (s && s[0]) {
char *ns;
r->errorMsgLen = strlen(s) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, s);
} else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, LOCAL_ErrorMessage);
ns = malloc(r->errorMsgLen);
strcpy(ns, s);
r->errorMsg = ns;
} else {
r->errorMsgLen = 0;
r->errorMsg = 0;

19
C/parser.c
View File

@ -60,12 +60,12 @@ static void syntax_msg(const char *msg, ...) {
va_list ap;
if (!LOCAL_ErrorMessage ||
(LOCAL_Error_TYPE == SYNTAX_ERROR &&
LOCAL_tokptr->TokPos < LOCAL_ActiveError->prologParserPos)) {
LOCAL_tokptr->TokPos < LOCAL_ActiveError->parserPos)) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
}
LOCAL_ActiveError->prologParserLine = LOCAL_tokptr->TokLine;
LOCAL_ActiveError->prologParserPos = LOCAL_tokptr->TokPos;
LOCAL_ActiveError->parserLine = LOCAL_tokptr->TokLine;
LOCAL_ActiveError->parserPos = LOCAL_tokptr->TokPos;
va_start(ap, msg);
vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap);
va_end(ap);
@ -911,12 +911,17 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
CACHE_REGS
// ensure that if we throw an exception
// t will be 0.
LOCAL_ActiveError->errorMsg=NULL;
LOCAL_ActiveError->errorMsgLen=0;
Volatile Term t = 0;
JMPBUFF FailBuff;
yhandle_t sls = Yap_StartSlots();
LOCAL_ErrorMessage = NULL;
LOCAL_toktide = LOCAL_tokptr;
if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
LOCAL_ActiveError->errorMsg=NULL;
LOCAL_ActiveError->errorMsgLen=0;
t = ParseTerm(prio, &FailBuff, enc, cmod PASS_REGS);
#if DEBUG
@ -936,9 +941,13 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) {
if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) {
LOCAL_Error_TYPE = SYNTAX_ERROR;
if (LOCAL_tokptr->TokNext) {
LOCAL_ErrorMessage = "bracket or operator expected.";
size_t sz = strlen("bracket or operator expected.");
LOCAL_ErrorMessage =malloc(sz+1);
strncpy(LOCAL_ErrorMessage, "bracket or operator expected.", sz );
} else {
LOCAL_ErrorMessage = "term must end with . or EOF.";
size_t sz = strlen("term must end with . or EOF.");
LOCAL_ErrorMessage =malloc(sz+1);
strncpy(LOCAL_ErrorMessage,"term must end with . or EOF.", sz );
}
t = 0;
}

22
C/stack.c
View File

@ -1124,7 +1124,7 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) {
yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t,
yamop *codeptr, PredEntry *pp) {
CACHE_REGS
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
t->prologPredName = AtomName((Atom)pp->FunctorOfPred);
@ -1138,36 +1138,18 @@ yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t,
: "prolog");
t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE;
if (codeptr->opc == UNDEF_OPCODE) {
t->prologPredFirstLine = 0;
t->prologPredLine = 0;
t->prologPredLastLine = 0;
return t;
} else if (pp->cs.p_code.NOfClauses) {
if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
if ((t->prologPredLine = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
0) {
t->prologPredLine = 0;
} else {
t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
}
if (pp->PredFlags & LogUpdatePredFlag) {
t->prologPredFirstLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), pp);
} else {
t->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
t->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
}
return t;
} else {
t->prologPredFirstLine = 0;
t->prologPredLine = t->errorLine;
t->prologPredLastLine = 0;
t->prologPredFile = t->errorFile;
return t;
}

2
C/text.c
View File

@ -990,7 +990,7 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
else
fprintf(stderr, "%s", out->val.c);
fprintf(stderr, "\n]\n"); */
pop_text_stack(l);
out->val.uc = pop_output_text_stack(l,out->val.uc);
return rc;
}

5
H/YapText.h
View File

@ -175,7 +175,10 @@ INLINE_ONLY char_kind_t chtype(Int ch) {
#endif
extern const char *Yap_tokText(void *tokptr);
extern Term Yap_tokRep(void *tokptr);
/// represent token *_tokptr_ in string s, maxlength is sz-1
///
/// conversion is based on token type.
extern Term Yap_tokRep(void *tokptrXS);
// standard strings

41
include/YapError.h
View File

@ -200,33 +200,51 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
/// all we need to know about an error/throw
typedef struct s_yap_error_descriptor {
/// error identifier
yap_error_number errorNo;
/// kind of error: derived from errorNo;
yap_error_class_number errorClass;
/// if non-NULL: goal who caused error;
const char *errorGoal;
/// errorNo as text
const char *errorAsText;
/// errorClass as text
const char *classAsText;
/// c-code that generated the error
/// C-line
intptr_t errorLine;
/// C-function
const char *errorFunction;
/// C-file
const char *errorFile;
// struct error_prolog_source *errorSource;
intptr_t prologPredCl;
uintptr_t prologPredLine;
uintptr_t prologPredFirstLine;
uintptr_t prologPredLastLine;
/// Prolog predicate that caused the error: name
const char *prologPredName;
/// Prolog predicate that caused the error:arity
uintptr_t prologPredArity;
/// Prolog predicate that caused the error:module
const char *prologPredModule;
/// Prolog predicate that caused the error:line
const char *prologPredFile;
uintptr_t prologParserPos;
uintptr_t prologParserLine;
uintptr_t prologParserFirstLine;
uintptr_t prologParserLastLine;
const char *prologParserText;
const char *prologParserFile;
/// line where error clause defined
uintptr_t prologPredLine;
/// syntax and other parsing errors
uintptr_t parserPos;
uintptr_t parserFirstPos;
uintptr_t parserLastPos;
uintptr_t parserLine;
uintptr_t parserFirstLine;
uintptr_t parserLastLine;
const char *parserTextA;
const char *parserTextB;
const char *parserFile;
/// reading a clause, or called from read?
bool parserReadingCode;
/// whether we are consulting
bool prologConsulting;
const char *culprit;
YAP_Term errorRawTerm, rawExtraErrorTerm;
char *errorMsg;
char *errorMsg;
size_t errorMsgLen;
struct s_yap_error_descriptor *top_error;
} yap_error_descriptor_t;
@ -242,6 +260,7 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
extern void Yap_CatchError(void);
extern void Yap_ThrowExistingError(void);
extern YAP_Term Yap_MkFullError(void);
extern bool Yap_MkErrorRecord(
yap_error_descriptor_t * r, const char *file, const char *function,
int lineno, yap_error_number type, YAP_Term where, const char *msg);

8
include/YapErrors.h
View File

@ -32,6 +32,8 @@ ECLASS(SYSTEM_ERROR_CLASS, "system_error", 1)
ECLASS(TYPE_ERROR, "type_error", 2)
/// should be unbound
ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1)
/// not quite an error, but almost
ECLASS(WARNING, "warning", 1)
/// user defined escape hatch
ECLASS(EVENT, "event", 1)
@ -196,7 +198,11 @@ E(TYPE_ERROR_REFERENCE, TYPE_ERROR, "reference")
E(TYPE_ERROR_STRING, TYPE_ERROR, "string")
E(TYPE_ERROR_TEXT, TYPE_ERROR, "text")
E(TYPE_ERROR_UBYTE, TYPE_ERROR, "ubyte")
E(TYPE_ERROR_UCHAR, TYPE_ERROR, "uchar")
E(TYPE_ERROR_UCHAR, TYPE_ERROR, "unsigned char")
E(WARNING_DISCONTIGUOUS, WARNING, "discontiguous")
E(WARNING_SINGLETONS, WARNING, "singletons")
E(WARNING_SYNTAX_ERROR, WARNING, "syntax_error")
E1(UNINSTANTIATION_ERROR, UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error")

64
os/format.c
View File

@ -278,33 +278,55 @@ static int format_print_str(Int sno, Int size, Int has_size, Term args,
while (*pt && (!has_size || size > 0)) {
utf8proc_int32_t ch;
if ((pt += get_utf8(pt, -1, &ch)) > 0) {
f_putc(sno, ch);
}
}
} else if (IsAtomTerm(args)) {
const unsigned char *pt = RepAtom(AtomOfTerm(args))->UStrOfAE;
while (*pt && (!has_size || size > 0)) {
utf8proc_int32_t ch;
if ((pt += get_utf8(pt, -1, &ch)) > 0) {
f_putc(sno, ch);
}
}
} else {
while (!has_size || size > 0) {
bool maybe_chars = true, maybe_codes = true;
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
Yap_ThrowError(INSTANTIATION_ERROR, args, "~s expects a bound argument");
return FALSE;
} else if (args == TermNil) {
return TRUE;
} else if (!IsPairTerm(args)) {
Yap_Error(TYPE_ERROR_LIST, args, "format/2");
Yap_ThrowError(TYPE_ERROR_TEXT, args, "format expects an atom, string, or list of codes or chars ");
return FALSE;
}
arghd = HeadOfTerm(args);
args = TailOfTerm(args);
if (IsVarTerm(arghd)) {
Yap_Error(INSTANTIATION_ERROR, arghd, "format/2");
Yap_ThrowError(INSTANTIATION_ERROR, arghd, "~s expects a bound argument");
return FALSE;
} else if (!IsIntTerm(arghd)) {
Yap_Error(TYPE_ERROR_LIST, arghd, "format/2");
} else if (maybe_codes && IsIntTerm(arghd)) {
f_putc(sno, (int)IntOfTerm(arghd));
size--;
maybe_chars = false;
} else if (maybe_chars && IsAtomTerm(arghd)) {
unsigned char *fptr = RepAtom(AtomOfTerm(arghd))->UStrOfAE;
int ch;
fptr += get_utf8(fptr, -1, &ch);
if (fptr[0] != '\0') {
Yap_ThrowError(TYPE_ERROR_TEXT, arghd, "~s expects a list of chars ");
}
f_putc(sno, ch);
size--;
maybe_codes = false;
} else {
Yap_ThrowError(TYPE_ERROR_TEXT, arghd, "~s expects an atom, string, or list of codes or chars ");
return FALSE;
}
f_putc(sno, (int)IntOfTerm(arghd));
size--;
}
}
}
return TRUE;
}
@ -313,11 +335,11 @@ static Int format_copy_args(Term args, Term *targs, Int tsz) {
Int n = 0;
while (args != TermNil) {
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2");
return FORMAT_COPY_ARGS_ERROR;
}
if (!IsPairTerm(args)) {
Yap_Error(TYPE_ERROR_LIST, args, "format/2");
Yap_ThrowError(TYPE_ERROR_LIST, args, "format/2");
return FORMAT_COPY_ARGS_ERROR;
}
if (n == tsz)
@ -402,7 +424,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
*HR++ = otail;
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
pop_text_stack(l);
Yap_Error(RESOURCE_ERROR_HEAP, otail, "format/2");
Yap_ThrowError(RESOURCE_ERROR_HEAP, otail, "format/2");
return false;
}
oargs = HR[-2];
@ -418,20 +440,20 @@ static Int doformat(volatile Term otail, volatile Term oargs,
targ = 0;
if (IsVarTerm(tail)) {
format_clean_up(sno0, sno, finfo );
Yap_Error(INSTANTIATION_ERROR, tail, "format/2");
Yap_ThrowError(INSTANTIATION_ERROR, tail, "format/2");
return (FALSE);
} else if ((fstr = Yap_TextToUTF8Buffer(tail))) {
fptr = fstr;
alloc_fstr = true;
} else {
format_clean_up(sno0, sno, finfo);
Yap_Error(TYPE_ERROR_TEXT, tail, "format/2");
Yap_ThrowError(TYPE_ERROR_TEXT, tail, "format/2");
return false;
}
if (IsVarTerm(args)) {
pop_text_stack(l);
format_clean_up(sno0, sno, finfo);
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
}
while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) {
@ -440,19 +462,19 @@ static Int doformat(volatile Term otail, volatile Term oargs,
if (IsVarTerm(fmod)) {
format_clean_up(sno0, sno, finfo);
pop_text_stack(l);
Yap_Error(INSTANTIATION_ERROR, fmod, "format/2");
Yap_ThrowError(INSTANTIATION_ERROR, fmod, "format/2");
return false;
}
if (!IsAtomTerm(fmod)) {
format_clean_up(sno0, sno, finfo);
pop_text_stack(l);
Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2");
Yap_ThrowError(TYPE_ERROR_ATOM, fmod, "format/2");
return false;
}
if (IsVarTerm(args)) {
format_clean_up(sno0, sno, finfo);
pop_text_stack(l);
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
}
}
@ -968,7 +990,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
Term ta[2];
ta[0] = otail;
ta[1] = oargs;
Yap_Error(LOCAL_Error_TYPE,
Yap_ThrowError(LOCAL_Error_TYPE,
Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta),
"arguments to format");
}
@ -1028,7 +1050,7 @@ static Term memStreamToTerm(int output_stream, Functor f, Term inp) {
} else if (f == FunctorString1) {
return Yap_CharsToString(s, enc PASS_REGS);
}
Yap_Error(DOMAIN_ERROR_FORMAT_OUTPUT, inp, NULL);
Yap_ThrowError(DOMAIN_ERROR_FORMAT_OUTPUT, inp, NULL);
return 0L;
}
@ -1088,7 +1110,7 @@ static Int with_output_to(USES_REGS1) {
bool mem_stream = false;
yhandle_t hdl = Yap_PushHandle(tin);
if (IsVarTerm(tin)) {
Yap_Error(INSTANTIATION_ERROR, tin, "with_output_to/3");
Yap_ThrowError(INSTANTIATION_ERROR, tin, "with_output_to/3");
return false;
}
if (IsApplTerm(tin) && (f = FunctorOfTerm(tin))) {
@ -1129,7 +1151,7 @@ static Int format(Term tf, Term tas, Term tout USES_REGS) {
bool mem_stream = false;
if (IsVarTerm(tout)) {
Yap_Error(INSTANTIATION_ERROR, tout, "format/3");
Yap_ThrowError(INSTANTIATION_ERROR, tout, "format/3");
return false;
}
yhandle_t hl = Yap_StartHandles(), yo = Yap_PushHandle(tout);

2
os/iopreds.h
View File

@ -176,7 +176,7 @@ extern int Yap_peekWide(int sno);
extern int Yap_peekChar(int sno);
extern Term Yap_syntax_error(TokEntry *tokptr, int sno);
extern Term Yap_syntax_error(TokEntry *tokptr, int sno, const char *msg);
extern int console_post_process_read_char(int, StreamDesc *);
extern int console_post_process_eof(StreamDesc *);

1101
os/readterm.c
View File

File diff suppressed because it is too large Load Diff

2
pl/consult.yap
View File

@ -695,7 +695,7 @@ db_files(Fs) :-
'$csult'(Fs, _M) :-
'$skip_list'(_, Fs ,L),
vz L \== [],
L \== [],
!,
user:dot_qualified_goal(Fs).
'$csult'(Fs, M) :-

60
pl/messages.yap
View File

@ -197,16 +197,22 @@ compose_message( halt, _Level) --> !,
[ 'YAP execution halted.'-[] ].
% syntax error.
compose_message(error(warning(syntax_error,Info), Exc), Level) -->
!,
compose_message(error(syntax_error(Info), Exc), Level).
compose_message(error(E, Exc), Level) -->
{ '$show_consult_level'(LC) },
location(error(E, Exc), Level, LC),
{
% start_low_level_trace,
'$show_consult_level'(LC)
},
location(error(E, Exc), Level, LC),
main_message(error(E,Exc) , Level, LC ),
c_goal( error(E, Exc), Level ),
caller( error(E, Exc), Level ),
extra_info( error(E, Exc), Level ),
!,
[nl],
[nl].
c_goal( error(E, Exc), Level ),
caller( error(E, Exc), Level ),
extra_info( error(E, Exc), Level ),
!,
[nl],
[nl].
compose_message( false, _Level) --> !,
[ 'false.'-[] ].
compose_message( '$abort', _Level) --> !,
@ -249,9 +255,16 @@ compose_message(Throw, _Level) -->
!,
[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)), _ , _) -->
!,
[ '~a:~d:~d: ' - [FileName,LN,0] ] .
location(error(syntax_error(_),Info), _Level , LC) -->
{ '$error_descriptor'(Info, Desc) },
{ query_exception(parserReadingCode, Desc, true) },
{LC > 0},
!,
{
query_exception(parserFile, Desc, FileName),
query_exception(parserLine, Desc, LN)
},
[ '~a:~d:~d: ' - [FileName,LN,0] ] .
location(style_check(A,LN,FileName,B ), Level , LC) -->
!,
display_consulting( FileName, Level,style_check(A,LN,FileName,B ), LC ),
@ -289,21 +302,17 @@ simplify_pred(F, F).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
main_message(error(Msg,In), _, _) --> {var(Msg)}, !,
[ 'Uninstantiated message ~w~n.' - [error(Msg,In)], nl ].
main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term)), Level, LC ) -->
!,
main_message( error(syntax_error(Msg),Info), Level, _LC ) -->
!,
{
'$error_descriptor'(Info, Desc),
query_exception(parserTextA, Desc, J),
query_exception(parserTextB, Desc, T),
query_exception(parserLine, Desc, L)
},
[' ~a: syntax error ~s' - [Level,Msg]],
[nl],
( syntax_error_term( between(L0,LM,LF), Term, LC )
->
[]
;
[' ~a: failed_processing syntax error term ~q' - [Level,Term]],
[nl]
).
main_message( error(syntax_error(Msg), _Info), Level, _LC ) -->
!,
[' ~a: syntax error ~s' - [Level,Msg]],
[nl].
[' ~s <<== at line ~d == ~s !' - [J,L,T], nl ].
main_message(style_check(singleton(SVs),_Pos,_File,P), _Level, _LC) -->
!,
% {writeln(ci)},
@ -370,6 +379,7 @@ display_consulting( F, Level, _, LC) -->
display_consulting(_F, _, _, _LC) -->
[].
c_goal( error(syntax_error(_),Info), _) --> !.
c_goal( error(_,Info), _) -->
{ '$error_descriptor'(Info, Desc) },
({ query_exception(errorGoal, Desc, Call),
@ -711,7 +721,7 @@ syntax_error_token(var(_,S), _, _LC) --> !,
syntax_error_token(string(S), _, _LC) --> !,
[ '`~s`' - [S] ].
syntax_error_token(error, L, _LC) --> !,
[ ' <<<< at line %d' - [L] ].
[ ' <<<< at line ~d >>>> ' - [L] ].
syntax_error_token('EOT',_, _LC) --> !,
[ '.' - [], nl ].
syntax_error_token('(',_, _LC) --> !,