fix matrix mess

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

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2006-12-27 01:32:37 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-01-24 10:01:38 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.202  2006/12/27 01:32:37  vsc
+* diverse fixes
+*
 * Revision 1.201  2006/12/13 16:10:14  vsc
 * several debugger and CLP(BN) improvements.
 *
@@ -3316,7 +3319,7 @@ all_envs(CELL *env_ptr)
     bp = H;
     H += 2;
     /* notice that MkIntegerTerm may increase the Heap */
-    bp[0] = MkIntegerTerm((Int)env_ptr[E_CP]);
+    bp[0] = MkIntegerTerm(LCL0-env_ptr);
     if (H >= ASP) {
       bp[1] = TermNil;
       return tf;
@@ -5739,20 +5742,50 @@ UnifyPredInfo(PredEntry *pe, int start_arg) {
       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
+ClauseId(yamop *ipc, PredEntry *pe)
+{
+  if (!ipc)
+    return 0;
+  return find_code_in_clause(pe, ipc, NULL, NULL);
+}
+
 static Int
 p_env_info(void)
 {
   PredEntry *pe;
-  yamop *env_cp = (yamop *)IntegerOfTerm(Deref(ARG1));
+  CELL *env = LCL0-IntegerOfTerm(Deref(ARG1));
+  yamop *env_cp;
+  Term env_b, taddr;
+  
+  if (!env)
+    return FALSE;
+  env_b = MkIntegerTerm((Int)(LCL0-(CELL *)env[E_CB]));
+  env_cp = (yamop *)env[E_CP];
   
   pe = PREVOP(env_cp,sla)->u.sla.p0;
-  return UnifyPredInfo(pe, 2);
+  taddr = MkIntegerTerm((Int)env);
+  return Yap_unify(ARG3,MkIntegerTerm((Int)env_cp)) &&
+    Yap_unify(ARG2, taddr) &&
+    Yap_unify(ARG4, env_b);
+}
+
+static Int
+p_cpc_info(void)
+{
+  PredEntry *pe;
+  yamop *ipc = (yamop *)IntegerOfTerm(Deref(ARG1));
+
+  pe = PREVOP(ipc,sla)->u.sla.p0;
+  return UnifyPredInfo(pe, 2) &&
+    Yap_unify(ARG5,MkIntegerTerm(ClauseId(ipc,pe)));
 }
 
 static Int
@@ -5762,8 +5795,10 @@ p_choicepoint_info(void)
   PredEntry *pe;
   int go_on = TRUE;
   yamop *ipc = cptr->cp_ap;
-  Term t;
+  yamop *ncl = NULL;
+  Term t, taddr;
   
+  taddr = MkIntegerTerm((Int)cptr);
   while (go_on) {
     op_numbers opnum = Yap_op_from_opcode(ipc->opc);
 
@@ -5829,15 +5864,18 @@ p_choicepoint_info(void)
     case _count_trust_logical:
     case _profiled_retry_logical:
     case _profiled_trust_logical:
+      ncl = ipc->u.lld.d->ClCode;
       pe = ipc->u.lld.d->ClPred;
       t = BuildActivePred(pe, cptr->cp_args);
       break;
     case _or_else:
       pe = ipc->u.sla.p0;
+      ncl = ipc;
       t = Yap_MkNewApplTerm(FunctorOr, 2);
       break;
     case _or_last:
       pe = ipc->u.p.p;
+      ncl = ipc;
       t = Yap_MkNewApplTerm(FunctorOr, 2);
       break;
     case _retry2:
@@ -5846,6 +5884,8 @@ p_choicepoint_info(void)
       pe = NULL;
       t = TermNil;
       ipc = NEXTOP(ipc,l);
+      if (!ncl)
+	ncl = ipc->u.ld.d;
       go_on = TRUE;
       break;
     case _jump:
@@ -5856,6 +5896,7 @@ p_choicepoint_info(void)
       break;
     case _retry_c:
     case _retry_userc:
+      ncl = ipc->u.ld.d;
       pe = ipc->u.lds.p;
       t = BuildActivePred(pe, cptr->cp_args);
       break;
@@ -5863,6 +5904,7 @@ p_choicepoint_info(void)
     case _count_retry:
       pe = NULL;
       t = TermNil;
+      ncl = ipc->u.ld.d;
       ipc = NEXTOP(ipc,p);
       go_on = TRUE;
       break;
@@ -5876,6 +5918,8 @@ p_choicepoint_info(void)
     case _profiled_retry_and_mark:
     case _retry:
     case _trust:
+      if (!ncl)
+	ncl = ipc->u.ld.d;
       pe = ipc->u.ld.p;
       t = BuildActivePred(pe, cptr->cp_args);
       break;
@@ -5893,13 +5937,17 @@ p_choicepoint_info(void)
       return FALSE;
     }
   }
-  return UnifyPredInfo(pe, 2) &&
+  return UnifyPredInfo(pe, 3) &&
-    Yap_unify(ARG5,t);
+    Yap_unify(ARG2, taddr) &&
+    Yap_unify(ARG6,t) &&
+    Yap_unify(ARG7,MkIntegerTerm(ClauseId(ncl,pe)));
 }
 
 void 
 Yap_InitCdMgr(void)
 {
+  Term cm = CurrentModule;
+
   Yap_InitCPred("$compile_mode", 2, p_compile_mode, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$start_consult", 3, p_startconsult, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$show_consult_level", 1, p_showconslultlev, SafePredFlag|HiddenPredFlag);
@@ -5953,10 +6001,13 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag|HiddenPredFlag);
   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);
