0.9.1.36:

[sbcl.git] / src / code / sysmacs.lisp

diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp
index aba0098..66114f0 100644 (file)
--- a/src/code/sysmacs.lisp
+++ b/src/code/sysmacs.lisp
@@ -10,15 +10,30 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
-\f
-(defmacro without-gcing (&rest body)
+
+(defmacro atomic-incf/symbol (symbol-name &optional (delta 1))
+  #!-sb-thread
+  `(incf ,symbol-name ,delta)
+  #!+sb-thread
+  `(locally
+    (declare (optimize (safety 0) (speed 3)))
+    (sb!vm::locked-symbol-global-value-add ',symbol-name ,delta)))
+
+;;; When >0, inhibits garbage collection.
+(declaim (type index *gc-inhibit*))
+(defvar *gc-inhibit*) ; initialized in cold init
+
+(defmacro without-gcing (&body body)
   #!+sb-doc
   "Executes the forms in the body without doing a garbage collection."
   `(unwind-protect
-       (let ((*gc-inhibit* t))
-        ,@body)
-     (when (and *need-to-collect-garbage* (not *gc-inhibit*))
-       (maybe-gc nil))))
+    (progn
+      (atomic-incf/symbol *gc-inhibit*)
+      ,@body)
+    (atomic-incf/symbol *gc-inhibit* -1)
+    (when (and *need-to-collect-garbage* (zerop *gc-inhibit*))
+      (sub-gc))))
+
 \f
 ;;; EOF-OR-LOSE is a useful macro that handles EOF.
 (defmacro eof-or-lose (stream eof-error-p eof-value)
@@ -35,28 +50,28 @@
     `(let ((,svar ,stream))
        (cond ((null ,svar) *standard-input*)
             ((eq ,svar t) *terminal-io*)
-            (T ,@(when check-type `((enforce-type ,svar ,check-type)))
+            (t ,@(when check-type `((enforce-type ,svar ,check-type))) ;
                #!+high-security
                (unless (input-stream-p ,svar)
                  (error 'simple-type-error
                         :datum ,svar
                         :expected-type '(satisfies input-stream-p)
                         :format-control "~S isn't an input stream"
-                        :format-arguments ,(list  svar)))              
+                        :format-arguments (list ,svar)))
                ,svar)))))
 (defmacro out-synonym-of (stream &optional check-type)
   (let ((svar (gensym)))
     `(let ((,svar ,stream))
        (cond ((null ,svar) *standard-output*)
             ((eq ,svar t) *terminal-io*)
-            (T ,@(when check-type `((check-type ,svar ,check-type)))
+            (t ,@(when check-type `((check-type ,svar ,check-type)))
                #!+high-security
                (unless (output-stream-p ,svar)
                  (error 'simple-type-error
                         :datum ,svar
                         :expected-type '(satisfies output-stream-p)
                         :format-control "~S isn't an output stream."
-                        :format-arguments ,(list  svar)))
+                        :format-arguments (list ,svar)))
                ,svar)))))
 
 ;;; WITH-mumble-STREAM calls the function in the given SLOT of the
@@ -90,7 +105,7 @@
 (defmacro prepare-for-fast-read-char (stream &body forms)
   `(let* ((%frc-stream% ,stream)
          (%frc-method% (ansi-stream-in %frc-stream%))
-         (%frc-buffer% (ansi-stream-in-buffer %frc-stream%))
+         (%frc-buffer% (ansi-stream-cin-buffer %frc-stream%))
          (%frc-index% (ansi-stream-in-index %frc-stream%)))
      (declare (type index %frc-index%)
              (type ansi-stream %frc-stream%))
@@ -111,7 +126,7 @@
      (prog1 (fast-read-char-refill %frc-stream% ,eof-error-p ,eof-value)
            (setq %frc-index% (ansi-stream-in-index %frc-stream%))))
     (t
-     (prog1 (code-char (aref %frc-buffer% %frc-index%))
+     (prog1 (aref %frc-buffer% %frc-index%)
            (incf %frc-index%)))))
 
 ;;;; And these for the fasloader...