From bbc19242c0683a6c8cb93146eab22e29aa453801 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 6 Nov 2007 14:17:40 +0000 Subject: [PATCH] 1.0.11.11: expand zero-object WITH-PINNED-OBJECTS to a PROGN * x86 and x86-64 only. --- src/compiler/x86-64/macros.lisp | 32 ++++++++++++++++--------------- src/compiler/x86/macros.lisp | 40 ++++++++++++++++++++------------------- version.lisp-expr | 2 +- 3 files changed, 39 insertions(+), 35 deletions(-) diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 32b3923..5bcb03a 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -531,18 +531,20 @@ ;;; helper for alien stuff. (def!macro with-pinned-objects ((&rest objects) &body body) "Arrange with the garbage collector that the pages occupied by -OBJECTS will not be moved in memory for the duration of BODY. -Useful for e.g. foreign calls where another thread may trigger -garbage collection" - `(multiple-value-prog1 - (progn - ,@(loop for p in objects - collect `(push-word-on-c-stack - (int-sap (sb!kernel:get-lisp-obj-address ,p)))) - ,@body) - ;; If the body returned normally, we should restore the stack pointer - ;; for the benefit of any following code in the same function. If - ;; there's a non-local exit in the body, sp is garbage anyway and - ;; will get set appropriately from {a, the} frame pointer before it's - ;; next needed - (pop-words-from-c-stack ,(length objects)))) +OBJECTS will not be moved in memory for the duration of BODY. Useful +for e.g. foreign calls where another thread may trigger garbage +collection" + (if objects + `(multiple-value-prog1 + (progn + ,@(loop for p in objects + collect `(push-word-on-c-stack + (int-sap (sb!kernel:get-lisp-obj-address ,p)))) + ,@body) + ;; If the body returned normally, we should restore the stack pointer + ;; for the benefit of any following code in the same function. If + ;; there's a non-local exit in the body, sp is garbage anyway and + ;; will get set appropriately from {a, the} frame pointer before it's + ;; next needed + (pop-words-from-c-stack ,(length objects))) + `(progn ,@body))) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index fe0469b..4c1fba6 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -550,22 +550,24 @@ ;;; helper for alien stuff. (def!macro with-pinned-objects ((&rest objects) &body body) "Arrange with the garbage collector that the pages occupied by -OBJECTS will not be moved in memory for the duration of BODY. -Useful for e.g. foreign calls where another thread may trigger -garbage collection" - `(multiple-value-prog1 - (progn - ,@(loop for p in objects - collect - ;; There is no race here wrt to gc, because at every - ;; point during the execution there is a reference to - ;; P on the stack or in a register. - `(push-word-on-c-stack - (int-sap (sb!kernel:get-lisp-obj-address ,p)))) - ,@body) - ;; If the body returned normally, we should restore the stack pointer - ;; for the benefit of any following code in the same function. If - ;; there's a non-local exit in the body, sp is garbage anyway and - ;; will get set appropriately from {a, the} frame pointer before it's - ;; next needed - (pop-words-from-c-stack ,(length objects)))) +OBJECTS will not be moved in memory for the duration of BODY. Useful +for e.g. foreign calls where another thread may trigger garbage +collection" + (if objects + `(multiple-value-prog1 + (progn + ,@(loop for p in objects + collect + ;; There is no race here wrt to gc, because at every + ;; point during the execution there is a reference to + ;; P on the stack or in a register. + `(push-word-on-c-stack + (int-sap (sb!kernel:get-lisp-obj-address ,p)))) + ,@body) + ;; If the body returned normally, we should restore the stack pointer + ;; for the benefit of any following code in the same function. If + ;; there's a non-local exit in the body, sp is garbage anyway and + ;; will get set appropriately from {a, the} frame pointer before it's + ;; next needed + (pop-words-from-c-stack ,(length objects))) + `(progn ,@body))) diff --git a/version.lisp-expr b/version.lisp-expr index 8d943dc..e0bccc0 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".) -"1.0.11.10" +"1.0.11.11" -- 1.7.10.4