+  CurrentModule = HACKS_MODULE;
-  Yap_InitCPred("$all_envs", 1, p_all_envs, HiddenPredFlag);
+  Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, HiddenPredFlag);
-  Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag);
+  Yap_InitCPred("current_continuations", 1, p_all_envs, HiddenPredFlag);
-  Yap_InitCPred("$env_info", 4, p_env_info, HiddenPredFlag);
+  Yap_InitCPred("choicepoint", 7, p_choicepoint_info, HiddenPredFlag);
+  Yap_InitCPred("continuation", 4, p_env_info, HiddenPredFlag);
+  Yap_InitCPred("cp_to_predicate", 5, p_cpc_info, HiddenPredFlag);
+  CurrentModule = cm;
   Yap_InitCPred("$predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag);
 #ifdef DEBUG
   Yap_InitCPred("$predicate_live_cps", 4, p_predicate_lu_cps, 0L);

C/dbase.c

@@ -3690,7 +3690,7 @@ index_sz(LogUpdIndex *x)
     if (x->ClFlags & DirtyMask)
       fprintf(stderr,"Dirty -- %p(%p)\n",ap,x);
     if (count > 200)
-      fprintf(stderr,"%d/%d/%d -- %p(%p)\n",count,count0,dead,ap,x);
+      fprintf(stderr,"%ld/%ld/%ld -- %p(%p)\n",count,count0,dead,ap,x);
   }
   x = x->ChildIndex;
   while (x != NULL) {

C/globals.c

@@ -1241,7 +1241,7 @@ p_nb_queue_enqueue(void)
       gsiz = 1024;
     }
     ARG3 = to;
-    fprintf(stderr,"growing %d cells\n",gsiz);
+    fprintf(stderr,"growing %ld cells\n",gsiz);
     if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3)) {
       Yap_Error(OUT_OF_STACK_ERROR, arena, Yap_ErrorMessage);
       return 0L;
@@ -2044,18 +2044,18 @@ p_nb_beam_check(void)
     if (Yap_compare_terms(pt[2*((i+1)/2-1)],pt[2*i]) > 0) {
       Yap_DebugPlWrite(pt[2*((i+1)/2-1)]); fprintf(stderr,"\n");
       Yap_DebugPlWrite(pt[2*i]); fprintf(stderr,"\n");
-      fprintf(stderr,"Error at %d\n",i);
+      fprintf(stderr,"Error at %ld\n",i);
       return FALSE;
     }
     back = IntegerOfTerm(pt[2*i+1]);
     if (IntegerOfTerm(pt2[3*back+1]) != i) {
-      fprintf(stderr,"Link error at %d\n",i);
+      fprintf(stderr,"Link error at %ld\n",i);
       return FALSE;
     }
   }
   for (i = 1; i < qsz; i++) {
     if (Yap_compare_terms(pt2[3*((i+1)/2-1)],pt2[3*i]) < 0) {
-      fprintf(stderr,"Error at sec %d\n",i);
+      fprintf(stderr,"Error at sec %ld\n",i);
       Yap_DebugPlWrite(pt2[3*((i+1)/2-1)]); fprintf(stderr,"\n");
       Yap_DebugPlWrite(pt2[3*i]); fprintf(stderr,"\n");
       return FALSE;

C/init.c

@@ -1028,6 +1028,9 @@ InitCodes(void)
     at = Yap_FullLookupAtom("$spy");
     pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
     Yap_heap_regs->spy_code = pred;
+    Yap_heap_regs->env_for_trustfail_code.p =
+      Yap_heap_regs->env_for_trustfail_code.p0 =
+      RepPredProp(PredPropByAtom(Yap_FullLookupAtom("fail"),PROLOG_MODULE));
   }
 #if DEBUG
   Yap_heap_regs->new_cps = 0;

C/iopreds.c

@@ -4355,6 +4355,17 @@ format_has_tabs(const char *seq)
   return FALSE;
 }
 
