From 640eac1797969ecff55275c71fefd68ef339c169 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Wed, 19 Nov 1997 02:47:04 +0000 Subject: [PATCH] Revise the pseudo-atomic macro to reduce the generated code size and increase speed. Replace the fixed-allocation macro by a with-fixed-allocation macro that wraps the allocation and optional forms in a pseudo-atomic. --- compiler/x86/macros.lisp | 58 +++++++++++++++++++++++++++------------- 1 file changed, 39 insertions(+), 19 deletions(-) diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp index 8e51db630..c876fdc50 100644 --- a/compiler/x86/macros.lisp +++ b/compiler/x86/macros.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.7 1997/11/18 16:55:52 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.8 1997/11/19 02:47:04 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -187,15 +187,17 @@ :foreign)))))))) (values)) -(defmacro fixed-allocation (result-tn type-code size &optional inline) +(defmacro with-fixed-allocation ((result-tn type-code size &optional inline) + &rest forms) "Allocate an other-pointer object of fixed Size with a single word header having the specified Type-Code. The result is placed in Result-TN." - `(progn + `(pseudo-atomic (allocation ,result-tn (pad-data-block ,size) ,inline) (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,result-tn) (inst lea ,result-tn - (make-ea :byte :base ,result-tn :disp other-pointer-type)))) + (make-ea :byte :base ,result-tn :disp other-pointer-type)) + ,@forms)) ;;;; Error Code @@ -282,27 +284,45 @@ ;;;; PSEUDO-ATOMIC. +(defvar *enable-pseudo-atomic* t) + ;;; PSEUDO-ATOMIC -- Internal Interface. ;;; (defmacro pseudo-atomic (&rest forms) (let ((label (gensym "LABEL-"))) `(let ((,label (gen-label))) - (store-symbol-value 0 lisp::*pseudo-atomic-interrupted*) - ;; Note: we just use cfp as some not-zero value. - (store-symbol-value ebp-tn lisp::*pseudo-atomic-atomic*) + (when *enable-pseudo-atomic* + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + 'lisp::*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + (- other-pointer-type))) + 0) + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + 'lisp::*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-type))) + (fixnum 1))) ,@forms - (store-symbol-value 0 lisp::*pseudo-atomic-atomic*) - (inst cmp (make-ea :dword - :disp (+ nil-value - (static-symbol-offset - 'lisp::*pseudo-atomic-interrupted*) - (ash symbol-value-slot word-shift) - (- other-pointer-type))) - 0) - (inst jmp :eq ,label) - (inst int 3) - (inst byte pending-interrupt-trap) - (emit-label ,label)))) + (when *enable-pseudo-atomic* + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + 'lisp::*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-type))) + 0) + (inst cmp (make-ea :byte + :disp (+ nil-value + (static-symbol-offset + 'lisp::*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + (- other-pointer-type))) + 0) + (inst jmp :eq ,label) + (inst int 3) + (inst byte pending-interrupt-trap) + (emit-label ,label))))) ;;;; Indexed references: -- GitLab