From 72c8b28ee0590f7eb22ce323d93dd266c4027525 Mon Sep 17 00:00:00 2001 From: Andreas Fuchs Date: Sun, 30 May 2004 21:34:10 +0000 Subject: [PATCH] 0.8.10.66: Make sb-grovel initialize allocated objects with 0 bytes This could fix the Mac OS X breakage we're seeing. If not, it fixes a bug that would probably come around and bite us in the future. --- contrib/sb-grovel/foreign-glue.lisp | 38 ++++++++++++++++++++++------------- version.lisp-expr | 2 +- 2 files changed, 25 insertions(+), 15 deletions(-) diff --git a/contrib/sb-grovel/foreign-glue.lisp b/contrib/sb-grovel/foreign-glue.lisp index 3a08349..c15509f 100644 --- a/contrib/sb-grovel/foreign-glue.lisp +++ b/contrib/sb-grovel/foreign-glue.lisp @@ -362,22 +362,32 @@ deeply nested structures." (sb-alien:define-alien-type ,@(first struct-elements))) ,@accessors (defmacro ,(intern (format nil "WITH-~A" name)) (var (&rest field-values) &body body) - (labels ((field-name (x) - (intern (concatenate 'string - (symbol-name ',name) "-" - (symbol-name x)) - ,(symbol-package name)))) - `(let ((,var ,'(,(intern (format nil "ALLOCATE-~A" name))))) - (unwind-protect - (progn - (progn ,@(mapcar (lambda (pair) - `(setf (,(field-name (first pair)) ,var) ,(second pair))) - field-values)) - ,@body) - (funcall ',',(intern (format nil "FREE-~A" name)) ,var))))) + (labels ((field-name (x) + (intern (concatenate 'string + (symbol-name ',name) "-" + (symbol-name x)) + ,(symbol-package name)))) + `(let ((,var ,'(,(intern (format nil "ALLOCATE-~A" name))))) + (unwind-protect + (progn + (progn ,@(mapcar (lambda (pair) + `(setf (,(field-name (first pair)) ,var) ,(second pair))) + field-values)) + ,@body) + (funcall ',',(intern (format nil "FREE-~A" name)) ,var))))) (defconstant ,(intern (format nil "SIZE-OF-~A" name)) ,size) (defun ,(intern (format nil "ALLOCATE-~A" name)) () - (sb-alien:make-alien ,name)) + (let* ((o (sb-alien:make-alien ,name)) + (c-o (cast o (* (unsigned 8))))) + ;; we have to initialize the object to all-0 before we can + ;; expect to make sensible use of it - the object returned + ;; by make-alien is initialized to all-D0 bytes. + + ;; FIXME: This should be fixed in sb-alien, where better + ;; optimizations might be possible. + (loop for i from 0 below ,size + do (setf (deref c-o i) 0)) + o)) (defun ,(intern (format nil "FREE-~A" name)) (o) (sb-alien:free-alien o))))) diff --git a/version.lisp-expr b/version.lisp-expr index 13752ac..7c96f97 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.10.65" +"0.8.10.66" -- 1.7.10.4