mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-31 23:00:54 -08:00
Code Issues Projects Releases Packages Wiki Activity

Finished porting the profiler

Browse source
This commit is contained in:
jgarcia 2008-02-09 08:37:25 +00:00
parent bebfeb179f
commit ff78d8030b
2 changed files with 12 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

27
contrib/profile/profile.lisp
View file

@ -37,22 +37,17 @@
)
(ffi:clines "
static size_t old_bytes_consed = 0;
")
(defun get-bytes-consed ()
(ffi:c-inline () () :object "
size_t bytes_consed = GC_get_total_bytes();
size_t delta;
if (bytes_consed < old_bytes_consed) {
delta = ~((size_t)0) - old_bytes_consed;
delta += bytes_consed;
} else {
delta = bytes_consed - old_bytes_consed;
}
old_bytes_consed = bytes_consed;
@(return) = ecl_make_unsigned_integer(delta);
"))
(defconstant +wrap+ (ffi:c-inline () () :object "ecl_make_unsigned_integer(~((size_t)0))"
:one-liner t))
(defun get-bytes-consed (orig)
(let ((bytes (ffi:c-inline () () :object "ecl_make_unsigned_integer(GC_get_total_bytes())"
:one-liner t)))
(if (< bytes orig)
(+ (- +wrap+ orig) bytes)
(- bytes orig))))
(deftype counter () '(integer 0 *))
@ -194,7 +189,7 @@ old_bytes_consed = bytes_consed;
(old-enclosed-consing *enclosed-consing*)
(old-enclosed-profiles *enclosed-profiles*)
(start-ticks (get-internal-ticks))
(start-consed (get-bytes-consed)))
(start-consed (get-bytes-consed 0)))
(unwind-protect
(progn
(setf *enclosed-ticks* 0
@ -202,7 +197,7 @@ old_bytes_consed = bytes_consed;
*enclosed-consing* 0)
(apply encapsulated-fun args))
(setf dticks (- (get-internal-ticks) start-ticks))
(setf dconsing (- (get-bytes-consed) start-consed))
(setf dconsing (get-bytes-consed start-consed))
(setf inner-enclosed-profiles *enclosed-profiles*)
(let ((net-dticks (- dticks *enclosed-ticks*)))
(incf ticks net-dticks))

2
src/lsp/config.lsp.in
View file

@ -24,7 +24,7 @@ Returns, as a string, the location of the machine on which ECL runs."
(defun lisp-implementation-version ()
"Args:()
Returns the version of your ECL as a string."
"@PACKAGE_VERSION@ (CVS 2008-02-09 00:53)")
"@PACKAGE_VERSION@ (CVS 2008-02-09 09:37)")
(defun machine-type ()
"Args: ()