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

printwarning

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-11-21 00:22:03 +00:00
parent 6d773a3189
commit f1f64bf25c
10 changed files with 92 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
H/iatoms.h
View File

@ -229,6 +229,7 @@
AtomPortray = Yap_FullLookupAtom("$portray");
AtomPredicateIndicator = Yap_LookupAtom("predicate_indicator");
AtomPrimitive = Yap_LookupAtom("primitive");
AtomPrintMessage = Yap_LookupAtom("print_message");
AtomPrivateProcedure = Yap_LookupAtom("private_procedure");
AtomProcedure = Yap_LookupAtom("procedure");
AtomProfile = Yap_FullLookupAtom("$profile");
@ -425,6 +426,7 @@
FunctorPermissionError = Yap_MkFunctor(AtomPermissionError,3);
FunctorPlus = Yap_MkFunctor(AtomPlus,2);
FunctorPortray = Yap_MkFunctor(AtomPortray,1);
FunctorPrintMessage = Yap_MkFunctor(AtomPrintMessage,2);
FunctorPrologConstraint = Yap_MkFunctor(AtomProlog,2);
FunctorQuery = Yap_MkFunctor(AtomQuery,1);
FunctorRecordedWithKey = Yap_MkFunctor(AtomRecordedWithKey,6);

2
H/pl-global.h
View File

@ -393,6 +393,8 @@ typedef struct PL_local_data {
} gmp;
#endif
int in_print_message;
struct regstore_t *reg_cache; /* pointer to YAP registers */
#ifdef O_LOCALE

2
H/pl-incl.h
View File

@ -276,6 +276,7 @@ users foreign language code.
* Error *
*********************************/
#define isDefinedProcedure(pred) TRUE // TBD
#include "pl-error.h"
/********************************
@ -568,7 +569,6 @@ extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w);
extern IOSTREAM ** /* provide access to Suser_input, */
_PL_streams(void); /* Suser_output and Suser_error */

2
H/ratoms.h
View File

@ -229,6 +229,7 @@
AtomPortray = AtomAdjust(AtomPortray);
AtomPredicateIndicator = AtomAdjust(AtomPredicateIndicator);
AtomPrimitive = AtomAdjust(AtomPrimitive);
AtomPrintMessage = AtomAdjust(AtomPrintMessage);
AtomPrivateProcedure = AtomAdjust(AtomPrivateProcedure);
AtomProcedure = AtomAdjust(AtomProcedure);
AtomProfile = AtomAdjust(AtomProfile);
@ -425,6 +426,7 @@
FunctorPermissionError = FuncAdjust(FunctorPermissionError);
FunctorPlus = FuncAdjust(FunctorPlus);
FunctorPortray = FuncAdjust(FunctorPortray);
FunctorPrintMessage = FuncAdjust(FunctorPrintMessage);
FunctorPrologConstraint = FuncAdjust(FunctorPrologConstraint);
FunctorQuery = FuncAdjust(FunctorQuery);
FunctorRecordedWithKey = FuncAdjust(FunctorRecordedWithKey);

4
H/tatoms.h
View File

@ -456,6 +456,8 @@
#define AtomPredicateIndicator Yap_heap_regs->AtomPredicateIndicator_
Atom AtomPrimitive_;
#define AtomPrimitive Yap_heap_regs->AtomPrimitive_
Atom AtomPrintMessage_;
#define AtomPrintMessage Yap_heap_regs->AtomPrintMessage_
Atom AtomPrivateProcedure_;
#define AtomPrivateProcedure Yap_heap_regs->AtomPrivateProcedure_
Atom AtomProcedure_;
@ -848,6 +850,8 @@
#define FunctorPlus Yap_heap_regs->FunctorPlus_
Functor FunctorPortray_;
#define FunctorPortray Yap_heap_regs->FunctorPortray_
Functor FunctorPrintMessage_;
#define FunctorPrintMessage Yap_heap_regs->FunctorPrintMessage_
Functor FunctorPrologConstraint_;
#define FunctorPrologConstraint Yap_heap_regs->FunctorPrologConstraint_
Functor FunctorQuery_;

24
library/dialect/swi/fli/swi.c
View File

