fix GPL

fix idb: stuff in coroutines.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1267 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/c_interface.c

@@ -10,8 +10,13 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2005-03-13 06:26:10 $,$Author: vsc $						 *
+* Last rev:	$Date: 2005-03-15 18:29:23 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.64  2005/03/13 06:26:10  vsc
+* fix excessive pruning in meta-calls
+* fix Term->int breakage in compiler
+* improve JPL (at least it does something now for amd64).
+*
 * Revision 1.63  2005/03/04 20:30:10  ricroc
 * bug fixes for YapTab support
 *
@@ -1129,12 +1134,16 @@ YAP_Init(YAP_init_args *yap_init)
   }
   if (yap_init->SavedState != NULL ||
       yap_init->YapPrologBootFile == NULL) {
+#if SUPPORT_CONDOR || SUPPORT_THREADS
+    restore_result = YAP_FULL_BOOT_FROM_PROLOG;
+#else
     restore_result = Yap_Restore(yap_init->SavedState, yap_init->YapLibDir);
     if (restore_result == FAIL_RESTORE) {
       yap_init->ErrorNo = Yap_Error_TYPE;
       yap_init->ErrorCause = Yap_ErrorMessage;
       return YAP_BOOT_FROM_SAVED_ERROR;
     }
+#endif
   } else {
     restore_result = FAIL_RESTORE;
   }

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2005-03-04 20:30:12 $,$Author: ricroc $						 *
+* Last rev:     $Date: 2005-03-15 18:29:23 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.119  2005/03/04 20:30:12  ricroc
+* bug fixes for YapTab support
+*
 * Revision 1.118  2005/03/01 22:25:08  vsc
 * fix pruning bug
 * make DL_MALLOC less enthusiastic about walking through buckets.
@@ -3850,7 +3853,7 @@ static ClauseDef *
 copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top, struct intermediates *cint)
 {
   UInt sz = ((max0+1)-min0)*sizeof(ClauseDef);
-  while ((char *)top + sz > Yap_TrailTop) {
+  if ((char *)top + sz >= Yap_TrailTop-4096) {
     Yap_Error_Size = sz;
     /* grow stack */
     longjmp(cint->CompilerBotch,4);

LGPL/JPL/jpl.yap

@@ -1,4 +1,4 @@
-/*  $Id: jpl.yap,v 1.2 2005-03-13 06:26:12 vsc Exp $
+/*  $Id: jpl.yap,v 1.3 2005-03-15 18:29:24 vsc Exp $
 
     Part of JPL -- SWI-Prolog/Java interface
 
@@ -836,6 +836,9 @@ jpl_new_array(boolean, Len, A) :-
 jpl_new_array(byte, Len, A) :-
     jNewByteArray(Len, A).
 
+jpl_new_array(char_byte, Len, A) :-
+    jNewByteArray(Len, A).
+
 jpl_new_array(char, Len, A) :-
     jNewCharArray(Len, A).
 
@@ -3013,7 +3016,7 @@ jpl_cache_type_of_ref(T, @(Tag)) :-
     (	\+ ground(T)
     ->	write('[jpl_cache_type_of_ref/2: arg 1 is not ground]'), nl,
 	fail
-    ;	\+ atom(Tag)
+    ;	\+ integer(Tag)
     ->	write('[jpl_cache_type_of_ref/2: arg 2 is not an atomic-tag ref]'), nl,
 	fail
     ;	Tag == null
@@ -3319,10 +3322,7 @@ jpl_is_object_type(T) :-
 %   could check initial character(s) or length? or adopt strong/weak scheme...
 
 jpl_is_ref(@(Y)) :-
-    atom(Y),	    % presumably a (garbage-collectable) tag
+    integer(Y).	    % presumably a (garbage-collectable) tag
-    Y \== void,	    % not a ref
-    Y \== false,    % not a ref
-    Y \== true.	    % not a ref
 
 %------------------------------------------------------------------------------
 
@@ -3454,6 +3454,7 @@ jpl_primitive_buffer_to_array(T, Xc, Bp, I, Size, [Vc|Vcs]) :-
 jpl_primitive_type(boolean).
 jpl_primitive_type(char).
 jpl_primitive_type(byte).
+jpl_primitive_type(char_byte).
 jpl_primitive_type(short).
 jpl_primitive_type(int).
 jpl_primitive_type(long).
@@ -3844,9 +3845,9 @@ jpl_value_to_type_1(A, class([java,lang],['String'])) :-   % yes it's a "value"
 
 jpl_value_to_type_1(I, T) :-
     integer(I),
-    (	I >= 0	->  (	I < 128	    ->	T = char_byte
+    (	I >= 0	->  (	I < 128	    ->	T = byte % char_byte
-		    ;	I < 32768   ->	T = char_short
+		    ;	I < 32768   ->	T = short % char_short
-		    ;	I < 65536   ->	T = char_int
+		    ;	I < 65536   ->	T = int % char_int
 				    ;	T = int		% was pos_int
 		    )
     ;	I >= -128   ->	T = byte			% was neg_byte
@@ -4262,7 +4263,6 @@ load_jpl_lib :-
 	jpl_java_home(JavaHome),
 	fetch_arch(Arch),
 	gen_jvm_lib(JavaHome,Arch,JLib),
-	write(JLib),nl,
 	load_foreign_files([jpl], [JLib], jpl_install), !.
 
 fetch_arch(Arch) :-

console/yap.c

@@ -250,7 +250,7 @@ static int
 parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
 {
   char *p;
-#if USE_MALLOC
+#if SUPPORT_CONDOR||SUPPORT_THREADS
   int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
 #else
   int BootMode = YAP_BOOT_FROM_SAVED_CODE;

library/swi.yap

@@ -6,10 +6,15 @@
 	nth1/3,
 	forall/2,
 	between/3,
+	term_to_atom/2,
 	concat_atom/2,
 	volatile/1]).
 
 
+:- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
+
+:- use_module(library(lists),[nth/3]).
+
 :- multifile user:file_search_path/2.
 
 :- dynamic user:file_search_path/2.
@@ -55,6 +60,14 @@ absolute_file_name(File, Opts, Path) :-
 	absolute_file_name(File, Path).
 
 
+term_to_atom(Term,Atom) :-
+	nonvar(Atom), !,
+	atom_codes(Atom,S),
+	read_from_chars(S,Term).
+term_to_atom(Term,Atom) :-
+	write_to_chars(Term,S),
+	atom_codes(Atom,S).
+
 concat_atom(List, Separator, New) :-
 	add_separator_to_list(List, Separator, NewList),
 	atomic_concat(NewList, New).

library/yap2swi/yap2swi.c

@@ -688,24 +688,31 @@ get_term(arg_types **buf)
   /* now build the error string */
   case PL_VARIABLE:
     t = YAP_MkVarTerm();
+    ptr++;
     break;
   case PL_ATOM:
     t = YAP_MkAtomTerm((YAP_Atom)ptr->arg.a);
+    ptr++;
     break;
   case PL_INTEGER:
     t = YAP_MkIntTerm(ptr->arg.l);
+    ptr++;
     break;
   case PL_FLOAT:
     t = YAP_MkFloatTerm(ptr->arg.dbl);
+    ptr++;
     break;
   case PL_POINTER:
     t = YAP_MkIntTerm((long int)(ptr->arg.p));
+    ptr++;
     break;
   case PL_STRING:
     t = YAP_BufferToString(ptr->arg.s);
+    ptr++;
     break;
   case PL_TERM:
     t = YAP_GetFromSlot(ptr->arg.t);
+    ptr++;
     break;
   case PL_CHARS:
     t = YAP_MkAtomTerm(YAP_LookupAtom(ptr->arg.s));
@@ -734,16 +741,17 @@ get_term(arg_types **buf)
       term_t loc;
 
       loc = YAP_NewSlots(2);
+      ptr++;
       YAP_PutInSlot(loc,get_term(&ptr));
       YAP_PutInSlot(loc+1,get_term(&ptr));
       t = YAP_MkPairTerm(YAP_GetFromSlot(loc),YAP_GetFromSlot(loc+1));
     }
     break;
   default:
-    fprintf(stderr, "PL_FUNCTOR not implemented yet\n");
+    fprintf(stderr, "type %d not implemented yet\n", type);
     exit(1);
   }
-  ptr++;
+  *buf = ptr;
   return t;
 }
 
