Skip to content
Snippets Groups Projects
Commit 640eac17 authored by dtc's avatar dtc
Browse files

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.
parent 798ec63b
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -187,15 +187,17 @@
:foreign)))))))) :foreign))))))))
(values)) (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 "Allocate an other-pointer object of fixed Size with a single
word header having the specified Type-Code. The result is placed in word header having the specified Type-Code. The result is placed in
Result-TN." Result-TN."
`(progn `(pseudo-atomic
(allocation ,result-tn (pad-data-block ,size) ,inline) (allocation ,result-tn (pad-data-block ,size) ,inline)
(storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,result-tn) (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,result-tn)
(inst lea ,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 ;;;; Error Code
...@@ -282,27 +284,45 @@ ...@@ -282,27 +284,45 @@
;;;; PSEUDO-ATOMIC. ;;;; PSEUDO-ATOMIC.
(defvar *enable-pseudo-atomic* t)
;;; PSEUDO-ATOMIC -- Internal Interface. ;;; PSEUDO-ATOMIC -- Internal Interface.
;;; ;;;
(defmacro pseudo-atomic (&rest forms) (defmacro pseudo-atomic (&rest forms)
(let ((label (gensym "LABEL-"))) (let ((label (gensym "LABEL-")))
`(let ((,label (gen-label))) `(let ((,label (gen-label)))
(store-symbol-value 0 lisp::*pseudo-atomic-interrupted*) (when *enable-pseudo-atomic*
;; Note: we just use cfp as some not-zero value. (inst mov (make-ea :byte :disp (+ nil-value
(store-symbol-value ebp-tn lisp::*pseudo-atomic-atomic*) (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 ,@forms
(store-symbol-value 0 lisp::*pseudo-atomic-atomic*) (when *enable-pseudo-atomic*
(inst cmp (make-ea :dword (inst mov (make-ea :byte :disp (+ nil-value
:disp (+ nil-value (static-symbol-offset
(static-symbol-offset 'lisp::*pseudo-atomic-atomic*)
'lisp::*pseudo-atomic-interrupted*) (ash symbol-value-slot word-shift)
(ash symbol-value-slot word-shift) (- other-pointer-type)))
(- other-pointer-type))) 0)
0) (inst cmp (make-ea :byte
(inst jmp :eq ,label) :disp (+ nil-value
(inst int 3) (static-symbol-offset
(inst byte pending-interrupt-trap) 'lisp::*pseudo-atomic-interrupted*)
(emit-label ,label)))) (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: ;;;; Indexed references:
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment