- Fix extension end marker database bug.

- Fix statistics/0.


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

C/dbase.c

@@ -319,8 +319,8 @@ static void remove_from_table() {
 inline static CELL *cpcells(CELL *to, CELL *from, Int n)
 {
 #if HAVE_MEMMOVE
-  memmove((void *)to, (void *)from, (size_t)((n+1)*sizeof(CELL)));
+  memmove((void *)to, (void *)from, (size_t)(n*sizeof(CELL)));
-  return(to+n+1);
+  return(to+n);
 #else
   while (n-- >= 0) {
     *to++ = *from++;
@@ -648,7 +648,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 #endif
 	    st[0] = (CELL)f;
 	    st[1] = ap2[1];
-	    st[2] = ap2[2];
+	    st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
 	    /* now reserve space */
 	    CodeMax = st+3;
 	    ++pt0;
@@ -667,11 +667,12 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 #endif
 	    st[0] = (CELL)f;
 	    {
-	      Int sz = 1+
+	      Int sz = 
 		sizeof(MP_INT)+
 		(((MP_INT *)(ap2+1))->_mp_alloc*sizeof(mp_limb_t));
-	      memcpy((void *)(st+1), (void *)(ap2+1), sz*CellSize);
+	      memcpy((void *)(st+1), (void *)(ap2+1), sz);
-	      CodeMax = st+(1+sz);
+	      CodeMax = st+1+sz/CellSize;
+	      *CodeMax++ = (sz+CellSize+EndSpecials)|MBIT;
 	    }
 	    ++pt0;
 	    continue;
@@ -689,9 +690,11 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 #endif
 	    st[0] = (CELL)f;
 	    st[1] = ap2[1];
-	    st[2] = ap2[2];
 #if  SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
-	    st[3] = ap2[3];
+	    st[2] = ap2[2];
+	    st[3] = ((3*sizeof(CELL)+EndSpecials)|MBIT);
+#else
+	    st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
 #endif
 	    /* now reserve space */
 	    CodeMax = st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT);
@@ -1205,11 +1208,12 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
 	    CELL *fp = RepAppl(Tm);
 
 	    ntp0[1] = fp[1];
-	    ntp0[2] = fp[2];
 #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
-	    ntp0[3] = fp[3];
+	    ntp0[2] = fp[2];
+	    ntp0[3] = ((3*sizeof(CELL)+EndSpecials)|MBIT);
 	    ntp = ntp0+4;
 #else
+	    ntp0[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
 	    ntp = ntp0+3;
 #endif
 	  }
@@ -1245,20 +1249,22 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
 	case (CELL)FunctorBigInt:
 	  {
 	    CELL *pt = RepAppl(Tm);
-	    Int sz = 1+
+	    Int sz =
 	      sizeof(MP_INT)+
 	      (((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
 
-	    memcpy((void *)(ntp0+1), (void *)(pt+1), sz*CellSize);
+	    memcpy((void *)(ntp0+1), (void *)(pt+1), sz);
-	    ntp = ntp0+(1+sz);
+	    ntp = ntp0+sz/sizeof(CELL)+1;
+	    *ntp++ = (sz+CellSize+EndSpecials)|MBIT;
 	  }
+	  break;
 #endif
 	default: /* LongInt */
 	  {
 	    CELL *pt = RepAppl(Tm);
 
 	    ntp0[1] = pt[1];
-	    ntp0[2] = pt[2];
+	    ntp0[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
 	    ntp = ntp0+3;
 	  }
 	  break;
@@ -1275,7 +1281,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
     CodeAbs = (CELL *)((CELL)ntp-(CELL)ntp0);
     if (DBErrorFlag)
       return (NULL);	/* Error Situation */
-    NOfCells = (ntp - 1) - ntp0;	/* End Of Code Info */
+    NOfCells = ntp - ntp0;	/* End Of Code Info */
 #ifdef IDB_LINK_TABLE
     *lr++ = 0;
     NOfLinks = (lr - LinkAr);
@@ -1363,7 +1369,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
 	nar += NOfCells+1;
 #endif
       } else {
-	nar = pp->Contents + Unsigned(NOfCells)+1;
+	nar = pp->Contents + Unsigned(NOfCells);
       }
 #ifdef IDB_LINK_TABLE
       woar = WordPtr(nar);

C/load_dl.c

@@ -60,7 +60,7 @@ LoadForeign(StringList ofiles, StringList libs,
     if((handle=dlopen(FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0)
 #endif
     {
-fprintf(stderr,"calling dlopen with error %s\n", dlerror());
+      fprintf(stderr,"calling dlopen with error %s\n", dlerror());
 /*      strcpy(LoadMsg,dlerror());*/
       return LOAD_FAILLED;
     }

changes4.3.html

@@ -6,7 +6,13 @@
 
 <H2 ALIGN=CENTER>Yap-4.3.19:</H2>
 <UL>
+      <LI> FIXED: statistics/0 should report to user_error (report from Nicos
+      Angelopoulos).
+      <LI> FIXED: database could copy compiled floats,longs, and bigs
+      to Heap, later crashing the garbage collector (report from Nicos
+      Angelopoulos).
       <LI> NEW: if/3.
+      <LI> SPEEDUP: inline functor(S) -> Na,Ar.
       <LI> SPEEDUP: inline functor(Na,Ar) -> S.
       <LI> FIXED: pillow installation path.
       <LI> FIXED: allow yap_flag(user_{},V).

docs/yap.tex

@@ -5620,7 +5620,8 @@ Succeeds if @var{M} are current modules associated to the file @var{F}.
 @findex statistics/0
 @saindex statistics/0
 @cyindex statistics/0
-Gives general information on space used and time spent by  the system.
+Send to the current user error stream general information on space used and time
+spent by the system.
 @example
 ?- statistics.
 Heap space : 2441216
@@ -11490,7 +11491,7 @@ static int my_process_id(void)
 @{
      Term pid = MkIntTerm(getpid());
      Term out = ARG1;
-     return(unify(&out,&pid));
+     return(unify(out,pid));
 @}
 
 void init_my_predicates()
@@ -11503,7 +11504,8 @@ void init_my_predicates()
 The commands to compile the above file depend on the operating
 system. Under Linux (i386 and Alpha) you should use:
 @example
-      gcc  -shared -fPIC my_process.c -o my_process.o
+      gcc -c -shared -fPIC my_process.c -o my_process.o
+      ld -shared -o my_process.so my_process.o
 @end example
 @noindent
 Under Solaris2 it is sufficient to use:

pl/utils.yap

@@ -403,53 +403,54 @@ system_predicate(A,P) :-			% generate
 statistics :- 
 	T is cputime, 
 	'$statistics_heap_info'(HpSpa, HpInUse), 
-	write(user,'Heap space : '), write(user,HpSpa), nl(user),
+	write(user_error,'Heap space : '), write(user_error,HpSpa), nl(user_error),
-	tab(user,8), write(user,'Heap in use: '), write(user,HpInUse),
+	tab(user_error,8), write(user_error,'Heap in use: '), write(user_error,HpInUse),
 	'$statistics_heap_max'(HpMax), 
-	write(user,', max. used: '), write(user,HpMax), nl(user),
+	write(user_error,', max. used: '), write(user_error,HpMax), nl(user_error),
 	'$statistics_trail_info'(TrlSpa, TrlInUse), 
-	write(user,'Trail space : '), write(user,TrlSpa), nl(user),
+	write(user_error,'Trail space : '), write(user_error,TrlSpa), nl(user_error),
-	tab(user,8), write(user,'Trail in use: '), write(user,TrlInUse),
+	tab(user_error,8), write(user_error,'Trail in use: '), write(user_error,TrlInUse),
 	'$statistics_trail_max'(TrlMax), 
-	( TrlMax \= TrlSpa -> write(user,', max. used: '), write(user,TrlMax) ;
+	( TrlMax \= TrlSpa -> write(user_error,', max. used: '), write(user_error,TrlMax) ;
-			write(user,', maximum used ') ), nl(user),
+			write(user_error,', maximum used ') ), nl(user_error),
 	'$statistics_stacks_info'(StkSpa, GlobInU, LocInU), 
-	write(user,'Stack space : '), write(user,StkSpa), nl(user),
+	write(user_error,'Stack space : '), write(user_error,StkSpa), nl(user_error),
-	tab(user,8), write(user,'Global in use: '), write(user,GlobInU),
+	tab(user_error,8), write(user_error,'Global in use: '), write(user_error,GlobInU),
 	'$statistics_global_max'(GlobMax), 
 	( GlobMax \= StkSpa ->
-	    write(user,', max. used: '), write(user,GlobMax) ;
+	    write(user_error,', max. used: '), write(user_error,GlobMax) ;
 	    true ),
-	    nl(user),
+	    nl(user_error),
-	tab(user,8), write(user,'Local in use: '), write(user,LocInU),
+	tab(user_error,8), write(user_error,'Local in use: '), write(user_error,LocInU),
 	'$statistics_local_max'(LocMax), 
-	( LocMax \= StkSpa -> write(user,', max. used: '), write(user,LocMax) ;
+	( LocMax \= StkSpa -> write(user_error,', max. used: '), write(user_error,LocMax) ;
-			  true ), nl(user),
+			  true ), nl(user_error),
-	( GlobMax = StkSpa -> tab(user,8),
+	( GlobMax = StkSpa -> tab(user_error,8),
-		write(user,'Stack space entirely used'), nl(user) ;
+		write(user_error,'Stack space entirely used'), nl(user_error) ;
 		true ),
-	nl(user),
+	nl(user_error),
-	nl(user),
+	nl(user_error),
 	'$inform_heap_overflows'(NOfHO,TotHOTime),
-	write(TotHOTime), write(' msec. for '),
+	write(user_error,TotHOTime), write(user_error,' msec. for '),
-	write(NOfHO),
+	write(user_error,
-	write(' heap overflows.'), nl(user),
+	      NOfHO),
+	write(user_error,' heap overflows.'), nl(user_error),
 	'$inform_stack_overflows'(NOfSO,TotSOTime),
-	write(TotSOTime), write(' msec. for '),
+	write(user_error,TotSOTime), write(user_error,' msec. for '),
-	write(NOfSO),
+	write(user_error,NOfSO),
-	write(' stack overflows.'), nl(user),
+	write(user_error,' stack overflows.'), nl(user_error),
 	'$inform_trail_overflows'(NOfTO,TotTOTime),
-	write(TotTOTime), write(' msec. for '),
+	write(user_error,TotTOTime), write(user_error,' msec. for '),
-	write(NOfTO),
+	write(user_error,NOfTO),
-	write(' trail overflows.'), nl(user),
+	write(user_error,' trail overflows.'), nl(user_error),
 	'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
-	write(TotGCTime), write(' msec. for '),
+	write(user_error,TotGCTime), write(user_error,' msec. for '),
-	write(NOfGC),
+	write(user_error,NOfGC),
-	write(' garbage collections which collected '),
+	write(user_error,' garbage collections which collected '),
-	write(TotGCSize),write(' bytes.'), nl(user),
+	write(user_error,TotGCSize),write(user_error,' bytes.'), nl(user_error),
-	write(user,'Runtime : '), write(user,T),
+	write(user_error,'Runtime : '), write(user_error,T),
 	'$set_value'('$last_runtime',T),
-	write(user,' sec.'), nl(user).
+	write(user_error,' sec.'), nl(user_error).
 
 statistics(runtime,[T,L]) :-
 	'$runtime'(T,L).