X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-extensions.lisp;h=088694dc90a177fcab171afc0adc0a910c290d63;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=f97607b284569f124959110d8f518e99bbf13af1;hpb=acc978383105b5a2bfd970f8a34214fd5774bb2a;p=sbcl.git

diff --git a/src/code/target-extensions.lisp b/src/code/target-extensions.lisp
index f97607b..088694d 100644
--- a/src/code/target-extensions.lisp
+++ b/src/code/target-extensions.lisp
@@ -35,6 +35,13 @@ order when a saved core image starts up, after the system itself has
 been initialized. Unused by SBCL itself: reserved for user and
 applications.")
 
+(defvar *exit-hooks* nil
+  #!+sb-doc
+  "This is a list of functions which are called in an unspecified
+order when SBCL process exits. Unused by SBCL itself: reserved for
+user and applications. Using (SB-EXT:EXIT :ABORT T), or calling
+exit(3) directly will circumvent these hooks.")
+
 
 ;;; Binary search for simple vectors
 (defun binary-search (value seq &key (key #'identity))
@@ -81,3 +88,39 @@ applications.")
          :format-arguments (list prefix-string (strerror errno))
          other-condition-args))
 
+;;; Constructing shortish strings one character at a time. More efficient then
+;;; a string-stream, as can directly use simple-base-strings when applicable,
+;;; and if the maximum size is know doesn't need to copy the result at all --
+;;; but if the result is going to be HUGE, string-streams will win.
+(defmacro with-push-char ((&key (element-type 'character) (initial-size 28)) &body body)
+  (with-unique-names (string size pointer)
+    `(let* ((,size ,initial-size)
+            (,string (make-array ,size :element-type ',element-type))
+            (,pointer 0))
+       (declare (type (integer 0 ,sb!xc:array-dimension-limit) ,size)
+                (type (integer 0 ,(1- sb!xc:array-dimension-limit)) ,pointer)
+                (type (simple-array ,element-type (*)) ,string))
+       (flet ((push-char (char)
+                (declare (optimize (sb!c::insert-array-bounds-checks 0)))
+                (when (= ,pointer ,size)
+                  (let ((old ,string))
+                    (setf ,size (* 2 (+ ,size 2))
+                          ,string (make-array ,size :element-type ',element-type))
+                    (replace ,string old)))
+                (setf (char ,string ,pointer) char)
+                (incf ,pointer))
+              (get-pushed-string ()
+                (let ((string ,string)
+                      (size ,pointer))
+                  (setf ,size 0
+                        ,pointer 0
+                        ,string ,(coerce "" `(simple-array ,element-type (*))))
+                  ;; This is really local, so we can be destructive!
+                  (%shrink-vector string size)
+                  string)))
+         ,@body))))
+
+;;; The smallest power of two that is equal to or greater than X.
+(defun power-of-two-ceiling (x)
+  (declare (index x))
+  (ash 1 (integer-length (1- x))))