Merge branch 'master' of yap.dcc.fc.up.pt:yap-6

C/exec.c

@@ -1034,11 +1034,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b)
   }
   B = (choiceptr)ASP;
   B--;
-#ifdef TABLING
-  if (top && GLOBAL_root_dep_fr) {
-    DepFr_cons_cp(GLOBAL_root_dep_fr) = B;
-  }
-#endif /* TABLING */
   B->cp_h     = H;
   B->cp_tr    = TR;
   B->cp_cp    = CP;

C/write.c

@@ -292,29 +292,30 @@ wrputref(CODEADDR ref, int Quote_illegal, wrf writewch)			/* writes a data base
 
 static int 
 legalAtom(unsigned char *s)			/* Is this a legal atom ? */
-	                  
 {
   wchar_t ch = *s;
 
   if (ch == '\0')
-    return(FALSE);
+    return FALSE;
   if (Yap_chtype[ch] != LC) {
-    if (ch == '[')
+    if (ch == '[') {
-      return (*++s == ']' && !(*++s));
+      return (s[1] == ']' && !s[2]);
-    else if (ch == '{')
+    } else if (ch == '{') {
-      return (*++s == '}' && !(*++s));
+	return (s[1] == '}' && !s[2]);
 //    else if (ch == '/')
 //      return (*++s != '*');
-    else if (Yap_chtype[ch] == SL)
+    } else if (Yap_chtype[ch] == SL) {
-      return (!*++s);
+      return (!s[1]);
-    else if ((ch == ',' || ch == '.') && !s[1])
+    } else if ((ch == ',' || ch == '.') && !s[1]) {
       return FALSE;
-    else
+    } else {
       while (ch) {
-	if (Yap_chtype[ch] != SY)
+	if (Yap_chtype[ch] != SY) {
 	  return FALSE;
+	}
 	ch = *++s;
       }
+    }
     return TRUE;
   } else
     while ((ch = *++s) != 0)

OPTYap/opt.init.c

@@ -239,6 +239,9 @@ void make_root_frames(void) {
   /* root dependency frame */
   if (!GLOBAL_root_dep_fr) {
     new_dependency_frame(GLOBAL_root_dep_fr, FALSE, NULL, NULL, NULL, NULL, NULL);
+#ifdef TABLING
+    DepFr_cons_cp(GLOBAL_root_dep_fr) = B;
+#endif /* TABLING */
   }
 #endif /* TABLING */
 }

include/SWI-Prolog.h

@@ -513,8 +513,8 @@ extern X_API int PL_recorded_external(char *, term_t);
 extern X_API int PL_erase_external(char *);
 extern X_API int PL_action(int,...);
 extern X_API void PL_on_halt(void (*)(int, void *), void *);
-extern X_API void *PL_malloc(int);
+extern X_API void *PL_malloc(size_t);
-extern X_API void *PL_realloc(void*,int);
+extern X_API void *PL_realloc(void*,size_t);
 extern X_API void PL_free(void *);
 extern X_API int  PL_eval_expression_to_int64_ex(term_t t, int64_t *val);
 extern X_API void  PL_cleanup_fork(void);

library/dialect/swi.yap

@@ -6,7 +6,6 @@
 :- module(system, [concat_atom/2,
 		   concat_atom/3,
 		   setenv/2,
-		   prolog_to_os_filename/2,
 		   is_absolute_file_name/1,
 		   read_clause/1,
 		   string/1,
@@ -224,7 +223,6 @@ goal_expansion(rename_file(A,B),system:swi_rename_file(A,B)) :- swi_io.
 goal_expansion(is_absolute_file_name(A), is_absolute_file_name(A)) :- swi_io.
 goal_expansion(file_base_name(A,B),system:swi_file_base_name(A,B)) :- swi_io.
 goal_expansion(file_directory_name(A,B),system:swi_file_directory_name(A,B)) :- swi_io.
-goal_expansion(prolog_to_os_filename(A,B),system:swi_prolog_to_os_filename(A,B)) :- swi_io.
 goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- swi_io.
 goal_expansion('$absolute_file_name'(A,B),system:'swi_$absolute_file_name'(A,B)) :- swi_io.
 
@@ -281,8 +279,6 @@ concat_atom(List, New) :-
 
 setenv(X,Y) :- unix(putenv(X,Y)).
 
-prolog_to_os_filename(X,X).
-
 is_absolute_file_name(X) :-
 	absolute_file_name(X,X).
 

library/tries/core_dbtries.c

@@ -612,8 +612,17 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
     } while (bucket != first_bucket);
   } else {
     do {
-      if (TrNode_entry(child) == PairEndTag)
+      if (TrNode_entry(child) == PairEndTag) {
-        return core_breadth_reduction(engine, child, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function);
+        /* do breadth reduction simplification */
+        node = TrNode_parent(child);
+        DATA_DESTRUCT_FUNCTION = destruct_function;
+        remove_child_nodes(TrNode_child(node));
+        TrNode_child(node) = NULL;
+        node = trie_node_check_insert(node, PairEndTag);
+        INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
+        return node;
+        //return core_breadth_reduction(engine, node, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function);
+      }
       while (IS_FUNCTOR_NODE(child)) {
         child = TrNode_child(child);
         if (IS_HASH_NODE(child)) { // gets first child in the hash

library/yap2swi/yap2swi.c

@@ -272,8 +272,8 @@ ensure_space(char **sp, size_t room, unsigned flags) {
     min += 512;
 
   if (flags & BUF_MALLOC) {
-    free(*sp);
+    PL_free(*sp);
-    *sp = malloc(room);
+    *sp = PL_malloc(room);
     return *sp; 
   } else if (flags & BUF_RING) {
     for (i=1; i<= SWI_BUF_RINGS; i++)
@@ -512,7 +512,7 @@ static int do_yap_putc(int sno, wchar_t ch) {
     UInt bufsize = putc_cur_lim-putc_cur_buf;
     UInt bufpos = putc_curp-putc_cur_buf;
 
-    if (!(putc_cur_buf = realloc(putc_cur_buf, bufsize+SWI_BUF_SIZE))) {
+    if (!(putc_cur_buf = PL_realloc(putc_cur_buf, bufsize+SWI_BUF_SIZE))) {
       /* we can+t go forever */
       return FALSE;
     }
@@ -564,7 +564,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
   if ((flags & BUF_RING)) {
     tmp = alloc_ring_buf();
   } else if ((flags & BUF_MALLOC)) {
-    tmp = malloc(SWI_BUF_SIZE);
+    tmp = PL_malloc(SWI_BUF_SIZE);
   } else {
     tmp = SWI_buffers[0];
   }
@@ -641,7 +641,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
   }
   if (flags & BUF_MALLOC) {
     size_t sz = strlen(tmp);
-    char *nbf = malloc(sz+1);
+    char *nbf = PL_malloc(sz+1);
     if (!nbf)
       return 0;
     strncpy(nbf,tmp,sz+1);
@@ -685,7 +685,7 @@ X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
   }
   room = (sz+1)*sizeof(wchar_t);
   if (flags & BUF_MALLOC) {
-    *wsp = buf = (wchar_t *)malloc(room);
+    *wsp = buf = (wchar_t *)PL_malloc(room);
   } else if (flags & BUF_RING) {
     *wsp = (wchar_t *)alloc_ring_buf();
     buf = (wchar_t *)ensure_space((char **)wsp, room, flags);
@@ -1129,7 +1129,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
 {
   va_list ap;
   int arity, i;
-  Term *tmp = (Term *)SWI_buffers[0];
+  Term *tmp, t;
   Functor ff = SWIFunctorToFunctor(f);
 
   if (IsAtomTerm((Term)ff)) {
@@ -1137,46 +1137,55 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
     return TRUE;
   }
   arity = ArityOfFunctor(ff);
-  if (arity > SWI_TMP_BUF_SIZE/sizeof(YAP_CELL)) {
+  while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) {
-    fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity); 
+    if (!Yap_gc(0, ENV, CP)) {
       return FALSE;
     }
+  }
+  if (arity == 2 && ff == FunctorDot) {
+    t = Yap_MkNewPairTerm();
+    tmp = RepPair(t);
+  } else {
+    t = Yap_MkNewApplTerm(ff, arity);
+    tmp = RepAppl(t)+1;
+  }
   va_start (ap, f);
   for (i = 0; i < arity; i++) {
-    tmp[i] =  Yap_GetFromSlot(va_arg(ap, term_t));
+    Yap_unify(tmp[i],Yap_GetFromSlot(va_arg(ap, term_t)));
   }
   va_end (ap);
-  if (arity == 2 && ff == FunctorDot)
+  Yap_PutInSlot(d,t);
-    Yap_PutInSlot(d,MkPairTerm(tmp[0],tmp[1]));
-  else
-    Yap_PutInSlot(d,Yap_MkApplTerm(ff,arity,tmp));
-  if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
-    if (!Yap_gc(0, ENV, CP)) {
-      return FALSE;
-    }
-  }
   return TRUE;
 }
 
-X_API int PL_cons_functor_v(term_t d, functor_t f,term_t a0)
+X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0)
 {
-  int arity;
+  int arity, i;
+  Term *tmp, t;
   Functor ff = SWIFunctorToFunctor(f);
 
   if (IsAtomTerm((Term)ff)) {
-    Yap_PutInSlot(d,(Term)ff);
+    Yap_PutInSlot(d, (YAP_Term)f);
     return TRUE;
   }
   arity = ArityOfFunctor(ff);
-  if (arity == 2 && ff == FunctorDot)
+  while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) {
-    Yap_PutInSlot(d,MkPairTerm(Yap_GetFromSlot(a0),Yap_GetFromSlot(a0+1)));    
-  else
-    Yap_PutInSlot(d,Yap_MkApplTerm(ff,arity,Yap_AddressFromSlot(a0)));
-  if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
     if (!Yap_gc(0, ENV, CP)) {
       return FALSE;
     }
   }
+  if (arity == 2 && ff == FunctorDot) {
+    t = Yap_MkNewPairTerm();
+    tmp = RepPair(t);
+  } else {
+    t = Yap_MkNewApplTerm(ff, arity);
+    tmp = RepAppl(t)+1;
+  }
+  for (i = 0; i < arity; i++) {
+    Yap_unify(tmp[i],Yap_GetFromSlot(a0));
+    a0++;
+  }
+  Yap_PutInSlot(d,t);
   return TRUE;
 }
 
@@ -3011,21 +3020,33 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old)
 
 
 X_API void *
-PL_malloc(int sz)
+PL_malloc(size_t sz)
 {
-  return (void *)Yap_AllocCodeSpace((long unsigned int)sz);
+  if ( sz == 0 )
+    return NULL;
+  return (void *)malloc((long unsigned int)sz);
 }
 
 X_API void *
-PL_realloc(void *ptr, int sz)
+PL_realloc(void *ptr, size_t sz)
 {
-  return Yap_ReallocCodeSpace((char *)ptr,(long unsigned int)sz);
+  if (ptr) {
+    if (sz) {
+      return realloc((char *)ptr,(long unsigned int)sz);
+    } else {
+      free(ptr);
+      return NULL;
+    }
+  } else {
+    return PL_malloc(sz);
+  }
 }
 
 X_API void
 PL_free(void *obj)
 {
-  return Yap_FreeCodeSpace((char *)obj);
+  if (obj)
+    free(obj);
 }
 
 X_API int

packages/clib/process.pl

@@ -45,6 +45,8 @@
 :- use_module(library(option)).
 :- use_module(library(error)).
 
+:- use_module(library(maplist)).
+
 :- use_foreign_library(foreign(process)).
 
 /** <module> Create processes and redirect I/O

packages/semweb/rdf_db.pl

@@ -127,6 +127,10 @@
 	    (rdf_meta)/1,		% +Heads
 	    op(1150, fx, (rdf_meta))
 	  ]).
+
+:- expects_dialect(swi).
+:- assert(system:swi_io).
+
 :- use_module(library(rdf)).
 :- use_module(library(lists)).
 :- use_module(library(shlib)).
@@ -153,6 +157,16 @@
 :- discontiguous
 	term_expansion/2.
 
+:- meta_predicate
+	rdf_transaction(0),
+	rdf_transaction(0, +),
+	rdf_monitor(1, +),
+	rdf_save(+, :),
+	rdf_load(+, :).
+
+:- thread_local
+	named_anon/2.			% +Resource, -Id
+
 /** <module> Core RDF database
 
 @see Documentation for semweb package
@@ -1369,16 +1383,6 @@ rdf_reset_db :-
 %			file-url (=|file://path|=) or a stream wrapped
 %			in a term stream(Out).
 
-:- meta_predicate
-	rdf_transaction(0),
-	rdf_transaction(0, +),
-	rdf_monitor(1, +),
-	rdf_save(+, :),
-	rdf_load(+, :).
-
-:- thread_local
-	named_anon/2.			% +Resource, -Id
-
 rdf_save(File) :-
 	rdf_save2(File, []).
 
@@ -2183,3 +2187,7 @@ into(_, _) --> [].			% TBD
 in_time(Triples, ParseTime) -->
 	[ ' in ~2f sec; ~D triples'-[ParseTime, Triples]
 	].
+
+:- retract(system:swi_io).
+
+

packages/tai/Makefile.in

@@ -56,4 +56,4 @@ install: all
 
 clean:
 	rm -f *.o *~ $(OBJS) $(SOBJS) *.BAK
-
+	-(cd libtai && $(MAKE) clean)

pl/consult.yap

@@ -1036,6 +1036,8 @@ file_name_extension(A1,A2,F) :-
 	atom_codes(A2, S2),
 	(
 	 S2 = [0'.|_] %'
+	;
+	 A2 = ''
 	->
 	 atom_concat(A1, A2, F)
 	;

pl/yio.yap

@@ -1209,3 +1209,21 @@ with_output_to(Output, Command) :-
 	atom_codes(Char, [Code]),
 	'$codes_to_chars'(String0, String, Chars).
 
+prolog_to_os_filename(Prolog, OS) :-
+	'$undefined'(swi_prolog_to_os_filename(Prolog, OS), system),
+	'$current_module'(Old, system),
+	load_foreign_files([libplstream], [], initIO),
+	'$current_module'(system, Old),
+	fail.
+prolog_to_os_filename(Prolog, OS) :-
+	system:swi_prolog_to_os_filename(Prolog, OS).
+
+
+
+
+
+
+
+
+
+