From f5fc38a79e772fb4244e0454740cda1b8fcf0587 Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 21 Oct 2005 16:09:03 +0000 Subject: [PATCH] SWI compatible module only operators git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1412 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/adtdefs.c | 23 ++++++++++++++- C/arrays.c | 53 +++++++++++++++++++++++++-------- C/init.c | 15 +++++----- C/iopreds.c | 49 +++++++++++++++++++++---------- C/parser.c | 62 +++++++++++++++++++++++---------------- C/stdpreds.c | 15 +++++++--- C/write.c | 8 ++--- H/Yapproto.h | 7 ++--- H/Yatom.h | 7 +++-- H/rheap.h | 14 +++++++-- console/yap.c | 35 +++++++++++++++++++++- include/YapInterface.h | 15 +++++----- include/yap_structs.h | 4 +++ library/swi.yap | 17 +++++++++++ library/system/sys.c | 10 +++++-- library/yap2swi/yap2swi.c | 22 ++++++++++++-- library/yap2swi/yap2swi.h | 6 +++- pl/boot.yap | 51 +++++++++++++++++++------------- pl/debug.yap | 10 ++++++- pl/modules.yap | 12 +++++++- pl/utils.yap | 13 +++++++- pl/yio.yap | 28 ++++++++++-------- 22 files changed, 348 insertions(+), 128 deletions(-) diff --git a/C/adtdefs.c b/C/adtdefs.c index 485e03bb0..b445b23b7 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -282,7 +282,7 @@ GetAPropHavingLock(AtomEntry *ae, PropFlags kind) Prop Yap_GetAPropHavingLock(AtomEntry *ae, PropFlags kind) { /* look property list of atom a for kind */ - return (GetAPropHavingLock(ae,kind)); + return GetAPropHavingLock(ae,kind); } static Prop @@ -303,6 +303,27 @@ Yap_GetAProp(Atom a, PropFlags kind) return GetAProp(a,kind); } +OpEntry * +Yap_GetOpProp(Atom a) +{ /* look property list of atom a for kind */ + AtomEntry *ae = RepAtom(a); + PropEntry *pp; + + READ_LOCK(ae->ARWLock); + pp = RepProp(ae->PropsOfAE); + while (!EndOfPAEntr(pp) && + pp->KindOfPE != OpProperty && + ((OpEntry *)pp)->OpModule && + ((OpEntry *)pp)->OpModule != CurrentModule) + pp = RepProp(pp->NextOfPE); + READ_UNLOCK(ae->ARWLock); + if (EndOfPAEntr(pp)) + return NULL; + else + return (OpEntry *)pp; +} + + inline static Prop GetPredPropByAtomHavingLock(AtomEntry* ae, Term cur_mod) /* get predicate entry for ap/arity; create it if neccessary. */ diff --git a/C/arrays.c b/C/arrays.c index 43d627d4a..96bf2f99c 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -1521,12 +1521,7 @@ p_assign_static(void) } /* a static array */ - if (IsVarTerm(t3)) { - WRITE_UNLOCK(ptr->ArRWLock); - Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); - return (FALSE); - } - if (indx < 0 || indx >= - ptr->ArrayEArity) { + if (indx < 0 || indx >= - ptr->ArrayEArity) { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static"); return(FALSE); @@ -1537,6 +1532,11 @@ p_assign_static(void) Int i; union arith_ret v; + if (IsVarTerm(t3)) { + WRITE_UNLOCK(ptr->ArRWLock); + Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); + return FALSE; + } if (IsIntTerm(t3)) i = IntOfTerm(t3); else if (Yap_Eval(t3, &v) == long_int_e) @@ -1555,6 +1555,11 @@ p_assign_static(void) Int i; union arith_ret v; + if (IsVarTerm(t3)) { + WRITE_UNLOCK(ptr->ArRWLock); + Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); + return FALSE; + } if (IsIntTerm(t3)) i = IntOfTerm(t3); else if (Yap_Eval(t3, &v) == long_int_e) @@ -1577,6 +1582,11 @@ p_assign_static(void) Int i; union arith_ret v; + if (IsVarTerm(t3)) { + WRITE_UNLOCK(ptr->ArRWLock); + Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); + return FALSE; + } if (IsIntTerm(t3)) i = IntOfTerm(t3); else if (Yap_Eval(t3, &v) == long_int_e) @@ -1600,6 +1610,11 @@ p_assign_static(void) Float f; union arith_ret v; + if (IsVarTerm(t3)) { + WRITE_UNLOCK(ptr->ArRWLock); + Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); + return FALSE; + } if (IsFloatTerm(t3)) f = FloatOfTerm(t3); else if (Yap_Eval(t3, &v) == double_e) @@ -1617,6 +1632,11 @@ p_assign_static(void) { Int r; + if (IsVarTerm(t3)) { + WRITE_UNLOCK(ptr->ArRWLock); + Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); + return FALSE; + } if (IsIntegerTerm(t3)) r = IntegerOfTerm(t3); else { @@ -1630,6 +1650,11 @@ p_assign_static(void) case array_of_atoms: { + if (IsVarTerm(t3)) { + WRITE_UNLOCK(ptr->ArRWLock); + Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); + return FALSE; + } if (!IsAtomTerm(t3)) { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(TYPE_ERROR_ATOM,t3,"assign_static"); @@ -1645,6 +1670,11 @@ p_assign_static(void) Term t0 = ptr->ValueOfVE.dbrefs[indx]; DBRef p = DBRefOfTerm(t3); + if (IsVarTerm(t3)) { + WRITE_UNLOCK(ptr->ArRWLock); + Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); + return FALSE; + } if (!IsDBRefTerm(t3)) { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(TYPE_ERROR_DBREF,t3,"assign_static"); @@ -1691,7 +1721,6 @@ p_assign_static(void) { Term told = ptr->ValueOfVE.lterms[indx].tstore; - Term tnew = Deref(ARG3); CELL *livep = &(ptr->ValueOfVE.lterms[indx].tlive); MaBind(livep,(CELL)livep); @@ -1699,12 +1728,12 @@ p_assign_static(void) if (IsApplTerm(told)) { Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told)); } - if (IsVarTerm(tnew)) { + if (IsVarTerm(t3)) { RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore)); - } else if (IsAtomicTerm(tnew)) { - ptr->ValueOfVE.lterms[indx].tstore = tnew; + } else if (IsAtomicTerm(t3)) { + ptr->ValueOfVE.lterms[indx].tstore = t3; } else { - DBTerm *new = Yap_StoreTermInDB(tnew,3); + DBTerm *new = Yap_StoreTermInDB(t3,3); if (!new) { WRITE_UNLOCK(ptr->ArRWLock); return FALSE; @@ -1722,7 +1751,7 @@ p_assign_static(void) if (ref != NULL) { Yap_ReleaseTermFromDB(ref); } - ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(Deref(ARG3),3); + ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(t3,3); if (ptr->ValueOfVE.terms[indx] == NULL){ WRITE_UNLOCK(ptr->ArRWLock); return FALSE; diff --git a/C/init.c b/C/init.c index 44acc6d3c..240b0b21a 100644 --- a/C/init.c +++ b/C/init.c @@ -59,7 +59,7 @@ int Yap_output_msg = FALSE; STATIC_PROTO(void InTTYLine, (char *)); #endif #endif -STATIC_PROTO(void SetOp, (int, int, char *)); +STATIC_PROTO(void SetOp, (int, int, char *, Term)); STATIC_PROTO(void InitOps, (void)); STATIC_PROTO(void InitDebug, (void)); STATIC_PROTO(void CleanBack, (PredEntry *, CPredicate, CPredicate)); @@ -222,7 +222,7 @@ Yap_IsOpType(char *type) } static int -OpDec(int p, char *type, Atom a) +OpDec(int p, char *type, Atom a, Term m) { int i; AtomEntry *ae = RepAtom(a); @@ -247,6 +247,7 @@ OpDec(int p, char *type, Atom a) info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry)); info->KindOfPE = Ord(OpProperty); info->NextOfPE = RepAtom(a)->PropsOfAE; + info->OpModule = m; RepAtom(a)->PropsOfAE = AbsOpProp(info); INIT_RWLOCK(info->OpRWLock); WRITE_LOCK(info->OpRWLock); @@ -280,19 +281,19 @@ OpDec(int p, char *type, Atom a) } int -Yap_OpDec(int p, char *type, Atom a) +Yap_OpDec(int p, char *type, Atom a, Term m) { - return(OpDec(p,type,a)); + return(OpDec(p,type,a,m)); } static void -SetOp(int p, int type, char *at) +SetOp(int p, int type, char *at, Term m) { #ifdef DEBUG if (Yap_Option[5]) fprintf(stderr,"[setop %d %s %s]\n", p, optypes[type], at); #endif - OpDec(p, optypes[type], Yap_LookupAtom(at)); + OpDec(p, optypes[type], Yap_LookupAtom(at), m); } /* Gets the info about an operator in a prop */ @@ -403,7 +404,7 @@ InitOps(void) { unsigned int i; for (i = 0; i < sizeof(Ops) / sizeof(*Ops); ++i) - SetOp(Ops[i].opPrio, Ops[i].opType, Ops[i].opName); + SetOp(Ops[i].opPrio, Ops[i].opType, Ops[i].opName, PROLOG_MODULE); } #ifdef DEBUG diff --git a/C/iopreds.c b/C/iopreds.c index fdc5da3d1..1c7375580 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -1313,9 +1313,9 @@ MemGetc (int sno) Int ch, spos; spos = s->u.mem_string.pos; - if (spos == s->u.mem_string.max_size) + if (spos == s->u.mem_string.max_size) { ch = -1; - else { + } else { ch = s->u.mem_string.buf[spos]; s->u.mem_string.pos = ++spos; } @@ -2961,6 +2961,15 @@ p_get_read_error_handler(void) return (Yap_unify_constant (ARG1, t)); } +/* + Assumes + Flag: ARG1 + Term: ARG2 + Module: ARG3 + Vars: ARG4 + Pos: ARG5 + Err: ARG6 + */ static Int do_read(int inp_stream) { @@ -2969,10 +2978,17 @@ do_read(int inp_stream) #if EMACS int emacs_cares = FALSE; #endif - + Term tmod = Deref(ARG3), OCurrentModule = CurrentModule; + + if (IsVarTerm(tmod)) { + tmod = CurrentModule; + } else if (!IsAtomTerm(tmod)) { + Yap_Error(TYPE_ERROR_ATOM, tmod, "read_term/2"); + return FALSE; + } if (Stream[inp_stream].status & Binary_Stream_f) { Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[inp_stream].u.file.name), "read_term/2"); - return(FALSE); + return FALSE; } while (TRUE) { CELL *old_H; @@ -3000,13 +3016,15 @@ do_read(int inp_stream) } else { Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - return (Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG4) && + return (Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG5) && Yap_unify_constant (ARG2, MkAtomTerm (AtomEof))); } } } repeat_cycle: + CurrentModule = tmod; if (Yap_ErrorMessage || (t = Yap_Parse()) == 0) { + CurrentModule = OCurrentModule; if (Yap_ErrorMessage) { int res; @@ -3057,11 +3075,12 @@ do_read(int inp_stream) t[1] = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); t1 = MkIntegerTerm(StartLine = tokstart->TokPos); Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - return(Yap_unify(t1,ARG4) && - Yap_unify(ARG5,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t))); + return(Yap_unify(t1,ARG5) && + Yap_unify(ARG6,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t))); } } } else { + CurrentModule = OCurrentModule; /* parsing succeeded */ break; } @@ -3090,27 +3109,27 @@ do_read(int inp_stream) } } Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - return(Yap_unify(t, ARG2) && Yap_unify (v, ARG3) && - Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4)); + return Yap_unify(t, ARG2) && Yap_unify (v, ARG4) && + Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG5); } else { Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - return(Yap_unify(t, ARG2) && Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG4)); + return(Yap_unify(t, ARG2) && Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),ARG5)); } } static Int p_read (void) -{ /* '$read'(+Flag,?Term,?Vars,-Pos,-Err) */ +{ /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ return(do_read(Yap_c_input_stream)); } static Int p_read2 (void) -{ /* '$read2'(+Flag,?Term,?Vars,-Pos,-Err,+Stream) */ +{ /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ int inp_stream; /* needs to change Yap_c_output_stream for write */ - inp_stream = CheckStream (ARG6, Input_Stream_f, "read/3"); + inp_stream = CheckStream (ARG7, Input_Stream_f, "read/3"); if (inp_stream == -1) { return(FALSE); } @@ -4860,8 +4879,8 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred ("$read", 5, p_read, SyncPredFlag|HiddenPredFlag); - Yap_InitCPred ("$read", 6, p_read2, SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$set_input", 1, p_set_input, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$set_output", 1, p_set_output, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag); diff --git a/C/parser.c b/C/parser.c index de195b31e..869099ca9 100644 --- a/C/parser.c +++ b/C/parser.c @@ -196,74 +196,84 @@ Yap_VarNames(VarEntry *p,Term l) } static int -IsPrefixOp(Prop opinfo,int *pptr, int *rpptr) +IsPrefixOp(OpEntry *opp,int *pptr, int *rpptr) { int p; - READ_LOCK(RepOpProp(opinfo)->OpRWLock); - if ((p = RepOpProp(opinfo)->Prefix) != 0) { - READ_UNLOCK(RepOpProp(opinfo)->OpRWLock); + READ_LOCK(opp->OpRWLock); + if (opp->OpModule && + opp->OpModule != CurrentModule) + return FALSE; + if ((p = opp->Prefix) != 0) { + READ_UNLOCK(opp->OpRWLock); *pptr = *rpptr = p & MaskPrio; if (p & DcrrpFlag) --* rpptr; - return (TRUE); + return TRUE; } else { - READ_UNLOCK(RepOpProp(opinfo)->OpRWLock); - return (FALSE); + READ_UNLOCK(opp->OpRWLock); + return FALSE; } } int -Yap_IsPrefixOp(Prop opinfo,int *pptr, int *rpptr) +Yap_IsPrefixOp(OpEntry *opinfo,int *pptr, int *rpptr) { return IsPrefixOp(opinfo,pptr,rpptr); } static int -IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr) +IsInfixOp(OpEntry *opp, int *pptr, int *lpptr, int *rpptr) { int p; - READ_LOCK(RepOpProp(opinfo)->OpRWLock); - if ((p = RepOpProp(opinfo)->Infix) != 0) { - READ_UNLOCK(RepOpProp(opinfo)->OpRWLock); + READ_LOCK(opp->OpRWLock); + if (opp->OpModule && + opp->OpModule != CurrentModule) + return FALSE; + if ((p = opp->Infix) != 0) { + READ_UNLOCK(opp->OpRWLock); *pptr = *rpptr = *lpptr = p & MaskPrio; if (p & DcrrpFlag) --* rpptr; if (p & DcrlpFlag) --* lpptr; - return (TRUE); + return TRUE; } else { - READ_UNLOCK(RepOpProp(opinfo)->OpRWLock); - return (FALSE); + READ_UNLOCK(opp->OpRWLock); + return FALSE; } } int -Yap_IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr) +Yap_IsInfixOp(OpEntry *opinfo, int *pptr, int *lpptr, int *rpptr) { return IsInfixOp(opinfo, pptr, lpptr, rpptr); } static int -IsPosfixOp(Prop opinfo, int *pptr, int *lpptr) +IsPosfixOp(OpEntry *opp, int *pptr, int *lpptr) { int p; - READ_LOCK(RepOpProp(opinfo)->OpRWLock); - if ((p = RepOpProp(opinfo)->Posfix) != 0) { - READ_UNLOCK(RepOpProp(opinfo)->OpRWLock); + + READ_LOCK(opp->OpRWLock); + if (opp->OpModule && + opp->OpModule != CurrentModule) + return FALSE; + if ((p = opp->Posfix) != 0) { + READ_UNLOCK(opp->OpRWLock); *pptr = *lpptr = p & MaskPrio; if (p & DcrlpFlag) --* lpptr; return (TRUE); } else { - READ_UNLOCK(RepOpProp(opinfo)->OpRWLock); + READ_UNLOCK(opp->OpRWLock); return (FALSE); } } int -Yap_IsPosfixOp(Prop opinfo, int *pptr, int *lpptr) +Yap_IsPosfixOp(OpEntry *opinfo, int *pptr, int *lpptr) { return IsPosfixOp(opinfo, pptr, lpptr); } @@ -396,7 +406,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff) { /* parse term with priority prio */ - Volatile Prop opinfo; + Volatile OpEntry *opinfo; Volatile Term t; Volatile Functor func; Volatile VarEntry *varinfo; @@ -408,7 +418,7 @@ ParseTerm(int prio, JMPBUFF *FailBuff) NextToken; if ((Yap_tokptr->Tok != Ord(Ponctuation_tok) || Unsigned(Yap_tokptr->TokInfo) != 'l') - && (opinfo = Yap_GetAProp((Atom) t, OpProperty)) + && (opinfo = Yap_GetOpProp((Atom) t)) && IsPrefixOp(opinfo, &opprio, &oprprio) ) { /* special rules apply for +1, -2.3, etc... */ @@ -561,8 +571,8 @@ ParseTerm(int prio, JMPBUFF *FailBuff) /* main loop to parse infix and posfix operators starts here */ while (TRUE) { if (Yap_tokptr->Tok == Ord(Name_tok) - && (opinfo = Yap_GetAProp((Atom)(Yap_tokptr->TokInfo), OpProperty))) { - Prop save_opinfo = opinfo; + && (opinfo = Yap_GetOpProp((Atom)(Yap_tokptr->TokInfo)))) { + OpEntry *save_opinfo = opinfo; if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio) && opprio <= prio && oplprio >= curprio) { /* try parsing as infix operator */ diff --git a/C/stdpreds.c b/C/stdpreds.c index 7e7ea650f..73ef43a98 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: 2005-09-08 22:06:45 $,$Author: rslopes $ * +* Last rev: $Date: 2005-10-21 16:09:02 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.94 2005/09/08 22:06:45 rslopes +* BEAM for YAP update... +* * Revision 1.93 2005/08/04 15:45:53 ricroc * TABLING NEW: support to limit the table space size * @@ -891,8 +894,12 @@ p_opdec(void) { /* '$opdec'(p,type,atom) */ /* we know the arguments are integer, atom, atom */ Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3); - return (Yap_OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE, - AtomOfTerm(at))); + Term tmod = Deref(ARG4); + if (tmod == TermProlog) { + tmod = PROLOG_MODULE; + } + return Yap_OpDec((int) IntOfTerm(p), RepAtom(AtomOfTerm(t))->StrOfAE, + AtomOfTerm(at), tmod); } @@ -3233,7 +3240,7 @@ Yap_InitCPreds(void) Yap_InitCPred("get_value", 2, p_value, TestPredFlag|SafePredFlag|SyncPredFlag); Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag|HiddenPredFlag); /* general purpose */ - Yap_InitCPred("$opdec", 3, p_opdec, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("$opdec", 4, p_opdec, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("name", 2, p_name, 0); Yap_InitCPred("char_code", 2, p_char_code, SafePredFlag); Yap_InitCPred("atom_chars", 2, p_atom_chars, 0); diff --git a/C/write.c b/C/write.c index 80c95b3a1..db1ab63b0 100644 --- a/C/write.c +++ b/C/write.c @@ -184,14 +184,14 @@ legalAtom(char *s) /* Is this a legal atom ? */ static int LeftOpToProtect(Atom at, int p) { int op, rp; - Prop opinfo = Yap_GetAProp(at, OpProperty); + OpEntry *opinfo = Yap_GetOpProp(at); return(opinfo && Yap_IsPrefixOp(opinfo, &op, &rp) ); } static int RightOpToProtect(Atom at, int p) { int op, lp; - Prop opinfo = Yap_GetAProp(at, OpProperty); + OpEntry *opinfo = Yap_GetOpProp(at); return(opinfo && Yap_IsPosfixOp(opinfo, &op, &lp) ); } @@ -430,7 +430,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb) Functor functor = FunctorOfTerm(t); int Arity; Atom atom; - Prop opinfo; + OpEntry *opinfo; int op, lp, rp; if (IsExtensionFunctor(functor)) { @@ -459,7 +459,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb) } Arity = ArityOfFunctor(functor); atom = NameOfFunctor(functor); - opinfo = Yap_GetAProp(atom, OpProperty); + opinfo = Yap_GetOpProp(atom); #ifdef SFUNC if (Arity == SFArity) { int argno = 1; diff --git a/H/Yapproto.h b/H/Yapproto.h index 86e4376d0..8c047978e 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.60 2005-08-17 20:13:49 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.61 2005-10-21 16:09:03 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -194,7 +194,7 @@ void STD_PROTO(Yap_KillStacks,(void)); #endif void STD_PROTO(Yap_InitYaamRegs,(void)); void STD_PROTO(Yap_ReInitWallTime, (void)); -int STD_PROTO(Yap_OpDec,(int,char *,Atom)); +int STD_PROTO(Yap_OpDec,(int,char *,Atom,Term)); /* inlines.c */ void STD_PROTO(Yap_InitInlines,(void)); @@ -243,9 +243,6 @@ Term STD_PROTO(Yap_MkNewPairTerm,(void)); /* parser.c */ -int STD_PROTO(Yap_IsPrefixOp,(Prop,int *,int *)); -int STD_PROTO(Yap_IsInfixOp,(Prop,int *,int *,int *)); -int STD_PROTO(Yap_IsPosfixOp,(Prop,int *,int *)); Term STD_PROTO(Yap_Parse,(void)); /* save.c */ diff --git a/H/Yatom.h b/H/Yatom.h index 9a374d691..50e43d5c8 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -268,6 +268,7 @@ typedef struct #if defined(YAPOR) || defined(THREADS) rwlock_t OpRWLock; /* a read-write lock to protect the entry */ #endif + Term OpModule; /* module of predicate */ BITS16 Prefix, Infix, Posfix; /* precedences */ } OpEntry; #if USE_OFFSETS_IN_PROPS @@ -280,8 +281,6 @@ RepOpProp (Prop p) return (OpEntry *) (AtomBase + Unsigned (p)); } - - inline EXTERN Prop AbsOpProp (OpEntry * p); inline EXTERN Prop @@ -324,7 +323,11 @@ IsOpProperty (int flags) return (PropFlags) ((flags == OpProperty)); } +OpEntry *STD_PROTO(Yap_GetOpProp,(Atom)); +int STD_PROTO(Yap_IsPrefixOp,(OpEntry *,int *,int *)); +int STD_PROTO(Yap_IsInfixOp,(OpEntry *,int *,int *,int *)); +int STD_PROTO(Yap_IsPosfixOp,(OpEntry *,int *,int *)); /* defines related to operator specifications */ #define MaskPrio 0x0fff diff --git a/H/rheap.h b/H/rheap.h index d2322bed2..f8e76a1a1 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,12 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2005-10-19 19:00:48 $,$Author: vsc $ * +* Last rev: $Date: 2005-10-21 16:09:03 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.55 2005/10/19 19:00:48 vsc +* extend arrays with nb_terms so that we can implement nb_ builtins +* correctly. +* * Revision 1.54 2005/09/09 17:24:39 vsc * a new and hopefully much better implementation of atts. * @@ -1090,8 +1094,14 @@ RestoreEntries(PropEntry *pp) RestoreBB(bb); } break; - case ExpProperty: case OpProperty: + { + OpEntry *opp = (OpEntry *)pp; + if (opp->OpModule) { + opp->OpModule = AtomTermAdjust(opp->OpModule); + } + } + case ExpProperty: case ModProperty: pp->NextOfPE = PropAdjust(pp->NextOfPE); diff --git a/console/yap.c b/console/yap.c index b870f0cf0..fd6f997f4 100644 --- a/console/yap.c +++ b/console/yap.c @@ -229,7 +229,10 @@ print_usage(void) fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n"); fprintf(stderr," -? Shows this screen\n"); fprintf(stderr," -b Boot file \n"); - fprintf(stderr," -l Prolog file\n"); + fprintf(stderr," -g Run Goal Before Top-Level \n"); + fprintf(stderr," -z Run Goal Before Top-Level \n"); + fprintf(stderr," -l load Prolog file\n"); + fprintf(stderr," -L run Prolog file and exit\n"); fprintf(stderr," -h Heap area in Kbytes (default: %d, minimum: %d)\n", DefHeapSpace, MinHeapSpace); fprintf(stderr," -s Stack area in Kbytes (default: %d, minimum: %d)\n", @@ -432,6 +435,34 @@ parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) iap->YapPrologRCFile = *argv; } break; + /* run goal before top-level */ + case 'g': + if ((*argv)[0] == '\0') + iap->YapPrologRCFile = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologGoal = *argv; + } + break; + /* run goal as top-level */ + case 'z': + if ((*argv)[0] == '\0') + iap->YapPrologRCFile = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologTopLevelGoal = *argv; + } + break; /* nf: Begin preprocessor code */ case 'D': { @@ -487,6 +518,8 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap) iap->YapPrologBootFile = NULL; iap->YapPrologInitFile = NULL; iap->YapPrologRCFile = NULL; + iap->YapPrologGoal = NULL; + iap->YapPrologTopLevelGoal = NULL; iap->HaltAfterConsult = FALSE; iap->FastBoot = FALSE; iap->MaxTableSpaceSize = 0; diff --git a/include/YapInterface.h b/include/YapInterface.h index 94650d8f7..ef759a422 100644 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -22,16 +22,16 @@ functions indirectly ****************************************************/ +#ifndef _yap_c_interface_h + +#define _yap_c_interface_h 1 + #include "yap_structs.h" #if HAVE_STDARG_H #include #endif -#ifndef _yap_c_interface_h - -#define _yap_c_interface_h 1 - /* __BEGIN_DECLS should be used at the beginning of the C declarations, so that C++ compilers don't mangle their names. __END_DECLS is used @@ -195,10 +195,11 @@ extern X_API void PROTO(YAP_UserBackCPredicate,(char *, YAP_Bool (*)(void), YAP_ extern X_API YAP_Bool PROTO(YAP_CallProlog,(YAP_Term t)); /* void cut_fail(void) */ -extern X_API void PROTO(YAP_cut_fail,(void)); +extern X_API void PROTO(YAP_cut_up,(void)); -/* void cut_succeed(void) */ -extern X_API void PROTO(YAP_cut_succeed,(void)); +#define YAP_cut_succeed() { YAP_cut_up(); return TRUE; } + +#define YAP_cut_fail() { YAP_cut_up(); return FALSE; } /* void *AllocSpaceFromYAP_(int) */ extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int)); diff --git a/include/yap_structs.h b/include/yap_structs.h index 7f1a4ae01..c897a00ae 100644 --- a/include/yap_structs.h +++ b/include/yap_structs.h @@ -83,6 +83,10 @@ typedef struct { char *YapPrologInitFile; /* if NON-NULL, name for a Prolog file to consult before entering top-level */ char *YapPrologRCFile; + /* if NON-NULL, a goal to run before top-level */ + char *YapPrologGoal; + /* if NON-NULL, a goal to run as top-level */ + char *YapPrologTopLevelGoal; /* if previous NON-NULL and TRUE, halt after consulting that file */ int HaltAfterConsult; /* ignore .yaprc, .prolog.ini, etc. files. */ diff --git a/library/swi.yap b/library/swi.yap index b7f51d857..2a5652770 100644 --- a/library/swi.yap +++ b/library/swi.yap @@ -9,6 +9,9 @@ :- use_module(library(lists),[nth/3]). +:- use_module(library(system),[datime/1, + mktime/2]). + :- use_module(library(terms),[term_variables/2, term_variables/3]). @@ -161,6 +164,10 @@ prolog:append([],L,L). prolog:append([X|L0],L,[X|Lf]) :- prolog:append(L0,L,Lf). +prolog:member(X[X|_]). +prolog:member(X,[_|L0]) :- + prolog:member(X,L0). + tv(Term,List) :- term_variables(Term,List). prolog:term_variables(Term,List) :- tv(Term,List). @@ -175,3 +182,13 @@ prolog:working_directory(OCWD,NCWD) :- prolog:chdir(X) :- cd(X). +% Time is given as int, not as float. +prolog:get_time(Secs) :- datime(Datime), mktime(Datime, Secs). + +% Time is received as int, and converted to "..." +prolog:convert_time(X,Y) :- swi:ctime(X,Y). + + + + + diff --git a/library/system/sys.c b/library/system/sys.c index 6d7b39fd3..12dcbcd57 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -8,8 +8,12 @@ * * ************************************************************************** * * -* $Id: sys.c,v 1.22 2005-03-10 18:04:01 rslopes Exp $ * +* $Id: sys.c,v 1.23 2005-10-21 16:09:03 vsc Exp $ * * mods: $Log: not supported by cvs2svn $ +* mods: Revision 1.22 2005/03/10 18:04:01 rslopes +* mods: update YAP_Error arguments +* mods: to be able to compile on Windows... +* mods: * mods: Revision 1.21 2004/08/11 16:14:54 vsc * mods: whole lot of fixes: * mods: - memory leak in indexing @@ -144,7 +148,7 @@ sysmktime(void) return YAP_Unify(YAP_ARG8,YAP_MkIntTerm((long int)((f1-f0)/10000000))); } #else - return FALSE + return FALSE; #endif #else #ifdef HAVE_MKTIME @@ -208,7 +212,7 @@ datime(void) oops #endif /* HAVE_TIME */ tf = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("datime"),6), 6, out); - return(YAP_Unify(YAP_ARG1, tf)); + return YAP_Unify(YAP_ARG1, tf); } #define BUF_SIZE 1024 diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index 830e190be..e82b213e7 100644 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -1320,10 +1320,28 @@ X_API int Sdprintf(char *format,...) return 1; } -int +static int +SWI_ctime(void) +{ + YAP_Term t1 = YAP_ARG1; + + if (YAP_IsVarTerm(t1)) { + YAP_Error(0,t1,"bad argumento to ctime"); + return FALSE; + } +#if HAVE_CTIME + time_t tim = (time_t)YAP_IntOfTerm(t1); + return YAP_Unify(YAP_BufferToString(ctime(&tim)), YAP_ARG2); +#else + YAP_Error(0,0L,"convert_time requires ctime"); + return FALSE; +#endif +} + +void swi_install(void) { - return TRUE; + YAP_UserCPredicate("ctime", SWI_ctime, 2); } #ifdef _WIN32 diff --git a/library/yap2swi/yap2swi.h b/library/yap2swi/yap2swi.h index 45ad86df7..5fbdd2cb9 100644 --- a/library/yap2swi/yap2swi.h +++ b/library/yap2swi/yap2swi.h @@ -12,8 +12,12 @@ //=== includes =============================================================== +#include "config.h" #include #include +#if HAVE_TIME_H +#include +#endif #if defined(_MSC_VER) && defined(YAP_EXPORTS) #define X_API __declspec(dllexport) @@ -231,5 +235,5 @@ extern X_API int PL_action(int,...); extern X_API int Sprintf(char *,...); extern X_API int Sdprintf(char *,...); -int swi_install(void); +void swi_install(void); diff --git a/pl/boot.yap b/pl/boot.yap index fc43c7fd0..2e0bdb6ae 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -96,8 +96,8 @@ true :- true. */ /* main execution loop */ -'$read_vars'(Stream,T,Pos,V) :- - '$read'(true,T,V,Pos,Err,Stream), +'$read_vars'(Stream,T,Mod,Pos,V) :- + '$read'(true,T,Mod,V,Pos,Err,Stream), (nonvar(Err) -> '$print_message'(error,Err), fail ; @@ -129,11 +129,17 @@ true :- true. ), '$print_message'(informational,prompt(BreakLevel,TraceDebug)), fail. +'$enter_top_level' :- + '$current_module'(Module), + get_value('$top_level_goal',GA), T \= [], !, + set_value('$top_level_goal',[]), + '$run_atom_goal'(GA), + set_value('$live','$false'). '$enter_top_level' :- prompt(_,' ?- '), prompt(' | '), '$run_toplevel_hooks', - '$read_vars'(user_input,Command,_,Varnames), + '$read_vars'(user_input,Command,_,_,Varnames), set_value(spy_gn,1), ( recorded('$spy_skip',_,R), erase(R), fail ; true), ( recorded('$spy_stop',_,R), erase(R), fail ; true), @@ -145,9 +151,14 @@ true :- true. '$startup_goals' :- recorded('$startup_goal',G,_), '$current_module'(Module), - '$system_catch'('$query'((G->true), []),Module,Error,user:'$Error'(Error)), + '$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)), fail. -'$startup_goals'. +'$startup_goals' :- + get_value('$init_goal',GA), GA \= [], + set_value('$init_goal',[]), + '$run_atom_goal'(GA), + fail. +'$startup_goals' :- stop_low_level_trace. '$startup_reconsult' :- get_value('$consult_on_boot',X), X \= [], !, @@ -723,9 +734,10 @@ not(G) :- \+ '$execute'(G). % make sure we do not loop on undefined predicates % for undefined_predicates. '$enter_undefp', - '$do_undefp'(G,M). + '$find_undefp_handler'(G,M,Goal,NM), !, + '$execute'(NM:Goal). -'$do_undefp'(G,M) :- +'$find_undefp_handler'(G,M,NG,S) :- functor(G,F,N), recorded('$import','$import'(S,M,F,N),_), S \= M, % can't try importing from the module itself. @@ -734,25 +746,22 @@ not(G) :- \+ '$execute'(G). ( '$meta_expansion'(S,M,G,G1,[]) -> - '$execute'(S:G1) + NG = G1 ; - '$execute'(S:G) + NG = G ). -'$do_undefp'(G,M) :- +'$find_undefp_handler'(G,M,NG,M) :- '$is_expand_goal_or_meta_predicate'(G,M), '$system_catch'(goal_expansion(G, M, NG), user, _, fail), !, - '$exit_undefp', - '$execute0'(NG,M). -'$do_undefp'(G,M) :- + '$exit_undefp'. +'$find_undefp_handler'(G,M,NG,user) :- \+ '$undefined'(unknown_predicate_handler(_,_,_), user), - '$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)), - '$exit_undefp', !, - '$execute'(user:NG). -'$do_undefp'(G,M) :- + '$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)), !, + '$exit_undefp'. +'$find_undefp_handler'(G,M,US,user) :- recorded('$unknown','$unknown'(M:G,US),_), !, - '$exit_undefp', - '$execute'(user:US). -'$do_undefp'(_,_) :- + '$exit_undefp'. +'$find_undefp_handler'(G,M,_,_) :- '$exit_undefp', fail. @@ -821,7 +830,7 @@ bootstrap(F) :- !. '$enter_command'(Stream,Status) :- - '$read_vars'(Stream,Command,_,Vars), + '$read_vars'(Stream,Command,_,_,Vars), '$command'(Command,Vars,Status). '$abort_loop'(Stream) :- diff --git a/pl/debug.yap b/pl/debug.yap index 7a093c86f..f7264a6b6 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -416,12 +416,20 @@ debugging :- '$execute_nonstop'(G, M). '$spycall'(G, M, InControl) :- '$flags'(G,M,F,F), - F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, or source + F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, user-C, or source % use the interpreter CP is '$last_choice_pt', '$clause'(G, M, Cl), '$do_not_creep', '$do_spy'(Cl, M, CP, InControl). +'$spycall'(G, M, InControl) :- + '$undefined'(G, M), !, + '$enter_undefp', + ( + '$find_undefp_handler'(G,M,Goal,NM) + -> + '$spycall'(Goal, NM, InControl) + ). '$spycall'(G, M, InControl) :- % I lost control here. CP is '$last_choice_pt', diff --git a/pl/modules.yap b/pl/modules.yap index df26cd5d0..423371c00 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -85,7 +85,17 @@ module(N) :- recorded('$module','$module'(F0,Mod,_),R), !, '$add_preexisting_module_on_file'(F, F0, Mod, Exports, R). '$add_module_on_file'(Mod, F, Exports) :- - recorda('$module','$module'(F,Mod,Exports),_). + '$process_exports'(Exports,Mod,ExportedPreds), + recorda('$module','$module'(F,Mod,ExportedPreds),_). + +'$process_exports'([],_,[]). +'$process_exports'([Name/Arity|Exports],Mod,[Name/Arity|ExportedPreds]):- !, + '$process_exports'(Exports,Mod,ExportedPreds). +'$process_exports'([op(Prio,Assoc,Name)|Exports],Mod,ExportedPreds) :- !, + '$opdec'(Prio,Assoc,Name,Mod), + '$process_exports'(Exports,Mod,ExportedPreds). +'$process_exports'([Trash|Exports],Mod,_) :- + '$do_error'(type_error(predicate_indicator,Trash),module(Mod,[Trash])). % redefining a previously-defined file, no problem. '$add_preexisting_module_on_file'(F, F, Mod, Exports, R) :- !, diff --git a/pl/utils.yap b/pl/utils.yap index 714c6dac7..c7068bade 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -176,7 +176,7 @@ op(P,T,V) :- '$op2'(P,T,V). '$op'(P,T,',') :- !, '$do_error'(permission_error(modify,operator,','),op(P,T,',')). -'$op'(P,T,A) :- '$opdec'(P,T,A). +'$op'(P,T,A) :- '$opdec'(P,T,A,prolog). %%% Operating System utilities @@ -725,3 +725,14 @@ nth_instance(X,Y,Z) :- nth_instance(X,Y,Z) :- '$nth_instance'(X,Y,Z). +'$run_atom_goal'(GA) :- + '$current_module'(Module), + atom_codes(GA,Gs), + charsio:open_mem_read_stream(Gs, Stream), + ( '$system_catch'(read(Stream, G),Module,_,fail) -> + close(Stream) + ; + close(Stream), + fail + ), + '$system_catch'('$query'(once(G), []),Module,Error,user:'$Error'(Error)). diff --git a/pl/yio.yap b/pl/yio.yap index e2889e3cb..7e8d8f156 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -147,7 +147,8 @@ open(F,T,S,Opts) :- '$check_opt_read'(singletons(_), _) :- !. '$check_opt_read'(syntax_errors(T), G) :- !, '$check_read_syntax_errors_arg'(T, G). -'$check_opt_read'(term_position(_), G) :- !. +'$check_opt_read'(term_position(_), _) :- !. +'$check_opt_read'(module(_), _) :- !. '$check_opt_read'(A, G) :- '$do_error'(domain_error(read_option,A),G). @@ -316,7 +317,7 @@ told :- current_output(Stream), '$close'(Stream), set_output(user). /* Term IO */ read(T) :- - '$read'(false,T,_,_,Err), + '$read'(false,T,_,_,_,Err), (nonvar(Err) -> '$print_message'(error,Err), fail ; @@ -324,7 +325,7 @@ read(T) :- ). read(Stream,T) :- - '$read'(false,T,V,_,Err,Stream), + '$read'(false,T,_,_,_,Err,Stream), (nonvar(Err) -> '$print_message'(error,Err), fail ; @@ -334,27 +335,29 @@ read(Stream,T) :- read_term(T, Options) :- '$check_io_opts'(Options,read_term(T, Options)), current_input(S), - '$preprocess_read_terms_options'(Options), - '$read_vars'(S,T,Pos,VL), + '$preprocess_read_terms_options'(Options,Module), + '$read_vars'(S,T,Module,Pos,VL), '$postprocess_read_terms_options'(Options, T, VL, Pos). read_term(Stream, T, Options) :- '$check_io_opts'(Options,read_term(T, Options)), - '$preprocess_read_terms_options'(Options), - '$read_vars'(Stream,T,Pos,VL), + '$preprocess_read_terms_options'(Options,Module), + '$read_vars'(Stream,T,Module,Pos,VL), '$postprocess_read_terms_options'(Options, T, VL, Pos). % % support flags to read % -'$preprocess_read_terms_options'([]). -'$preprocess_read_terms_options'([syntax_errors(NewVal)|L]) :- !, +'$preprocess_read_terms_options'([],_). +'$preprocess_read_terms_options'([syntax_errors(NewVal)|L],Mod) :- !, '$get_read_error_handler'(OldVal), set_value('$read_term_error_handler', OldVal), '$set_read_error_handler'(NewVal), - '$preprocess_read_terms_options'(L). -'$preprocess_read_terms_options'([_|L]) :- - '$preprocess_read_terms_options'(L). + '$preprocess_read_terms_options'(L,Mod). +'$preprocess_read_terms_options'([module(Mod)|L],Mod) :- !, + '$preprocess_read_terms_options'(L,Mod). +'$preprocess_read_terms_options'([_|L],Mod) :- + '$preprocess_read_terms_options'(L,Mod). '$postprocess_read_terms_options'([], _, _, _). '$postprocess_read_terms_options'([H|Tail], T, VL, Pos) :- !, @@ -377,6 +380,7 @@ read_term(Stream, T, Options) :- '$postprocess_read_terms_option'(variables(Val), T, _, _) :- '$variables_in_term'(T, [], Val). '$postprocess_read_terms_option'(term_position(Pos), _, _, Pos). +'$postprocess_read_terms_option'(module(_), _, _, _). %'$postprocess_read_terms_option'(cycles(Val), _, _). '$read_term_non_anonymous'([], []).