fix some overflows

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

C/grow.c

@@ -1537,11 +1537,11 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
 #else
   CELL **old_top = (CELL **)Yap_TrailTop;
   if (do_growtrail(64 * 1024L, FALSE, FALSE, NULL, NULL, NULL)) {
-    CELL **dest = (CELL **)((char *)to_visit+64 * 1024L);
+    CELL **dest = (CELL **)((char *)to_visit+(Yap_TrailTop-(ADDR)old_top));
     cpcellsd((CELL *)dest, (CELL *)to_visit, (CELL)((CELL *)old_top-(CELL *)to_visit));
     return dest;
   } else {
-    Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"cannot grow temporary stack for unification (%p)", Yap_TrailTop);    
+    Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"cannot grow temporary stack for unification (%p)", Yap_TrailTop);    
     return to_visit;
   }
 #endif

C/tracer.c

@@ -161,10 +161,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   LOCK(Yap_heap_regs->low_level_trace_lock);
   sc = Yap_heap_regs;
   vsc_count++;
-  if (vsc_count == 5723445)
-    jmp_deb(1);
-  if (vsc_count < 5723000)
-    return;
 #ifdef COMMENTED
   if (vsc_count == 40650191LL)
     jmp_deb(1);

CLPBN/clpbn/dists.yap

@@ -61,7 +61,7 @@ where Id is the id,
 
 ********************************************/
 
- :- dynamic id/1, db/6.
+ :- dynamic id/1.
 
 id(1).
 
@@ -127,12 +127,12 @@ distribution(Domain, CPT, Id, Parents, Parents) :-
 	add_dist(Domain, tab, CPT, Id).
 
 add_dist(Domain, Type, CPT, Id) :-
-	db(Id, CPT, Type, Domain, _, _), !.
+	recorded(clpbn_dist_db, db(Id, CPT, Type, Domain, _, _), _), !.
 add_dist(Domain, Type, CPT, Id) :-
 	length(CPT, CPTSize),
 	length(Domain, DSize),
 	new_id(Id),
-	assert(db(Id, CPT, Type, Domain, CPTSize, DSize)).
+	recordz(clpbn_dist_db,db(Id, CPT, Type, Domain, CPTSize, DSize),_).
 
 %
 % Often, * is used to code empty in HMMs.
@@ -144,13 +144,13 @@ compress_hmm_table([Prob|L],[P|Parents],[Prob|NL],[P|NParents]) :-
 	compress_hmm_table(L,Parents,NL,NParents).
 
 dist(Id) :-
-	db(Id, _, _, _, _, _).
+	recorded(clpbn_dist_db, db(Id, _, _, _, _, _), _).
 
 get_dist(Id, Type, Domain, Tab) :-
-	db(Id, Tab, Type, Domain, _, _).
+	recorded(clpbn_dist_db, db(Id, Tab, Type, Domain, _, _), _).
 
 get_dist_matrix(Id, Parents, Type, Domain, Mat) :-
-	db(Id, Tab, Type, Domain, _, DomainSize),
+	recorded(clpbn_dist_db, db(Id, Tab, Type, Domain, _, DomainSize), _),
 	get_dsizes(Parents, Sizes, []),
 	matrix_new(floats, [DomainSize|Sizes], Tab, Mat).
 
@@ -162,15 +162,15 @@ get_dsizes([P|Parents], [Sz|Sizes], Sizes0) :-
 
 
 get_dist_params(Id, Parms) :-
-	db(Id, Parms, _, _, _, _).
+	recorded(clpbn_dist_db, db(Id, Parms, _, _, _, _), _).
 
 get_dist_domain_size(Id, DSize) :-
-	db(Id, _, _, _, _, DSize).
+	recorded(clpbn_dist_db, db(Id, _, _, _, _, DSize), _).
 
 get_dist_domain(Id, Domain) :-
-	db(Id, _, _, Domain, _, _).
+	recorded(clpbn_dist_db, db(Id, _, _, Domain, _, _), _).
 
 get_dist_nparams(Id, NParms) :-
-	db(Id, _, _, _, NParms, _).
+	recorded(clpbn_dist_db, db(Id, _, _, _, NParms, _), _).
 
 dist_to_term(_Id,_Term).

CLPBN/clpbn/matrix_cpt_utils.yap

@@ -50,11 +50,23 @@ vnth([V1|Deps], N0, V, N, [V1|NDeps]) :-
 reorder_CPT(Vs0,T0,Vs,TF,Sizes) :-
 	var(Vs), !,
 	order_vec(Vs0,Vs,Map),
-	matrix_shuffle(T0,Map,TF),
+	(
+	 Vs == V0
+	->
+	 matrix_shuffle(T0,Map,TF)
+	;
+	 TF = T0
+	),
 	matrix_dims(TF, Sizes).
 reorder_CPT(Vs0,T0,Vs,TF,Sizes) :-
 	mapping(Vs0,Vs,Map),
-	matrix_shuffle(T0,Map,TF),
+	(
+	 Vs == V0
+	->
+	 matrix_shuffle(T0,Map,TF)
+	;
+	 TF = T0
+	),
 	matrix_dims(TF, Sizes).
 
 order_vec(Vs0,Vs,Map) :-