@ -52,6 +52,10 @@
#include "swi.h"
#include "pl-error.h"
extern int PL_unify_termv(term_t l, va_list args);
extern X_API Atom YAP_AtomFromSWIAtom(atom_t at);
extern X_API atom_t YAP_SWIAtomFromAtom(Atom at);
@ -1454,10 +1458,9 @@ typedef struct {
/* SWI: int PL_unify_term(term_t ?t1, term_t ?t2)
YAP long int YAP_Unify(YAP_Term* a, Term* b) */
X_API int PL_unify_term(term_t l,...)
int PL_unify_termv(term_t l, va_list ap)
{
CACHE_REGS
va_list ap;
int type, res;
int nels = 1;
int depth = 1;
@ -1471,7 +1474,6 @@ X_API int PL_unify_term(term_t l,...)
return FALSE;
}
}
va_start (ap, l);
pt = a;
while (depth > 0) {
while (nels > 0) {
@ -1673,12 +1675,25 @@ X_API int PL_unify_term(term_t l,...)
nels = stack[depth-1].nels;
}
}
va_end (ap);
res = Yap_unify(Yap_GetFromSlot(l PASS_REGS),a[0]);
RECOVER_MACHINE_REGS();
return res;
}
int
PL_unify_term(term_t t, ...)
{ va_list args;
int rval;
va_start(args, t);
rval = PL_unify_termv(t, args);
va_end(args);
return rval;
}
/* end PL_unify_* functions =============================*/
/* SWI: void PL_register_atom(atom_t atom) */
@ -2209,7 +2224,6 @@ PL_close_foreign_frame(fid_t f)
{
CACHE_REGS
choiceptr cp_b = (choiceptr)(LCL0-(UInt)f);
CELL *old_slots;
LOCAL_CurSlot = IntOfTerm(cp_b->cp_a1);
B = cp_b->cp_b;
CP = cp_b->cp_cp;

42
library/dialect/swi/fli/swi.h
View File

@ -1,47 +1,6 @@
void Yap_swi_install(void);
void Yap_install_blobs(void);
/* Required by PL_error */
#define ERR_NO_ERROR 0
#define ERR_INSTANTIATION 1 /* void */
#define ERR_TYPE 2 /* atom_t expected, term_t value */
#define ERR_DOMAIN 3 /* atom_t domain, term_t value */
#define ERR_REPRESENTATION 4 /* atom_t what */
#define ERR_MODIFY_STATIC_PROC 5 /* predicate_t proc */
#define ERR_EVALUATION 6 /* atom_t what */
#define ERR_AR_TYPE 7 /* atom_t expected, Number value */
#define ERR_NOT_EVALUABLE 8 /* functor_t func */
#define ERR_DIV_BY_ZERO 9 /* void */
#define ERR_FAILED 10 /* predicate_t proc */
#define ERR_FILE_OPERATION 11 /* atom_t action, atom_t type, term_t */
#define ERR_PERMISSION 12 /* atom_t type, atom_t op, term_t obj*/
#define ERR_NOT_IMPLEMENTED 13 /* const char *what */
#define ERR_EXISTENCE 14 /* atom_t type, term_t obj */
#define ERR_STREAM_OP 15 /* atom_t action, term_t obj */
#define ERR_RESOURCE 16 /* atom_t resource */
#define ERR_NOMEM 17 /* void */
#define ERR_SYSCALL 18 /* void */
#define ERR_SHELL_FAILED 19 /* term_t command */
#define ERR_SHELL_SIGNALLED 20 /* term_t command, int signal */
#define ERR_AR_UNDEF 21 /* void */
#define ERR_AR_OVERFLOW 22 /* void */
#define ERR_AR_UNDERFLOW 23 /* void */
#define ERR_UNDEFINED_PROC 24 /* Definition def */
#define ERR_SIGNALLED 25 /* int sig, char *name */
#define ERR_CLOSED_STREAM 26 /* IOSTREAM * */
#define ERR_BUSY 27 /* mutexes */
#define ERR_PERMISSION_PROC 28 /* op, type, Definition */
#define ERR_DDE_OP 29 /* op, error */
#define ERR_SYNTAX 30 /* what */
#define ERR_SHARED_OBJECT_OP 31 /* op, error */
#define ERR_TIMEOUT 32 /* op, object */
#define ERR_NOT_IMPLEMENTED_PROC 33 /* name, arity */
#define ERR_FORMAT 34 /* message */
#define ERR_FORMAT_ARG 35 /* seq, term */
#define ERR_OCCURS_CHECK 36 /* Word, Word */
#define ERR_CHARS_TYPE 37 /* char *, term */
#define ERR_MUST_BE_VAR 38 /* int argn, term_t term */
typedef struct open_query_struct {
int open;
int state;
@ -127,3 +86,4 @@ SWIFunctorToFunctor(functor_t f)
return (Functor)f;
}
#define isDefinedProcedure(pred) TRUE // TBD

2
misc/ATOMS
View File

@ -234,6 +234,7 @@ A Pointer N "pointer"
A Portray F "$portray"
A PredicateIndicator N "predicate_indicator"
A Primitive N "primitive"
A PrintMessage N "print_message"
A PrivateProcedure N "private_procedure"
A Procedure N "procedure"
A Profile F "$profile"
@ -430,6 +431,7 @@ F Or Semic 2
F PermissionError PermissionError 3
F Plus Plus 2
F Portray Portray 1
F PrintMessage PrintMessage 2
F PrologConstraint Prolog 2
F Query Query 1
F RecordedWithKey RecordedWithKey 6

60
os/pl-error.c
View File

@ -7,12 +7,7 @@
#endif
void fatalError(const char *fm, ...) {exit(1);}
int printMessage(atom_t severity, ...) {
#if DEBUG
fprintf(stderr,"calling printMessage: not implemented\n");
#endif
return 0;
}
int printMessage(atom_t severity, ...);
/*******************************
* ERROR-CHECKING *_get() *
@ -312,6 +307,59 @@ notImplemented(char *name, int arity)
{ return (word)PL_error(NULL, 0, NULL, ERR_NOT_IMPLEMENTED_PROC, name, arity);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
printMessage(atom_t severity, ...)
Calls print_message(severity, term), where ... are arguments as for
PL_unify_term(). This predicate saves possible pending exceptions and
restores them to make the call from B_THROW possible.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define OK_RECURSIVE 10
int
printMessage(atom_t severity, ...)
{ GET_LD
//wakeup_state wstate;
term_t av;
predicate_t pred = RepPredProp(PredPropByFunc(FunctorPrintMessage,PROLOG_MODULE)); //PROCEDURE_print_message2;
va_list args;
int rc;
if ( ++LD->in_print_message >= OK_RECURSIVE*3 )
fatalError("printMessage(): recursive call\n");
/* if ( !saveWakeup(&wstate, TRUE PASS_LD) )
{ LD->in_print_message--;
return FALSE;
}
*/
av = PL_new_term_refs(2);
va_start(args, severity);
PL_put_atom(av+0, severity);
rc = PL_unify_termv(av+1, args);
va_end(args);
if ( rc )
{ if ( isDefinedProcedure(pred) && LD->in_print_message <= OK_RECURSIVE )
{ rc = PL_call_predicate(NULL, PL_Q_NODEBUG|PL_Q_CATCH_EXCEPTION,
pred, av);
} else if ( LD->in_print_message <= OK_RECURSIVE*2 )
{ Sfprintf(Serror, "Message: ");
rc = PL_write_term(Serror, av+1, 1200, 0);
Sfprintf(Serror, "\n");
} else /* in_print_message == 2 */
{ Sfprintf(Serror, "printMessage(): recursive call\n");
}
}
/* restoreWakeup(&wstate PASS_LD); */
LD->in_print_message--;
return rc;
}
int PL_error(const char *pred, int arity, const char *msg, PL_error_code id, ...)
{
GET_LD

5
os/pl-read.c
View File

@ -1243,6 +1243,11 @@ retry:
return FALSE;
}
#ifdef O_QUASIQUOTATIONS
if ( rval)
rval = parse_quasi_quotations(&rd PASS_LD);
#endif
if ( rval )
{ if ( tpos )
rval = unify_read_term_position(tpos PASS_LD);