@@ -816,13 +824,6 @@ X_API int PL_unify_term(term_t l,...)
 /* SAM TO DO */
 X_API void PL_register_atom(atom_t atom)
 {
-  YAP_Term ti = YAP_GetValue((YAP_Atom)atom);
-  if (ti == YAP_MkAtomTerm(YAP_LookupAtom("[]"))) {
-    YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(1));
-  } else if (YAP_IsIntTerm(ti)) {
-    long int i = YAP_IntOfTerm(ti);
-    YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(i++));
-  }
 }
 
 /* SWI: void PL_unregister_atom(atom_t atom)
@@ -830,13 +831,6 @@ X_API void PL_register_atom(atom_t atom)
 /* SAM TO DO */
 X_API void PL_unregister_atom(atom_t atom)
 {
-  YAP_Term ti = YAP_GetValue((YAP_Atom)atom);
-  if (YAP_IsIntTerm(ti)) {
-    long int i = YAP_IntOfTerm(ti);
-    if (i == 1)
-      YAP_PutValue((YAP_Atom)atom, YAP_MkAtomTerm(YAP_LookupAtom("[]")));
-    YAP_PutValue((YAP_Atom)atom, YAP_MkIntTerm(i--));
-  }
 }
 
 X_API int PL_get_string_chars(term_t t, char **s, int *len)

pl/threads.yap

@@ -387,7 +387,7 @@ thread_local(X) :-
 
 '$thread_local2'(A/N, Mod) :- integer(N), atom(A), !,
 	functor(T,A,N),
-	'$flags'(T,Mod,F,F),
+	(Mod \= idb -> '$flags'(T,Mod,F,F) ; true),
 	( '$install_thread_local'(T,Mod) -> true ;
 	   F /\ 0x08002000 =\= 0 -> '$do_error'(permission_error(modify,dynamic_procedure,A/N),thread_local(Mod:A/N)) ;
 	   '$do_error'(permission_error(modify,static_procedure,A/N),thread_local(Mod:A/N))