From b3cc23ce64bd4e05290c16a43b14a35957998b15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 8 Oct 2015 02:23:45 +0100 Subject: [PATCH] IO patches simplify error handling use get and inject use wide support in OS be stricter in checkin streams and arguments --- C/atomic.c | 2 +- C/flags.c | 2 +- C/stack.c | 1582 ++++++++++++++---------------- C/text.c | 55 +- C/write.c | 9 +- H/YapText.h | 2 +- H/dhstruct.h | 4 +- H/hstruct.h | 4 +- H/ihstruct.h | 4 +- H/ilocals.h | 2 +- H/rhstruct.h | 4 +- include/YapDefs.h | 21 +- include/YapErrors.h | 1 + include/YapInterface.h | 2 +- library/dialect/swi/os/pl-read.c | 2 +- misc/HEAPFIELDS | 6 +- misc/LOCALS | 2 +- os/charsio.c | 220 ++--- os/chartypes.c | 30 +- os/encoding.h | 62 +- os/files.c | 2 +- os/format.c | 2 +- os/iopreds.c | 396 +++----- os/iopreds.h | 6 +- os/mem.c | 20 +- os/readterm.c | 41 +- os/readutil.c | 2 +- os/streams.c | 6 +- os/writeterm.c | 102 +- os/yapio.h | 12 +- 30 files changed, 1224 insertions(+), 1381 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 5772ec5ff..568bd9545 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -427,7 +427,7 @@ atom_chars( USES_REGS1 ) if (LOCAL_Error_TYPE && Yap_HandleError( "atom_chars/2" )) { goto restart_aux; } - return FALSE; + return false; } static Int diff --git a/C/flags.c b/C/flags.c index 438a314de..c21ad4c9d 100644 --- a/C/flags.c +++ b/C/flags.c @@ -1143,7 +1143,7 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr ) Term t0; if (bootstrap) { return false; } CACHE_REGS - t0 = Yap_StringToTerm(s, strlen(s)+1, LOCAL_encoding, 1200, NULL); + t0 = Yap_StringToTerm(s, strlen(s)+1, &LOCAL_encoding, 1200, NULL); if (!t0) return false; if (IsAtomTerm(t0) || IsIntTerm(t0)) { diff --git a/C/stack.c b/C/stack.c index 1e3dc272f..166504b23 100644 --- a/C/stack.c +++ b/C/stack.c @@ -9,7 +9,7 @@ ************************************************************************** * * * File: stack.c * -* comments: Stack Introspection * +* comments: Stack Introspection * * * * Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ * @@ -22,10 +22,10 @@ * @file stack.c * @author VITOR SANTOS COSTA * @date Tue Sep 8 23:33:02 2015 - * + * * @brief Get to know what is in your stack. - * - * + * + * */ #include "Yap.h" @@ -35,7 +35,7 @@ #include "tracer.h" #ifdef YAPOR #include "or.macros.h" -#endif /* YAPOR */ +#endif /* YAPOR */ #ifdef TABLING #include "tab.macros.h" #endif /* TABLING */ @@ -48,20 +48,18 @@ static void mark_pred(int, PredEntry *); static void do_toggle_static_predicates_in_use(int); #endif -static Int in_use( USES_REGS1 ); -static Int PredForCode(yamop *, Atom *, arity_t *, Term *, PredEntry **); +static Int in_use(USES_REGS1); +static Int PredForCode(yamop *, Atom *, arity_t *, Term *, PredEntry **); static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *); static StaticIndex *find_owner_static_index(StaticIndex *, yamop *); -#define IN_BLOCK(P,B,SZ) ((CODEADDR)(P) >= (CODEADDR)(B) && \ - (CODEADDR)(P) < (CODEADDR)(B)+(SZ)) +#define IN_BLOCK(P, B, SZ) \ + ((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ)) -static PredEntry * -get_pred(Term t, Term tmod, char *pname) -{ +static PredEntry *get_pred(Term t, Term tmod, char *pname) { Term t0 = t; - restart: +restart: if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t0, pname); return NULL; @@ -70,20 +68,20 @@ get_pred(Term t, Term tmod, char *pname) } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { return Yap_FindLUIntKey(IntegerOfTerm(t)); } else if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); + Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) { Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); return NULL; } if (fun == FunctorModule) { Term tmod = ArgOfTerm(1, t); - if (IsVarTerm(tmod) ) { - Yap_Error(INSTANTIATION_ERROR, t0, pname); - return NULL; + if (IsVarTerm(tmod)) { + Yap_Error(INSTANTIATION_ERROR, t0, pname); + return NULL; } - if (!IsAtomTerm(tmod) ) { - Yap_Error(TYPE_ERROR_ATOM, t0, pname); - return NULL; + if (!IsAtomTerm(tmod)) { + Yap_Error(TYPE_ERROR_ATOM, t0, pname); + return NULL; } t = ArgOfTerm(2, t); goto restart; @@ -93,17 +91,15 @@ get_pred(Term t, Term tmod, char *pname) return NULL; } - -static PredEntry * -PredForChoicePt(yamop *p_code, op_numbers *opn) { +static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) { while (TRUE) { op_numbers opnum; if (!p_code) return NULL; opnum = Yap_op_from_opcode(p_code->opc); if (opn) - *opn = opnum; - switch(opnum) { + *opn = opnum; + switch (opnum) { case _Nstop: return NULL; case _jump: @@ -161,17 +157,17 @@ PredForChoicePt(yamop *p_code, op_numbers *opn) { case _table_completion: #ifdef THREADS_CONSUMER_SHARING case _table_answer_resolution_completion: -#endif /* THREADS_CONSUMER_SHARING */ +#endif /* THREADS_CONSUMER_SHARING */ return NULL; /* ricroc: is this OK? */ - /* compile error --> return ENV_ToP(gc_B->cp_cp); */ -#endif /* TABLING */ + /* compile error --> return ENV_ToP(gc_B->cp_cp); */ +#endif /* TABLING */ case _or_else: if (p_code == p_code->y_u.Osblp.l) { - /* repeat */ - Atom at = AtomRepeatSpace; - return RepPredProp(PredPropByAtom(at, PROLOG_MODULE)); + /* repeat */ + Atom at = AtomRepeatSpace; + return RepPredProp(PredPropByAtom(at, PROLOG_MODULE)); } else { - return p_code->y_u.Osblp.p0; + return p_code->y_u.Osblp.p0; } break; case _or_last: @@ -186,7 +182,7 @@ PredForChoicePt(yamop *p_code, op_numbers *opn) { case _retry2: case _retry3: case _retry4: - p_code = NEXTOP(p_code,l); + p_code = NEXTOP(p_code, l); break; default: return p_code->y_u.Otapl.p; @@ -195,67 +191,67 @@ PredForChoicePt(yamop *p_code, op_numbers *opn) { return NULL; } -/** +/** * Yap_PredForChoicePt(): find out the predicate who generated a CP. - * + * * @param cp the choice point * @param op the YAAM instruction to process next - * + * * @return A predixate structure or NULL * * usually pretty straightforward, it can fall in trouble with 8 OR-P or tabling. */ -PredEntry * -Yap_PredForChoicePt(choiceptr cp, op_numbers *op) { +PredEntry *Yap_PredForChoicePt(choiceptr cp, op_numbers *op) { if (cp == NULL) return NULL; return PredForChoicePt(cp->cp_ap, op); } #if !defined(YAPOR) && !defined(THREADS) -static yamop *cur_clause(PredEntry *pe, yamop *codeptr) -{ +static yamop *cur_clause(PredEntry *pe, yamop *codeptr) { StaticClause *cl; cl = ClauseCodeToStaticClause(pe->cs.p_code.FirstClause); do { - if (IN_BLOCK(codeptr,cl,cl->ClSize)) { + if (IN_BLOCK(codeptr, cl, cl->ClSize)) { return cl->ClCode; } if (cl->ClCode == pe->cs.p_code.LastClause) break; cl = cl->ClNext; } while (TRUE); - Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"could not find clause for indexing code"); - return(NULL); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "could not find clause for indexing code"); + return (NULL); } -static yamop *cur_log_upd_clause(PredEntry *pe, yamop *codeptr) -{ +static yamop *cur_log_upd_clause(PredEntry *pe, yamop *codeptr) { LogUpdClause *cl; cl = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause); do { - if (IN_BLOCK(codeptr,cl->ClCode,cl->ClSize)) { - return((yamop *)cl->ClCode); + if (IN_BLOCK(codeptr, cl->ClCode, cl->ClSize)) { + return ((yamop *)cl->ClCode); } cl = cl->ClNext; } while (cl != NULL); - Yap_Error(SYSTEM_ERROR_INTERNAL,TermNil,"could not find clause for indexing code"); - return(NULL); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "could not find clause for indexing code"); + return (NULL); } -bool -Yap_search_for_static_predicate_in_use(PredEntry *p, bool check_everything) -{ +bool Yap_search_for_static_predicate_in_use(PredEntry *p, + bool check_everything) { choiceptr b_ptr = B; CELL *env_ptr = ENV; if (check_everything && P) { PredEntry *pe = EnvPreg(P); - if (p == pe) return true; + if (p == pe) + return true; pe = EnvPreg(CP); - if (p == pe) return true; + if (p == pe) + return true; } do { PredEntry *pe; @@ -263,17 +259,18 @@ Yap_search_for_static_predicate_in_use(PredEntry *p, bool check_everything) /* check first environments that are younger than our latest choicepoint */ if (check_everything && env_ptr) { /* - I do not need to check environments for asserts, - only for retracts + I do not need to check environments for asserts, + only for retracts */ while (env_ptr && b_ptr > (choiceptr)env_ptr) { - yamop *cp = (yamop *)env_ptr[E_CP]; - PredEntry *pe; + yamop *cp = (yamop *)env_ptr[E_CP]; + PredEntry *pe; - pe = EnvPreg(cp); - if (p == pe) return true; - if (env_ptr != NULL) - env_ptr = (CELL *)(env_ptr[E_E]); + pe = EnvPreg(cp); + if (p == pe) + return true; + if (env_ptr != NULL) + env_ptr = (CELL *)(env_ptr[E_E]); } } /* now mark the choicepoint */ @@ -284,44 +281,42 @@ Yap_search_for_static_predicate_in_use(PredEntry *p, bool check_everything) return false; if (pe == p) { if (check_everything) - return true; - PELOCK(38,p); + return true; + PELOCK(38, p); if (p->PredFlags & IndexedPredFlag) { - yamop *code_p = b_ptr->cp_ap; - yamop *code_beg = p->cs.p_code.TrueCodeOfPred; + yamop *code_p = b_ptr->cp_ap; + yamop *code_beg = p->cs.p_code.TrueCodeOfPred; - /* FIX ME */ + /* FIX ME */ - if (p->PredFlags & LogUpdatePredFlag) { - LogUpdIndex *cl = ClauseCodeToLogUpdIndex(code_beg); - if (find_owner_log_index(cl, code_p)) - b_ptr->cp_ap = cur_log_upd_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); - } else if (p->PredFlags & MegaClausePredFlag) { - StaticIndex *cl = ClauseCodeToStaticIndex(code_beg); - if (find_owner_static_index(cl, code_p)) - b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); - } else { - /* static clause */ - StaticIndex *cl = ClauseCodeToStaticIndex(code_beg); - if (find_owner_static_index(cl, code_p)) { - b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); - } - } + if (p->PredFlags & LogUpdatePredFlag) { + LogUpdIndex *cl = ClauseCodeToLogUpdIndex(code_beg); + if (find_owner_log_index(cl, code_p)) + b_ptr->cp_ap = cur_log_upd_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); + } else if (p->PredFlags & MegaClausePredFlag) { + StaticIndex *cl = ClauseCodeToStaticIndex(code_beg); + if (find_owner_static_index(cl, code_p)) + b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); + } else { + /* static clause */ + StaticIndex *cl = ClauseCodeToStaticIndex(code_beg); + if (find_owner_static_index(cl, code_p)) { + b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d); + } + } } - UNLOCKPE(63,pe); + UNLOCKPE(63, pe); } env_ptr = b_ptr->cp_env; b_ptr = b_ptr->cp_b; } while (b_ptr != NULL); - return(FALSE); + return (FALSE); } -static void -mark_pred(int mark, PredEntry *pe) -{ +static void mark_pred(int mark, PredEntry *pe) { /* if the predicate is static mark it */ if (pe->ModuleOfPred) { - PELOCK(39,p); + PELOCK(39, p); if (mark) { pe->PredFlags |= InUsePredFlag; } else { @@ -334,9 +329,7 @@ mark_pred(int mark, PredEntry *pe) /* go up the chain of choice_points and environments, marking all static predicates that current execution is depending upon */ -static void -do_toggle_static_predicates_in_use(int mask) -{ +static void do_toggle_static_predicates_in_use(int mask) { choiceptr b_ptr = B; CELL *env_ptr = ENV; @@ -356,7 +349,7 @@ do_toggle_static_predicates_in_use(int mask) /* now mark the choicepoint */ if ((b_ptr)) { if ((pe = PredForChoicePt(b_ptr->cp_ap, NULL))) { - mark_pred(mask, pe); + mark_pred(mask, pe); } } env_ptr = b_ptr->cp_env; @@ -366,22 +359,20 @@ do_toggle_static_predicates_in_use(int mask) STATIC_PREDICATES_MARKED = mask; } -static Int -toggle_static_predicates_in_use( USES_REGS1 ) -{ +static Int toggle_static_predicates_in_use(USES_REGS1) { #if !defined(YAPOR) && !defined(THREADS) Term t = Deref(ARG1); Int mask; /* find out whether we need to mark or unmark */ if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,t,"toggle_static_predicates_in_use/1"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t, "toggle_static_predicates_in_use/1"); + return (FALSE); } if (!IsIntTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER,t,"toggle_static_predicates_in_use/1"); - return(FALSE); - } else { + Yap_Error(TYPE_ERROR_INTEGER, t, "toggle_static_predicates_in_use/1"); + return (FALSE); + } else { mask = IntOfTerm(t); } do_toggle_static_predicates_in_use(mask); @@ -391,13 +382,12 @@ toggle_static_predicates_in_use( USES_REGS1 ) #endif /* !defined(YAPOR) && !defined(THREADS) */ -static void -clause_was_found(PredEntry *pp, Atom *pat, UInt *parity) { +static void clause_was_found(PredEntry *pp, Atom *pat, UInt *parity) { if (pp->ModuleOfPred == IDB_MODULE) { if (pp->PredFlags & NumberDBPredFlag) { *parity = 0; *pat = AtomInteger; - } else if (pp->PredFlags & AtomDBPredFlag) { + } else if (pp->PredFlags & AtomDBPredFlag) { *parity = 0; *pat = (Atom)pp->FunctorOfPred; } else { @@ -418,17 +408,18 @@ clause_was_found(PredEntry *pp, Atom *pat, UInt *parity) { } } -static void -code_in_pred_info(PredEntry *pp, Atom *pat, UInt *parity) { +static void code_in_pred_info(PredEntry *pp, Atom *pat, UInt *parity) { clause_was_found(pp, pat, parity); } -static int -code_in_pred_lu_index(LogUpdIndex *icl, yamop *codeptr, void* *startp, void* *endp) { +static int code_in_pred_lu_index(LogUpdIndex *icl, yamop *codeptr, + void **startp, void **endp) { LogUpdIndex *cicl; - if (IN_BLOCK(codeptr,icl,icl->ClSize)) { - if (startp) *startp = (CODEADDR)icl; - if (endp) *endp = (CODEADDR)icl+icl->ClSize; + if (IN_BLOCK(codeptr, icl, icl->ClSize)) { + if (startp) + *startp = (CODEADDR)icl; + if (endp) + *endp = (CODEADDR)icl + icl->ClSize; return TRUE; } cicl = icl->ChildIndex; @@ -440,12 +431,14 @@ code_in_pred_lu_index(LogUpdIndex *icl, yamop *codeptr, void* *startp, void* *en return FALSE; } -static int -code_in_pred_s_index(StaticIndex *icl, yamop *codeptr, void* *startp, void* *endp) { +static int code_in_pred_s_index(StaticIndex *icl, yamop *codeptr, void **startp, + void **endp) { StaticIndex *cicl; - if (IN_BLOCK(codeptr,icl,icl->ClSize)) { - if (startp) *startp = (CODEADDR)icl; - if (endp) *endp = (CODEADDR)icl+icl->ClSize; + if (IN_BLOCK(codeptr, icl, icl->ClSize)) { + if (startp) + *startp = (CODEADDR)icl; + if (endp) + *endp = (CODEADDR)icl + icl->ClSize; return TRUE; } cicl = icl->ChildIndex; @@ -457,8 +450,8 @@ code_in_pred_s_index(StaticIndex *icl, yamop *codeptr, void* *startp, void* *end return FALSE; } -static Int -find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp, void **endp) { +static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp, + void **endp) { Int i = 1; yamop *clcode; @@ -467,128 +460,130 @@ find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp, void **endp) { if (pp->PredFlags & LogUpdatePredFlag) { LogUpdClause *cl = ClauseCodeToLogUpdClause(clcode); do { - if (IN_BLOCK(codeptr,(CODEADDR)cl,cl->ClSize)) { - if (startp) - *startp = (CODEADDR)cl; - if (endp) - *endp = (CODEADDR)cl+cl->ClSize; - return i; - } - i++; - cl = cl->ClNext; + if (IN_BLOCK(codeptr, (CODEADDR)cl, cl->ClSize)) { + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl + cl->ClSize; + return i; + } + i++; + cl = cl->ClNext; } while (cl != NULL); } else if (pp->PredFlags & DynamicPredFlag) { do { - DynamicClause *cl; - - cl = ClauseCodeToDynamicClause(clcode); - if (IN_BLOCK(codeptr,cl,cl->ClSize)) { - if (startp) - *startp = (CODEADDR)cl; - if (endp) - *endp = (CODEADDR)cl+cl->ClSize; - return i; - } - if (clcode == pp->cs.p_code.LastClause) - break; - i++; - clcode = NextDynamicClause(clcode); + DynamicClause *cl; + + cl = ClauseCodeToDynamicClause(clcode); + if (IN_BLOCK(codeptr, cl, cl->ClSize)) { + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl + cl->ClSize; + return i; + } + if (clcode == pp->cs.p_code.LastClause) + break; + i++; + clcode = NextDynamicClause(clcode); } while (TRUE); } else if (pp->PredFlags & MegaClausePredFlag) { MegaClause *cl; - + cl = ClauseCodeToMegaClause(clcode); - if (IN_BLOCK(codeptr,cl,cl->ClSize)) { - if (startp) - *startp = (CODEADDR)cl; - if (endp) - *endp = (CODEADDR)cl+cl->ClSize; - return 1+((char *)codeptr-(char *)cl->ClCode)/cl->ClItemSize; + if (IN_BLOCK(codeptr, cl, cl->ClSize)) { + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl + cl->ClSize; + return 1 + ((char *)codeptr - (char *)cl->ClCode) / cl->ClItemSize; } } else { StaticClause *cl; - + cl = ClauseCodeToStaticClause(clcode); do { - if (IN_BLOCK(codeptr,cl,cl->ClSize)) { - if (startp) - *startp = (CODEADDR)cl; - if (endp) - *endp = (CODEADDR)cl+cl->ClSize; - return i; - } - if (cl->ClCode == pp->cs.p_code.LastClause) - break; - i++; - cl = cl->ClNext; + if (IN_BLOCK(codeptr, cl, cl->ClSize)) { + if (startp) + *startp = (CODEADDR)cl; + if (endp) + *endp = (CODEADDR)cl + cl->ClSize; + return i; + } + if (cl->ClCode == pp->cs.p_code.LastClause) + break; + i++; + cl = cl->ClNext; } while (TRUE); } } - return(0); + return (0); } -static Term -clause_loc(void *clcode, PredEntry *pp) { +static Term clause_loc(void *clcode, PredEntry *pp) { CACHE_REGS if (pp->PredFlags & LogUpdatePredFlag) { LogUpdClause *cl = ClauseCodeToLogUpdClause(clcode); - cl = ClauseCodeToLogUpdClause(clcode); - - if (cl->ClFlags & FactMask) { - return MkIntegerTerm(cl->lusl.ClLine); - } else { - return MkIntegerTerm(cl->lusl.ClSource->ag.line_number); - } - } else if (pp->PredFlags & DynamicPredFlag) { - DynamicClause *cl; - cl = ClauseCodeToDynamicClause(clcode); - - return TermNil; - } else if (pp->PredFlags & MegaClausePredFlag) { - MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); - return MkIntTerm(mcl->ClLine); + cl = ClauseCodeToLogUpdClause(clcode); + + if (cl->ClFlags & FactMask) { + return MkIntegerTerm(cl->lusl.ClLine); } else { - StaticClause *cl; - cl = ClauseCodeToStaticClause(clcode); - - if (cl->ClFlags & FactMask) { - return MkIntTerm(cl->usc.ClLine); - } else if (cl->ClFlags & SrcMask) { - return MkIntTerm(cl->usc.ClSource->ag.line_number); - } else - return TermNil; - + return MkIntegerTerm(cl->lusl.ClSource->ag.line_number); + } + } else if (pp->PredFlags & DynamicPredFlag) { + DynamicClause *cl; + cl = ClauseCodeToDynamicClause(clcode); + + return TermNil; + } else if (pp->PredFlags & MegaClausePredFlag) { + MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); + return MkIntTerm(mcl->ClLine); + } else { + StaticClause *cl; + cl = ClauseCodeToStaticClause(clcode); + + if (cl->ClFlags & FactMask) { + return MkIntTerm(cl->usc.ClLine); + } else if (cl->ClFlags & SrcMask) { + return MkIntTerm(cl->usc.ClSource->ag.line_number); + } else + return TermNil; } return TermNil; } -static int -cl_code_in_pred(PredEntry *pp, yamop *codeptr, void* *startp, void* *endp) { +static int cl_code_in_pred(PredEntry *pp, yamop *codeptr, void **startp, + void **endp) { Int out; - PELOCK(39,pp); + PELOCK(39, pp); /* check if the codeptr comes from the indexing code */ if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & LogUpdatePredFlag) { - if (code_in_pred_lu_index(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, startp, endp)) { - UNLOCK(pp->PELock); - return TRUE; + if (code_in_pred_lu_index( + ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + startp, endp)) { + UNLOCK(pp->PELock); + return TRUE; } } else { - if (code_in_pred_s_index(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, startp, endp)) { - UNLOCK(pp->PELock); - return TRUE; + if (code_in_pred_s_index( + ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + startp, endp)) { + UNLOCK(pp->PELock); + return TRUE; } } } - if (pp->PredFlags & (CPredFlag|AsmPredFlag|UserCPredFlag)) { + if (pp->PredFlags & (CPredFlag | AsmPredFlag | UserCPredFlag)) { StaticClause *cl = ClauseCodeToStaticClause(pp->CodeOfPred); - if (IN_BLOCK(codeptr,(CODEADDR)cl,cl->ClSize)) { + if (IN_BLOCK(codeptr, (CODEADDR)cl, cl->ClSize)) { if (startp) - *startp = (CODEADDR)cl; + *startp = (CODEADDR)cl; if (endp) - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; UNLOCK(pp->PELock); return TRUE; } else { @@ -598,41 +593,46 @@ cl_code_in_pred(PredEntry *pp, yamop *codeptr, void* *startp, void* *endp) { } else { out = find_code_in_clause(pp, codeptr, startp, endp); } - UNLOCK(pp->PELock); - if (out) return TRUE; + UNLOCK(pp->PELock); + if (out) + return TRUE; return FALSE; } -static Int -code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { +static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, + yamop *codeptr) { Int out; - PELOCK(40,pp); + PELOCK(40, pp); /* check if the codeptr comes from the indexing code */ if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & LogUpdatePredFlag) { - if (code_in_pred_lu_index(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, NULL, NULL)) { - code_in_pred_info(pp, pat, parity); - UNLOCK(pp->PELock); - return -1; + if (code_in_pred_lu_index( + ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + NULL, NULL)) { + code_in_pred_info(pp, pat, parity); + UNLOCK(pp->PELock); + return -1; } } else { - if (code_in_pred_s_index(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, NULL, NULL)) { - code_in_pred_info(pp, pat, parity); - UNLOCK(pp->PELock); - return -1; + if (code_in_pred_s_index( + ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + NULL, NULL)) { + code_in_pred_info(pp, pat, parity); + UNLOCK(pp->PELock); + return -1; } } } if ((out = find_code_in_clause(pp, codeptr, NULL, NULL))) { clause_was_found(pp, pat, parity); } - UNLOCK(pp->PELock); + UNLOCK(pp->PELock); return out; } -static Int -PredForCode(yamop *codeptr, Atom *pat, UInt *parity, Term *pmodule, PredEntry **pep) { +static Int PredForCode(yamop *codeptr, Atom *pat, UInt *parity, Term *pmodule, + PredEntry **pep) { Int found = 0; ModEntry *me = CurrentModules; @@ -642,7 +642,7 @@ PredForCode(yamop *codeptr, Atom *pat, UInt *parity, Term *pmodule, PredEntry ** PredEntry *pp; pp = me->PredForME; while (pp != NULL) { - if ((found = code_in_pred(pp, pat, parity, codeptr)) != 0) { + if ((found = code_in_pred(pp, pat, parity, codeptr)) != 0) { if (pmodule) *pmodule = MkAtomTerm(me->AtomOfME); if (pep) @@ -653,11 +653,11 @@ PredForCode(yamop *codeptr, Atom *pat, UInt *parity, Term *pmodule, PredEntry ** } me = me->NextME; } - return(0); + return (0); } -Int -Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *parity, Term *pmodule) { +Int Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, + UInt *parity, Term *pmodule) { PredEntry *p; if (where_from == FIND_PRED_FROM_CP) { @@ -667,10 +667,10 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari if (p) { Int out; if (p->ModuleOfPred == PROLOG_MODULE) - *pmodule = TermProlog; + *pmodule = TermProlog; else - *pmodule = p->ModuleOfPred; - out = find_code_in_clause(p, codeptr, NULL, NULL); + *pmodule = p->ModuleOfPred; + out = find_code_in_clause(p, codeptr, NULL, NULL); clause_was_found(p, pat, parity); return out; } @@ -689,113 +689,100 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari } /* intruction blocks we found ourselves at */ -static PredEntry * -walk_got_lu_block(LogUpdIndex *cl, void* *startp, void* *endp) -{ +static PredEntry *walk_got_lu_block(LogUpdIndex *cl, void **startp, + void **endp) { PredEntry *pp = cl->ClPred; *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; return pp; } /* intruction blocks we found ourselves at */ -static PredEntry * -walk_got_lu_clause(LogUpdClause *cl, void* *startp, void* *endp) -{ +static PredEntry *walk_got_lu_clause(LogUpdClause *cl, void **startp, + void **endp) { *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; return cl->ClPred; } /* we hit a meta-call, so we don't know what is happening */ -static PredEntry * -found_meta_call(void* *startp, void* *endp) -{ +static PredEntry *found_meta_call(void **startp, void **endp) { PredEntry *pp = PredMetaCall; - *startp = (CODEADDR)&(pp->OpcodeOfPred); - *endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred),e); + *startp = (CODEADDR) & (pp->OpcodeOfPred); + *endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred), e); return pp; } /* intruction blocks we found ourselves at */ -static PredEntry * -walk_found_c_pred(PredEntry *pp, void* *startp, void* *endp) -{ - StaticClause *cl = ClauseCodeToStaticClause(pp->CodeOfPred); - *startp = (CODEADDR)&(cl->ClCode); - *endp = (CODEADDR)&(cl->ClCode)+cl->ClSize; +static PredEntry *walk_found_c_pred(PredEntry *pp, void **startp, void **endp) { + StaticClause *cl = ClauseCodeToStaticClause(pp->CodeOfPred); + *startp = (CODEADDR) & (cl->ClCode); + *endp = (CODEADDR) & (cl->ClCode) + cl->ClSize; return pp; } /* we hit a mega-clause, no point in going on */ -static PredEntry * -found_mega_clause(PredEntry *pp, void* *startp, void* *endp) -{ +static PredEntry *found_mega_clause(PredEntry *pp, void **startp, void **endp) { MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); *startp = (CODEADDR)mcl; - *endp = (CODEADDR)mcl+mcl->ClSize; + *endp = (CODEADDR)mcl + mcl->ClSize; return pp; } /* we hit a mega-clause, no point in going on */ -static PredEntry * -found_idb_clause(yamop *pc, void* *startp, void* *endp) -{ +static PredEntry *found_idb_clause(yamop *pc, void **startp, void **endp) { LogUpdClause *cl = ClauseCodeToLogUpdClause(pc); *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; return cl->ClPred; } /* we hit a expand_index, no point in going on */ -static PredEntry * -found_expand_index(yamop *pc, void* *startp, void* *endp, yamop *codeptr USES_REGS) -{ +static PredEntry *found_expand_index(yamop *pc, void **startp, void **endp, + yamop *codeptr USES_REGS) { PredEntry *pp = codeptr->y_u.sssllp.p; if (pc == codeptr) { *startp = (CODEADDR)codeptr; - *endp = (CODEADDR)NEXTOP(codeptr,sssllp); + *endp = (CODEADDR)NEXTOP(codeptr, sssllp); } return pp; } /* we hit a expand_index, no point in going on */ -static PredEntry * -found_fail(yamop *pc, void* *startp, void* *endp USES_REGS) -{ - PredEntry *pp = RepPredProp(Yap_GetPredPropByAtom(AtomFail,CurrentModule)); +static PredEntry *found_fail(yamop *pc, void **startp, void **endp USES_REGS) { + PredEntry *pp = RepPredProp(Yap_GetPredPropByAtom(AtomFail, CurrentModule)); *startp = *endp = (CODEADDR)FAILCODE; return pp; } /* we hit a expand_index, no point in going on */ -static PredEntry * -found_owner_op(yamop *pc, void* *startp, void* *endp USES_REGS) -{ - PredEntry *pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->OpcodeOfPred)))); - *startp = (CODEADDR)&(pp->OpcodeOfPred); - *endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred),e); +static PredEntry *found_owner_op(yamop *pc, void **startp, + void **endp USES_REGS) { + PredEntry *pp = ((PredEntry *)(Unsigned(pc) - + (CELL)(&(((PredEntry *)NULL)->OpcodeOfPred)))); + *startp = (CODEADDR) & (pp->OpcodeOfPred); + *endp = (CODEADDR)NEXTOP((yamop *)&(pp->OpcodeOfPred), e); return pp; } /* we hit a expand_index, no point in going on */ -static PredEntry * -found_expand(yamop *pc, void* *startp, void* *endp USES_REGS) -{ - PredEntry *pp = ((PredEntry *)(Unsigned(pc)-(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); - *startp = (CODEADDR)&(pp->cs.p_code.ExpandCode); - *endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode),e); +static PredEntry *found_expand(yamop *pc, void **startp, + void **endp USES_REGS) { + PredEntry *pp = + ((PredEntry *)(Unsigned(pc) - + (CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); + *startp = (CODEADDR) & (pp->cs.p_code.ExpandCode); + *endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode), e); return pp; } -static PredEntry * -found_ystop(yamop *pc, int clause_code, void* *startp, void* *endp, PredEntry *pp USES_REGS) -{ +static PredEntry *found_ystop(yamop *pc, int clause_code, void **startp, + void **endp, PredEntry *pp USES_REGS) { if (pc == YESCODE) { - pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,CurrentModule)); + pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue, CurrentModule)); *startp = (CODEADDR)YESCODE; - *endp = (CODEADDR)YESCODE+(CELL)(NEXTOP((yamop *)NULL,e)); + *endp = (CODEADDR)YESCODE + (CELL)(NEXTOP((yamop *)NULL, e)); return pp; } if (!pp) { @@ -807,41 +794,40 @@ found_ystop(yamop *pc, int clause_code, void* *startp, void* *endp, PredEntry *p if (clause_code) { LogUpdClause *cl = ClauseCodeToLogUpdClause(pc->y_u.l.l); *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; } else { LogUpdIndex *cl = ClauseCodeToLogUpdIndex(pc->y_u.l.l); *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; } } else if (pp->PredFlags & DynamicPredFlag) { DynamicClause *cl = ClauseCodeToDynamicClause(pc->y_u.l.l); *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; } else { if (clause_code) { StaticClause *cl = ClauseCodeToStaticClause(pc->y_u.l.l); *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; } else { StaticIndex *cl = ClauseCodeToStaticIndex(pc->y_u.l.l); *startp = (CODEADDR)cl; - *endp = (CODEADDR)cl+cl->ClSize; + *endp = (CODEADDR)cl + cl->ClSize; } } return pp; } -static PredEntry * -ClauseInfoForCode(yamop *codeptr, void* *startp, void* *endp USES_REGS) { +static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp, + void **endp USES_REGS) { yamop *pc; PredEntry *pp = NULL; int clause_code = FALSE; - if (codeptr >= COMMA_CODE && - codeptr < FAILCODE) { - pp = RepPredProp(Yap_GetPredPropByFunc(FunctorComma,CurrentModule)); + if (codeptr >= COMMA_CODE && codeptr < FAILCODE) { + pp = RepPredProp(Yap_GetPredPropByFunc(FunctorComma, CurrentModule)); *startp = (CODEADDR)COMMA_CODE; - *endp = (CODEADDR)(FAILCODE-1); + *endp = (CODEADDR)(FAILCODE - 1); return pp; } pc = codeptr; @@ -849,8 +835,8 @@ ClauseInfoForCode(yamop *codeptr, void* *startp, void* *endp USES_REGS) { return NULL; } -PredEntry * -Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, void* *startp, void* *endp) { +PredEntry *Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, + void **startp, void **endp) { CACHE_REGS if (where_from == FIND_PRED_FROM_CP) { PredEntry *pp = PredForChoicePt(codeptr, NULL); @@ -868,35 +854,28 @@ Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, void* *startp, v return NULL; } - - - -/** +/** * Detect whether the predicate describing the goal in A1, - * module A2 is currently live in the stack. - * - * @param USES_REGS1 - * + * module A2 is currently live in the stack. + * + * @param USES_REGS1 + * * @return liveness */ -static Int -in_use( USES_REGS1 ) -{ /* '$in_use'(+P,+Mod) */ - PredEntry *pe; - Int out; +static Int in_use(USES_REGS1) { /* '$in_use'(+P,+Mod) */ + PredEntry *pe; + Int out; - pe = get_pred(Deref(ARG1), Deref(ARG2), "$in_use"); + pe = get_pred(Deref(ARG1), Deref(ARG2), "$in_use"); if (EndOfPAEntr(pe)) return FALSE; - PELOCK(25,pe); - out = Yap_static_in_use(pe,TRUE); - UNLOCKPE(42,pe); - return(out); + PELOCK(25, pe); + out = Yap_static_in_use(pe, TRUE); + UNLOCKPE(42, pe); + return (out); } - -static Int -pred_for_code( USES_REGS1 ) { +static Int pred_for_code(USES_REGS1) { yamop *codeptr; Atom at; arity_t arity; @@ -907,29 +886,27 @@ pred_for_code( USES_REGS1 ) { if (IsVarTerm(t)) { return FALSE; } else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorStaticClause) { - codeptr = Yap_ClauseFromTerm(t)->ClCode; + codeptr = Yap_ClauseFromTerm(t)->ClCode; } else if (IsIntegerTerm(t)) { - codeptr = (yamop *)IntegerOfTerm(t); + codeptr = (yamop *)IntegerOfTerm(t); } else if (IsDBRefTerm(t)) { - codeptr = (yamop *)DBRefOfTerm(t); + codeptr = (yamop *)DBRefOfTerm(t); } else { return FALSE; } cl = PredForCode(codeptr, &at, &arity, &tmodule, NULL); - if (!tmodule) tmodule = TermProlog; + if (!tmodule) + tmodule = TermProlog; if (cl == 0) { - return Yap_unify(ARG5,MkIntTerm(0)); + return Yap_unify(ARG5, MkIntTerm(0)); } else { - return(Yap_unify(ARG2,MkAtomTerm(at)) && - Yap_unify(ARG3,MkIntegerTerm(arity)) && - Yap_unify(ARG4,tmodule) && - Yap_unify(ARG5,MkIntegerTerm(cl))); + return (Yap_unify(ARG2, MkAtomTerm(at)) && + Yap_unify(ARG3, MkIntegerTerm(arity)) && Yap_unify(ARG4, tmodule) && + Yap_unify(ARG5, MkIntegerTerm(cl))); } } -static LogUpdIndex * -find_owner_log_index(LogUpdIndex *cl, yamop *code_p) -{ +static LogUpdIndex *find_owner_log_index(LogUpdIndex *cl, yamop *code_p) { yamop *code_beg = cl->ClCode; yamop *code_end = (yamop *)((char *)cl + cl->ClSize); @@ -947,9 +924,7 @@ find_owner_log_index(LogUpdIndex *cl, yamop *code_p) return NULL; } -static StaticIndex * -find_owner_static_index(StaticIndex *cl, yamop *code_p) -{ +static StaticIndex *find_owner_static_index(StaticIndex *cl, yamop *code_p) { yamop *code_beg = cl->ClCode; yamop *code_end = (yamop *)((char *)cl + cl->ClSize); @@ -967,52 +942,46 @@ find_owner_static_index(StaticIndex *cl, yamop *code_p) return NULL; } -ClauseUnion * -Yap_find_owner_index(yamop *ipc, PredEntry *ap) -{ +ClauseUnion *Yap_find_owner_index(yamop *ipc, PredEntry *ap) { /* we assume we have an owner index */ if (ap->PredFlags & LogUpdatePredFlag) { LogUpdIndex *cl = ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred); - return (ClauseUnion *)find_owner_log_index(cl,ipc); + return (ClauseUnion *)find_owner_log_index(cl, ipc); } else { StaticIndex *cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred); - return (ClauseUnion *)find_owner_static_index(cl,ipc); + return (ClauseUnion *)find_owner_static_index(cl, ipc); } } -static Term -all_envs(CELL *env_ptr USES_REGS) -{ +static Term all_envs(CELL *env_ptr USES_REGS) { Term tf = AbsPair(HR); CELL *start = HR; CELL *bp = NULL; - + /* walk the environment chain */ while (env_ptr) { bp = HR; HR += 2; /* notice that MkIntegerTerm may increase the HReap */ - bp[0] = MkIntegerTerm(LCL0-env_ptr); - if (HR >= ASP-1024) { + bp[0] = MkIntegerTerm(LCL0 - env_ptr); + if (HR >= ASP - 1024) { HR = start; - LOCAL_Error_Size = (ASP-1024)-HR; + LOCAL_Error_Size = (ASP - 1024) - HR; while (env_ptr) { - LOCAL_Error_Size += 2; - env_ptr = (CELL *)(env_ptr[E_E]); + LOCAL_Error_Size += 2; + env_ptr = (CELL *)(env_ptr[E_E]); } return 0L; } else { bp[1] = AbsPair(HR); } - env_ptr = (CELL *)(env_ptr[E_E]); + env_ptr = (CELL *)(env_ptr[E_E]); } bp[1] = TermNil; return tf; } -static Term -all_cps(choiceptr b_ptr USES_REGS) -{ +static Term all_cps(choiceptr b_ptr USES_REGS) { CELL *bp = NULL; CELL *start = HR; Term tf = AbsPair(HR); @@ -1021,13 +990,13 @@ all_cps(choiceptr b_ptr USES_REGS) bp = HR; HR += 2; /* notice that MkIntegerTerm may increase the HReap */ - bp[0] = MkIntegerTerm((Int)(LCL0-(CELL *)b_ptr)); - if (HR >= ASP-1024) { + bp[0] = MkIntegerTerm((Int)(LCL0 - (CELL *)b_ptr)); + if (HR >= ASP - 1024) { HR = start; - LOCAL_Error_Size = (ASP-1024)-HR; + LOCAL_Error_Size = (ASP - 1024) - HR; while (b_ptr) { - LOCAL_Error_Size += 2; - b_ptr = b_ptr->cp_b; + LOCAL_Error_Size += 2; + b_ptr = b_ptr->cp_b; } return 0L; } else { @@ -1039,37 +1008,30 @@ all_cps(choiceptr b_ptr USES_REGS) return tf; } - - -static Int -p_all_choicepoints( USES_REGS1 ) -{ +static Int p_all_choicepoints(USES_REGS1) { Term t; while ((t = all_cps(B PASS_REGS)) == 0L) { - if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P,CP))) { + if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "while dumping choicepoints"); return FALSE; } } - return Yap_unify(ARG1,t); + return Yap_unify(ARG1, t); } -static Int -p_all_envs( USES_REGS1 ) -{ +static Int p_all_envs(USES_REGS1) { Term t; while ((t = all_envs(ENV PASS_REGS)) == 0L) { - if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P,CP))) { + if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "while dumping environments"); return FALSE; } } - return Yap_unify(ARG1,t); + return Yap_unify(ARG1, t); } - Term -clause_info ( yamop *codeptr, PredEntry *pp) { - CACHE_REGS +Term clause_info(yamop *codeptr, PredEntry *pp) { + CACHE_REGS Term ts[2]; void *begin; @@ -1077,46 +1039,39 @@ clause_info ( yamop *codeptr, PredEntry *pp) { ts[0] = MkAtomTerm((Atom)pp->FunctorOfPred); ts[1] = MkIntTerm(0); } else { - ts[0] = MkAtomTerm(NameOfFunctor( pp->FunctorOfPred)); + ts[0] = MkAtomTerm(NameOfFunctor(pp->FunctorOfPred)); ts[1] = MkIntegerTerm(pp->ArityOfPE); } - + ts[0] = MkAtomTerm(pp->src.OwnerFile); - Term t1 = Yap_MkApplTerm( FunctorModule, 2, ts); - if (find_code_in_clause(pp, codeptr, &begin, NULL) <= 0 || - ((ts[0] = clause_loc(begin, pp) == TermNil ))) { + Term t1 = Yap_MkApplTerm(FunctorModule, 2, ts); + if (find_code_in_clause(pp, codeptr, &begin, NULL) <= 0 || + ((ts[0] = clause_loc(begin, pp) == TermNil))) { ts[0] = clause_loc(pp->cs.p_code.FirstClause, pp); ts[1] = clause_loc(pp->cs.p_code.LastClause, pp); - if (ts[0] == ts[1] && ts[1] != TermNil) - {} - else if (ts[1]== TermNil && ts[0] != TermNil) - ts[0] = Yap_MkApplTerm( FunctorMinus, 2, ts); + if (ts[0] == ts[1] && ts[1] != TermNil) { + } else if (ts[1] == TermNil && ts[0] != TermNil) + ts[0] = Yap_MkApplTerm(FunctorMinus, 2, ts); } ts[1] = t1; - return Yap_MkApplTerm( FunctorModule, 2, ts ); + return Yap_MkApplTerm(FunctorModule, 2, ts); } - - - - - - -static Term -error_culprit(bool internal USES_REGS) -{ +static Term error_culprit(bool internal USES_REGS) { PredEntry *pe; // case number 1: Yap_Error called from built-in. if (internal) { pe = EnvPreg(CP); - if (pe->PredFlags & HiddenPredFlag) return clause_info(P, pe); + if (pe->PredFlags & HiddenPredFlag) + return clause_info(P, pe); } else { - CELL * curENV = ENV; + CELL *curENV = ENV; yamop *curCP = CP; PredEntry *pe = EnvPreg(curCP); while (curCP != YESCODE) { - if (pe->ModuleOfPred) return clause_info(P, pe); + if (pe->ModuleOfPred) + return clause_info(P, pe); curENV = (CELL *)(curENV[E_E]); curCP = (yamop *)(curENV[E_CP]); pe = EnvPreg(curCP); @@ -1125,11 +1080,9 @@ error_culprit(bool internal USES_REGS) return TermNil; } -static Term -all_calls( bool internal USES_REGS ) -{ +static Term all_calls(bool internal USES_REGS) { Term ts[6]; - Functor f = Yap_MkFunctor(AtomLocalSp,6); + Functor f = Yap_MkFunctor(AtomLocalSp, 6); // The first argument is key: it tries to // catch the culprit at the user level, @@ -1140,50 +1093,41 @@ all_calls( bool internal USES_REGS ) if (trueLocalPrologFlag(STACK_DUMP_ON_ERROR_FLAG)) { ts[4] = all_envs(ENV PASS_REGS); ts[5] = all_cps(B PASS_REGS); - if (ts[4] == 0L || - ts[5] == 0L) + if (ts[4] == 0L || ts[5] == 0L) return 0L; } else { ts[4] = ts[5] = TermNil; } - return Yap_MkApplTerm(f,6,ts); + return Yap_MkApplTerm(f, 6, ts); } -/** +/** * report the current status of the stacks up to level $N$ - * - * @param depth - * - * @return data on the current program counter + * + * @param depth + * + * @return data on the current program counter */ -Term - Yap_all_calls( void ) -{ +Term Yap_all_calls(void) { CACHE_REGS - return all_calls( true PASS_REGS ); + return all_calls(true PASS_REGS); } - -static Int -current_stack( USES_REGS1 ) -{ +static Int current_stack(USES_REGS1) { Term t; - while ((t = all_calls( false PASS_REGS)) == 0L) { - if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P,CP))) { + while ((t = all_calls(false PASS_REGS)) == 0L) { + if (!Yap_gcl(LOCAL_Error_Size, 1, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "while dumping stack"); return FALSE; } } - return Yap_unify(ARG1,t); + return Yap_unify(ARG1, t); } - #if LOW_PROF -static void -add_code_in_lu_index(LogUpdIndex *cl, PredEntry *pp) -{ +static void add_code_in_lu_index(LogUpdIndex *cl, PredEntry *pp) { char *code_end = (char *)cl + cl->ClSize; Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_LU_INDEX); cl = cl->ChildIndex; @@ -1193,9 +1137,7 @@ add_code_in_lu_index(LogUpdIndex *cl, PredEntry *pp) } } -static void -add_code_in_static_index(StaticIndex *cl, PredEntry *pp) -{ +static void add_code_in_static_index(StaticIndex *cl, PredEntry *pp) { char *code_end = (char *)cl + cl->ClSize; Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_STATIC_INDEX); cl = cl->ChildIndex; @@ -1205,17 +1147,16 @@ add_code_in_static_index(StaticIndex *cl, PredEntry *pp) } } - -static void -add_code_in_pred(PredEntry *pp) { +static void add_code_in_pred(PredEntry *pp) { yamop *clcode; - PELOCK(49,pp); + PELOCK(49, pp); /* check if the codeptr comes from the indexing code */ /* highly likely this is used for indexing */ - Yap_inform_profiler_of_clause(&(pp->OpcodeOfPred), &(pp->OpcodeOfPred)+1, pp, GPROF_INIT_OPCODE); - if (pp->PredFlags & (CPredFlag|AsmPredFlag)) { + Yap_inform_profiler_of_clause(&(pp->OpcodeOfPred), &(pp->OpcodeOfPred) + 1, + pp, GPROF_INIT_OPCODE); + if (pp->PredFlags & (CPredFlag | AsmPredFlag)) { char *code_end; StaticClause *cl; @@ -1226,7 +1167,9 @@ add_code_in_pred(PredEntry *pp) { UNLOCK(pp->PELock); return; } - Yap_inform_profiler_of_clause(&(pp->cs.p_code.ExpandCode), &(pp->cs.p_code.ExpandCode)+1, pp, GPROF_INIT_EXPAND); + Yap_inform_profiler_of_clause(&(pp->cs.p_code.ExpandCode), + &(pp->cs.p_code.ExpandCode) + 1, pp, + GPROF_INIT_EXPAND); clcode = pp->cs.p_code.TrueCodeOfPred; if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & LogUpdatePredFlag) { @@ -1242,43 +1185,44 @@ add_code_in_pred(PredEntry *pp) { if (pp->PredFlags & LogUpdatePredFlag) { LogUpdClause *cl = ClauseCodeToLogUpdClause(clcode); do { - char *code_end; + char *code_end; - code_end = (char *)cl + cl->ClSize; - Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_INIT_LOG_UPD_CLAUSE); - cl = cl->ClNext; + code_end = (char *)cl + cl->ClSize; + Yap_inform_profiler_of_clause(cl, code_end, pp, + GPROF_INIT_LOG_UPD_CLAUSE); + cl = cl->ClNext; } while (cl != NULL); } else if (pp->PredFlags & DynamicPredFlag) { do { - DynamicClause *cl; - CODEADDR code_end; + DynamicClause *cl; + CODEADDR code_end; - cl = ClauseCodeToDynamicClause(clcode); - code_end = (CODEADDR)cl + cl->ClSize; - Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_INIT_DYNAMIC_CLAUSE); - if (clcode == pp->cs.p_code.LastClause) - break; - clcode = NextDynamicClause(clcode); + cl = ClauseCodeToDynamicClause(clcode); + code_end = (CODEADDR)cl + cl->ClSize; + Yap_inform_profiler_of_clause(cl, code_end, pp, + GPROF_INIT_DYNAMIC_CLAUSE); + if (clcode == pp->cs.p_code.LastClause) + break; + clcode = NextDynamicClause(clcode); } while (TRUE); } else { StaticClause *cl = ClauseCodeToStaticClause(clcode); do { - char *code_end; + char *code_end; - code_end = (char *)cl + cl->ClSize; - Yap_inform_profiler_of_clause(cl, code_end, pp,GPROF_INIT_STATIC_CLAUSE); - if (cl->ClCode == pp->cs.p_code.LastClause) - break; - cl = cl->ClNext; + code_end = (char *)cl + cl->ClSize; + Yap_inform_profiler_of_clause(cl, code_end, pp, + GPROF_INIT_STATIC_CLAUSE); + if (cl->ClCode == pp->cs.p_code.LastClause) + break; + cl = cl->ClNext; } while (TRUE); } } UNLOCK(pp->PELock); } - -void -Yap_dump_code_area_for_profiler(void) { +void Yap_dump_code_area_for_profiler(void) { ModEntry *me = CurrentModules; while (me) { @@ -1286,55 +1230,54 @@ Yap_dump_code_area_for_profiler(void) { while (pp != NULL) { /* if (pp->ArityOfPE) { - fprintf(stderr,"%s/%d %p\n", - RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE, - pp->ArityOfPE, - pp); + fprintf(stderr,"%s/%d %p\n", + RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE, + pp->ArityOfPE, + pp); } else { - fprintf(stderr,"%s %p\n", - RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE, - pp); - }*/ + fprintf(stderr,"%s %p\n", + RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE, + pp); + }*/ add_code_in_pred(pp); pp = pp->NextPredOfModule; } me = me->NextME; } - Yap_inform_profiler_of_clause(COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma,0)), GPROF_INIT_COMMA); - Yap_inform_profiler_of_clause(FAILCODE, FAILCODE+1, RepPredProp(Yap_GetPredPropByAtom(AtomFail,0)), GPROF_INIT_FAIL); + Yap_inform_profiler_of_clause( + COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)), + GPROF_INIT_COMMA); + Yap_inform_profiler_of_clause(FAILCODE, FAILCODE + 1, + RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)), + GPROF_INIT_FAIL); } #endif /* LOW_PROF */ - -static Int -program_continuation( USES_REGS1 ) -{ +static Int program_continuation(USES_REGS1) { PredEntry *pe = EnvPreg((yamop *)((ENV_Parent(ENV))[E_CP])); if (pe->ModuleOfPred) { - if (!Yap_unify(ARG1,pe->ModuleOfPred)) + if (!Yap_unify(ARG1, pe->ModuleOfPred)) return FALSE; } else { - if (!Yap_unify(ARG1,TermProlog)) + if (!Yap_unify(ARG1, TermProlog)) return FALSE; } if (pe->ArityOfPE) { - if (!Yap_unify(ARG2,MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)))) + if (!Yap_unify(ARG2, MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)))) return FALSE; - if (!Yap_unify(ARG3,MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred)))) + if (!Yap_unify(ARG3, MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred)))) return FALSE; } else { - if (!Yap_unify(ARG2,MkAtomTerm((Atom)pe->FunctorOfPred))) + if (!Yap_unify(ARG2, MkAtomTerm((Atom)pe->FunctorOfPred))) return FALSE; - if (!Yap_unify(ARG3,MkIntTerm(0))) + if (!Yap_unify(ARG3, MkIntTerm(0))) return FALSE; } return TRUE; } -static Term -BuildActivePred(PredEntry *ap, CELL *vect) -{ +static Term BuildActivePred(PredEntry *ap, CELL *vect) { CACHE_REGS arity_t i; @@ -1347,16 +1290,15 @@ BuildActivePred(PredEntry *ap, CELL *vect) CELL *pt = VarOfTerm(t); /* one stack */ if (pt > HR) { - Term nt = MkVarTerm(); - Yap_unify(t, nt); + Term nt = MkVarTerm(); + Yap_unify(t, nt); } } } return Yap_MkApplTerm(ap->FunctorOfPred, ap->ArityOfPE, vect); } -static int -UnifyPredInfo(PredEntry *pe, int start_arg USES_REGS) { +static int UnifyPredInfo(PredEntry *pe, int start_arg USES_REGS) { arity_t arity = pe->ArityOfPE; Term tmod, tname; @@ -1385,53 +1327,43 @@ UnifyPredInfo(PredEntry *pe, int start_arg USES_REGS) { } return Yap_unify(XREGS[start_arg], tmod) && - Yap_unify(XREGS[start_arg+1],tname) && - Yap_unify(XREGS[start_arg+2],MkIntegerTerm(arity)); + Yap_unify(XREGS[start_arg + 1], tname) && + Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity)); } - -static Int -ClauseId(yamop *ipc, PredEntry *pe) -{ +static Int ClauseId(yamop *ipc, PredEntry *pe) { if (!ipc) return 0; return find_code_in_clause(pe, ipc, NULL, NULL); } -static Int -env_info( USES_REGS1 ) -{ - CELL *env = LCL0-IntegerOfTerm(Deref(ARG1)); +static Int env_info(USES_REGS1) { + CELL *env = LCL0 - IntegerOfTerm(Deref(ARG1)); yamop *env_cp; Term env_b, taddr; if (!env) return FALSE; - env_b = MkIntegerTerm((Int)(LCL0-(CELL *)env[E_CB])); + env_b = MkIntegerTerm((Int)(LCL0 - (CELL *)env[E_CB])); env_cp = (yamop *)env[E_CP]; /* pe = PREVOP(env_cp,Osbpp)->y_u.Osbpp.p0; */ taddr = MkIntegerTerm((Int)env); - return Yap_unify(ARG3,MkIntegerTerm((Int)env_cp)) && - Yap_unify(ARG2, taddr) && - Yap_unify(ARG4, env_b); + return Yap_unify(ARG3, MkIntegerTerm((Int)env_cp)) && + Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b); } -static Int -p_cpc_info( USES_REGS1 ) -{ +static Int p_cpc_info(USES_REGS1) { PredEntry *pe; yamop *ipc = (yamop *)IntegerOfTerm(Deref(ARG1)); - pe = PREVOP(ipc,Osbpp)->y_u.Osbpp.p0; + pe = PREVOP(ipc, Osbpp)->y_u.Osbpp.p0; return UnifyPredInfo(pe, 2 PASS_REGS) && - Yap_unify(ARG5,MkIntegerTerm(ClauseId(ipc,pe))); + Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe))); } -static Int -p_choicepoint_info( USES_REGS1 ) -{ - choiceptr cptr = (choiceptr)(LCL0-IntegerOfTerm(Deref(ARG1))); +static Int p_choicepoint_info(USES_REGS1) { + choiceptr cptr = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1))); PredEntry *pe = NULL; int go_on = TRUE; yamop *ipc = cptr->cp_ap; @@ -1464,13 +1396,13 @@ p_choicepoint_info( USES_REGS1 ) #ifdef LOW_LEVEL_TRACER #ifdef DETERMINISTIC_TABLING if (IS_DET_GEN_CP(cptr)) { - pe = DET_GEN_CP(cptr)->cp_pred_entry; - t = MkVarTerm(); + pe = DET_GEN_CP(cptr)->cp_pred_entry; + t = MkVarTerm(); } else #endif /* DETERMINISTIC_TABLING */ { - pe = GEN_CP(cptr)->cp_pred_entry; - t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1)); + pe = GEN_CP(cptr)->cp_pred_entry; + t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1)); } #else pe = UndefCode; @@ -1550,9 +1482,9 @@ p_choicepoint_info( USES_REGS1 ) case _retry4: pe = NULL; t = TermNil; - ipc = NEXTOP(ipc,l); + ipc = NEXTOP(ipc, l); if (!ncl) - ncl = ipc->y_u.Otapl.d; + ncl = ipc->y_u.Otapl.d; go_on = TRUE; break; case _jump: @@ -1563,7 +1495,7 @@ p_choicepoint_info( USES_REGS1 ) break; case _retry_c: case _retry_userc: - ncl = NEXTOP(ipc,OtapFs); + ncl = NEXTOP(ipc, OtapFs); pe = ipc->y_u.OtapFs.p; t = BuildActivePred(pe, cptr->cp_args); break; @@ -1572,7 +1504,7 @@ p_choicepoint_info( USES_REGS1 ) pe = NULL; t = TermNil; ncl = ipc->y_u.Otapl.d; - ipc = NEXTOP(ipc,p); + ipc = NEXTOP(ipc, p); go_on = TRUE; break; case _retry_me: @@ -1586,7 +1518,7 @@ p_choicepoint_info( USES_REGS1 ) case _retry: case _trust: if (!ncl) - ncl = ipc->y_u.Otapl.d; + ncl = ipc->y_u.Otapl.d; pe = ipc->y_u.Otapl.p; t = BuildActivePred(pe, cptr->cp_args); break; @@ -1596,27 +1528,23 @@ p_choicepoint_info( USES_REGS1 ) pe = ipc->y_u.lp.p; t = BuildActivePred(pe, cptr->cp_args); break; - case _Nstop: - { - Atom at = AtomLive; - t = MkAtomTerm(at); - pe = RepPredProp(PredPropByAtom(at, CurrentModule)); - } - break; + case _Nstop: { + Atom at = AtomLive; + t = MkAtomTerm(at); + pe = RepPredProp(PredPropByAtom(at, CurrentModule)); + } break; case _Ystop: default: return FALSE; } } - return UnifyPredInfo(pe, 3 PASS_REGS) && - Yap_unify(ARG2, taddr) && - Yap_unify(ARG6,t) && - Yap_unify(ARG7,MkIntegerTerm(ClauseId(ncl,pe))); + return UnifyPredInfo(pe, 3 PASS_REGS) && Yap_unify(ARG2, taddr) && + Yap_unify(ARG6, t) && + Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe))); } -static Int /* $parent_pred(Module, Name, Arity) */ -parent_pred( USES_REGS1 ) -{ +static Int /* $parent_pred(Module, Name, Arity) */ + parent_pred(USES_REGS1) { /* This predicate is called from the debugger. We assume a sequence of the form a -> b */ Atom at; @@ -1624,50 +1552,46 @@ parent_pred( USES_REGS1 ) Term module; if (!PredForCode(P_before_spy, &at, &arity, &module, NULL)) { return Yap_unify(ARG1, MkIntTerm(0)) && - Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && - Yap_unify(ARG3, MkIntTerm(0)); - } + Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && + Yap_unify(ARG3, MkIntTerm(0)); + } return Yap_unify(ARG1, MkIntTerm(module)) && - Yap_unify(ARG2, MkAtomTerm(at)) && - Yap_unify(ARG3, MkIntTerm(arity)); + Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity)); } -void Yap_dump_stack( void ); -void DumpActiveGoals( CACHE_TYPE1 ); +void Yap_dump_stack(void); +void DumpActiveGoals(CACHE_TYPE1); static int hidden(Atom); -static int legal_env(CELL * CACHE_TYPE); +static int legal_env(CELL *CACHE_TYPE); -#define ONLOCAL(ptr) (CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase)) +#define ONLOCAL(ptr) \ + (CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase)) -static int -hidden (Atom at) -{ +static int hidden(Atom at) { AtomEntry *chain; READ_LOCK(INVISIBLECHAIN.AERWLock); chain = RepAtom(INVISIBLECHAIN.Entry); - while (!EndOfPAEntr (chain) && AbsAtom (chain) != at) + while (!EndOfPAEntr(chain) && AbsAtom(chain) != at) chain = RepAtom(chain->NextOfAE); READ_UNLOCK(INVISIBLECHAIN.AERWLock); - if (EndOfPAEntr (chain)) + if (EndOfPAEntr(chain)) return (FALSE); return (TRUE); } -static int -legal_env (CELL *ep USES_REGS) -{ +static int legal_env(CELL *ep USES_REGS) { CELL cp, ps; PredEntry *pe; - if (!ONLOCAL (ep) || Unsigned (ep) & 3) + if (!ONLOCAL(ep) || Unsigned(ep) & 3) return (FALSE); cp = ep[E_CP]; - if (!ONHEAP (cp)) + if (!ONHEAP(cp)) return (FALSE); - ps = *((CELL *) (Addr (cp) - CellSize)); - pe = (PredEntry *) (ps - sizeof (OPREG) - sizeof (Prop)); - PELOCK(70,pe); - if (!ONHEAP (pe) || Unsigned (pe) & 3 || pe->KindOfPE & 0xff00) { + ps = *((CELL *)(Addr(cp) - CellSize)); + pe = (PredEntry *)(ps - sizeof(OPREG) - sizeof(Prop)); + PELOCK(70, pe); + if (!ONHEAP(pe) || Unsigned(pe) & 3 || pe->KindOfPE & 0xff00) { UNLOCK(pe->PELock); return (FALSE); } @@ -1675,35 +1599,29 @@ legal_env (CELL *ep USES_REGS) return (TRUE); } -static bool -handled_exception( USES_REGS1 ) -{ - yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,l); - bool found_handler = false; - choiceptr gc_b; +static bool handled_exception(USES_REGS1) { + yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred, l); + bool found_handler = false; + choiceptr gc_b; - gc_b = B; - while (gc_b) { - yamop *ap = gc_b->cp_ap; - if (ap == NOCODE) { - /* C-code: let they deal with that */ - return false; - } else if (ap == pos) { - if (found_handler) - return TRUE; /* we have two handlers */ - found_handler = true; - } - gc_b = gc_b->cp_b; - } - /* handled by Top c-code? */ - return !found_handler; + gc_b = B; + while (gc_b) { + yamop *ap = gc_b->cp_ap; + if (ap == NOCODE) { + /* C-code: let they deal with that */ + return false; + } else if (ap == pos) { + if (found_handler) + return TRUE; /* we have two handlers */ + found_handler = true; + } + gc_b = gc_b->cp_b; + } + /* handled by Top c-code? */ + return !found_handler; } - - -void -Yap_dump_stack( void ) -{ +void Yap_dump_stack(void) { CACHE_REGS choiceptr b_ptr = B; CELL *env_ptr = ENV; @@ -1712,67 +1630,77 @@ Yap_dump_stack( void ) int max_count = 200; /* check if handled */ - if (handled_exception( PASS_REGS1 )) + if (handled_exception(PASS_REGS1)) return; #if DEBUG - fprintf(stderr,"%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",P,CP,ASP,HR,TR,HeapTop); - fprintf(stderr,"%% YAP mode: %ux\n",(unsigned int)LOCAL_PrologMode); + fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n", + P, CP, ASP, HR, TR, HeapTop); + fprintf(stderr, "%% YAP mode: %ux\n", (unsigned int)LOCAL_PrologMode); if (LOCAL_ErrorMessage) - fprintf(stderr,"%% LOCAL_ErrorMessage: %s\n",LOCAL_ErrorMessage); + fprintf(stderr, "%% LOCAL_ErrorMessage: %s\n", LOCAL_ErrorMessage); #endif if (HR > ASP || HR > LCL0) { - fprintf(stderr,"%% YAP ERROR: Global Collided against Local (%p--%p)\n",HR,ASP); - } else if (HeapTop > (ADDR)LOCAL_GlobalBase) { - fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", HeapTop, LOCAL_GlobalBase); + fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n", + HR, ASP); + } else if (HeapTop > (ADDR)LOCAL_GlobalBase) { + fprintf(stderr, + "%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", + HeapTop, LOCAL_GlobalBase); } else { #if !USE_SYSTEM_MALLOC - fprintf (stderr,"%ldKB of Code Space (%p--%p)\n",(long int)((CELL)HeapTop-(CELL)Yap_HeapBase)/1024,Yap_HeapBase,HeapTop); + fprintf(stderr, "%ldKB of Code Space (%p--%p)\n", + (long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase, + HeapTop); #if USE_DL_MALLOC if (Yap_NOfMemoryHoles) { UInt i; - for (i=0; i < Yap_NOfMemoryHoles; i++) - fprintf(stderr," Current hole: %p--%p\n", - Yap_MemoryHoles[i].start, + for (i = 0; i < Yap_NOfMemoryHoles; i++) + fprintf(stderr, " Current hole: %p--%p\n", Yap_MemoryHoles[i].start, Yap_MemoryHoles[i].end); } #endif #endif Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256); - fprintf (stderr,"%%\n%% PC: %s\n",(char *)HR); + fprintf(stderr, "%%\n%% PC: %s\n", (char *)HR); Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256); - fprintf (stderr,"%% Continuation: %s\n",(char *)HR); - fprintf (stderr,"%% %luKB of Global Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(HR-H0))/1024,H0,HR); - fprintf (stderr,"%% %luKB of Local Stack (%p--%p)\n",(unsigned long int)(sizeof(CELL)*(LCL0-ASP))/1024,ASP,LCL0); - fprintf (stderr,"%% %luKB of Trail (%p--%p)\n",(unsigned long int)((ADDR)TR-LOCAL_TrailBase)/1024,LOCAL_TrailBase,TR); - fprintf (stderr,"%% Performed %ld garbage collections\n", (unsigned long int)LOCAL_GcCalls); + fprintf(stderr, "%% Continuation: %s\n", (char *)HR); + fprintf(stderr, "%% %luKB of Global Stack (%p--%p)\n", + (unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR); + fprintf(stderr, "%% %luKB of Local Stack (%p--%p)\n", + (unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0); + fprintf(stderr, "%% %luKB of Trail (%p--%p)\n", + (unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024, + LOCAL_TrailBase, TR); + fprintf(stderr, "%% Performed %ld garbage collections\n", + (unsigned long int)LOCAL_GcCalls); #if LOW_LEVEL_TRACER { extern long long vsc_count; if (vsc_count) { #if _WIN32 - fprintf(stderr,"Trace Counter at %I64d\n",vsc_count); + fprintf(stderr, "Trace Counter at %I64d\n", vsc_count); #else - fprintf(stderr,"Trace Counter at %lld\n",vsc_count); + fprintf(stderr, "Trace Counter at %lld\n", vsc_count); #endif } } #endif - fprintf (stderr,"%% All Active Calls and\n"); - fprintf (stderr,"%% Goals With Alternatives Open (Global In Use--Local In Use)\n%%\n"); + fprintf(stderr, "%% All Active Calls and\n"); + fprintf(stderr, "%% Goals With Alternatives Open (Global In " + "Use--Local In Use)\n%%\n"); while (b_ptr != NULL) { while (env_ptr && env_ptr <= (CELL *)b_ptr) { Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, tp, 256); - if (env_ptr == (CELL *)b_ptr && - (choiceptr)env_ptr[E_CB] > b_ptr) { + if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) { b_ptr = b_ptr->cp_b; - fprintf(stderr,"%% %s\n", tp); + fprintf(stderr, "%% %s\n", tp); } else { - fprintf(stderr,"%% %s\n", tp); + fprintf(stderr, "%% %s\n", tp); } if (!max_count--) { - fprintf(stderr,"%% .....\n"); + fprintf(stderr, "%% .....\n"); return; } ipc = (yamop *)(env_ptr[E_CP]); @@ -1780,7 +1708,7 @@ Yap_dump_stack( void ) } if (b_ptr) { if (!max_count--) { - fprintf(stderr,"%% .....\n"); + fprintf(stderr, "%% .....\n"); return; } if (b_ptr->cp_ap && /* tabling */ @@ -1789,9 +1717,9 @@ Yap_dump_stack( void ) b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) { /* we can safely ignore ; because there is always an upper env */ Yap_detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, tp, 256); - fprintf(stderr,"%% %s (%luKB--%luKB)\n", tp, - (unsigned long int)((b_ptr->cp_h-H0)*sizeof(CELL)/1024), - (unsigned long int)((ADDR)LCL0-(ADDR)b_ptr)/1024); + fprintf(stderr, "%% %s (%luKB--%luKB)\n", tp, + (unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024), + (unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024); } b_ptr = b_ptr->cp_b; } @@ -1799,331 +1727,313 @@ Yap_dump_stack( void ) } } -void -DumpActiveGoals ( USES_REGS1 ) -{ +void DumpActiveGoals(USES_REGS1) { /* try to dump active goals */ - CELL *ep = YENV; /* and current environment */ + CELL *ep = YENV; /* and current environment */ choiceptr b_ptr = B; CELL cp; PredEntry *pe; int first = 1; - if (legal_env (YENV PASS_REGS) && YENV < ENV) + if (legal_env(YENV PASS_REGS) && YENV < ENV) ep = YENV; - else if (legal_env (ENV PASS_REGS)) + else if (legal_env(ENV PASS_REGS)) ep = ENV; - while (TRUE) - { - if (!ONLOCAL (ep) || (Unsigned (ep) & (sizeof(CELL)-1))) - break; - cp = ep[E_CP]; - if (!ONHEAP (cp) || (Unsigned (cp) & (sizeof(CELL)-1))) - break; - pe = EnvPreg((yamop *)cp); - if (!ONHEAP (pe) || Unsigned (pe) & (sizeof(CELL)-1)) - break; - PELOCK(71,pe); - if (pe->KindOfPE & 0xff00) { - UNLOCK(pe->PELock); - break; - } - if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag)) - { - Functor f; - - UNLOCK(pe->PELock); - f = pe->FunctorOfPred; - if (pe->KindOfPE && hidden (NameOfFunctor (f))) - goto next; - if (first++ == 1) - fprintf(stderr,"Active ancestors:\n"); - Yap_DebugWriteIndicator(pe); - Yap_DebugPutc (stderr,'\n'); - } else { - UNLOCK(pe->PELock); - } - next: - ep = (CELL *) ep[E_E]; + while (TRUE) { + if (!ONLOCAL(ep) || (Unsigned(ep) & (sizeof(CELL) - 1))) + break; + cp = ep[E_CP]; + if (!ONHEAP(cp) || (Unsigned(cp) & (sizeof(CELL) - 1))) + break; + pe = EnvPreg((yamop *)cp); + if (!ONHEAP(pe) || Unsigned(pe) & (sizeof(CELL) - 1)) + break; + PELOCK(71, pe); + if (pe->KindOfPE & 0xff00) { + UNLOCK(pe->PELock); + break; } + if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag)) { + Functor f; + + UNLOCK(pe->PELock); + f = pe->FunctorOfPred; + if (pe->KindOfPE && hidden(NameOfFunctor(f))) + goto next; + if (first++ == 1) + fprintf(stderr, "Active ancestors:\n"); + Yap_DebugWriteIndicator(pe); + Yap_DebugPutc(stderr, '\n'); + } else { + UNLOCK(pe->PELock); + } + next: + ep = (CELL *)ep[E_E]; + } first = 1; - fprintf(stderr,"Active Choice-Points:\n"); - while (TRUE) - { - PredEntry *pe; - op_numbers opnum; - if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL) - break; - fprintf(stderr,"%p ", b_ptr); - pe = Yap_PredForChoicePt(b_ptr, &opnum); - if (opnum == _Nstop) { - fprintf(stderr, " ********** C-Code Interface Boundary ***********\n"); - } else { - Functor f; - Term mod = PROLOG_MODULE; + fprintf(stderr, "Active Choice-Points:\n"); + while (TRUE) { + PredEntry *pe; + op_numbers opnum; + if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL) + break; + fprintf(stderr, "%p ", b_ptr); + pe = Yap_PredForChoicePt(b_ptr, &opnum); + if (opnum == _Nstop) { + fprintf(stderr, " ********** C-Code Interface Boundary ***********\n"); + } else { + Functor f; + Term mod = PROLOG_MODULE; - f = pe->FunctorOfPred; - if (pe->ModuleOfPred) - mod = pe->ModuleOfPred; - else mod = TermProlog; - if (mod != TermProlog && - mod != MkAtomTerm(AtomUser) ) { - Yap_DebugPlWrite (mod); - Yap_DebugPutc (stderr,':'); - } - if (mod == IDB_MODULE) { - if (pe->PredFlags & NumberDBPredFlag) { - Int id = pe->src.IndxId; - Yap_DebugPlWrite(MkIntegerTerm(id)); - } else if (pe->PredFlags & AtomDBPredFlag) { - Atom At = (Atom)pe->FunctorOfPred; - Yap_DebugPlWrite(MkAtomTerm(At)); - } else { - Functor f = pe->FunctorOfPred; - Atom At = NameOfFunctor(f); - arity_t arity = ArityOfFunctor(f); - int i; - - Yap_DebugPlWrite(MkAtomTerm(At)); - Yap_DebugPutc (stderr,'('); - for (i= 0; i < arity; i++) { - if (i > 0) Yap_DebugPutc (stderr,','); - Yap_DebugPutc (stderr,'_'); - } - Yap_DebugPutc (stderr,')'); - } - Yap_DebugPutc (stderr,'('); - Yap_DebugPlWrite(b_ptr->cp_a2); - Yap_DebugPutc (stderr,')'); - } else if (pe->ArityOfPE == 0) { - Yap_DebugPlWrite (MkAtomTerm ((Atom)f)); - } else { - Int i = 0, arity = pe->ArityOfPE; - if (opnum == _or_last|| - opnum == _or_else) { - Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f))); - Yap_DebugPutc (stderr,'('); - for (i= 0; i < arity; i++) { - if (i > 0) Yap_DebugPutc (stderr,','); - Yap_DebugPutc(stderr, '_'); - } - Yap_DebugErrorPuts (") :- ... ( _ ; _ "); - } else { - Term *args = &(b_ptr->cp_a1); - Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f))); - Yap_DebugPutc (stderr,'('); - for (i= 0; i < arity; i++) { - if (i > 0) Yap_DebugPutc (stderr,','); - Yap_DebugPlWrite(args[i]); - } - } - Yap_DebugPutc (stderr,')'); - } - Yap_DebugPutc (stderr,'\n'); + f = pe->FunctorOfPred; + if (pe->ModuleOfPred) + mod = pe->ModuleOfPred; + else + mod = TermProlog; + if (mod != TermProlog && mod != MkAtomTerm(AtomUser)) { + Yap_DebugPlWrite(mod); + Yap_DebugPutc(stderr, ':'); } - b_ptr = b_ptr->cp_b; + if (mod == IDB_MODULE) { + if (pe->PredFlags & NumberDBPredFlag) { + Int id = pe->src.IndxId; + Yap_DebugPlWrite(MkIntegerTerm(id)); + } else if (pe->PredFlags & AtomDBPredFlag) { + Atom At = (Atom)pe->FunctorOfPred; + Yap_DebugPlWrite(MkAtomTerm(At)); + } else { + Functor f = pe->FunctorOfPred; + Atom At = NameOfFunctor(f); + arity_t arity = ArityOfFunctor(f); + int i; + + Yap_DebugPlWrite(MkAtomTerm(At)); + Yap_DebugPutc(stderr, '('); + for (i = 0; i < arity; i++) { + if (i > 0) + Yap_DebugPutc(stderr, ','); + Yap_DebugPutc(stderr, '_'); + } + Yap_DebugPutc(stderr, ')'); + } + Yap_DebugPutc(stderr, '('); + Yap_DebugPlWrite(b_ptr->cp_a2); + Yap_DebugPutc(stderr, ')'); + } else if (pe->ArityOfPE == 0) { + Yap_DebugPlWrite(MkAtomTerm((Atom)f)); + } else { + Int i = 0, arity = pe->ArityOfPE; + if (opnum == _or_last || opnum == _or_else) { + Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor(f))); + Yap_DebugPutc(stderr, '('); + for (i = 0; i < arity; i++) { + if (i > 0) + Yap_DebugPutc(stderr, ','); + Yap_DebugPutc(stderr, '_'); + } + Yap_DebugErrorPuts(") :- ... ( _ ; _ "); + } else { + Term *args = &(b_ptr->cp_a1); + Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor(f))); + Yap_DebugPutc(stderr, '('); + for (i = 0; i < arity; i++) { + if (i > 0) + Yap_DebugPutc(stderr, ','); + Yap_DebugPlWrite(args[i]); + } + } + Yap_DebugPutc(stderr, ')'); + } + Yap_DebugPutc(stderr, '\n'); } + b_ptr = b_ptr->cp_b; + } } - -void -Yap_detect_bug_location(yamop *yap_pc, int where_from, char *tp, int psize) -{ - Atom pred_name; +void Yap_detect_bug_location(yamop *yap_pc, int where_from, char *tp, + int psize) { + Atom pred_name; UInt pred_arity; Term pred_module; Int cl; tp[0] = '\0'; - if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity, &pred_module)) - == 0) { - /* system predicate */ -#if HAVE_SNPRINTF - snprintf(tp, psize, "%s", - "meta-call"); + if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity, + &pred_module)) == 0) { +/* system predicate */ +#if HAVE_SNPRINTF + snprintf(tp, psize, "%s", "meta-call"); #else - sprintf(tp, "%s", - "meta-call"); + sprintf(tp, "%s", "meta-call"); #endif } else if (pred_module == 0) { - /* don't give info on system predicates */ -#if HAVE_SNPRINTF - snprintf(tp, psize, "prolog:%s/%lu", - RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity); +/* don't give info on system predicates */ +#if HAVE_SNPRINTF + snprintf(tp, psize, "prolog:%s/%lu", RepAtom(pred_name)->StrOfAE, + (unsigned long int)pred_arity); #else - sprintf(tp, "in prolog:%s/%lu", - RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity); + sprintf(tp, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE, + (unsigned long int)pred_arity); #endif } else if (cl < 0) { -#if HAVE_SNPRINTF - snprintf(tp, psize, "%s:%s/%lu", - RepAtom(AtomOfTerm(pred_module))->StrOfAE, +#if HAVE_SNPRINTF + snprintf(tp, psize, "%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE, RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity); #else - sprintf(tp, "%s:%s/%lu", - RepAtom(AtomOfTerm(pred_module))->StrOfAE, + sprintf(tp, "%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE, RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity); #endif } else { -#if HAVE_SNPRINTF +#if HAVE_SNPRINTF snprintf(tp, psize, "%s:%s/%lu at clause %lu ", RepAtom(AtomOfTerm(pred_module))->StrOfAE, - RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, (unsigned long int)cl); + RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, + (unsigned long int)cl); #else sprintf(tp, "%s:%s/%lu at clause %lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE, - RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, (unsigned long int)cl); + RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, + (unsigned long int)cl); #endif } } -static Term -build_bug_location( yamop *codeptr, PredEntry *pe) -{ +static Term build_bug_location(yamop *codeptr, PredEntry *pe) { CACHE_REGS Term p[5]; if (pe->ModuleOfPred == PROLOG_MODULE) - p[0] = TermProlog; - else - p[0] = pe->ModuleOfPred; - if (pe->ArityOfPE) - p[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)); - else - p[1] = MkAtomTerm((Atom)pe->FunctorOfPred); - p[2] = MkIntegerTerm( pe->ArityOfPE ); - if (pe->src.OwnerFile) { - p[3] = MkAtomTerm(pe->src.OwnerFile); - if (pe->PredFlags & MegaClausePredFlag) { - MegaClause *mcl; - mcl = - ClauseCodeToMegaClause(pe->cs.p_code.FirstClause); - p[4] = MkIntegerTerm( mcl->ClLine ); - } else { - void *clcode; - if ( find_code_in_clause( pe, codeptr, &clcode, NULL) > 0 ) { - if (pe->PredFlags & LogUpdatePredFlag) { - LogUpdClause *cl = clcode; - - if (cl->ClFlags & FactMask) { - p[4] = MkIntegerTerm(cl->lusl.ClLine); - } else { - p[4] = MkIntegerTerm(cl->lusl.ClSource->ag.line_number); - } - } else if (pe->PredFlags & DynamicPredFlag) { - - p[4] = MkIntTerm(0); - } else { - StaticClause *cl; - cl = clcode; - - if (cl->ClFlags & FactMask) { - p[4] = MkIntTerm(cl->usc.ClLine); - } else if (cl->ClFlags & SrcMask) { - p[4] = MkIntTerm(cl->usc.ClSource->ag.line_number); - } else - p[4] = MkIntTerm(0); - } - } - } - } else if (pe->OpcodeOfPred == UNDEF_OPCODE) { - RESET_VARIABLE(p+3); - RESET_VARIABLE(p+4); - } else { - // by default, user_input - p[3] = MkAtomTerm(AtomUserIn); - p[4] = MkIntTerm(0); + p[0] = TermProlog; + else + p[0] = pe->ModuleOfPred; + if (pe->ArityOfPE) + p[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred)); + else + p[1] = MkAtomTerm((Atom)pe->FunctorOfPred); + p[2] = MkIntegerTerm(pe->ArityOfPE); + if (pe->src.OwnerFile) { + p[3] = MkAtomTerm(pe->src.OwnerFile); + if (pe->PredFlags & MegaClausePredFlag) { + MegaClause *mcl; + mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause); + p[4] = MkIntegerTerm(mcl->ClLine); + } else { + void *clcode; + if (find_code_in_clause(pe, codeptr, &clcode, NULL) > 0) { + if (pe->PredFlags & LogUpdatePredFlag) { + LogUpdClause *cl = clcode; + + if (cl->ClFlags & FactMask) { + p[4] = MkIntegerTerm(cl->lusl.ClLine); + } else { + p[4] = MkIntegerTerm(cl->lusl.ClSource->ag.line_number); + } + } else if (pe->PredFlags & DynamicPredFlag) { + + p[4] = MkIntTerm(0); + } else { + StaticClause *cl; + cl = clcode; + + if (cl->ClFlags & FactMask) { + p[4] = MkIntTerm(cl->usc.ClLine); + } else if (cl->ClFlags & SrcMask) { + p[4] = MkIntTerm(cl->usc.ClSource->ag.line_number); + } else + p[4] = MkIntTerm(0); + } } - return Yap_MkApplTerm( Yap_MkFunctor(Yap_LookupAtom("p"), 5), 5, p); + } + } else if (pe->OpcodeOfPred == UNDEF_OPCODE) { + RESET_VARIABLE(p + 3); + RESET_VARIABLE(p + 4); + } else { + // by default, user_input + p[3] = MkAtomTerm(AtomUserIn); + p[4] = MkIntTerm(0); + } + return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("p"), 5), 5, p); } - -Term -Yap_pc_location(yamop *pc, choiceptr b_ptr, CELL *env) -{ +Term Yap_pc_location(yamop *pc, choiceptr b_ptr, CELL *env) { CACHE_REGS yamop *codeptr = pc; PredEntry *pe; if (PP == NULL) { - if(PredForCode(pc, NULL, NULL, NULL, &pe) < 0) + if (PredForCode(pc, NULL, NULL, NULL, &pe) <= 0) return TermNil; } else pe = PP; if (pe != NULL - //pe->ModuleOfPred != PROLOG_MODULE && + // pe->ModuleOfPred != PROLOG_MODULE && // &&!(pe->PredFlags & HiddenPredFlag) ) { - return build_bug_location( codeptr, pe ); + return build_bug_location(codeptr, pe); } return TermNil; } - -Term -Yap_env_location( yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) -{ - while ( true ) { +Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) { + CACHE_REGS + while (true) { if (b_ptr == NULL || env == NULL) return TermNil; - PredEntry *pe= EnvPreg(cp); - if (ignore_first <= 0 && pe - //pe->ModuleOfPred != PROLOG_MODULE &&s - && !(pe->PredFlags & HiddenPredFlag) - ) { - return build_bug_location( cp, pe ); + PredEntry *pe = EnvPreg(cp); + if (pe == PredTrue) + return TermNil; + if (ignore_first <= 0 && pe + // pe->ModuleOfPred != PROLOG_MODULE &&s + && + !(pe->PredFlags & HiddenPredFlag)) { + return build_bug_location(cp, pe); + } else { + if (NULL && b_ptr && b_ptr->cp_env < env) { + cp = b_ptr->cp_cp; + env = b_ptr->cp_env; + b_ptr = b_ptr->cp_b; } else { - if (b_ptr && b_ptr->cp_env < env) { - cp = b_ptr->cp_cp; - env = b_ptr->cp_env; - b_ptr = b_ptr->cp_b; - } else { - cp = (yamop *)env[E_CP]; - env = ENV_Parent(env); - } - ignore_first--; + cp = (yamop *)env[E_CP]; + env = ENV_Parent(env); + } + ignore_first--; } } } -static Int -clause_location( USES_REGS1 ) -{ +static Int clause_location(USES_REGS1) { return Yap_unify(Yap_pc_location(P, B, ENV), ARG1) && - Yap_unify(Yap_env_location(CP, B, ENV, 1), ARG2); + Yap_unify(Yap_env_location(CP, B, ENV, 1), ARG2); } -static Int -ancestor_location( USES_REGS1 ) -{ - return - Yap_unify(Yap_env_location(CP, B, ENV, 2), ARG1) && - Yap_unify(Yap_env_location(CP, B, ENV, 3), ARG2); +static Int ancestor_location(USES_REGS1) { + return Yap_unify(Yap_env_location(CP, B, ENV, 2), ARG1) && + Yap_unify(Yap_env_location(CP, B, ENV, 3), ARG2); } - -void -Yap_InitStInfo(void) -{ +void Yap_InitStInfo(void) { CACHE_REGS Term cm = CurrentModule; - Yap_InitCPred("in_use", 2, in_use, HiddenPredFlag|TestPredFlag | SafePredFlag|SyncPredFlag); + Yap_InitCPred("in_use", 2, in_use, + HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag); #ifndef THREADS - Yap_InitCPred("toggle_static_predicates_in_use", 0, toggle_static_predicates_in_use, HiddenPredFlag|SafePredFlag|SyncPredFlag); + Yap_InitCPred("toggle_static_predicates_in_use", 0, + toggle_static_predicates_in_use, + HiddenPredFlag | SafePredFlag | SyncPredFlag); #endif CurrentModule = HACKS_MODULE; Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 0); Yap_InitCPred("current_continuations", 1, p_all_envs, 0); Yap_InitCPred("choicepoint", 7, p_choicepoint_info, 0); - Yap_InitCPred("continuation", 4, env_info,0); + Yap_InitCPred("continuation", 4, env_info, 0); Yap_InitCPred("cp_to_predicate", 5, p_cpc_info, 0); CurrentModule = cm; Yap_InitCPred("current_stack", 1, current_stack, HiddenPredFlag); Yap_InitCPred("pred_for_code", 5, pred_for_code, HiddenPredFlag); - Yap_InitCPred("parent_pred", 3, parent_pred, HiddenPredFlag|SafePredFlag); - Yap_InitCPred("program_continuation", 3, program_continuation, HiddenPredFlag|SafePredFlag); - Yap_InitCPred("clause_location", 2, clause_location, HiddenPredFlag|SafePredFlag); - Yap_InitCPred("ancestor_location", 2, ancestor_location, HiddenPredFlag|SafePredFlag); - - + Yap_InitCPred("parent_pred", 3, parent_pred, HiddenPredFlag | SafePredFlag); + Yap_InitCPred("program_continuation", 3, program_continuation, + HiddenPredFlag | SafePredFlag); + Yap_InitCPred("clause_location", 2, clause_location, + HiddenPredFlag | SafePredFlag); + Yap_InitCPred("ancestor_location", 2, ancestor_location, + HiddenPredFlag | SafePredFlag); } - diff --git a/C/text.c b/C/text.c index 83a10493b..0eb879955 100644 --- a/C/text.c +++ b/C/text.c @@ -22,12 +22,6 @@ #include "yapio.h" #include "YapText.h" -#if defined(__BIG_ENDIAN__) -#define ENC_WCHAR ENC_ISO_UTF32_BE -#else -#define ENC_WCHAR ENC_ISO_UTF32_LE -#endif - #include #include @@ -39,9 +33,9 @@ min_size(size_t i, size_t j) { #define wcsnlen(S, N) min_size(N, wcslen(S)) #endif -static inline unsigned char *get_char(unsigned char *p, int *c) { *c = *p; return p+1; } +static inline unsigned char *getChar(unsigned char *p, int *c) { *c = *p; return p+1; } -static inline wchar_t *get_wchar(wchar_t *p, int *c) { *c = *p; return p+1; } +static inline wchar_t *getWchar(wchar_t *p, int *c) { *c = *p; return p+1; } #ifndef NAN #define NAN (0.0/0.0) @@ -366,19 +360,31 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l bool wide; /* we know what the term is */ - if (inp->type & YAP_STRING_STRING && !IsVarTerm(inp->val.t) && IsStringTerm(inp->val.t)) { const char *s; - s = (char *)StringOfTerm( inp->val.t ); - if ( s == NULL ) { - return 0L; + if ( !(inp->type & (YAP_STRING_CHARS|YAP_STRING_WCHARS))) + { + if (IsVarTerm(inp->val.t) && !(inp->type & YAP_STRING_TERM)) { + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { + LOCAL_Error_TYPE = TYPE_ERROR_ATOM; + } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { + LOCAL_Error_TYPE = TYPE_ERROR_STRING; + } else if (!IsNumTerm(inp->val.t) && (inp->type & ( YAP_STRING_INT|YAP_STRING_FLOAT| YAP_STRING_BIG)) == inp->type) { + LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; + } else if (!IsAtomicTerm(inp->val.t) && !(inp->type & YAP_STRING_TERM)) { + LOCAL_Error_TYPE = TYPE_ERROR_ATOMIC; + } + LOCAL_Error_Term = inp->val.t; } + // this is a term, extract the UTF8 representation + if ( IsStringTerm(inp->val.t)) { *enc = ENC_ISO_UTF8; *minimal = FALSE; if (lengp) *lengp = strlen(s); return (void *)s; } - if (inp->type & YAP_STRING_ATOM && !IsVarTerm(inp->val.t) && IsAtomTerm(inp->val.t)) { + if ( IsAtomTerm(inp->val.t)) { // this is a term, extract to a buffer, and representation is wide *minimal = TRUE; Atom at = AtomOfTerm(inp->val.t); @@ -394,13 +400,13 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l return s; } } - if (inp->type & YAP_STRING_CODES && !IsVarTerm(inp->val.t) && (s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { + if (inp->type & YAP_STRING_CODES && (s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { // this is a term, extract to a sfer, and representation is wide *minimal = TRUE; *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); return s; } - if (inp->type & YAP_STRING_ATOMS && !IsVarTerm(inp->val.t) && (s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { + if (inp->type & YAP_STRING_ATOMS && (s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { // this is a term, extract to a buffer, and representation is wide *minimal = TRUE; s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); @@ -449,7 +455,8 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l if (buf) s = buf; else s = Yap_PreAllocCodeSpace(); size_t sz = LOCAL_MAX_SIZE-1; - o = Yap_TermToString(inp->val.t, s, sz, lengp, ENC_ISO_UTF8, 0); + encoding_t enc = ENC_ISO_UTF8; + o = Yap_TermToString(inp->val.t, s, sz, lengp, &enc, 0); return s; } if (inp->type & YAP_STRING_CHARS) { @@ -513,7 +520,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng LOCAL_TERM_ERROR( t, 2*(lim-s) ); buf = buf_from_tstring(HR); while (cp < lim) { - cp = get_char(cp, &chr); + cp = getChar(cp, &chr); buf += put_utf8(buf, chr); } if (max >= min) *buf++ = '\0'; @@ -535,7 +542,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng buf = buf_from_tstring(HR); while (wp < lim) { utf8proc_int32_t chr; - wp = get_wchar(wp, &chr); + wp = getWchar(wp, &chr); buf += put_utf8(buf, chr); } if (max >= min) *buf++ = '\0'; @@ -599,7 +606,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U LOCAL_TERM_ERROR( t, 2*(lim-s) ); while (cp < lim) { utf8proc_int32_t chr; - cp = get_char(cp, &chr); + cp = getChar(cp, &chr); if (chr == '\0') break; w[0] = chr; HR[0] = MkAtomTerm(Yap_LookupAtom(w)); @@ -619,7 +626,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U LOCAL_TERM_ERROR( t, 2*(lim-s) ); while (*cp && cp < lim) { utf8proc_int32_t chr; - cp = get_wchar(cp, &chr); + cp = getWchar(cp, &chr); if (chr == '\0') break; w[0] = chr; HR[0] = MkAtomTerm(Yap_LookupMaybeWideAtom(w)); @@ -679,7 +686,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U LOCAL_TERM_ERROR( t, 2*(lim-s) ); while (cp < lim) { utf8proc_int32_t chr; - cp = get_char(cp, &chr); + cp = getChar(cp, &chr); HR[0] = MkIntTerm(chr); HR[1] = AbsPair(HR+2); HR += 2; @@ -695,7 +702,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U LOCAL_TERM_ERROR( t, 2*(lim-s) ); while (cp < lim) { utf8proc_int32_t chr; - cp = get_wchar(cp, &chr); + cp = getWchar(cp, &chr); HR[0] = MkIntTerm(chr); HR[1] = AbsPair(HR+2); HR += 2; @@ -1049,13 +1056,13 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng static Term write_number( void *s0, seq_tv_t *out, encoding_t enc, int minimal, int size USES_REGS) { - return Yap_StringToNumberTerm(s0, enc); + return Yap_StringToNumberTerm(s0, &enc); } static Term string_to_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) { - return Yap_StringToTerm(s0, strlen(s0)+1, enc, 1200, NULL); + return Yap_StringToTerm(s0, strlen(s0)+1, &enc, 1200, NULL); } diff --git a/C/write.c b/C/write.c index a99aa5f18..561f116f8 100644 --- a/C/write.c +++ b/C/write.c @@ -388,7 +388,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) { int sno; char *so; - sno = Yap_open_buf_write_stream(*s, sz, GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); + sno = Yap_open_buf_write_stream(*s, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); if (sno < 0) return FALSE; wglb.stream = GLOBAL_Stream+sno; @@ -1251,7 +1251,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio char * -Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t encp, int flags) +Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t *encp, int flags) { CACHE_REGS int sno = Yap_open_buf_write_stream(s, sz, encp, flags); @@ -1259,10 +1259,11 @@ Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t encp, i if (sno < 0) return NULL; - LOCK(GLOBAL_Stream[sno].streamlock); LOCAL_c_output_stream = sno; if (encp) - GLOBAL_Stream[sno].encoding = encp; + GLOBAL_Stream[sno].encoding = *encp; + else + GLOBAL_Stream[sno].encoding = LOCAL_encoding; Yap_plwrite (t, GLOBAL_Stream+sno, 0, flags, 1200); s = Yap_MemExportStreamPtr( sno ); Yap_CloseStream( sno ); diff --git a/H/YapText.h b/H/YapText.h index 7c3028f55..93ad257bf 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -384,7 +384,7 @@ Yap_AtomSWIToString(Term t0 USES_REGS) seq_tv_t inp, out; inp.val.t = t0; - inp.type = YAP_STRING_ATOM|YAP_STRING_STRING|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_ATOMS_CODES|YAP_STRING_TERM; + inp.type = YAP_STRING_ATOM|YAP_STRING_STRING|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_ATOMS_CODES; out.type = YAP_STRING_STRING; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) diff --git a/H/dhstruct.h b/H/dhstruct.h index 5b5aa5c12..e019b4bca 100644 --- a/H/dhstruct.h +++ b/H/dhstruct.h @@ -102,8 +102,6 @@ #define DBLOAD_MODULE Yap_heap_regs->dbload_module #define RANGE_MODULE Yap_heap_regs->range_module -#define HIDDEN_PREDICATES Yap_heap_regs->hidden_predicates - #define CurrentModules Yap_heap_regs->current_modules @@ -111,6 +109,8 @@ +#define HIDDEN_PREDICATES Yap_heap_regs->hidden_predicates + #define GLOBAL_Flags Yap_heap_regs->GLOBAL_Flags_ diff --git a/H/hstruct.h b/H/hstruct.h index 748015c67..437d230e5 100755 --- a/H/hstruct.h +++ b/H/hstruct.h @@ -102,8 +102,6 @@ Term dbload_module; Term range_module; - Prop hidden_predicates; - struct mod_entry *current_modules; @@ -111,6 +109,8 @@ + Prop hidden_predicates; + union flagTerm* GLOBAL_Flags_; diff --git a/H/ihstruct.h b/H/ihstruct.h index c63ebabb7..95b5eb2c7 100644 --- a/H/ihstruct.h +++ b/H/ihstruct.h @@ -102,8 +102,6 @@ DBLOAD_MODULE = MkAtomTerm(AtomDBLoad); RANGE_MODULE = MkAtomTerm(AtomRange); - HIDDEN_PREDICATES = NULL; - CurrentModules = NULL; @@ -111,6 +109,8 @@ Yap_InitModules(); + HIDDEN_PREDICATES = NULL; + Yap_InitPlIO(); GLOBAL_Flags = 0; diff --git a/H/ilocals.h b/H/ilocals.h index 9cb430afa..a8ac7b282 100755 --- a/H/ilocals.h +++ b/H/ilocals.h @@ -21,7 +21,7 @@ static void InitWorker(int wid) { REMOTE_FormatInfo(wid) = NULL; REMOTE_AtPrompt(wid) = AtomNil; - REMOTE_encoding(wid) = Yap_InitialEncoding(); + REMOTE_encoding(wid) = Yap_DefaultEncoding(); REMOTE_quasi_quotations(wid) = false; REMOTE_default_priority(wid) = 1200; REMOTE_eot_before_eof(wid) = false; diff --git a/H/rhstruct.h b/H/rhstruct.h index 3e145155c..db697862c 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -102,8 +102,6 @@ DBLOAD_MODULE = AtomTermAdjust(DBLOAD_MODULE); RANGE_MODULE = AtomTermAdjust(RANGE_MODULE); - RestoreHiddenPredicates(); - CurrentModules = ModEntryPtrAdjust(CurrentModules); @@ -111,6 +109,8 @@ + RestoreHiddenPredicates(); + diff --git a/include/YapDefs.h b/include/YapDefs.h index a0942e5a5..bde5ca971 100755 --- a/include/YapDefs.h +++ b/include/YapDefs.h @@ -96,6 +96,8 @@ typedef bool YAP_Bool; #define YAP_agc_hook Agc_hook +#define YAP_encoding_t encoding_t + #else /* Type definitions */ @@ -146,6 +148,10 @@ typedef int (*YAP_agc_hook)(void *_Atom); #include "YapError.h" +#include <../os/encoding.h> + +typedef encoding_t YAP_encoding_t; + #endif typedef struct YAP_thread_attr_struct { @@ -368,21 +374,6 @@ typedef enum stream_f { typedef uint64_t stream_flags_t; -/********* encoding ***********************/ - -typedef enum -{ PL_ENC_UNKNOWN = 0, /* invalid/unknown */ - PL_ENC_OCTET, /* raw 8 bit input */ - PL_ENC_ASCII, /* US-ASCII (0..127) */ - PL_ENC_ISO_LATIN_1, /* ISO Latin-1 (0..256) */ - PL_ENC_ANSI, /* default (multibyte) codepage */ - PL_ENC_UTF8, - PL_ENC_UNICODE_BE, /* big endian unicode file */ - PL_ENC_UNICODE_LE, /* little endian unicode file */ - PL_ENC_WCHAR /* pl_wchar_t */ -} PL_IOENC; - - /********* YAP C-Flags ***********************/ typedef enum diff --git a/include/YapErrors.h b/include/YapErrors.h index 3ec98ad22..9c230ee99 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -46,6 +46,7 @@ BEGIN_ERRORS() E(DOMAIN_ERROR_STREAM_POSITION, DOMAIN_ERROR, "stream_position") E(DOMAIN_ERROR_TIMEOUT_SPEC, DOMAIN_ERROR, "timeout_spec") E(DOMAIN_ERROR_SYNTAX_ERROR_HANDLER, DOMAIN_ERROR, "syntax_error_handler") + E(DOMAIN_ERROR_WRITE_OPTION, DOMAIN_ERROR, "write_option") E(EVALUATION_ERROR_FLOAT_OVERFLOW, EVALUATION_ERROR, "float_overflow") E(EVALUATION_ERROR_FLOAT_UNDERFLOW, EVALUATION_ERROR, "float_underflow") diff --git a/include/YapInterface.h b/include/YapInterface.h index e5799d2db..c3a87e0ec 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -1868,7 +1868,7 @@ extern X_API void YAP_Error(int myerrno, YAP_Term t, const char *buf, ...); extern X_API int YAP_WriteBuffer(YAP_Term,char *,size_t,int); -extern X_API char* YAP_WriteDynamicBuffer(YAP_Term t,char *buf,size_t sze, size_t *lengthp, int *encp, int flags); +extern X_API char* YAP_WriteDynamicBuffer(YAP_Term t,char *buf,size_t sze, size_t *lengthp, YAP_encoding_t *encp, int flags); /* void YAP_Term(YAP_Term) */ extern X_API YAP_Term YAP_CopyTerm(YAP_Term); diff --git a/library/dialect/swi/os/pl-read.c b/library/dialect/swi/os/pl-read.c index 0dec8c119..1af2d57aa 100644 --- a/library/dialect/swi/os/pl-read.c +++ b/library/dialect/swi/os/pl-read.c @@ -1530,7 +1530,7 @@ atom_to_term(term_t atom, term_t term, term_t bindings) } Term -Yap_StringToTerm(const char *s, size_t len, term_t bindings) +Yap_StringToTerm(const char *s, size_t *lenp, term_t bindings) { GET_LD; read_data rd; int rval; diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index d8ab1d390..c60b0b439 100644 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -105,9 +105,6 @@ Term swi_module SWI_MODULE MkAT AtomSwi Term dbload_module DBLOAD_MODULE MkAT AtomDBLoad Term range_module RANGE_MODULE MkAT AtomRange -// hidden predicates -Prop hidden_predicates HIDDEN_PREDICATES =NULL RestoreHiddenPredicates() - // // Module list // @@ -116,6 +113,9 @@ struct mod_entry *current_modules CurrentModules =NULL ModEntryPtrAdjust // don't actually want to define a field void void void Yap_InitModules() void +// hidden predicates +Prop hidden_predicates HIDDEN_PREDICATES =NULL RestoreHiddenPredicates() + // make sure we have the streams set at this point. // don't actually want to define a field void void void Yap_InitPlIO() void diff --git a/misc/LOCALS b/misc/LOCALS index 9b81b9e84..14f4ef587 100755 --- a/misc/LOCALS +++ b/misc/LOCALS @@ -25,7 +25,7 @@ struct format_status* FormatInfo =NULL Atom AtPrompt =AtomNil char Prompt[MAX_PROMPT+1] void -encoding_t encoding =Yap_InitialEncoding() +encoding_t encoding =Yap_DefaultEncoding() bool quasi_quotations =false UInt default_priority =1200 diff --git a/os/charsio.c b/os/charsio.c index 5caa43cb5..53dad4fe1 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -71,8 +71,10 @@ INLINE_ONLY inline EXTERN Term MkCharTerm (Int c) { wchar_t cs[2]; + if (c < 0) + return MkAtomTerm(AtomEof); cs[0] = c; - cs[0] = '\0'; + cs[1] = '\0'; return MkAtomTerm(Yap_LookupMaybeWideAtom(cs)); } @@ -94,22 +96,75 @@ CharOfAtom (Atom at) } } +static int +plUnGetc( int sno, int ch ) +{ + return ungetc(ch, GLOBAL_Stream[sno].file); +} +static Int dopeek( int sno ) +{ + Int ocharcount, olinecount, olinepos; + StreamDesc *s; + Int ch; + + s = GLOBAL_Stream+sno; + ocharcount = s->charcount; + olinecount = s->linecount; + olinepos = s->linepos; + ch = get_wchar(sno); + s->charcount = ocharcount; + s->linecount = olinecount; + s->linepos = olinepos; + /* buffer the character */ + if (s->encoding == LOCAL_encoding)) { + ungetwc( ch, s-> file ); + } else { + /* do the ungetc as if a write .. */ + int (*f)(int, int) = s->stream_putc; + s->stream_putc = plUnGetc; + put_wchar( ch, sno ); + s->stream_putc = f; + } + return ch; +} + +static Int dopeek_byte( int sno ) +{ + Int ocharcount, olinecount, olinepos; + StreamDesc *s; + Int ch; + + s = GLOBAL_Stream+sno; + ocharcount = s->charcount; + olinecount = s->linecount; + olinepos = s->linepos; + ch = GLOBAL_Stream[sno].stream_getc(sno); + s->charcount = ocharcount; + s->linecount = olinecount; + s->linepos = olinepos; + /* buffer the character */ + ungetc(ch, s->file); + return ch; +} static Int at_end_of_stream ( USES_REGS1 ) { /* at_end_of_stream */ /* the next character is a EOF */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "past_eof/1"); + int sno = Yap_CheckStream (ARG1, Input_Stream_f, NULL); Int out; if (sno < 0) return (FALSE); - if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - return FALSE; - } out = GLOBAL_Stream[sno].status & Eof_Stream_f; + if (!out) { + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + out = ( dopeek_byte(sno) < 0 ); + } else { + out = ( dopeek(sno) < 0 ); + } + } UNLOCK(GLOBAL_Stream[sno].streamlock); return out; } @@ -118,15 +173,13 @@ static Int at_end_of_stream_0 ( USES_REGS1 ) { /* at_end_of_stream */ /* the next character is a EOF */ - int sno = LOCAL_c_input_stream; Int out; - LOCK(GLOBAL_Stream[sno].streamlock); - if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - return FALSE; - } + int sno = LOCAL_c_input_stream; out = GLOBAL_Stream[sno].status & Eof_Stream_f; + if (!out) { + out = ( dopeek(sno) < 0 ); + } UNLOCK(GLOBAL_Stream[sno].streamlock); return out; } @@ -152,18 +205,13 @@ yap_fflush( sno) static Int get ( USES_REGS1 ) { /* '$get'(Stream,-N) */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get/2"); + int sno = Yap_CheckTextStream (ARG1, Input_Stream_f, "get/2"); int ch; Int status; if (sno < 0) return FALSE; status = GLOBAL_Stream[sno].status; - if (status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get/2"); - return FALSE; - } while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0) ; UNLOCK(GLOBAL_Stream[sno].streamlock); @@ -173,18 +221,13 @@ get ( USES_REGS1 ) static Int get_char ( USES_REGS1 ) { /* '$get'(Stream,-N) */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get/2"); + int sno = Yap_CheckTextStream (ARG1, Input_Stream_f, "get/2"); int ch; Int status; if (sno < 0) return FALSE; status = GLOBAL_Stream[sno].status; - if (status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get/2"); - return FALSE; - } ch = GLOBAL_Stream[sno].stream_wgetc(sno); UNLOCK(GLOBAL_Stream[sno].streamlock); return (Yap_unify_constant (ARG2, MkCharTerm (ch))); @@ -193,18 +236,13 @@ get_char ( USES_REGS1 ) static Int get_code ( USES_REGS1 ) { /* get0(Stream,-N) */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get0/2"); + int sno = Yap_CheckTextStream (ARG1, Input_Stream_f, "get0/2"); Int status; Int out; if (sno < 0) return(FALSE); status = GLOBAL_Stream[sno].status; - if (status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); - return FALSE; - } out = GLOBAL_Stream[sno].stream_wgetc(sno); UNLOCK(GLOBAL_Stream[sno].streamlock); return (Yap_unify_constant (ARG2, MkIntegerTerm (out)) ); @@ -220,11 +258,6 @@ get_1 ( USES_REGS1 ) LOCK(GLOBAL_Stream[sno].streamlock); status = GLOBAL_Stream[sno].status; - if (status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get_code/1"); - return FALSE; - } while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0) ; UNLOCK(GLOBAL_Stream[sno].streamlock); @@ -240,11 +273,6 @@ getcode_1 ( USES_REGS1 ) status = GLOBAL_Stream[sno].status; LOCK(GLOBAL_Stream[sno].streamlock); - if (status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); - return FALSE; - } out = GLOBAL_Stream[sno].stream_wgetc(sno); UNLOCK(GLOBAL_Stream[sno].streamlock); return (Yap_unify_constant (ARG1, MkIntegerTerm (out)) ); @@ -259,11 +287,6 @@ getchar_1 ( USES_REGS1 ) LOCK(GLOBAL_Stream[sno].streamlock); status = GLOBAL_Stream[sno].status; - if (status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); - return FALSE; - } out = GLOBAL_Stream[sno].stream_wgetc(sno); UNLOCK(GLOBAL_Stream[sno].streamlock); return (Yap_unify_constant (ARG1, MkCharTerm (out)) ); @@ -273,7 +296,7 @@ getchar_1 ( USES_REGS1 ) static Int get0_line_codes ( USES_REGS1 ) { /* '$get0'(Stream,-N) */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get0/2"); + int sno = Yap_CheckTextStream (ARG1, Input_Stream_f, "get0/2"); Int status; Term out; Int ch = '\0'; @@ -281,18 +304,8 @@ get0_line_codes ( USES_REGS1 ) if (sno < 0) return(FALSE); - if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { - ch = PlUnGetc(sno); - rewind = TRUE; - } else { - rewind = FALSE; - } + rewind = FALSE; status = GLOBAL_Stream[sno].status; - if (status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); - return FALSE; - } out = read_line(sno); UNLOCK(GLOBAL_Stream[sno].streamlock); if (rewind) @@ -311,8 +324,9 @@ get_byte ( USES_REGS1 ) if (sno < 0) return(FALSE); status = GLOBAL_Stream[sno].status; - if (!(status & Binary_Stream_f) && - strictISOFlag()) { + if (!(status & Binary_Stream_f) + //&& strictISOFlag() + ) { UNLOCK(GLOBAL_Stream[sno].streamlock); Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "get_byte/2"); return(FALSE); @@ -331,8 +345,9 @@ get_byte_1 ( USES_REGS1 ) LOCK(GLOBAL_Stream[sno].streamlock); status = GLOBAL_Stream[sno].status; - if (!(status & Binary_Stream_f) && - strictISOFlag()) { + if (!(status & Binary_Stream_f) + // &&strictISOFlag() + ) { UNLOCK(GLOBAL_Stream[sno].streamlock); Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "get_byte/1"); return(FALSE); @@ -359,11 +374,6 @@ put_code_1 ( USES_REGS1 ) return FALSE; } LOCK(GLOBAL_Stream[sno].streamlock); - if (GLOBAL_Stream[sno].status & Binary_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); - return(FALSE); - } GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2))); /* * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) @@ -390,7 +400,7 @@ put_code ( USES_REGS1 ) Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1"); return FALSE; } - sno = Yap_CheckStream (ARG1, Output_Stream_f, "put/2"); + sno = Yap_CheckTextStream (ARG1, Output_Stream_f, "put/2"); if (sno < 0) return (FALSE); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { @@ -457,7 +467,7 @@ put_char ( USES_REGS1 ) Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_char/1"); return FALSE; } - sno = Yap_CheckStream (ARG1, Output_Stream_f, "put/2"); + sno = Yap_CheckTextStream (ARG1, Output_Stream_f, "put/2"); if (sno < 0) return (FALSE); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { @@ -524,7 +534,7 @@ tab ( USES_REGS1 ) Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1"); return FALSE; } - sno = Yap_CheckStream (ARG1, Output_Stream_f, "nl/1"); + sno = Yap_CheckTextStream (ARG1, Output_Stream_f, "nl/1"); if (sno < 0) return (FALSE); @@ -566,7 +576,7 @@ nl_1 ( USES_REGS1 ) static Int nl ( USES_REGS1 ) { /* nl(Stream) */ - int sno = Yap_CheckStream (ARG1, Output_Stream_f, "nl/1"); + int sno = Yap_CheckTextStream (ARG1, Output_Stream_f, "nl/1"); if (sno < 0) return (FALSE); if (GLOBAL_Stream[sno].status & Binary_Stream_f) { @@ -589,10 +599,10 @@ put_byte ( USES_REGS1 ) Term t2; Int ch; if (IsVarTerm(t2 = Deref(ARG2))) { - Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); + Yap_Error(INSTANTIATION_ERROR, t2, "put_code/2"); return FALSE; } else if (!IsIntegerTerm (t2)) { - Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1"); + Yap_Error(TYPE_ERROR_BYTE, t2, "put_code/2"); return FALSE; } else if ((ch = IntegerOfTerm (t2)) < -1) { Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1"); @@ -601,11 +611,12 @@ put_byte ( USES_REGS1 ) int sno = Yap_CheckStream (ARG1, Output_Stream_f, "put/2"); if (sno < 0) return (FALSE); - if (!(GLOBAL_Stream[sno].status & Binary_Stream_f) && - strictISOFlag()) { + if (!(GLOBAL_Stream[sno].status & Binary_Stream_f) + // && strictISOFlag() + ) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "get0/2"); - return(FALSE); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, NULL); + return false; } GLOBAL_Stream[sno].stream_putc(sno, ch); /* @@ -626,15 +637,16 @@ put_byte_1 ( USES_REGS1 ) Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); return FALSE; } else if (!IsIntegerTerm (t2)) { - Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1"); + Yap_Error(TYPE_ERROR_BYTE, t2, "put_code/1"); return FALSE; } else if ((ch = IntegerOfTerm (t2)) < -1) { Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1"); return FALSE; } LOCK(GLOBAL_Stream[sno].streamlock); - if (!(GLOBAL_Stream[sno].status & Binary_Stream_f) && - strictISOFlag()) { + if (!(GLOBAL_Stream[sno].status & Binary_Stream_f) + //&& strictISOFlag() + ) { UNLOCK(GLOBAL_Stream[sno].streamlock); Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "get0/2"); return(FALSE); @@ -663,7 +675,7 @@ skip_1 ( USES_REGS1 ) Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "skip/2"); return FALSE; } - sno = Yap_CheckStream (ARG1, Input_Stream_f, "skip/2"); + sno = Yap_CheckTextStream (ARG1, Input_Stream_f, "skip/2"); if (sno < 0) return (FALSE); while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != n && ch != -1) @@ -750,30 +762,6 @@ flush_all_streams ( USES_REGS1 ) return TRUE; } -static Int dopeek( int sno ) -{ - Int ocharcount, olinecount, olinepos; - StreamDesc *s; - Int ch; - - s = GLOBAL_Stream+sno; - ocharcount = s->charcount; - olinecount = s->linecount; - olinepos = s->linepos; - ch = get_wchar(sno); - s->charcount = ocharcount; - s->linecount = olinecount; - s->linepos = olinepos; - /* buffer the character */ - s->och = ch; - /* mark a special function to recover this character */ - Yap_DefaultStreamOps( s ); - s->stream_getc = PlUnGetc; - - - return ch; -} - /** @pred peek(+ _S_, - _C_) is deprecated @@ -797,7 +785,7 @@ static Int peek_code ( USES_REGS1 ) { /* at_end_of_stream */ /* the next character is a EOF */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); + int sno = Yap_CheckTextStream (ARG1, Input_Stream_f, "peek/2"); Int ch; if (sno < 0) @@ -807,9 +795,11 @@ peek_code ( USES_REGS1 ) PlIOError(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_code/2"); return FALSE; } - if ((ch = dopeek( sno )) < 0) - return false; + if ((ch = dopeek( sno )) < 0) { UNLOCK(GLOBAL_Stream[sno].streamlock); + return false; + } + UNLOCK(GLOBAL_Stream[sno].streamlock); return(Yap_unify_constant(ARG2,MkIntTerm(ch))); } @@ -854,19 +844,21 @@ static Int peek_byte ( USES_REGS1 ) { /* at_end_of_stream */ /* the next character is a EOF */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek_byte/2"); Int ch; if (sno < 0) return(FALSE); if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); + Yap_Error(PERMISSION_ERROR_INPUT_STREAM, ARG1, "peek_byte/2"); return(FALSE); } - if ((ch = dopeek( sno )) < 0) - return false; + if ((ch = dopeek_byte( sno )) < 0) { UNLOCK(GLOBAL_Stream[sno].streamlock); + return false; + } + UNLOCK(GLOBAL_Stream[sno].streamlock); return(Yap_unify_constant(ARG2,MkIntTerm(ch))); } @@ -893,7 +885,7 @@ peek_byte_1 ( USES_REGS1 ) Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); return(FALSE); } - if ((ch = dopeek( sno )) < 0) { + if ((ch = dopeek_byte( sno )) < 0) { UNLOCK(GLOBAL_Stream[sno].streamlock); return false; } @@ -913,7 +905,7 @@ static Int peek_char ( USES_REGS1 ) { /* the next character is a EOF */ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); + int sno = Yap_CheckTextStream (ARG1, Input_Stream_f, "peek/2"); wchar_t wsinp[2]; Int ch; @@ -945,7 +937,7 @@ static Int peek_char_1 ( USES_REGS1 ) { /* the next character is a EOF */ - int sno = LOCAL_c_input_stream; + int sno = LOCAL_c_input_stream; wchar_t wsinp[2]; Int ch; diff --git a/os/chartypes.c b/os/chartypes.c index e47aa608b..63c6be967 100644 --- a/os/chartypes.c +++ b/os/chartypes.c @@ -1,4 +1,3 @@ - /************************************************************************* * * * YAP Prolog * @@ -54,14 +53,18 @@ static char SccsId[] = "%W% %G%"; static Int p_change_type_of_char(USES_REGS1); static Int p_type_of_char(USES_REGS1); -Term Yap_StringToNumberTerm(char *s, encoding_t enc) { +Term Yap_StringToNumberTerm(char *s, encoding_t *encp) { + CACHE_REGS int sno; Term t; - sno = Yap_open_buf_read_stream(s, strlen(s), enc, MEM_BUF_USER); + sno = Yap_open_buf_read_stream(s, strlen(s), encp, MEM_BUF_USER); if (sno < 0) return FALSE; - GLOBAL_Stream[sno].encoding = enc; + if (encp) + GLOBAL_Stream[sno].encoding = *encp; + else + GLOBAL_Stream[sno].encoding = LOCAL_encoding; UNLOCK(GLOBAL_Stream[sno].streamlock); while (*s && isblank(*s++)) ; @@ -162,25 +165,6 @@ void Yap_SetDefaultEncoding(encoding_t new_encoding) { LOCAL_encoding = new_encoding; } -encoding_t Yap_InitialEncoding(void) { - char *s = getenv("LANG"); - size_t sz; - - /* if we don't have a LANG then just use ISO_LATIN1 */ - if (s == NULL) - s = getenv("LC_CTYPE"); - if (s == NULL) - return ENC_ISO_UTF8; - sz = strlen(s); - if (sz >= 5) { - if (s[sz - 5] == 'U' && s[sz - 4] == 'T' && s[sz - 3] == 'F' && - s[sz - 2] == '-' && s[sz - 1] == '8') { - return ENC_ISO_UTF8; - } - } - return ENC_ISO_UTF8; -} - static Int get_default_encoding(USES_REGS1) { Term out = MkIntegerTerm(Yap_DefaultEncoding()); return Yap_unify(ARG1, out); diff --git a/os/encoding.h b/os/encoding.h index ba5f69eee..a52de596d 100644 --- a/os/encoding.h +++ b/os/encoding.h @@ -19,9 +19,6 @@ #define ENCODING_H 1 - -#include "Yap.h" - typedef enum { ENC_OCTET = 0, /// binary files ENC_ISO_LATIN1 = 1, /// US+West Europe @@ -33,12 +30,56 @@ typedef enum { ENC_ISO_UTF32_BE = 64, /// nobody ENC_ISO_UTF32_LE = 128, /// yes, nobody } encoding_t; -/// read the initial encoding from the Operating System's environment; -encoding_t Yap_InitialEncoding( void ); + +#if defined(__BIG_ENDIAN__) +#define ENC_WCHAR ENC_ISO_UTF32_BE +#else +#define ENC_WCHAR ENC_ISO_UTF32_LE +#endif + +#ifdef YAP_H + /// read the current environment, as set by the user or as Initial encoding_t Yap_DefaultEncoding( void ); void Yap_SetDefaultEncoding(encoding_t new_encoding); +#if HAVE_XLOCALE_H +typedef enum { + SEQ_ENC_OCTET, /// binary files + SEQ_ENC_ISO_LATIN1, /// US+West Europe + SEQ_ENC_ISO_ASCII , /// US only + SEQ_ENC_ISO_ANSI , /// Who cares + SEQ_ENC_ISO_UTF8 , /// Most everyone nowadays + SEQ_ENC_UTF16_BE, /// People who made a mistake + SEQ_ENC_UTF16_LE, /// People who made the same mistake +v\ SEQ_ENC_ISO_UTF32_BE, /// nobody + SEQ_ENC_ISO_UTF32_LE /// yes, nobody + } seq_encoding_t; + +/// convert from unary to binary representation. +static inline seq_encoding_t seq_encoding(encoding_t inp) { +#if HAVE__BUILTIN_FFSLL + return __builtin_ffsll(inp); +#elif HAVE_FFSLL + return ffsll(inp); +#else + unsigned int out; + // supports max 16 different encodings. + if (inp==0) + return 0L; + // if (inp & ((CELL)0xffffL << 16)) {inp >>= 16; out += 16;} + if (inp & ((CELL)0xffL << 8)) {inp >>= 8; out += 8;} + if (inp & ((CELL)0xfL << 4)) {inp >>= 4; out += 4;} + if (inp & ((CELL)0x3L << 2)) {inp >>= 2; out += 2;} + if (inp & ((CELL)0x1 << 1)) out++; +#endif + return out; +} + +extern xlocale enc_locales[SEQ_ENC_ISO_UTF32_LE+1]; +#endif + + static inline const char *enc_name(encoding_t enc) { switch(enc) @@ -59,23 +100,24 @@ static inline encoding_t enc_id(char *s) { { - if (!strcmp(s, "octet")) return ENC_OCTET; + if (!strcmp(s, "iso_utf8")) return ENC_ISO_UTF8; + if (!strcmp(s, "utf16_be")) return ENC_UTF16_BE; + if (!strcmp(s, "utf16_le")) return ENC_UTF16_LE; + if (!strcmp(s, "octet")) return ENC_OCTET; if (!strcmp(s, "iso_latin_1")) return ENC_ISO_LATIN1; if (!strcmp(s, "iso_ascii")) return ENC_ISO_ASCII; if (!strcmp(s, "iso_ansi")) return ENC_ISO_ANSI; - if (!strcmp(s, "iso_utf8")) return ENC_ISO_UTF8; - if (!strcmp(s, "utf16_be")) return ENC_UTF16_BE; - if (!strcmp(s, "utf16_le")) return ENC_UTF16_LE; if (!strcmp(s, "utf32_be")) return ENC_ISO_UTF32_BE; if (!strcmp(s, "utf32_le")) return ENC_ISO_UTF32_LE; if (!strcmp(s, "default")) return Yap_DefaultEncoding(); else { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, 0, "bad encoding %s", s); + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, 0, "bad encoding %s", s); return ENC_OCTET; } } } +#endif #endif diff --git a/os/files.c b/os/files.c index 4cef2f1a6..a0d4aff97 100644 --- a/os/files.c +++ b/os/files.c @@ -73,7 +73,7 @@ static char SccsId[] = "%W% %G%"; #endif #ifdef _WIN32 #if HAVE_IO_H -/* Windows */ + /* Windows */ #include #endif #endif diff --git a/os/format.c b/os/format.c index 84f8c3be7..31dd2be20 100644 --- a/os/format.c +++ b/os/format.c @@ -829,7 +829,7 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS) finfo.pad_entries[finfo.padders].pad = (char *)bufp; bufp = NULL; sz = 0; - nsno = Yap_open_buf_write_stream((char *)bufp, sz, GLOBAL_Stream[sno].encoding, 0); + nsno = Yap_open_buf_write_stream((char *)bufp, sz, &GLOBAL_Stream[sno].encoding, 0); if (osno) { GLOBAL_Stream[nsno].linepos = GLOBAL_Stream[sno].linepos; GLOBAL_Stream[nsno].linecount = GLOBAL_Stream[sno].linecount; diff --git a/os/iopreds.c b/os/iopreds.c index 905143d12..c5f05b926 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -158,7 +158,6 @@ Yap_DefaultStreamOps( StreamDesc * st) { st->stream_wputc = put_wchar; st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; if (GLOBAL_CharConversionTable != NULL) st->stream_wgetc_for_read = ISOWGetc; else @@ -363,7 +362,7 @@ Int PlIOError__ (const char *file, const char *function, int lineno, yap_error_number type, Term culprit, ...) { - if (trueLocalPrologFlag(FILEERRORS_FLAG) == MkIntTerm(1) || + if (trueLocalPrologFlag(FILEERRORS_FLAG) == TermTrue|| type == RESOURCE_ERROR_MAX_STREAMS /* do not catch resource errors */) { va_list args; const char *format; @@ -469,9 +468,15 @@ Yap_DebugPuts( FILE *s, const char *sch) { if (Yap_Option['l' - 96]) (void) fputs(sch, Yap_logfile); - return (fputs(sch, s)); + return fputs( sch, s); } +void Yap_DebugErrorPuts(const char *s) +{ + Yap_DebugPuts (stderr, s); +} + + void Yap_DebugPlWrite(Term t) { @@ -485,12 +490,6 @@ Yap_DebugErrorPutc(int c) Yap_DebugPutc (stderr, c); } -void -Yap_DebugErrorPuts(const char *s) -{ - Yap_DebugPuts (stderr, s); -} - void Yap_DebugWriteIndicator( PredEntry *ap ) { CACHE_REGS @@ -616,6 +615,23 @@ ResetEOF(StreamDesc *s) { } /* handle reading from a stream after having found an EOF */ +static int +EOFWGetc(int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + + if (s->status & Push_Eof_Stream_f) { + /* ok, we have pushed an EOF, send it away */ + s->status &= ~Push_Eof_Stream_f; + return EOF; + } + if (ResetEOF(s)) { + s->stream_wgetc = get_wchar; + return(s->stream_wgetc(sno)); + } + return EOF; +} + static int EOFGetc(int sno) { @@ -627,6 +643,7 @@ EOFGetc(int sno) return EOF; } if (ResetEOF(s)) { + s->stream_getc = PlGetc; return(s->stream_getc(sno)); } return EOF; @@ -638,7 +655,6 @@ console_post_process_eof(StreamDesc *s) { CACHE_REGS s->stream_getc = EOFGetc; - Yap_DefaultStreamOps( s ); LOCAL_newline = FALSE; return EOFCHAR; } @@ -665,10 +681,18 @@ post_process_eof(StreamDesc *s) { s->status |= Eof_Stream_f; s->stream_getc = EOFGetc; - Yap_DefaultStreamOps( s ); return EOFCHAR; } +int +post_process_weof(StreamDesc *s) +{ + s->status |= Eof_Stream_f; + s->stream_wgetc = EOFWGetc; + return EOFCHAR; +} + + /* standard routine, it should read from anything pointed by a FILE *. It could be made more efficient by doing our own buffering and avoiding post_process_read_char, something to think about */ @@ -741,168 +765,6 @@ GetUTF8 (int sno) return c; } - -/* reads a character from a buffer and does the rest */ -int -PlUnGetc (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc) - return(s->stream_getc(sno)); - ch = s->och; - if (s->status & InMemory_Stream_f) { - Yap_MemOps( s ); - s->stream_wputc = put_wchar; - } else if (s->status & Socket_Stream_f) { - Yap_SocketOps( s ); - s->stream_wputc = put_wchar; - } else if (s->status & Promptable_Stream_f) { - Yap_ConsoleOps( s ); - s->stream_wputc = put_wchar; - } else { - s->stream_getc = PlGetc; - s->stream_gets = PlGetsFunc(); - } - return(ch); -} - -/* give back 0376+ch */ -static int -PlUnGetc376 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc376) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc; - ch = s->och; - s->och = 0xFE; - return ch; -} - -/* give back 0376+ch */ -static int -PlUnGetc00 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc00) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc; - ch = s->och; - s->och = 0x00; - return ch; -} - -/* give back 0377+ch */ -static int -PlUnGetc377 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc377) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc; - ch = s->och; - s->och = 0xFF; - return ch; -} - -/* give back 0357+ch */ -static int -PlUnGetc357 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc357) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc; - ch = s->och; - s->och = 0xEF; - return ch; -} - -/* give back 0357+0273+ch */ -static int -PlUnGetc357273 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc357273) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc357; - ch = s->och; - s->och = 0xBB; - return ch; -} - -/* give back 000+000+ch */ -static int -PlUnGetc0000 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc0000) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc00; - ch = s->och; - s->och = 0x00; - return ch; -} - -/* give back 000+000+ch */ -static int -PlUnGetc0000fe (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc0000fe) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc0000; - ch = s->och; - s->och = 0xfe; - return ch; -} - -/* give back 0377+0376+ch */ -static int -PlUnGetc377376 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc377376) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc377; - ch = s->och; - s->och = 0xFE; - return ch; -} - -/* give back 0377+0376+000+ch */ -static int -PlUnGetc37737600 (int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - - if (s->stream_getc != PlUnGetc37737600) - return(s->stream_getc(sno)); - s->stream_getc = PlUnGetc377376; - ch = s->och; - s->och = 0x00; - return ch; -} - static int utf8_nof(char ch) { @@ -917,20 +779,21 @@ utf8_nof(char ch) return 5; } -int -get_wchar(int sno) +static int +get_wchar__(int sno) { int ch; wchar_t wch; int how_many = 0; + StreamDesc *s = GLOBAL_Stream+sno; while (TRUE) { - ch = GLOBAL_Stream[sno].stream_getc(sno); + ch = getc(GLOBAL_Stream[sno].file); if (ch == -1) { if (how_many) { /* error */ } - return EOF; + return post_process_weof(s); } switch (GLOBAL_Stream[sno].encoding) { case ENC_OCTET: @@ -981,12 +844,7 @@ get_wchar(int sno) /* error */ /* try to recover character, assume this is our first character */ wchar_t och = GLOBAL_Stream[sno].och; - - GLOBAL_Stream[sno].och = ch; - GLOBAL_Stream[sno].stream_getc = PlUnGetc; - GLOBAL_Stream[sno].stream_wgetc = get_wchar; - GLOBAL_Stream[sno].stream_gets = DefaultGets; - return och; + return och; } if (!how_many) { return wch; @@ -1033,6 +891,12 @@ get_wchar(int sno) return EOF; } +int +get_wchar(int sno) +{ + return post_process_read_char( get_wchar__( sno ), GLOBAL_Stream+sno ); +} + #ifndef MB_LEN_MAX #define MB_LEN_MAX 6 #endif @@ -1075,8 +939,7 @@ handle_write_encoding_error(int sno, wchar_t ch) int put_wchar(int sno, wchar_t ch) { - - /* pass the bug if we can */ + /* pass the bucck if we can */ switch (GLOBAL_Stream[sno].encoding) { case ENC_OCTET: return GLOBAL_Stream[sno].stream_putc(sno, ch); @@ -1284,42 +1147,31 @@ write_bom(int sno, StreamDesc *st) static void check_bom(int sno, StreamDesc *st) { + int ch1, ch2, ch3, ch4; - int ch; - - ch = st->stream_getc(sno); - if (ch == EOFCHAR) { - st->och = ch; - st->stream_getc = PlUnGetc; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return; - } - switch(ch) { + ch1 = st->stream_getc(sno); + switch(ch1) { case 0x00: { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0x00) { - st->och = ch; - st->stream_getc = PlUnGetc00; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch2 = st->stream_getc(sno); + if ( ch2 != 0x00) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); return; } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0xFE) { - st->och = ch; - st->stream_getc = PlUnGetc0000; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch3 = st->stream_getc(sno); + if (ch3 == EOFCHAR || ch3 != 0xFE) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); + ungetc( ch3, st->file ); return; } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0xFF) { - st->och = ch; - st->stream_getc = PlUnGetc0000fe; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch4 = st->stream_getc(sno); + if (ch4 == EOFCHAR || ch3 != 0xFF) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); + ungetc( ch3, st->file ); + ungetc( ch4, st->file ); return; } else { st->status |= HAS_BOM_f; @@ -1331,12 +1183,10 @@ check_bom(int sno, StreamDesc *st) } case 0xFE: { - ch = st->stream_getc(sno); - if (ch != 0xFF) { - st->och = ch; - st->stream_getc = PlUnGetc376; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch2 = st->stream_getc(sno); + if (ch2 != 0xFF) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); return; } else { st->status |= HAS_BOM_f; @@ -1346,27 +1196,26 @@ check_bom(int sno, StreamDesc *st) } case 0xFF: { - ch = st->stream_getc(sno); - if (ch != 0xFE) { - st->och = ch; - st->stream_getc = PlUnGetc377; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch2 = st->stream_getc(sno); + if (ch2 != 0xFE) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); return; } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0x00) { - st->och = ch; - st->stream_getc = PlUnGetc377376; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch3 = st->stream_getc(sno); + if ( ch3 != 0x00) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); + ungetc( ch3, st->file ); + return; } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0x00) { - st->och = ch; - st->stream_getc = PlUnGetc37737600; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch4 = st->stream_getc(sno); + if (ch4 != 0x00) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); + ungetc( ch3, st->file ); + ungetc( ch4, st->file ); + return; } else { st->status |= HAS_BOM_f; st->encoding = ENC_ISO_UTF32_LE; @@ -1379,20 +1228,17 @@ check_bom(int sno, StreamDesc *st) } } case 0xEF: - ch = st->stream_getc(sno); - if (ch != 0xBB) { - st->och = ch; - st->stream_getc = PlUnGetc357; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return; + ch2 = st->stream_getc(sno); + if (ch2 != 0xBB) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); + return; } else { - ch = st->stream_getc(sno); - if (ch != 0xBF) { - st->och = ch; - st->stream_getc = PlUnGetc357273; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; + ch3 = st->stream_getc(sno); + if (ch3 != 0xBF) { + ungetc( ch1, st->file ); + ungetc( ch2, st->file ); + ungetc( ch3, st->file ); return; } else { st->status |= HAS_BOM_f; @@ -1400,12 +1246,8 @@ check_bom(int sno, StreamDesc *st) return; } } - default: - st->och = ch; - st->stream_getc = PlUnGetc; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return; + default: + ungetc( ch1, st->file ); } } @@ -1548,8 +1390,11 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS ) } /* get options */ xarg *args = Yap_ArgListToVector ( tlist, open_defs, OPEN_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, "option handling in open/3"); return FALSE; + } /* done */ sno = GetFreeStreamD(); if (sno < 0) @@ -1579,7 +1424,7 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS ) fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf); } else { if (!strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX)) - return (PlIOError (SYSTEM_ERROR_INTERNAL,file_name,"file name is too long in open/3")); + return PlIOError (SYSTEM_ERROR_INTERNAL,file_name,"file name is too long in open/3"); } } else if (trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG)) { fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf); @@ -1651,6 +1496,7 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS ) Yap_SetTextFile (RepAtom (AtomOfTerm (file_name))->StrOfAE); } #endif + flags &= ~(Free_Stream_f); if (!initStream( sno, fd, fname, file_name, encoding, flags, open_mode )) return false; if (open_mode == AtomWrite ) { @@ -1670,7 +1516,6 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS ) } - flags &= ~(Free_Stream_f); UNLOCK(st->streamlock); { Term t = Yap_MkStream (sno); @@ -1730,7 +1575,7 @@ p_open_null_stream (USES_REGS1) st->stream_putc = NullPutc; st->stream_wputc = put_wchar; st->stream_getc = PlGetc; - st->stream_gets = PlGetsFunc(); + st->stream_gets = PlGets; st->stream_wgetc = get_wchar; st->stream_wgetc_for_read = get_wchar; if (st->encoding == ENC_ISO_UTF8) @@ -1808,28 +1653,43 @@ CheckStream (Term arg, int kind, const char *msg) } if (GLOBAL_Stream[sno].status & Free_Stream_f) { - PlIOError(EXISTENCE_ERROR_STREAM, arg, msg); + Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); return (-1); } LOCK(GLOBAL_Stream[sno].streamlock); - if ((GLOBAL_Stream[sno].status & kind) == 0) + if (( kind & Input_Stream_f) && !(GLOBAL_Stream[sno].status & Input_Stream_f)) + { + UNLOCK(GLOBAL_Stream[sno].streamlock); + PlIOError(PERMISSION_ERROR_INPUT_STREAM, arg, msg); + } + if ((kind & (Append_Stream_f|Output_Stream_f)) && ! (GLOBAL_Stream[sno].status & Output_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); - if (kind & Input_Stream_f) - PlIOError(PERMISSION_ERROR_INPUT_STREAM, arg, msg); - else - PlIOError(PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); - return (-1); + PlIOError(PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); } return (sno); } + int Yap_CheckStream (Term arg, int kind, const char *msg) { return CheckStream(arg, kind, (char *)msg); } +int +Yap_CheckTextStream (Term arg, int kind, const char *msg) +{ + int sno; + if ((sno = CheckStream(arg, kind, (char *)msg)) < 0) + return -1; + if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return -1; + } + return sno; +} + static Int diff --git a/os/iopreds.h b/os/iopreds.h index 58bae1cde..ff8fd75b8 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -52,6 +52,7 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */ extern Term Yap_InitSocketStream(int, socket_info, socket_domain); extern int Yap_CheckStream(Term, int, const char *); +extern int Yap_CheckTextStream(Term, int, const char *); extern int Yap_CheckSocketStream(Term, const char *); extern socket_domain Yap_GetSocketDomain(int); extern socket_info Yap_GetSocketStatus(int); @@ -305,13 +306,13 @@ int console_post_process_read_char( int, StreamDesc *); int console_post_process_eof( StreamDesc *); int post_process_read_char( int, StreamDesc *); int post_process_eof( StreamDesc *); +int post_process_weof( StreamDesc *); bool is_same_tty(FILE *f1, FILE *f2); int ISOWGetc (int sno); int GetUTF8 (int sno); Term read_line(int sno); -int PlUnGetc( int); int PlGets (int sno, UInt size, char *buf); GetsFunc PlGetsFunc(void); int PlGetc (int sno); @@ -419,9 +420,6 @@ StreamPosition(int sno) Term sargs[5]; Int cpos; cpos = GLOBAL_Stream[sno].charcount; - if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { - cpos--; - } sargs[0] = MkIntegerTerm (LOCAL_StartCharCount = cpos); sargs[1] = MkIntegerTerm (LOCAL_StartLineCount = GLOBAL_Stream[sno].linecount); sargs[2] = MkIntegerTerm (LOCAL_StartLinePos = GLOBAL_Stream[sno].linepos); diff --git a/os/mem.c b/os/mem.c index d10217f22..fd84b326d 100644 --- a/os/mem.c +++ b/os/mem.c @@ -153,8 +153,9 @@ MemPutc(int sno, int ch) int - Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t enc, memBufSource src) + Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t *encp, memBufSource src) { + CACHE_REGS int sno; StreamDesc *st; @@ -180,7 +181,10 @@ MemPutc(int sno, int ch) st->linepos = 0; st->charcount = 0; st->linecount = 1; - st->encoding = enc; + if (encp) + st->encoding = *encp; + else + st->encoding = LOCAL_encoding; UNLOCK(st->streamlock); return sno; } @@ -227,14 +231,15 @@ open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ ti = TailOfTerm(ti); } nbuf[nchars] = '\0'; - sno = Yap_open_buf_read_stream(nbuf, nchars, LOCAL_encoding, MEM_BUF_CODE); + sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE); t = Yap_MkStream (sno); return (Yap_unify (ARG2, t)); } int -Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t enc, memBufSource sr) +Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSource sr) { + CACHE_REGS int sno; StreamDesc *st; @@ -258,7 +263,10 @@ Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t enc, memBufSourc st->linepos = 0; st->charcount = 0; st->linecount = 1; - st->encoding = enc; + if (encp) + st->encoding = *encp; + else + st->encoding = LOCAL_encoding; Yap_DefaultStreamOps( st ); #if MAY_WRITE st->file = open_memstream(&st->nbuf, &st->nsize); @@ -287,7 +295,7 @@ Yap_OpenBufWriteStream( USES_REGS1 ) return -1; } } - return Yap_open_buf_write_stream(nbuf, sz, GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); + return Yap_open_buf_write_stream(nbuf, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); } static Int diff --git a/os/readterm.c b/os/readterm.c index e5ff25229..e9be3ee51 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -432,10 +432,6 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { } re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; if (re->seekable) { - if (GLOBAL_Stream[inp_stream].stream_getc == PlUnGetc) { - re->had_ungetc = TRUE; - re->ungetc_oldc = GLOBAL_Stream[inp_stream].och; - } #if HAVE_FGETPOS fgetpos(GLOBAL_Stream[inp_stream].file, &re->rpos); #else @@ -676,10 +672,6 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { } } // go back to the start - if (re->had_ungetc) { - GLOBAL_Stream[inp_stream].stream_getc = PlUnGetc; - GLOBAL_Stream[inp_stream].och = re->ungetc_oldc; - } if (re->seekable) { if (GLOBAL_Stream[inp_stream].status & InMemory_Stream_f) { GLOBAL_Stream[inp_stream].u.mem_string.pos = re->cpos; @@ -808,7 +800,7 @@ static Int read_term( /* needs to change LOCAL_output_stream for write */ yhandle_t h = Yap_InitSlot(ARG2); - inp_stream = Yap_CheckStream(ARG1, Input_Stream_f, "read/3"); + inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); if (inp_stream == -1) { return (FALSE); } @@ -876,10 +868,6 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, fe->ce = Yap_CharacterEscapes(CurrentModule); re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; if (re->seekable) { - if (GLOBAL_Stream[inp_stream].stream_getc == PlUnGetc) { - re->had_ungetc = TRUE; - re->ungetc_oldc = GLOBAL_Stream[inp_stream].och; - } #if HAVE_FGETPOS fgetpos(GLOBAL_Stream[inp_stream].file, &re->rpos); #else @@ -995,7 +983,7 @@ static Int read_clause( Term t3 = Deref(ARG3); yhandle_t h = Yap_InitSlot(ARG2); /* needs to change LOCAL_output_stream for write */ - inp_stream = Yap_CheckStream(ARG1, Input_Stream_f, "read/3"); + inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); out = Yap_read_term(inp_stream, t3, -3); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); return out && Yap_unify(Yap_GetFromSlot(h), out); @@ -1036,7 +1024,7 @@ static Int read2( Int out; /* needs to change LOCAL_output_stream for write */ - inp_stream = Yap_CheckStream(ARG1, Input_Stream_f, "read/3"); + inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); if (inp_stream == -1) { return (FALSE); } @@ -1129,7 +1117,7 @@ static Int style_checker(USES_REGS1) { return TRUE; } -Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, +Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings) { CACHE_REGS Term bvar = MkVarTerm(), ctl; @@ -1144,7 +1132,7 @@ Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, } Term rval; - int stream = Yap_open_buf_read_stream(s, len, enc, MEM_BUF_USER); + int stream = Yap_open_buf_read_stream(s, len, encp, MEM_BUF_USER); rval = Yap_read_term(stream, ctl, 3); Yap_CloseStream(stream); @@ -1162,12 +1150,14 @@ Term Yap_ReadFromAtom(Atom a, Term opts) { if (IsWideAtom(a)) { wchar_t *ws = a->WStrOfAE; size_t len = wcslen(ws); - sno = Yap_open_buf_read_stream((char *)ws, len, ENC_ISO_ANSI, MEM_BUF_USER); + encoding_t enc = ENC_ISO_ANSI; + sno = Yap_open_buf_read_stream((char *)ws, len, &enc, MEM_BUF_USER); } else { char *s = a->StrOfAE; size_t len = strlen(s); + encoding_t enc = ENC_ISO_LATIN1; sno = - Yap_open_buf_read_stream((char *)s, len, ENC_ISO_LATIN1, MEM_BUF_USER); + Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER); } rval = Yap_read_term(sno, opts, 3); @@ -1178,7 +1168,8 @@ Term Yap_ReadFromAtom(Atom a, Term opts) { static Term readFromBuffer(const char *s, Term opts) { Term rval; int sno; - sno = Yap_open_buf_read_stream((char *)s, strlen_utf8((unsigned char *)s), ENC_ISO_UTF8, + encoding_t enc = ENC_ISO_UTF8; + sno = Yap_open_buf_read_stream((char *)s, strlen_utf8((unsigned char *)s), &enc, MEM_BUF_USER); rval = Yap_read_term(sno, opts, 3); @@ -1231,7 +1222,7 @@ term_to_string(USES_REGS1) { const char * s; if (IsVarTerm(t2)) { size_t length; - s = Yap_TermToString(ARG1, NULL, 0, &length, 0, Quote_illegal_f|Handle_vars_f); + s = Yap_TermToString(ARG1, NULL, 0, &length, NULL, Quote_illegal_f|Handle_vars_f); if (!s || ! MkStringTerm(s)) { Yap_Error(RESOURCE_ERROR_HEAP,t1,"Could not get memory from the operating system"); @@ -1265,7 +1256,7 @@ term_to_atom(USES_REGS1) { if (IsVarTerm(t1)) { size_t length; char * s = - Yap_TermToString(t1, NULL, 0, &length, 0, Quote_illegal_f|Handle_vars_f); + Yap_TermToString(t1, NULL, 0, &length, NULL, Quote_illegal_f|Handle_vars_f); if (!s || !(at = Yap_LookupAtom(s))) { Yap_Error(RESOURCE_ERROR_HEAP,t1,"Could not get memory from the operating system"); return false; @@ -1340,7 +1331,8 @@ static Int read_term_from_string(USES_REGS1) { len = strlen_utf8(s); } char *ss = (char *)s; - int sno = Yap_open_buf_read_stream(ss, len, ENC_ISO_UTF8, MEM_BUF_USER); + encoding_t enc = ENC_ISO_UTF8; + int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER); rc = readFromBuffer(ss, Deref(ARG3)); Yap_CloseStream(sno); if (!rc) @@ -1378,7 +1370,8 @@ static Int read_term_from_atomic(USES_REGS1) { len = strlen_utf8(( unsigned char *)s); } char *ss = (char *)s; - int sno = Yap_open_buf_read_stream(ss, len, ENC_ISO_UTF8, MEM_BUF_USER); + encoding_t enc = ENC_ISO_UTF8; + int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER); rc = readFromBuffer(ss, Deref(ARG3)); Yap_CloseStream(sno); if (!rc) diff --git a/os/readutil.c b/os/readutil.c index 9acc9d2a1..c107d06ee 100644 --- a/os/readutil.c +++ b/os/readutil.c @@ -83,7 +83,7 @@ rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) end = Deref(XREGS[arity]); if (GLOBAL_Stream[sno].encoding == ENC_ISO_UTF8) return Yap_unify(ARG2, Yap_UTF8ToDiffListOfCodes((const char *)TR, end PASS_REGS)) ; - else if (GLOBAL_Stream[sno].encoding == PL_ENC_WCHAR) + else if (GLOBAL_Stream[sno].encoding == ENC_WCHAR) return Yap_unify(ARG2, Yap_WCharsToDiffListOfCodes((const wchar_t *)TR, end PASS_REGS)) ; return Yap_unify(ARG2, Yap_CharsToDiffListOfCodes((const char *)TR, end, ENC_ISO_LATIN1 PASS_REGS)) ; } diff --git a/os/streams.c b/os/streams.c index 47c338267..d33b2e971 100644 --- a/os/streams.c +++ b/os/streams.c @@ -137,9 +137,9 @@ int GetFreeStreamD(void) { UNLOCK(GLOBAL_StreamDescLock); return -1; } - GLOBAL_Stream[sno].encoding = LOCAL_encoding; LOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_StreamDescLock); + GLOBAL_Stream[sno].encoding = LOCAL_encoding; return sno; } @@ -588,6 +588,7 @@ static bool do_stream_property(int sno, } } } + UNLOCK(GLOBAL_Stream[sno].streamlock); return rc; } @@ -657,7 +658,8 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */ i = Yap_CheckStream(t1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "current_stream/3"); if (i < 0) { - cut_fail(); + UNLOCK(GLOBAL_Stream[i].streamlock); + cut_fail(); } args = Yap_ArgListToVector(Deref(ARG2), stream_property_defs, STREAM_PROPERTY_END); diff --git a/os/writeterm.c b/os/writeterm.c index 4487931d5..a39a7d512 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -310,8 +310,13 @@ write_term2 ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ xarg * args = Yap_ArgListToVector ( ARG2, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) + LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; + } yhandle_t mySlots = Yap_StartSlots(); int output_stream = LOCAL_c_output_stream; if (output_stream == -1) output_stream = 1; @@ -335,11 +340,18 @@ write_term3 ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ - yhandle_t mySlots = Yap_StartSlots(); xarg *args = Yap_ArgListToVector ( ARG3, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) + LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; - int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2"); + } + int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); + if (output_stream < 0 ) + return false; + yhandle_t mySlots = Yap_StartSlots(); write_term( output_stream, ARG2, args PASS_REGS); UNLOCK(GLOBAL_Stream[output_stream].streamlock); Yap_CloseSlots( mySlots ); @@ -360,14 +372,23 @@ write2 ( USES_REGS1 ) we cannot make recursive Prolog calls */ - xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + xarg *args; + yhandle_t mySlots; + int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); + if (output_stream < 0 ) return false; - yhandle_t mySlots = Yap_StartSlots(); - int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2"); + args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); + if (args == NULL) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) + LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + return false; + } + mySlots = Yap_StartSlots(); args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].tvalue = TermTrue; -write_term( output_stream, ARG2, args PASS_REGS); + write_term( output_stream, ARG2, args PASS_REGS); UNLOCK(GLOBAL_Stream[output_stream].streamlock); Yap_CloseSlots( mySlots ); if (EX != 0L) { @@ -385,13 +406,16 @@ write1 ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ - int output_stream = LOCAL_c_output_stream; + int output_stream = LOCAL_c_output_stream; if (output_stream == -1) output_stream = 1; xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; + } yhandle_t mySlots = Yap_StartSlots(); - args[WRITE_NUMBERVARS].used = true; + args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].tvalue = TermTrue; LOCK(GLOBAL_Stream[output_stream].streamlock); write_term( output_stream, ARG1, args PASS_REGS); @@ -415,8 +439,11 @@ write_canonical1 ( USES_REGS1 ) int output_stream = LOCAL_c_output_stream; if (output_stream == -1) output_stream = 1; xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; + } yhandle_t mySlots = Yap_StartSlots(); args[WRITE_IGNORE_OPS].used = true; args[WRITE_IGNORE_OPS].tvalue = TermTrue; @@ -442,10 +469,15 @@ write_canonical ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + return false; + } + int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); + if (output_stream < 0 ) return false; yhandle_t mySlots = Yap_StartSlots(); - int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2"); args[WRITE_IGNORE_OPS].used = true; args[WRITE_IGNORE_OPS].tvalue = TermTrue; args[WRITE_QUOTED].used = true; @@ -469,8 +501,11 @@ writeq1 ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; + } yhandle_t mySlots = Yap_StartSlots(); int output_stream = LOCAL_c_output_stream; if (output_stream == -1) output_stream = 1; @@ -499,10 +534,15 @@ writeq ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + return false; + } + int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); + if (output_stream < 0 ) return false; yhandle_t mySlots = Yap_StartSlots(); - int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2"); args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_QUOTED].used = true; @@ -527,8 +567,11 @@ print1 ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; + } yhandle_t mySlots = Yap_StartSlots(); int output_stream = LOCAL_c_output_stream; if (output_stream == -1) output_stream = 1; @@ -557,9 +600,14 @@ print ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + return false; + } + int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); + if (output_stream < 0 ) return false; - int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "write/2"); yhandle_t mySlots = Yap_StartSlots(); args[WRITE_PORTRAY].used = true; args[WRITE_PORTRAY].tvalue = TermTrue; @@ -586,8 +634,11 @@ writeln1 ( USES_REGS1 ) int output_stream = LOCAL_c_output_stream; if (output_stream == -1) output_stream = 1; xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; + } yhandle_t mySlots = Yap_StartSlots(); args[WRITE_NL].used = true; args[WRITE_NL].tvalue = TermTrue; @@ -614,9 +665,12 @@ writeln ( USES_REGS1 ) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); - if (args == NULL ) + if (args == NULL) { + if (LOCAL_Error_TYPE) + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); return false; - int output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "writeln/2"); + } + int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "writeln/2"); if (output_stream < 0) return false; yhandle_t mySlots = Yap_StartSlots(); diff --git a/os/yapio.h b/os/yapio.h index 3fc7fbd7d..845ae4c0d 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -98,8 +98,8 @@ int Yap_PlFGetchar(void); int Yap_GetCharForSIGINT(void); Int Yap_StreamToFileNo(Term); int Yap_OpenStream(FILE *,char *,Term,int); -char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t encoding, int flags); -char *Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, encoding_t encoding, int flags); +char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t *encoding, int flags); +char *Yap_HandleToString(yhandle_t l, size_t sz, size_t *length, encoding_t *encoding, int flags); int Yap_GetFreeStreamD(void); int Yap_GetFreeStreamDForReading(void); @@ -143,11 +143,11 @@ typedef enum mem_buf_source { char * Yap_MemStreamBuf( int sno ); -extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *bindings_p); -extern Term Yap_StringToNumberTerm(char *s, encoding_t encp); +extern Term Yap_StringToTerm(const char *s, size_t len, encoding_t* encp, int prio, Term *bindings_p); +extern Term Yap_StringToNumberTerm(char *s, encoding_t *encp); int Yap_FormatFloat(Float f, char **s, size_t sz); -int Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t enc, memBufSource src); -int Yap_open_buf_write_stream( char *nbuf, size_t nchars, encoding_t enc, memBufSource src); +int Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t *encp, memBufSource src); +int Yap_open_buf_write_stream( char *nbuf, size_t nchars, encoding_t *encp, memBufSource src); Term Yap_ReadFromAtom(Atom a, Term opts); FILE *Yap_GetInputStream(Term t, const char *m); FILE *Yap_GetOutputStream(Term t,const char *m);