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

@@ -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.              */

C/arrays.c

@@ -1521,11 +1521,6 @@ 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) {
     WRITE_UNLOCK(ptr->ArRWLock);
     Yap_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
@@ -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)) {
+      } else if (IsAtomicTerm(t3)) {
-	ptr->ValueOfVE.lterms[indx].tstore = tnew;
+	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;

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

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) &&
+	  return(Yap_unify(t1,ARG5) &&
-		 Yap_unify(ARG5,Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("error"),2),2,t)));
+		 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) &&
+    return Yap_unify(t, ARG2) && Yap_unify (v, ARG4) &&
-	   Yap_unify(MkIntTerm(StartLine = tokstart->TokPos),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_read, SyncPredFlag|HiddenPredFlag);
-  Yap_InitCPred ("$read", 6, p_read2, 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);

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);
+  READ_LOCK(opp->OpRWLock);
-  if ((p = RepOpProp(opinfo)->Prefix) != 0) {
+  if (opp->OpModule &&
-    READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
+      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);
+    READ_UNLOCK(opp->OpRWLock);
-    return (FALSE);
+    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);
+  READ_LOCK(opp->OpRWLock);
-  if ((p = RepOpProp(opinfo)->Infix) != 0) {
+  if (opp->OpModule &&
-    READ_UNLOCK(RepOpProp(opinfo)->OpRWLock);
+      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);
+    READ_UNLOCK(opp->OpRWLock);
-    return (FALSE);
+    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_LOCK(opp->OpRWLock);
-    READ_UNLOCK(RepOpProp(opinfo)->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))) {
+	&& (opinfo = Yap_GetOpProp((Atom)(Yap_tokptr->TokInfo)))) {
-      Prop save_opinfo = opinfo;
+      OpEntry *save_opinfo = opinfo;
       if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio)
 	  && opprio <= prio && oplprio >= curprio) {
 	/* try parsing as infix operator */

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,
+  Term tmod = Deref(ARG4);
-		AtomOfTerm(at)));
+  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);

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;

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 */

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

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);

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;

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 <stdarg.h>
 #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) */
+#define YAP_cut_succeed() { YAP_cut_up(); return TRUE; }
-extern X_API void PROTO(YAP_cut_succeed,(void));
+
+#define YAP_cut_fail() { YAP_cut_up(); return FALSE; }
 
 /*  void *AllocSpaceFromYAP_(int) */
 extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));

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.  */

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).
+
+
+
+
+

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

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

library/yap2swi/yap2swi.h

@@ -12,8 +12,12 @@
 
 
 //=== includes ===============================================================
+#include "config.h"
 #include	<YapInterface.h>
 #include	<stdarg.h>
+#if HAVE_TIME_H
+#include <time.h>
+#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);
 

pl/boot.yap

@@ -96,8 +96,8 @@ true :- true.
 */
 
 /* main execution loop							*/
-'$read_vars'(Stream,T,Pos,V) :-
+'$read_vars'(Stream,T,Mod,Pos,V) :-
-	'$read'(true,T,V,Pos,Err,Stream),
+	'$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',
+	'$exit_undefp'.
-	'$execute0'(NG,M).
+'$find_undefp_handler'(G,M,NG,user) :-
-'$do_undefp'(G,M) :-
 	\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
-	'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)),
+	'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)), !,
-	'$exit_undefp', !,
+	'$exit_undefp'.
-	'$execute'(user:NG).
+'$find_undefp_handler'(G,M,US,user) :-
-'$do_undefp'(G,M) :-
 	recorded('$unknown','$unknown'(M:G,US),_), !,
-	'$exit_undefp',
+	'$exit_undefp'.
-	'$execute'(user:US).
+'$find_undefp_handler'(G,M,_,_) :-
-'$do_undefp'(_,_) :-
 	'$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) :-

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',

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) :- !,

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)).

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),
+	'$preprocess_read_terms_options'(Options,Module),
-	'$read_vars'(S,T,Pos,VL),
+	'$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),
+	'$preprocess_read_terms_options'(Options,Module),
-	'$read_vars'(Stream,T,Pos,VL),
+	'$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'([],_).
-'$preprocess_read_terms_options'([syntax_errors(NewVal)|L]) :- !,
+'$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,Mod).
-'$preprocess_read_terms_options'([_|L]) :-
+'$preprocess_read_terms_options'([module(Mod)|L],Mod) :- !,
-	'$preprocess_read_terms_options'(L).
+	'$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'([], []).