CLPBN/clpbn/vel.yap

@@ -145,13 +145,13 @@ multiply_sizes([V|Vs],K0,K) :-
 process(LV0, InputVs, Out) :-
 	find_best(LV0, V0, -1, V, WorkTables, LVI, InputVs),
 	V \== V0, !,
-%format('1 ~w: ~w~n',[V,WorkTables]),
+% format('1 ~w: ~w~n',[V,WorkTables]),
 	multiply_tables(WorkTables, tab(Tab0,Deps0,_)),
 	reorder_CPT(Deps0,Tab0,Deps,Tab,Sizes),
 	Table = tab(Tab,Deps,Sizes),
-%format('2 ~w: ~w~n',[V,Table]),
+% format('2 ~w: ~w~n',[V,Table]),
 	project_from_CPT(V,Table,NewTable),
-%format('3 ~w: ~w~n',[V,NewTable]),
+% format('3 ~w: ~w~n',[V,NewTable]),
 	include(LVI,NewTable,V,LV2),
 	process(LV2, InputVs, Out).
 process(LV0, _, Out) :-

library/matrix/matrix.c

@@ -1467,12 +1467,19 @@ matrix_op(void)
     data1 = matrix_long_data(mat1, dims);
 
     if (mat2[MAT_TYPE] == INT_MATRIX) {
-      long int *data2 = matrix_long_data(mat2, dims);
+      long int *data2;
       long int *ndata;
 
       tf = new_int_matrix(dims,mat1+MAT_DIMS,NULL);
-      if (tf == YAP_TermNil())
+      if (tf == YAP_TermNil()) {
 	return FALSE;
+      } else {
+	/* there may have been an overflow */
+	mat1 = (int *)YAP_BlobOfTerm(YAP_ARG1);
+	data1 = matrix_long_data(mat1, dims);
+	mat2 = (int *)YAP_BlobOfTerm(YAP_ARG2);
+	data2 = matrix_long_data(mat2, dims);
+      }
       nmat = YAP_BlobOfTerm(tf);
       ndata = matrix_long_data(nmat, dims);
       switch (op) {
@@ -1489,12 +1496,19 @@ matrix_op(void)
 	return FALSE;
       }
     } else if (mat2[MAT_TYPE] == FLOAT_MATRIX) {
-      double *data2 = matrix_double_data(mat2, dims);
+      double *data2;
       double *ndata;
 
       tf = new_float_matrix(dims,mat1+MAT_DIMS,NULL);
-      if (tf == YAP_TermNil())
+      if (tf == YAP_TermNil()) {
 	return FALSE;
+      } else {
+	/* there may have been an overflow */
+	mat1 = (int *)YAP_BlobOfTerm(YAP_ARG1);
+	data1 = matrix_long_data(mat1, dims);
+	mat2 = (int *)YAP_BlobOfTerm(YAP_ARG2);
+	data2  = matrix_double_data(mat2, dims);
+      }
       nmat = YAP_BlobOfTerm(tf);
       ndata = matrix_double_data(nmat, dims);
       switch (op) {
@@ -1520,12 +1534,19 @@ matrix_op(void)
     data1 = matrix_double_data(mat1, dims);
 
     if (mat2[MAT_TYPE] == INT_MATRIX) {
-      long int *data2 = matrix_long_data(mat2, dims);
+      long int *data2;
       double *ndata;
 
       tf = new_float_matrix(dims,mat1+MAT_DIMS,NULL);
-      if (tf == YAP_TermNil())
+      if (tf == YAP_TermNil()) {
 	return FALSE;
+      } else {
+	/* there may have been an overflow */
+	mat1 = (int *)YAP_BlobOfTerm(YAP_ARG1);
+	data1 = matrix_double_data(mat1, dims);
+	mat2 = (int *)YAP_BlobOfTerm(YAP_ARG2);
+	data2  = matrix_long_data(mat2, dims);
+      }
       nmat = YAP_BlobOfTerm(tf);
       ndata = matrix_double_data(nmat, dims);
       switch (op) {
@@ -1542,12 +1563,19 @@ matrix_op(void)
 	return FALSE;
       }
     } else if (mat2[MAT_TYPE] == FLOAT_MATRIX) {
-      double *data2 = matrix_double_data(mat2, dims);
+      double *data2;
       double *ndata;
 
       tf = new_float_matrix(dims,mat1+MAT_DIMS,NULL);
-      if (tf == YAP_TermNil())
+      if (tf == YAP_TermNil()) {
 	return FALSE;
+      } else {
+	/* there may have been an overflow */
+	mat1 = (int *)YAP_BlobOfTerm(YAP_ARG1);
+	data1 = matrix_double_data(mat1, dims);
+	mat2 = (int *)YAP_BlobOfTerm(YAP_ARG2);
+	data2  = matrix_double_data(mat2, dims);
+      }
       nmat = YAP_BlobOfTerm(tf);
       ndata = matrix_double_data(nmat, dims);
       switch (op) {