+static wchar_t
+base_dig(Int dig, Int ch)
+{
+  if (dig < 10) 
+    return dig+'0';
+  else if (ch == 'r')
+    return (dig-10)+'a';
+  else /* ch == 'R' */
+    return (dig-10)+'A';
+}
+
 static Int
 format(volatile Term otail, volatile Term oargs, int sno)
 {
@@ -4604,7 +4615,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
 	    goto do_type_int_error;
 
 	  {
-	    Int siz = 0, i;
+	    Int siz = 0;
 	    char *ptr = tmp1;
 
 	    if (IsIntegerTerm(t)) {
@@ -4670,7 +4681,8 @@ format(volatile Term otail, volatile Term oargs, int sno)
 	  case 'r':
 	  case 'R':
 	    {
-	      Int numb, radix, div = 1;
+	      Int numb, radix, div = 1, size = 1, i;
+	      wchar_t och;
 
 	      /* print a decimal, using weird . stuff */
 	      if (targ > tnum-1)
@@ -4691,23 +4703,23 @@ format(volatile Term otail, volatile Term oargs, int sno)
 		numb = -numb;
 		f_putc(sno, (int) '-');
 	      }
-	      i = numb;
+	      while (div <  numb) {
-	      while (i > 0) {
-		i /= radix;
 		div *= radix;
+		size++;
 	      }
+	      if (div != numb) {
 		div /= radix;
-	      while (numb) {
+		size--;
+	      }
+	      for (i = 1; i < size; i++) {
 		Int dig = numb/div;
-		if (dig < 10) 
+		och = base_dig(dig, ch);
-		  f_putc(sno, (int)(dig+'0'));
+		f_putc(sno, och);
-		else if (ch == 'r')
-		  f_putc(sno, (int)((dig-10)+'a'));
-		else
-		  f_putc(sno, (int)((dig-10)+'A'));
 		numb %= div;
 		div /= radix;
 	      }
+	      och = base_dig(numb, ch);
+	      f_putc(sno, och);
 	      break;
 	    }
 	  case 's':

Makefile.in

@@ -528,7 +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/matrices; make)
+	@INSTALL_DLLS@ (cd library/matrix; make)
 	@ENABLE_JPL@ @INSTALL_DLLS@ (cd LGPL/JPL/src; make)
 
 startup: yap@EXEC_SUFFIX@ $(PL_SOURCES)

configure.in

@@ -603,7 +603,7 @@ case "$target_os" in
           if test "$have_dl" = "yes"
 	  then
 	    SHLIB_SUFFIX=".so"
-            SHLIB_LD="ld -shared -export-dynamic"
+            SHLIB_LD="gcc -shared -export-dynamic"
             DO_SECOND_LD=""
 	    LIBS="$LIBS -ldl"
 	    case "$host_cpu" in
@@ -1271,7 +1271,7 @@ AC_DEFINE(GC_NO_TAGS,1)
 AC_DEFINE(USE_DL_MALLOC,1)
 fi
 
-mkdir -p  library/matrices
+mkdir -p  library/matrix
 mkdir -p  library/mpi
 mkdir -p  library/random
 mkdir -p  library/regex
@@ -1292,7 +1292,7 @@ mkdir -p  LGPL/clp
 mkdir -p  LGPL/clpr
 mkdir -p  LGPL/chr
 
-AC_OUTPUT(Makefile library/matrices/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile  LGPL/JPL/jpl_paths.yap)
+AC_OUTPUT(Makefile library/matrix/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile  LGPL/JPL/jpl_paths.yap)
 
 make depend
 

library/hacks.yap

@@ -1,12 +1,78 @@
 %   File   : hacks.yap
 %   Author : Vitor Santos Costa
-%   Updated: 2006
+%   Updated: 2007
 %   Purpose: Prolog hacking
 
 :- module(yap_hacks, [
 		  cut_by/1,
-		  current_choice_point/1
+		  current_choicepoints/1,
+		  choicepoint/6,
+		  current_continuations/1,
+		  continuation/4,
+		  stack_dump/0
               ]).
 
+stack_dump :-
+	current_choicepoints(CPs),
+	current_continuations([Env|Envs]),
+	continuation(Env,_,ContP,_),
+	length(CPs, LCPs),
+	length(Envs, LEnvs),
+	format(user_error,'~n~n~tStack Dump~t~40+~n~nAddress~tChoiceP~16+ Cur/Next Clause        Goal~n',[LCPs,LEnvs]),
+	display_stack_info(CPs,Envs,ContP).
+
+display_stack_info([],[],_).
+display_stack_info([CP|CPs],[],_) :-
+	show_lone_cp(CP),
+	display_stack_info(CPs,[],_).
+display_stack_info([],[Env|Envs],Cont) :-
+	show_env(Env, Cont, NCont),
+	display_stack_info([], Envs, NCont).
+display_stack_info([CP|LCPs],[Env|LEnvs],Cont) :-
+	continuation(Env, _, NCont, CB), 
+	( CP == Env, CB < CP ->
+	    % if we follow choice-point and we cut to before choice-point
+	    % we are the same goal
+	   show_cp(CP, 'Cur'), %
+           display_stack_info(LCPs, LEnvs, NCont)
+	;
+          CP > Env ->
+	   show_cp(CP, 'Next'),
+	   display_stack_info(LCPs,[Env|LEnvs],Cont)
+	;
+	   show_env(Env,Cont,NCont),
+	   display_stack_info([CP|LCPs],LEnvs,NCont)
+	).
+
+show_cp(CP, Continuation) :-
+	choicepoint(CP, Addr, Mod, Name, Arity, Goal, ClNo),
+	( Goal = (_;_)
+          ->
+	  format(user_error,'0x~16r~t*~16+ Cur~t~d~16+ ~q:~q/~d( ? ; ? )~n',
+		[Addr, ClNo, Mod, Name, Arity])
+	    ;
+	  prolog_flag( debugger_print_options, Opts),
+	  format(user_error,'0x~16r~t *~16+ ~a~t ~d~16+ ~q:~@~n',
+		[Addr, Continuation, ClNo, Mod, write_term(Goal,Opts)])
+	).
+
+show_env(Env,Cont,NCont) :-
+	continuation(Env, Addr, NCont, _),
+	cp_to_predicate(Cont, Mod, Name, Arity, ClId),
+        format(user_error,'0x~16r~t  ~16+ Cur~t ~d~16+ ~q:~q~@~n',
+		[Addr, ClId, Mod, Name, show_args(Arity)]).
+
+show_args(0) :- !.
+show_args(I) :-
+	format('(?',[]),
+	I1 is I-1,
+	show_inner_args(I1),
+	format(')',[]).
+
+show_inner_args(0) :- !.
+show_inner_args(I) :-
+	format(', ?',[]),
+	I1 is I-1,
+	show_inner_args(I1).
 
 

pl/debug.yap

@@ -793,7 +793,7 @@ debugging :-
 	'$delete_if_there'(L, T, LN).
 
 '$show_choicepoint_stack' :-
-	'$all_choicepoints'(Cps),
+	yap_hacks:current_choicepoints(Cps),
 	length(Cps,Level),
 	'$debug_show_cps'(Cps,Level).
 
@@ -804,7 +804,7 @@ debugging :-
 	'$debug_show_cps'(Cps, Level1).
 
 '$debug_show_cp'(C, Level) :-
-	'$choicepoint_info'(C,Module,Name,Arity,Goal),
+	yap_hacks:choicepoint(C,_,Module,Name,Arity,Goal,_),
 	'$continue_debug_show_cp'(Module,Name,Arity,Goal,Level).
 
 '$continue_debug_show_cp'(prolog,'$do_live',0,(_;_),Level) :- !,
@@ -831,26 +831,25 @@ debugging :-
 	format(user_error,'      [~d] ~q~n',[Level,G]).
 	
 '$debugger_deterministic_goal'(G) :-
-	'$all_choicepoints'(CPs),
+	yap_hacks:current_choicepoints(CPs),
 	'$debugger_skip_traces'(CPs,CPs1),
 	'$debugger_skip_loop_spy2'(CPs1,[Catch|_]),
-	'$choicepoint_info'(Catch,prolog,'$catch',3,'$catch'(_,'$loop_spy_event'(_,_,G,_,_),_)).
+	yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$loop_spy_event'(_,_,G,_,_),_),_).
 
 
 '$cps'([CP|CPs]) :-
-    '$choicepoint_info'(CP,A,B,C,D),
+    yap_hacks:choicepoint(CP,_,_,_,_,_,_),
-    write(A:B:C:D:CPs),nl,
     '$cps'(CPs).
 '$cps'([]).
 
 
 '$debugger_skip_traces'([CP|CPs],CPs1) :-
-	'$choicepoint_info'(CP,prolog,'$trace',4,(_;_)), !,
+	yap_hacks:choicepoint(CP,_,prolog,'$trace',4,(_;_),_), !,
 	'$debugger_skip_traces'(CPs,CPs1).
 '$debugger_skip_traces'(CPs,CPs).
 
 '$debugger_skip_loop_spy2'([CP|CPs],CPs1) :-
-	'$choicepoint_info'(CP,prolog,'$loop_spy2',5,(_;_)), !,
+	yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !,
 	'$debugger_skip_loop_spy2'(CPs,CPs1).
 '$debugger_skip_loop_spy2'(CPs,CPs).
 

pl/directives.yap

@@ -563,7 +563,7 @@ yap_flag(stack_dump_on_error,OUT) :-
 	'$access_yap_flags'(17,X),
 	'$transl_to_on_off'(X,OUT).
 yap_flag(stack_dump_on_error,on) :- !,
-	'$transl_to_on_off'(X,on),
+'$transl_to_on_off'(X,on),
 	'$set_yap_flags'(17,X).
 yap_flag(stack_dump_on_error,off) :- !,
 	'$transl_to_on_off'(X,off),

pl/signals.yap

@@ -165,9 +165,10 @@ read_sig.
 
 
 '$protected_env' :-
-	'$all_envs'(Envs),
+	yap_hacks:current_continuations([Env|Envs]),
 %'$envs'(Envs),
-	'$skim_envs'(Envs,Mod,Name,Arity),
+	yap_hacks:continuation(Env,_,Addr,_),
+	'$skim_envs'(Envs,Addr,Mod,Name,Arity),
 	\+ '$external_call_seen'(Mod,Name,Arity).
 
 
@@ -177,13 +178,13 @@ read_sig.
 % 	 '$envs'(Envs).
 % '$envs'([]).
 
-
+'$skim_envs'([Env|Envs],Addr0,Mod,Name,Arity) :-
-'$skim_envs'([Env|Envs],Mod,Name,Arity) :-
+	yap_hacks:cp_to_predicate(Addr0, Mod0, Name0, Arity0, _ClId),
-        '$env_info'(Env,Mod0,Name0,Arity0),
 	'$debugger_env'(Mod0,Name0,Arity0), !,
-	'$skim_envs'(Envs,Mod,Name,Arity).
+        yap_hacks:continuation(Env,_,Addr,_),
-'$skim_envs'([Env|Envs],Mod,Name,Arity) :-
+	'$skim_envs'(Envs,Addr,Mod,Name,Arity).
-        '$env_info'(Env,Mod,Name,Arity).
+'$skim_envs'(_,Addr,Mod,Name,Arity) :-
+	yap_hacks:cp_to_predicate(Addr, Mod, Name, Arity, _ClId).
 
 '$debugger_env'(prolog,'$start_creep',1).