From 90c1641841f9bc6cd54efae026cede6092167077 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 13 Dec 2006 16:10:26 +0000 Subject: [PATCH] several debugger and CLP(BN) improvements. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1732 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/agc.c | 34 +- C/amasm.c | 16 +- C/analyst.c | 33 +- C/c_interface.c | 127 +++---- C/cdmgr.c | 107 ++++-- C/dbase.c | 16 - C/exec.c | 4 +- C/globals.c | 19 +- C/grow.c | 36 +- C/init.c | 7 +- C/iopreds.c | 141 ++++---- C/scanner.c | 4 +- C/stdpreds.c | 70 ++-- C/unify.c | 2 +- CLPBN/clpbn.yap | 11 +- CLPBN/clpbn/evidence.yap | 2 +- CLPBN/clpbn/examples/School/tables.yap | 4 +- H/Atoms.h | 11 +- H/Yap.h | 6 +- H/Yapproto.h | 4 +- Makefile.in | 4 + changes-5.1.html | 4 + configure | 6 +- configure.in | 4 +- include/YapInterface.h | 11 +- library/Makefile.in | 2 +- library/swi.yap | 2 +- misc/yap.def | 7 +- pl/boot.yap | 179 +++++----- pl/consult.yap | 28 +- pl/corout.yap | 4 - pl/debug.yap | 444 ++++++++++++++----------- pl/directives.yap | 6 +- pl/errors.yap | 8 +- pl/init.yap | 2 - pl/signals.yap | 58 +++- pl/yio.yap | 2 +- 37 files changed, 831 insertions(+), 594 deletions(-) diff --git a/C/agc.c b/C/agc.c index baaa6be9c..b5c204d11 100644 --- a/C/agc.c +++ b/C/agc.c @@ -173,7 +173,10 @@ mark_hash_entry(AtomHashEntry *HashPtr) AtomEntry *at = RepAtom(atm); do { #ifdef DEBUG_RESTORE1 /* useful during debug */ - fprintf(errout, "Restoring %s\n", at->StrOfAE); + if (IsWideAtom(atm)) + fprintf(errout, "Restoring %S\n", at->WStrOfAE); + else + fprintf(errout, "Restoring %s\n", at->StrOfAE); #endif RestoreEntries(RepProp(at->PropsOfAE)); atm = at->NextOfAE; @@ -211,7 +214,10 @@ mark_atoms(void) } do { #ifdef DEBUG_RESTORE1 /* useful during debug */ - fprintf(errout, "Restoring %s\n", at->StrOfAE); + if (IsWideAtom(atm)) + fprintf(errout, "Restoring %S\n", at->WStrOfAE); + else + fprintf(errout, "Restoring %s\n", at->StrOfAE); #endif RestoreEntries(RepProp(at->PropsOfAE)); atm = at->NextOfAE; @@ -330,12 +336,19 @@ clean_atom(AtomHashEntry *HashPtr) atm = at->NextOfAE; NOfAtoms--; } else { + if (IsWideAtom(atm)) { #ifdef DEBUG_RESTORE3 - fprintf(stderr, "Purged %p:%s\n", at, at->StrOfAE); + fprintf(errout, "Purged %p:%S\n", at, at->WStrOfAE); #endif + agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE); + } else { +#ifdef DEBUG_RESTORE3 + fprintf(stderr, "Purged %p:%s\n", at, at->StrOfAE); +#endif + agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); + } *patm = at->NextOfAE; atm = at->NextOfAE; - agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); Yap_FreeCodeSpace((char *)at); } } @@ -370,12 +383,19 @@ clean_atoms(void) NOfAtoms--; atm = at->NextOfAE; } else { -#ifdef DEBUG_RESTORE1 - fprintf(stderr, "Purged %s\n", at->StrOfAE); + if (IsWideAtom(atm)) { +#ifdef DEBUG_RESTORE3 + fprintf(errout, "Purged %p:%S\n", at, at->WStrOfAE); #endif + agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE); + } else { +#ifdef DEBUG_RESTORE3 + fprintf(stderr, "Purged %p:%s\n", at, at->StrOfAE); +#endif + agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); + } *patm = at->NextOfAE; atm = at->NextOfAE; - agc_collected += sizeof(AtomEntry) + strlen(at->StrOfAE); Yap_FreeCodeSpace((char *)at); } } diff --git a/C/amasm.c b/C/amasm.c index f202e8dd0..614a9b3d7 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,11 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2006-11-15 00:13:36 $ * +* Last rev: $Date: 2006-12-13 16:10:14 $ * * $Log: not supported by cvs2svn $ +* Revision 1.92 2006/11/15 00:13:36 vsc +* fixes for indexing code. +* * Revision 1.91 2006/11/06 18:35:03 vsc * 1estranha * @@ -1310,7 +1313,8 @@ compile_cmp_flags(char *s) wamreg Yap_compile_cmp_flags(PredEntry *pred) { - return compile_cmp_flags(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE); + return + compile_cmp_flags(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE); } static yamop * @@ -3506,12 +3510,16 @@ Yap_InitComma(void) Functor fp = Yap_MkFunctor(Yap_FullLookupAtom("$generate_pred_info"),4); code_p->opc = emit_op(_call_cpred); code_p->u.sla.s = emit_count(-Signed(RealEnvSize)); - code_p->u.sla.sla_u.p = RepPredProp(Yap_GetPredPropByFunc(fp,0)); + code_p->u.sla.sla_u.p = + code_p->u.sla.p0 = + RepPredProp(Yap_GetPredPropByFunc(fp,0)); code_p->u.sla.bmap = NULL; GONEXT(sla); code_p->opc = emit_op(_call); code_p->u.sla.s = emit_count(-Signed(RealEnvSize)); - code_p->u.sla.sla_u.p = PredMetaCall; + code_p->u.sla.sla_u.p = + code_p->u.sla.p0 = + PredMetaCall; code_p->u.sla.bmap = NULL; GONEXT(sla); code_p->opc = emit_op(_deallocate); diff --git a/C/analyst.c b/C/analyst.c index a0c87747e..da8c647f8 100644 --- a/C/analyst.c +++ b/C/analyst.c @@ -87,16 +87,26 @@ static Int p_show_op_counters() { int i; - char *program; Term t1 = Deref(ARG1); if (IsVarTerm(t1) || !IsAtomTerm(t1)) { return FALSE; } else { - program = RepAtom(AtomOfTerm(t1))->StrOfAE; + Atom at1 = AtomOfTerm(t1); + + if (IsWideAtom(at1)) { + wchar_t *program; + + program = RepAtom(at1)->WStrOfAE; + fprintf(Yap_stderr, "\n Instructions Executed in %S\n", program); + } else { + char *program; + + program = RepAtom(at1)->StrOfAE; + fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program); + } } - fprintf(Yap_stderr, "\n Instructions Executed in %s \n", program); for (i = 0; i <= _std_top; ++i) print_instruction(i); fprintf(Yap_stderr, "\n Control Instructions \n"); @@ -300,14 +310,24 @@ p_show_ops_by_group(void) ccpcount c_cp; int gets, unifies, puts, writes, controls, choice_pts, indexes, misc, total; - char *program; Term t1; + Atom at1; t1 = Deref(ARG1); if (IsVarTerm(t1) || !IsAtomTerm(t1)) return (FALSE); - else - program = RepAtom(AtomOfTerm(t1))->StrOfAE; + at1 = AtomOfTerm(t1); + if (IsWideAtom(at1)) { + wchar_t *program; + + program = RepAtom(at1)->WStrOfAE; + fprintf(Yap_stderr, "\n Instructions Executed in %S\n", program); + } else { + char *program; + + program = RepAtom(at1)->StrOfAE; + fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program); + } c_get.nxvar = Yap_opcount[_get_x_var]; @@ -634,7 +654,6 @@ p_show_ops_by_group(void) * print_instruction(i); */ - fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program); fprintf(Yap_stderr, "Groups are\n\n"); fprintf(Yap_stderr, " GET instructions: %8d (%3d%%)\n", gets, (gets * 100) / total); diff --git a/C/c_interface.c b/C/c_interface.c index 5dd8067b2..3528bf03d 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -10,8 +10,11 @@ * File: c_interface.c * * comments: c_interface primitives definition * * * -* Last rev: $Date: 2006-11-27 17:42:02 $,$Author: vsc $ * +* Last rev: $Date: 2006-12-13 16:10:14 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.86 2006/11/27 17:42:02 vsc +* support for UNICODE, and other bug fixes. +* * Revision 1.85 2006/05/16 18:37:30 vsc * WIN32 fixes * compiler bug fixes @@ -338,10 +341,9 @@ X_API CELL STD_PROTO(YAP_ThreadCreateEngine,(thread_attr *)); X_API int STD_PROTO(YAP_ThreadAttachEngine,(int)); X_API int STD_PROTO(YAP_ThreadDetachEngine,(int)); X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int)); -X_API int STD_PROTO(YAP_ArgsToIntArray,(Term, UInt, const Int *)); -X_API Term STD_PROTO(YAP_IntArrayToArgs,(UInt, const Int *)); -X_API int STD_PROTO(YAP_ArgsToFloatArray,(Term, UInt, const Float *)); -X_API Term STD_PROTO(YAP_FloatArrayToArgs,(UInt, const Float *)); +X_API Term STD_PROTO(YAP_MkBlobTerm,(unsigned int)); +X_API void *STD_PROTO(YAP_BlobOfTerm,(Term)); +X_API Term STD_PROTO(YAP_TermNil,(void)); static int (*do_getf)(void); @@ -475,6 +477,40 @@ YAP_BigNumOfTerm(Term t, void *b) #endif /* USE_GMP */ } +X_API Term +YAP_MkBlobTerm(unsigned int sz) +{ + Term I; + MP_INT *dst; + BACKUP_H(); + + I = AbsAppl(H); + if (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024) + return TermNil; + H[0] = (CELL)FunctorBigInt; + dst = (MP_INT *)(H+1); + dst->_mp_size = 0L; + dst->_mp_alloc = sz; + H += (1+sizeof(MP_INT)/sizeof(CELL)); + H[sz] = EndSpecials; + H += sz+1; + RECOVER_H(); + + return I; +} + +X_API void * +YAP_BlobOfTerm(Term t) +{ + MP_INT *src; + if (IsVarTerm(t)) + return NULL; + if (!IsBigIntTerm(t)) + return NULL; + src = (MP_INT *)(RepAppl(t)+1); + return (void *)(src+1); +} + X_API Term YAP_MkFloatTerm(double n) { @@ -1640,86 +1676,9 @@ YAP_ThreadDestroyEngine(int wid) #endif } -/* Copy a number of terms to an array of integers */ -X_API int -YAP_ArgsToIntArray(Term t, UInt size, const Int *ar) -{ - Int *dest = (Int *)ar; - CELL *ptr; - - if (IsVarTerm(t) || - !IsApplTerm(t)) return FALSE; - if (ArityOfFunctor(FunctorOfTerm(t)) != size) - return FALSE; - ptr = RepAppl(t)+1; - while (size) { - Term t = *ptr++; - if (IsVarTerm(t) || !IsIntegerTerm(t)) - return FALSE; - *dest++ = IntegerOfTerm(t); - } - return TRUE; -} - X_API Term -YAP_IntArrayToArgs(UInt size, const Int *ar) +YAP_TermNil(void) { - Term t; - BACKUP_H(); - CELL *ptr = H+1; - Int *source = (Int *)ar; - - if (H+(size+1) >= ASP) { - return TermNil; - } - t = AbsAppl(H); - *H++ = (CELL)Yap_MkFunctor(Yap_LookupAtom("data"),size); - H+=size; - while (size) { - *ptr++ = MkIntegerTerm(*source++); - } - RECOVER_H(); - return t; -} - -X_API int -YAP_ArgsToFloatArray(Term t, UInt size, const Float *ar) -{ - CELL *ptr; - Float *dest = (Float *)ar; - - if (IsVarTerm(t) || - !IsApplTerm(t)) return FALSE; - if (ArityOfFunctor(FunctorOfTerm(t)) != size) - return FALSE; - ptr = RepAppl(t)+1; - while (size) { - Term t = *ptr++; - if (IsVarTerm(t) || !IsFloatTerm(t)) - return FALSE; - *dest++ = FloatOfTerm(t); - } - return TRUE; -} - -X_API Term -YAP_FloatArrayToArgs(UInt size, const Float *ar) -{ - Term t; - BACKUP_H(); - CELL *ptr = H+1; - Float *source = (Float *)ar; - - if (H+(size+1) >= ASP) { - return TermNil; - } - t = AbsAppl(H); - *H++ = (CELL)Yap_MkFunctor(Yap_LookupAtom("data"),size); - H+=size; - while (size) { - *ptr++ = MkFloatTerm(*source++); - } - RECOVER_H(); - return t; + return TermNil; } diff --git a/C/cdmgr.c b/C/cdmgr.c index da3951b1e..cd23ab83b 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2006-11-27 17:42:02 $,$Author: vsc $ * +* Last rev: $Date: 2006-12-13 16:10:14 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.200 2006/11/27 17:42:02 vsc +* support for UNICODE, and other bug fixes. +* * Revision 1.199 2006/11/15 00:13:36 vsc * fixes for indexing code. * @@ -3375,6 +3378,12 @@ p_all_choicepoints(void) return Yap_unify(ARG1,all_cps(B)); } +static Int +p_all_envs(void) +{ + return Yap_unify(ARG1,all_envs(ENV)); +} + static Int p_current_stack(void) { @@ -5680,12 +5689,69 @@ p_program_continuation(void) static Term BuildActivePred(PredEntry *ap, CELL *vect) { + UInt i; + if (!ap->ArityOfPE) { return MkVarTerm(); } + for (i = 0; i < ap->ArityOfPE; i++) { + Term t = Deref(vect[i]); + if (IsVarTerm(t)) { + CELL *pt = VarOfTerm(t); + /* one stack */ + if (pt > H) { + Term nt = MkVarTerm(); + Yap_unify(t, nt); + } + } + } return Yap_MkApplTerm(ap->FunctorOfPred, ap->ArityOfPE, vect); } +static int +UnifyPredInfo(PredEntry *pe, int start_arg) { + UInt arity = pe->ArityOfPE; + Term tmod, tname; + + if (pe->ModuleOfPred != IDB_MODULE) { + if (pe->ModuleOfPred == PROLOG_MODULE) { + tmod = TermProlog; + } else { + tmod = pe->ModuleOfPred; + } + if (pe->ArityOfPE == 0) { + tname = MkAtomTerm((Atom)pe->FunctorOfPred); + } else { + Functor f = pe->FunctorOfPred; + tname = MkAtomTerm(NameOfFunctor(f)); + } + } else { + tmod = pe->ModuleOfPred; + if (pe->PredFlags & NumberDBPredFlag) { + tname = MkIntegerTerm(pe->src.IndxId); + } else if (pe->PredFlags & AtomDBPredFlag) { + tname = MkAtomTerm((Atom)pe->FunctorOfPred); + } else { + Functor f = pe->FunctorOfPred; + tname = MkAtomTerm(NameOfFunctor(f)); + } + } + return Yap_unify(XREGS[start_arg], tmod) && + Yap_unify(XREGS[start_arg+1],tname) && + Yap_unify(XREGS[start_arg+2],MkIntegerTerm(arity)); +} + + +static Int +p_env_info(void) +{ + PredEntry *pe; + yamop *env_cp = (yamop *)IntegerOfTerm(Deref(ARG1)); + + pe = PREVOP(env_cp,sla)->u.sla.p0; + return UnifyPredInfo(pe, 2); +} + static Int p_choicepoint_info(void) { @@ -5693,8 +5759,7 @@ p_choicepoint_info(void) PredEntry *pe; int go_on = TRUE; yamop *ipc = cptr->cp_ap; - Term t, tname, tmod; - UInt arity; + Term t; while (go_on) { op_numbers opnum = Yap_op_from_opcode(ipc->opc); @@ -5812,6 +5877,12 @@ p_choicepoint_info(void) t = BuildActivePred(pe, cptr->cp_args); break; case _Nstop: + { + Atom at = Yap_FullLookupAtom("$live"); + t = MkAtomTerm(at); + pe = RepPredProp(PredPropByAtom(at, CurrentModule)); + } + break; case _Ystop: default: pe = NULL; @@ -5819,33 +5890,7 @@ p_choicepoint_info(void) return FALSE; } } - arity = pe->ArityOfPE; - if (pe->ModuleOfPred != IDB_MODULE) { - if (pe->ModuleOfPred == PROLOG_MODULE) { - tmod = TermProlog; - } else { - tmod = pe->ModuleOfPred; - } - if (pe->ArityOfPE == 0) { - tname = MkAtomTerm((Atom)pe->FunctorOfPred); - } else { - Functor f = pe->FunctorOfPred; - tname = MkAtomTerm(NameOfFunctor(f)); - } - } else { - tmod = pe->ModuleOfPred; - if (pe->PredFlags & NumberDBPredFlag) { - tname = MkIntegerTerm(pe->src.IndxId); - } else if (pe->PredFlags & AtomDBPredFlag) { - tname = MkAtomTerm((Atom)pe->FunctorOfPred); - } else { - Functor f = pe->FunctorOfPred; - tname = MkAtomTerm(NameOfFunctor(f)); - } - } - return Yap_unify(ARG2, tmod) && - Yap_unify(ARG3,tname) && - Yap_unify(ARG4,MkIntegerTerm(arity)) && + return UnifyPredInfo(pe, 2) && Yap_unify(ARG5,t); } @@ -5906,7 +5951,9 @@ Yap_InitCdMgr(void) Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$all_choicepoints", 1, p_all_choicepoints, HiddenPredFlag); + Yap_InitCPred("$all_envs", 1, p_all_envs, HiddenPredFlag); Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag); + Yap_InitCPred("$env_info", 4, p_env_info, HiddenPredFlag); Yap_InitCPred("$predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag); #ifdef DEBUG Yap_InitCPred("$predicate_live_cps", 4, p_predicate_lu_cps, 0L); diff --git a/C/dbase.c b/C/dbase.c index ae0d92730..1351ec15d 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -4845,22 +4845,6 @@ cont_current_key(void) READ_UNLOCK(HashChain[i].AERWLock); i++; } - i = 0; - while (i < WideAtomHashTableSize) { - /* protect current hash table line, notice that the current - LOCK/UNLOCK algorithm assumes new entries are added to - the *front* of the list, otherwise I should have locked - earlier. - */ - READ_LOCK(HashChain[i].AERWLock); - a = HashChain[i].Entry; - if (a != NIL) { - break; - } - /* move to next entry */ - READ_UNLOCK(HashChain[i].AERWLock); - i++; - } if (i == AtomHashTableSize) { /* we have left the atom hash table */ /* we don't have a lock over the hash table any longer */ diff --git a/C/exec.c b/C/exec.c index 128035593..10e12acbe 100644 --- a/C/exec.c +++ b/C/exec.c @@ -362,7 +362,6 @@ EnterCreepMode(Term t, Term mod) { LOCK(SignalLock); CreepFlag = CalculateStackGap(); UNLOCK(SignalLock); - yap_flags[SPY_CREEP_FLAG] = TRUE; P_before_spy = P; return (CallPredicate(PredCreep, B, PredCreep->CodeOfPred)); } @@ -601,6 +600,8 @@ p_execute_nonstop(void) /* call may not define new system predicates!! */ if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred); + } else if (RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) { + return RepPredProp(pe)->cs.f_code(); } else { return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred); } @@ -1241,7 +1242,6 @@ exec_absmi(int top) restore_B(); /* H is not so important, because we're gonna backtrack */ restore_H(); - yap_flags[SPY_CREEP_FLAG] = 0; LOCK(SignalLock); CreepFlag = CalculateStackGap(); Yap_PrologMode = UserMode; diff --git a/C/globals.c b/C/globals.c index b8463b3ce..128cd90b3 100644 --- a/C/globals.c +++ b/C/globals.c @@ -145,12 +145,14 @@ NewDelayArena(UInt size) { attvar_record *max = DelayTop(), *min = max-size; Term out; + UInt howmuch; while ((ADDR)min < Yap_GlobalBase+1024) { - if (!Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))) { + if ((howmuch = Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))==0)) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); return TermNil; } + size = howmuch/sizeof(attvar_record); max = DelayTop(), min = max-size; } out = CreateDelayArena(max, min); @@ -162,6 +164,8 @@ static Term GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity) { Term arena = *arenap; + UInt howmuch; + if (size == 0) { if (old_size < 1024) { size = old_size; @@ -173,10 +177,11 @@ GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity) size = 64; } XREGS[arity+1] = (CELL)arenap; - if (!Yap_InsertInGlobal((CELL *)arena, (size-old_size)*sizeof(attvar_record))) { + if ((howmuch = Yap_InsertInGlobal((CELL *)arena, (size-old_size)*sizeof(attvar_record)))==0) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return TermNil; } + size = howmuch/sizeof(attvar_record)+old_size; arenap = (CELL *)XREGS[arity+1]; arena = *arenap; CreateDelayArena(DelayArenaPt(arena), DelayArenaPt(arena)-size); @@ -189,6 +194,7 @@ static Term NewArena(UInt size, UInt arity, CELL *where) { Term t; + UInt new_size; if (where == NULL || where == H) { while (H+size > ASP-1024) { @@ -200,10 +206,11 @@ NewArena(UInt size, UInt arity, CELL *where) t = CreateNewArena(H, size); H += size; } else { - if (!Yap_InsertInGlobal(where, size*sizeof(CELL))) { + if ((new_size=Yap_InsertInGlobal(where, size*sizeof(CELL)))==0) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); return TermNil; } + size = new_size/sizeof(CELL); t = CreateNewArena(where, size); } return t; @@ -291,10 +298,11 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity) H += size; } else { XREGS[arity+1] = arena; - if (!Yap_InsertInGlobal(pt, size*sizeof(CELL))) { + if ((size=Yap_InsertInGlobal(pt, size*sizeof(CELL)))==0) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; } + size = size/sizeof(CELL); arena = XREGS[arity+1]; } CreateNewArena(ArenaPt(arena), size+old_size); @@ -1474,10 +1482,11 @@ p_nb_heap_add_to_heap(void) } else { extra_size = hmsize; } - if (!Yap_InsertInGlobal(top, extra_size*2*sizeof(CELL))) { + if ((extra_size=Yap_InsertInGlobal(top, extra_size*2*sizeof(CELL)))==0) { Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); return FALSE; } + extra_size = extra_size/(2*sizeof(CELL)); qd = GetHeap(ARG1,"add_to_heap"); hmsize += extra_size; if (!qd) diff --git a/C/grow.c b/C/grow.c index a29d152dd..29661d1e7 100644 --- a/C/grow.c +++ b/C/grow.c @@ -607,7 +607,11 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit) } if (size < ((char *)H0-omax)/8) size = ((char *)H0-omax)/8; - size0 = size = AdjustPageSize(size); + if (do_grow) { + size0 = size = AdjustPageSize(size); + } else { + size0 = size; + } /* adjust to a multiple of 256) */ Yap_ErrorMessage = NULL; Yap_PrologMode |= GrowStackMode; @@ -621,7 +625,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit) if (size < 0) { Yap_ErrorMessage = "Global Stack crashed against Local Stack"; Yap_PrologMode &= ~GrowStackMode; - return FALSE; + return 0; } } } @@ -705,7 +709,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit) fprintf(Yap_stderr, "%% %cO Total of %g sec expanding stacks \n", vb_msg1, (double)total_delay_overflow_time/1000); } Yap_PrologMode &= ~GrowStackMode; - return(TRUE); + return size0; } static void @@ -1062,19 +1066,7 @@ Yap_growglobal(CELL **ptr) return(FALSE); } #endif - if (!static_growglobal(sz, ptr, NULL)) - return(FALSE); -#ifdef TABLING - fix_tabling_info(); -#endif /* TABLING */ - return(TRUE); -} - - -int -Yap_InsertInGlobal(CELL *where, UInt howmuch) -{ - if (!static_growglobal(howmuch, NULL, where)) + if ( static_growglobal(sz, ptr, NULL) == 0) return FALSE; #ifdef TABLING fix_tabling_info(); @@ -1083,6 +1075,18 @@ Yap_InsertInGlobal(CELL *where, UInt howmuch) } +UInt +Yap_InsertInGlobal(CELL *where, UInt howmuch) +{ + if ((howmuch = static_growglobal(howmuch, NULL, where)) == 0) + return 0; +#ifdef TABLING + fix_tabling_info(); +#endif /* TABLING */ + return howmuch; +} + + int Yap_growstack(long size) { diff --git a/C/init.c b/C/init.c index f59161213..b4dc689a1 100644 --- a/C/init.c +++ b/C/init.c @@ -528,7 +528,9 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags) p_code->opc = Yap_opcode(_call_cpred); p_code->u.sla.bmap = NULL; p_code->u.sla.s = -Signed(RealEnvSize); - p_code->u.sla.sla_u.p = pe; + p_code->u.sla.sla_u.p = + p_code->u.sla.p0 = + pe; p_code = NEXTOP(p_code,sla); if (!(flags & SafePredFlag)) { p_code->opc = Yap_opcode(_deallocate); @@ -628,7 +630,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred); p_code->u.sla.bmap = NULL; p_code->u.sla.s = -Signed(RealEnvSize); - p_code->u.sla.sla_u.p = pe; + p_code->u.sla.sla_u.p = p_code->u.sla.p0 = pe; p_code = NEXTOP(p_code,sla); p_code->opc = Yap_opcode(_procceed); p_code->u.p.p = pe; @@ -837,7 +839,6 @@ InitFlags(void) yap_flags[YAP_TO_CHARS_FLAG] = QUINTUS_TO_CHARS; yap_flags[LANGUAGE_MODE_FLAG] = 0; yap_flags[STRICT_ISO_FLAG] = FALSE; - yap_flags[SPY_CREEP_FLAG] = 0; yap_flags[SOURCE_MODE_FLAG] = FALSE; yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES; yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE; diff --git a/C/iopreds.c b/C/iopreds.c index 15742a383..1cdd4f2f4 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -83,8 +83,10 @@ static char SccsId[] = "%W% %G%"; STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *)); STATIC_PROTO (int FilePutc, (int, int)); STATIC_PROTO (int MemPutc, (int, int)); -STATIC_PROTO (int console_post_process_read_char, (int, StreamDesc *)); +STATIC_PROTO (int console_post_process_read_char, (wchar_t, StreamDesc *)); +STATIC_PROTO (int console_post_process_eof, (StreamDesc *)); STATIC_PROTO (int post_process_read_char, (int, StreamDesc *)); +STATIC_PROTO (int post_process_eof, (StreamDesc *)); #if USE_SOCKET STATIC_PROTO (int SocketPutc, (int, int)); STATIC_PROTO (int ConsoleSocketPutc, (int, int)); @@ -999,7 +1001,7 @@ static int ReadlineGetc(int sno) { register StreamDesc *s = &Stream[sno]; - register int ch; + register wchar_t ch; while (ttyptr == NULL) { /* Only sends a newline if we are at the start of a line */ @@ -1042,7 +1044,7 @@ ReadlineGetc(int sno) if (Yap_PrologMode & AbortMode) { Yap_Error(PURE_ABORT, TermNil, ""); Yap_ErrorMessage = "Abort"; - return(console_post_process_read_char(EOF, s)); + return console_post_process_eof(s); } continue; } else { @@ -1052,7 +1054,7 @@ ReadlineGetc(int sno) strncpy (Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT); /* window of vulnerability closed */ if (myrl_line == NULL) - return(console_post_process_read_char(EOF, s)); + return console_post_process_eof(s); if (myrl_line[0] != '\0' && myrl_line[1] != '\0') add_history (myrl_line); ttyptr = myrl_line; @@ -1064,7 +1066,7 @@ ReadlineGetc(int sno) ch = *((unsigned char *)ttyptr); ttyptr++; } - return(console_post_process_read_char(ch, s)); + return console_post_process_read_char(ch, s); } #endif /* HAVE_LIBREADLINE */ @@ -1073,7 +1075,7 @@ ReadlineGetc(int sno) int Yap_GetCharForSIGINT(void) { - int ch; + wchar_t ch; #if HAVE_LIBREADLINE if ((Yap_PrologMode & ConsoleGetcMode) && myrl_line != (char *) NULL) { ch = myrl_line[0]; @@ -1175,54 +1177,62 @@ EOFGetc(int sno) static int post_process_read_char(int ch, StreamDesc *s) { + ++s->charcount; + ++s->linepos; if (ch == '\n') { ++s->linecount; - ++s->charcount; s->linepos = 0; /* don't convert if the stream is binary */ if (!(s->status & Binary_Stream_f)) ch = 10; - } else if (ch == EOF) { - s->status |= Eof_Stream_f; - s->stream_getc = EOFGetc; - s->stream_wgetc = get_wchar; - if (CharConversionTable != NULL) - s->stream_wgetc_for_read = ISOWGetc; - else - s->stream_wgetc_for_read = s->stream_wgetc; - return EOFCHAR; - } else { - ++s->charcount; - ++s->linepos; } return ch; } /* check if we read a newline or an EOF */ static int -console_post_process_read_char(int ch, StreamDesc *s) +post_process_eof(StreamDesc *s) +{ + s->status |= Eof_Stream_f; + s->stream_getc = EOFGetc; + s->stream_wgetc = get_wchar; + if (CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; + return EOFCHAR; +} + +/* check if we read a newline or an EOF */ +static int +console_post_process_read_char(wchar_t ch, StreamDesc *s) { if (ch == '\n') { ++s->linecount; ++s->charcount; s->linepos = 0; newline = TRUE; - } else if (ch == EOF) { - s->status |= Eof_Stream_f; - s->stream_getc = EOFGetc; - s->stream_wgetc = get_wchar; - if (CharConversionTable != NULL) - s->stream_wgetc_for_read = ISOWGetc; - else - s->stream_wgetc_for_read = s->stream_wgetc; - newline = FALSE; - return (EOFCHAR); } else { ++s->charcount; ++s->linepos; newline = FALSE; } - return(ch); + return ch; +} + +/* check if we read a newline or an EOF */ +static int +console_post_process_eof(StreamDesc *s) +{ + s->status |= Eof_Stream_f; + s->stream_getc = EOFGetc; + s->stream_wgetc = get_wchar; + if (CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; + newline = FALSE; + return EOFCHAR; } #if USE_SOCKET @@ -1234,7 +1244,7 @@ static int SocketGetc(int sno) { register StreamDesc *s = &Stream[sno]; - register int ch; + register Int ch; char c; int count; /* should be able to use a buffer */ @@ -1245,7 +1255,7 @@ SocketGetc(int sno) #endif if (count == 0) { s->u.socket.flags = closed_socket; - ch = EOF; + return post_process_eof(s); } else if (count > 0) { ch = c; } else { @@ -1256,9 +1266,9 @@ SocketGetc(int sno) Yap_Error(SYSTEM_ERROR, TermNil, "(socket_getc)"); #endif - return EOF; + return post_process_eof(s); } - return(post_process_read_char(ch, s)); + return post_process_read_char(ch, s); } /* @@ -1269,8 +1279,8 @@ static int ConsoleSocketGetc(int sno) { register StreamDesc *s = &Stream[sno]; - register int ch; - char c; + register wchar_t ch; + Int c; int count; /* send the prompt away */ @@ -1292,14 +1302,14 @@ ConsoleSocketGetc(int sno) #endif Yap_PrologMode &= ~ConsoleGetcMode; if (count == 0) { - ch = EOF; + return console_post_process_eof(s); } else if (count > 0) { ch = c; } else { Yap_Error(SYSTEM_ERROR, TermNil, "read"); - return(EOF); + return console_post_process_eof(s); } - return(console_post_process_read_char(ch, s)); + return console_post_process_read_char(ch, s); } #endif @@ -1307,9 +1317,10 @@ static int PipeGetc(int sno) { register StreamDesc *s = &Stream[sno]; - register int ch; + register Int ch; char c; - /* should be able to use a buffer */ + + /* should be able to use a buffer */ #if _MSC_VER || defined(__MINGW32__) DWORD count; if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) { @@ -1321,14 +1332,14 @@ PipeGetc(int sno) count = read(s->u.pipe.fd, &c, sizeof(char)); #endif if (count == 0) { - ch = EOF; + return post_process_eof(s); } else if (count > 0) { ch = c; } else { Yap_Error(SYSTEM_ERROR, TermNil, "read"); - return(EOF); + return post_process_eof(s); } - return(post_process_read_char(ch, s)); + return post_process_read_char(ch, s); } /* @@ -1339,7 +1350,7 @@ static int ConsolePipeGetc(int sno) { register StreamDesc *s = &Stream[sno]; - register int ch; + register wchar_t ch; char c; #if _MSC_VER || defined(__MINGW32__) DWORD count; @@ -1362,7 +1373,7 @@ ConsolePipeGetc(int sno) Yap_PrologMode |= ConsoleGetcMode; PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error"); Yap_PrologMode &= ~ConsoleGetcMode; - return(EOF); + return console_post_process_eof(s); } #else /* should be able to use a buffer */ @@ -1371,14 +1382,14 @@ ConsolePipeGetc(int sno) Yap_PrologMode &= ~ConsoleGetcMode; #endif if (count == 0) { - ch = EOF; + return console_post_process_eof(s); } else if (count > 0) { ch = c; } else { Yap_Error(SYSTEM_ERROR, TermNil, "read"); - return(EOF); + return console_post_process_eof(s); } - return(console_post_process_read_char(ch, s)); + return console_post_process_read_char(ch, s); } /* standard routine, it should read from anything pointed by a FILE *. @@ -1388,10 +1399,12 @@ static int PlGetc (int sno) { register StreamDesc *s = &Stream[sno]; - register int ch; + register Int ch; ch = YP_getc (s->u.file.file); - return(post_process_read_char(ch, s)); + if (ch == EOF) + return post_process_eof(s); + return post_process_read_char(ch, s); } /* standard routine, it should read from anything pointed by a FILE *. @@ -1403,8 +1416,9 @@ PlGets (int sno, UInt size, char *buf) register StreamDesc *s = &Stream[sno]; UInt len; - if (fgets (buf, size, s->u.file.file) == NULL) - return -1; + if (fgets (buf, size, s->u.file.file) == NULL) { + return post_process_eof(s); + } len = strlen(buf); s->charcount += len-1; post_process_read_char(buf[len-2], s); @@ -1418,7 +1432,7 @@ static int DefaultGets (int sno, UInt size, char *buf) { StreamDesc *s = &Stream[sno]; - int ch; + char ch; char *pt = buf; @@ -1435,23 +1449,24 @@ static int MemGetc (int sno) { register StreamDesc *s = &Stream[sno]; - Int ch, spos; + Int ch; + int spos; spos = s->u.mem_string.pos; if (spos == s->u.mem_string.max_size) { - ch = -1; + return post_process_eof(s); } else { ch = s->u.mem_string.buf[spos]; s->u.mem_string.pos = ++spos; } - return(post_process_read_char(ch, s)); + return post_process_read_char(ch, s); } /* I dispise this code!!!!! */ static wchar_t ISOWGetc (int sno) { - wchar_t ch = Stream[sno].stream_wgetc(sno); + Int ch = Stream[sno].stream_wgetc(sno); if (ch != EOF && CharConversionTable != NULL) { if (ch < NUMBER_OF_CHARS) { @@ -1468,7 +1483,7 @@ static int ConsoleGetc(int sno) { register StreamDesc *s = &Stream[sno]; - char ch; + int ch; restart: if (newline) { @@ -1497,13 +1512,15 @@ ConsoleGetc(int sno) if (Yap_PrologMode & AbortMode) { Yap_Error(PURE_ABORT, TermNil, ""); Yap_ErrorMessage = "Abort"; - return(console_post_process_read_char(EOF, s)); + return console_post_process_eof(s); } goto restart; } else { Yap_PrologMode &= ~ConsoleGetcMode; } - return(console_post_process_read_char(ch, s)); + if (ch == EOF) + return console_post_process_eof(s); + return console_post_process_read_char(ch, s); } /* reads a character from a buffer and does the rest */ diff --git a/C/scanner.c b/C/scanner.c index 263c8bc81..cf5e4c6be 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -983,7 +983,7 @@ Yap_tokenizer(int inp_stream) Yap_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; break; } - if (ch >= 0xff){ + if (ch > MAX_ISO_LATIN1){ /* does not fit in ISO-LATIN */ wcharp = ch_to_wide(TokImage, charp); } @@ -1007,7 +1007,7 @@ Yap_tokenizer(int inp_stream) *wcharp++ = read_quoted_char(&scan_next, inp_stream, QuotedNxtch); else { wchar_t next = read_quoted_char(&scan_next, inp_stream, QuotedNxtch); - if (next >= 0xff){ + if (next > MAX_ISO_LATIN1){ /* does not fit in ISO-LATIN */ wcharp = ch_to_wide(TokImage, charp); *wcharp++ = next; diff --git a/C/stdpreds.c b/C/stdpreds.c index 58c46887a..25fd607a8 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -11,8 +11,11 @@ * File: stdpreds.c * * comments: General-purpose C implemented system predicates * * * -* Last rev: $Date: 2006-11-28 13:46:41 $,$Author: vsc $ * +* Last rev: $Date: 2006-12-13 16:10:23 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.115 2006/11/28 13:46:41 vsc +* fix wide_char support for name/2. +* * Revision 1.114 2006/11/27 17:42:03 vsc * support for UNICODE, and other bug fixes. * @@ -441,7 +444,6 @@ p_creep(void) at = Yap_FullLookupAtom("$creep"); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); CreepCode = pred; - yap_flags[SPY_CREEP_FLAG] = TRUE; do_signal(YAP_CREEP_SIGNAL); return TRUE; } @@ -455,7 +457,6 @@ p_delayed_creep(void) at = Yap_FullLookupAtom("$creep"); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); CreepCode = pred; - yap_flags[SPY_CREEP_FLAG] = FALSE; do_signal(YAP_CREEP_SIGNAL); LOCK(SignalLock); CreepFlag = CalculateStackGap(); @@ -754,28 +755,52 @@ p_char_code(void) return(FALSE); } else { Int code = IntegerOfTerm(t1); - char codes[2]; Term tout; - if (code < 0 || code > 256) { + if (code < 0) { Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,t1,"char_code/2"); return(FALSE); } - codes[0] = code; - codes[1] = '\0'; - tout = MkAtomTerm(Yap_LookupAtom(codes)); - return(Yap_unify(ARG1,tout)); + if (code > MAX_ISO_LATIN1) { + wchar_t wcodes[2]; + + wcodes[0] = code; + wcodes[1] = '\0'; + tout = MkAtomTerm(Yap_LookupWideAtom(wcodes)); + } else { + char codes[2]; + + codes[0] = code; + codes[1] = '\0'; + tout = MkAtomTerm(Yap_LookupAtom(codes)); + } + return Yap_unify(ARG1,tout); } } else if (!IsAtomTerm(t0)) { Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); return(FALSE); } else { - char *c = RepAtom(AtomOfTerm(t0))->StrOfAE; - if (c[1] != '\0') { - Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); - return(FALSE); + Atom at = AtomOfTerm(t0); + Term tf; + + if (IsWideAtom(at)) { + wchar_t *c = RepAtom(at)->WStrOfAE; + + if (c[1] != '\0') { + Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); + return FALSE; + } + tf = MkIntegerTerm(c[0]); + } else { + char *c = RepAtom(at)->StrOfAE; + + if (c[1] != '\0') { + Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); + return FALSE; + } + tf = MkIntTerm((unsigned char)(c[0])); } - return(Yap_unify(ARG2,MkIntTerm((Int)(c[0])))); + return Yap_unify(ARG2,tf); } } @@ -3309,11 +3334,6 @@ p_set_yap_flags(void) return(FALSE); yap_flags[STRICT_ISO_FLAG] = value; break; - case SPY_CREEP_FLAG: - if (value != 0 && value != 1) - return(FALSE); - yap_flags[SPY_CREEP_FLAG] = value; - break; case SOURCE_MODE_FLAG: if (value != 0 && value != 1) return(FALSE); @@ -3403,6 +3423,17 @@ p_set_yap_flags(void) return(TRUE); } +static Int +p_system_mode(void) +{ + Int i = IntegerOfTerm(Deref(ARG1)); + if (i == 0) + Yap_PrologMode &= ~SystemMode; + else + Yap_PrologMode |= SystemMode; + return TRUE; +} + static Int p_lock_system(void) { @@ -3631,6 +3662,7 @@ Yap_InitCPreds(void) Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("$p_system_mode", 1, p_system_mode, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("abort", 0, p_abort, SyncPredFlag); Yap_InitCPred("$max_tagged_integer", 1, p_max_tagged_integer, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$min_tagged_integer", 1, p_min_tagged_integer, SafePredFlag|HiddenPredFlag); diff --git a/C/unify.c b/C/unify.c index 76d9a1616..bd5160f49 100644 --- a/C/unify.c +++ b/C/unify.c @@ -309,7 +309,7 @@ OCUnify_complex(register CELL *pt0, register CELL *pt0_end, } } /* Do we still have compound terms to visit */ - if (to_visit < to_visit_max) { + if (to_visit < to_visit_base) { pt0 = to_visit[0]; pt0_end = to_visit[1]; pt1 = to_visit[2]; diff --git a/CLPBN/clpbn.yap b/CLPBN/clpbn.yap index 68d309df3..eb9fcd34c 100644 --- a/CLPBN/clpbn.yap +++ b/CLPBN/clpbn.yap @@ -3,7 +3,9 @@ :- module(clpbn, [{}/1, clpbn_flag/2, set_clpbn_flag/2, - clpbn_flag/3]). + clpbn_flag/3, + clpbn_key/2, + clpbn_marginalise/2]). :- use_module(library(atts)). :- use_module(library(lists)). @@ -111,6 +113,11 @@ add_evidence(V,NV) :- clpbn:put_atts(NV,evidence(V)). add_evidence(V,V). +clpbn_marginalise(V, Dist) :- + attributes:all_attvars(AVars), + project_attributes([V], AVars), + vel:get_atts(V, posterior(_,_,Dist,_)). + % % called by top-level % or by call_residue/2 @@ -244,3 +251,5 @@ user:term_expansion((A :- {}), ( :- true )) :- !, % evidence prolog_load_context(module, M), store_evidence(M:A). +clpbn_key(Var,Key) :- + get_atts(Var, [key(Key)]). diff --git a/CLPBN/clpbn/evidence.yap b/CLPBN/clpbn/evidence.yap index 8ac2f67ba..7bf19da82 100644 --- a/CLPBN/clpbn/evidence.yap +++ b/CLPBN/clpbn/evidence.yap @@ -5,7 +5,7 @@ -:- module(evidence, [ +:- module(clpbn_evidence, [ store_evidence/1, incorporate_evidence/2 ]). diff --git a/CLPBN/clpbn/examples/School/tables.yap b/CLPBN/clpbn/examples/School/tables.yap index 0fe5c4cae..240b0c4fb 100644 --- a/CLPBN/clpbn/examples/School/tables.yap +++ b/CLPBN/clpbn/examples/School/tables.yap @@ -1,7 +1,9 @@ :- use_module(library('clpbn/aggregates'),[cpt_average/5]). -int_table(_, [0.5, 0.4, 0.1],[h, m, l]). +int_table(_, [0.5, + 0.4, + 0.1],[h, m, l]). grade_table(I, D, /* h h h m h l m h m m m l l h l m l l */ diff --git a/H/Atoms.h b/H/Atoms.h index ae6703f12..df3d2a2a0 100644 --- a/H/Atoms.h +++ b/H/Atoms.h @@ -22,6 +22,8 @@ #define EXTERN #endif +#include + /********* operations for atoms ****************************************/ /* Atoms are assumed to be uniquely represented by an OFFSET and to have @@ -47,10 +49,17 @@ typedef struct AtomEntryStruct rwlock_t ARWLock; #endif - char StrOfAE[MIN_ARRAY]; /* representation of atom as a string */ + union { + char uStrOfAE[MIN_ARRAY]; /* representation of atom as a string */ + wchar_t uWStrOfAE[MIN_ARRAY]; /* representation of atom as a string */ + } rep; } AtomEntry; +#define StrOfAE rep.uStrOfAE +#define WStrOfAE rep.uWStrOfAE + + /* Props and Atoms are stored in chains, ending with a NIL */ #if USE_OFFSETS # define EndOfPAEntr(P) ( Addr(P) == AtomBase) diff --git a/H/Yap.h b/H/Yap.h index 54fa72821..928cf5aac 100644 --- a/H/Yap.h +++ b/H/Yap.h @@ -10,7 +10,7 @@ * File: Yap.h.m4 * * mods: * * comments: main header file for YAP * -* version: $Id: Yap.h,v 1.17 2006-11-27 17:42:03 vsc Exp $ * +* version: $Id: Yap.h,v 1.18 2006-12-13 16:10:25 vsc Exp $ * *************************************************************************/ #include "config.h" @@ -513,7 +513,6 @@ typedef enum YAP_TO_CHARS_FLAG = 7, LANGUAGE_MODE_FLAG = 8, STRICT_ISO_FLAG = 9, - SPY_CREEP_FLAG = 10, SOURCE_MODE_FLAG = 11, CHARACTER_ESCAPE_FLAG = 12, WRITE_QUOTED_STRING_FLAG = 13, @@ -1152,7 +1151,8 @@ typedef enum CCallMode = 0x1000, /* In c Call */ UnifyMode = 0x2000, /* In Unify Code */ UserCCallMode = 0x4000, /* In User C-call Code */ - MallocMode = 0x8000 /* Doing malloc, realloc, free */ + MallocMode = 0x8000, /* Doing malloc, realloc, free */ + SystemMode = 0x10000, /* in system mode */ } prolog_exec_mode; extern prolog_exec_mode Yap_PrologMode; diff --git a/H/Yapproto.h b/H/Yapproto.h index 4e916b944..ca725c9f3 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.76 2006-08-22 16:12:46 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.77 2006-12-13 16:10:25 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -172,7 +172,7 @@ void STD_PROTO(Yap_InitGlobals,(void)); /* grow.c */ Int STD_PROTO(Yap_total_stack_shift_time,(void)); void STD_PROTO(Yap_InitGrowPreds, (void)); -int STD_PROTO(Yap_InsertInGlobal, (CELL *, UInt)); +UInt STD_PROTO(Yap_InsertInGlobal, (CELL *, UInt)); int STD_PROTO(Yap_growheap, (int, UInt, void *)); int STD_PROTO(Yap_growstack, (long)); int STD_PROTO(Yap_growtrail, (long, int)); diff --git a/Makefile.in b/Makefile.in index 754e28343..75ad34304 100644 --- a/Makefile.in +++ b/Makefile.in @@ -528,6 +528,7 @@ all: startup @INSTALL_DLLS@ (cd library/yap2swi; make) @INSTALL_DLLS@ (cd library/Tries; make) @INSTALL_DLLS@ (cd library/lammpi; make) + @INSTALL_DLLS@ (cd library/matrix; make) @ENABLE_JPL@ @INSTALL_DLLS@ (cd LGPL/JPL/src; make) startup: yap@EXEC_SUFFIX@ $(PL_SOURCES) @@ -564,6 +565,7 @@ install_unix: startup libYap.a @INSTALL_DLLS@ (cd library/yap2swi; make install) @INSTALL_DLLS@ (cd library/Tries; make install) @INSTALL_DLLS@ (cd library/lammpi; make install) + @INSTALL_DLLS@ (cd library/matrix; make install) @ENABLE_JPL@ @INSTALL_DLLS@ (cd LGPL/JPL/src; make install) mkdir -p $(DESTDIR)$(INCLUDEDIR) for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done @@ -584,6 +586,7 @@ install_win32: startup for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done $(INSTALL) config.h $(INCLUDEDIR)/config.h (cd library/random; make install) + (cd library/matrix; make install) (cd library/regex; make install) (cd library/system; make install) (cd library/yap2swi; make install) @@ -621,6 +624,7 @@ depend: $(HEADERS) $(C_SOURCES) clean: clean_docs rm -f *.o *~ *.BAK *.a + @INSTALL_DLLS@ (cd library/matrix; make clean) @INSTALL_DLLS@ (cd library/random; make clean) @INSTALL_DLLS@ (cd library/regex; make clean) @INSTALL_DLLS@ (cd library/system; make clean) diff --git a/changes-5.1.html b/changes-5.1.html index a8cc1532d..3898548d0 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,6 +16,10 @@

Yap-5.1.2: