diff --git a/C/heapgc.c b/C/heapgc.c
index 15fb10ffc..c3585f093 100644
--- a/C/heapgc.c
+++ b/C/heapgc.c
@@ -35,7 +35,7 @@ static
#endif
unsigned int gc_calls = 0; /* number of times GC has been called */
-static CELL tot_gc_time = 0; /* total time spent in GC */
+static Int tot_gc_time = 0; /* total time spent in GC */
/* in a single gc */
UInt total_marked; /* number of heap objects marked */
@@ -2600,7 +2600,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
}
#endif
#ifdef DEBUG
- // check_global();
+ check_global();
#endif
if (GetValue(AtomGcTrace) != TermNil)
gc_trace = 1;
@@ -2672,14 +2672,14 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
}
gc_time += (c_time-time_start);
tot_gc_time += gc_time;
- tot_gc_recovered += (H-H0)-total_marked;
+ tot_gc_recovered += heap_cells-total_marked;
if (gc_verbose) {
YP_fprintf(YP_stderr, "[GC] GC %d took %g sec, total of %g sec doing GC so far.\n", gc_calls, (double)gc_time/1000, (double)tot_gc_time/1000);
YP_fprintf(YP_stderr, "[GC] Left %ld cells free in stacks.\n",
(unsigned long int)(ASP-H));
}
#ifdef DEBUG
- // check_global();
+ check_global();
#endif
return(effectiveness);
}
@@ -2706,8 +2706,8 @@ static Int
p_inform_gc(void)
{
Term tn = MkIntegerTerm(tot_gc_time);
- Term tt = MkIntTerm(gc_calls);
- Term ts = MkIntTerm((total_marked*sizeof(CELL)));
+ Term tt = MkIntegerTerm(gc_calls);
+ Term ts = MkIntegerTerm((tot_gc_recovered*sizeof(CELL)));
return(unify(tn, ARG2) && unify(tt, ARG1) && unify(ts, ARG3));
@@ -2757,7 +2757,7 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
while (gc_margin >= gap && !growstack(gc_margin))
gc_margin = gc_margin/2;
#ifdef DEBUG
- // check_global();
+ check_global();
#endif
return(gc_margin >= gap);
}
diff --git a/C/sysbits.c b/C/sysbits.c
index b5b5f40de..e16d9be77 100644
--- a/C/sysbits.c
+++ b/C/sysbits.c
@@ -1871,6 +1871,33 @@ static Int p_putenv(void)
#endif
}
+/* set a variable in YAP's environment */
+static Int p_file_age(void)
+{
+#if HAVE_LSTAT
+ struct stat buf;
+ char *file_name = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
+
+ if (lstat(file_name, &buf) == -1) {
+ /* file does not exist, but was opened? Return -1 */
+ return(unify(ARG2, MkIntTerm(-1)));
+ }
+ return(unify(ARG2, MkIntegerTerm(buf.st_mtime)));
+#elif defined(__MINGW32__) || _MSC_VER
+ /* for some weird reason _stat did not work with mingw32 */
+ struct _stat buf;
+ char *file_name = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
+
+ if (_stat(file_name, &buf) != 0) {
+ /* return an error number */
+ return(unify(ARG2, MkIntTerm(-1)));
+ }
+ return(unify(ARG2, MkIntegerTerm(buf.st_mtime)));
+#else
+ return(unify(ARG2, MkIntTerm(0)));
+#endif
+}
+
/* wrapper for alarm system call */
#if defined(_WIN32)
static VOID CALLBACK HandleTimer(LPVOID v, DWORD d1, DWORD d2) {
@@ -1998,6 +2025,7 @@ InitSysPreds(void)
InitCPred ("$alarm", 2, p_alarm, SafePredFlag|SyncPredFlag);
InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
+ InitCPred ("$file_age", 2, p_file_age, SafePredFlag|SyncPredFlag);
}
diff --git a/C/write.c b/C/write.c
index 671ffe8db..8ecc16cfa 100644
--- a/C/write.c
+++ b/C/write.c
@@ -123,7 +123,7 @@ wrputf(Float f) /* writes a float */
wrputc(' ');
}
lastw = alphanum;
- sprintf(s, "%.6g", f);
+ sprintf(s, "%.15g", f);
while (*pt == ' ')
pt++;
if (*pt == 'i' || *pt == 'n') /* inf or nan */
diff --git a/TO_DO b/TO_DO
index 3bb0a6a92..caf8936ad 100644
--- a/TO_DO
+++ b/TO_DO
@@ -3,12 +3,9 @@ BEFORE 4.4:
- write infinite terms
- constraints in DB.
- non-void temporaries going to global
-- timestamps on files.
- warnings in documentation file.
- fix restore when code is moved around.
- document new interface functions.
-- add more precision when outputting floats.
-- make statistics/0 better looking.
- mask when installing.
TO CHECK:
@@ -82,6 +79,9 @@ DONE:
- ^C can break code.
- system library
- library(system) for WIN32
+- timestamps on files.
+- add more precision when outputting floats.
+- make statistics/0 better looking.
TO DO (tabling)
- make gc work after mutable var changes.
diff --git a/changes4.3.html b/changes4.3.html
index d818aaadb..b241437e2 100644
--- a/changes4.3.html
+++ b/changes4.3.html
@@ -16,6 +16,10 @@
Yap-4.3.19:
+ - FIXED: new statistics/0.
+ - FIXED: use 15 bits of precision for floats, instead of the
+ default 6..
+ - FIXED: check for last file modification in use_module.
- FIXED: get_list + unify_local was being compiled into
glval, breaking ENV vars
- FIXED: abort was crashing in Alpha machines.
diff --git a/pl/boot.yap b/pl/boot.yap
index 2c1005a10..015920bd8 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -916,17 +916,14 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
!.
-'$loaded'(Stream) :-
- '$file_name'(Stream,F),
- '$recorded'('$loaded',F,_), !.
-
'$record_loaded'(user).
'$record_loaded'(user_input).
'$record_loaded'(Stream) :-
'$loaded'(Stream), !.
'$record_loaded'(Stream) :-
'$file_name'(Stream,F),
- '$recorda'('$loaded',F,_).
+ '$file_age'(F,Age),
+ '$recorda'('$loaded','$loaded'(F,Age),_).
'$set_consulting_file'(user) :- !,
'$set_value'('$consulting_file',user_input).
diff --git a/pl/consult.yap b/pl/consult.yap
index 396e5039b..126a32493 100644
--- a/pl/consult.yap
+++ b/pl/consult.yap
@@ -276,7 +276,11 @@ prolog_load_context(term_position, Position) :-
stream_position(Stream, Position).
+'$loaded'(Stream) :-
+ '$file_name'(Stream,F),
+ '$recorded'('$loaded','$loaded'(F,Age),R), !,
+ '$file_age'(F,CurrentAge),
+ ((CurrentAge = Age ; Age = -1) -> true; erase(R), fail).
-
diff --git a/pl/utils.yap b/pl/utils.yap
index aaf7f8d9a..77d0d6217 100644
--- a/pl/utils.yap
+++ b/pl/utils.yap
@@ -382,57 +382,54 @@ system_predicate(A,P) :- % generate
%%% User interface for statistics
-statistics :-
- T is cputime,
+statistics :-
+ '$runtime'(Runtime,_),
+ '$cputime'(CPUtime,_),
+ '$walltime'(Walltime,_),
'$statistics_heap_info'(HpSpa, HpInUse),
- write(user_error,'Heap space : '), write(user_error,HpSpa), nl(user_error),
- tab(user_error,8), write(user_error,'Heap in use: '), write(user_error,HpInUse),
'$statistics_heap_max'(HpMax),
- write(user_error,', max. used: '), write(user_error,HpMax), nl(user_error),
'$statistics_trail_info'(TrlSpa, TrlInUse),
- write(user_error,'Trail space : '), write(user_error,TrlSpa), nl(user_error),
- tab(user_error,8), write(user_error,'Trail in use: '), write(user_error,TrlInUse),
'$statistics_trail_max'(TrlMax),
- ( TrlMax \= TrlSpa -> write(user_error,', max. used: '), write(user_error,TrlMax) ;
- write(user_error,', maximum used ') ), nl(user_error),
'$statistics_stacks_info'(StkSpa, GlobInU, LocInU),
- write(user_error,'Stack space : '), write(user_error,StkSpa), nl(user_error),
- tab(user_error,8), write(user_error,'Global in use: '), write(user_error,GlobInU),
'$statistics_global_max'(GlobMax),
- ( GlobMax \= StkSpa ->
- write(user_error,', max. used: '), write(user_error,GlobMax) ;
- true ),
- nl(user_error),
- tab(user_error,8), write(user_error,'Local in use: '), write(user_error,LocInU),
'$statistics_local_max'(LocMax),
- ( LocMax \= StkSpa -> write(user_error,', max. used: '), write(user_error,LocMax) ;
- true ), nl(user_error),
- ( GlobMax = StkSpa -> tab(user_error,8),
- write(user_error,'Stack space entirely used'), nl(user_error) ;
- true ),
- nl(user_error),
- nl(user_error),
'$inform_heap_overflows'(NOfHO,TotHOTime),
- write(user_error,TotHOTime), write(user_error,' msec. for '),
- write(user_error,
- NOfHO),
- write(user_error,' heap overflows.'), nl(user_error),
'$inform_stack_overflows'(NOfSO,TotSOTime),
- write(user_error,TotSOTime), write(user_error,' msec. for '),
- write(user_error,NOfSO),
- write(user_error,' stack overflows.'), nl(user_error),
'$inform_trail_overflows'(NOfTO,TotTOTime),
- write(user_error,TotTOTime), write(user_error,' msec. for '),
- write(user_error,NOfTO),
- write(user_error,' trail overflows.'), nl(user_error),
'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
- write(user_error,TotGCTime), write(user_error,' msec. for '),
- write(user_error,NOfGC),
- write(user_error,' garbage collections which collected '),
- write(user_error,TotGCSize),write(user_error,' bytes.'), nl(user_error),
- write(user_error,'Runtime : '), write(user_error,T),
- '$set_value'('$last_runtime',T),
- write(user_error,' sec.'), nl(user_error).
+ TotalMemory is HpSpa+StkSpa+TrlSpa,
+ format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
+ format(user_error," program space~t~d bytes~35+", [HpSpa]),
+ format(user_error,":~t ~d in use~19+", [HpInUse]),
+ HpFree is HpSpa-HpInUse,
+ format(user_error,",~t ~d free~19+~n", [HpFree]),
+ format(user_error," stack space~t~d bytes~35+", [StkSpa]),
+ StackInUse is GlobInU+LocInU,
+ format(user_error,":~t ~d in use~19+", [StackInUse]),
+ StackFree is StkSpa-StackInUse,
+ format(user_error,",~t ~d free~19+~n", [StackFree]),
+ format(user_error," global stack:~t~35+", []),
+ format(user_error," ~t ~d in use~19+", [GlobInU]),
+ format(user_error,",~t ~d max~19+~n", [GlobMax]),
+ format(user_error," local stack:~t~35+", []),
+ format(user_error," ~t ~d in use~19+", [LocInU]),
+ format(user_error,",~t ~d max~19+~n", [LocMax]),
+ format(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
+ format(user_error,":~t ~d in use~19+", [TrlInUse]),
+ TrlFree is TrlSpa-TrlInUse,
+ format(user_error,",~t ~d free~19+~n", [TrlFree]),
+
+ OvfTime is TotHOTime+TotSOTime+TotTOTime,
+ format("~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
+ [OvfTime,NOfHO,NOfSO,NOfTO]),
+ format("~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n",
+ [TotGCTime,NOfGC,TotGCSize]),
+ RTime is float(Runtime)/1000,
+ format("~t~3f~12+ sec. runtime~n", [RTime]),
+ CPUTime is float(CPUtime)/1000,
+ format("~t~3f~12+ sec. cputime~n", [CPUTime]),
+ WallTime is float(Walltime)/1000,
+ format("~t~3f~12+ sec. elapsed time~n~n", [WallTime]).
statistics(runtime,[T,L]) :-
'$runtime'(T,L).