allocate: thread-local allocations.

compiler/lap-arm64.lisp

@@ -834,7 +834,7 @@
              ;; switch add/sub around for negative values
              (when (minusp imm-value)
                (setf imm-value (- imm-value))
-               (setf opc (logxor opc (ash opcode 30))))
+               (setf opc (logxor opc (ash 1 30))))
              (emit-instruction (logior #x11000000
                                        opc
                                        (if (eql amount 12)

runtime/allocate.lisp

@@ -48,12 +48,29 @@
 (sys.int::defglobal *general-area-expansion-granularity*)
 (sys.int::defglobal *cons-area-expansion-granularity*)
 
-(sys.int::defglobal *general-fast-path-hits*)
-(sys.int::defglobal *general-allocation-count*)
-(sys.int::defglobal *cons-fast-path-hits*)
-(sys.int::defglobal *cons-allocation-count*)
+(defun bytes-consed ()
+  (loop for cpu in mezzano.supervisor::*cpus*
+        sum (mezzano.supervisor::cpu-bytes-consed cpu)))
 
-(sys.int::defglobal *bytes-consed*)
+(defun general-allocation-count ()
+  (loop for cpu in mezzano.supervisor::*cpus*
+        sum (mezzano.supervisor::cpu-general-allocation-count cpu)))
+
+(defun general-fast-path-hits ()
+  (loop for cpu in mezzano.supervisor::*cpus*
+        sum (mezzano.supervisor::cpu-general-fast-path-hits cpu)))
+
+(defun cons-allocation-count ()
+  (loop for cpu in mezzano.supervisor::*cpus*
+        sum (mezzano.supervisor::cpu-cons-allocation-count cpu)))
+
+(defun cons-fast-path-hits ()
+  (loop for cpu in mezzano.supervisor::*cpus*
+        sum (mezzano.supervisor::cpu-cons-fast-path-hits cpu)))
+
+
+(defconstant sys.int::+tlab-size+ (* 256 1024))
+(defconstant sys.int::+tlab-object-size-limit+ (* 64 1024))
 
 (defvar *maximum-allocation-attempts* 5
   "GC this many times before giving up on an allocation.")
@@ -90,11 +107,6 @@
         *enable-allocation-profiling* nil
         *general-area-expansion-granularity* sys.int::+allocation-minimum-alignment+
         *cons-area-expansion-granularity* sys.int::+allocation-minimum-alignment+
-        *general-fast-path-hits* 0
-        *general-allocation-count* 0
-        *cons-fast-path-hits* 0
-        *cons-allocation-count* 0
-        *bytes-consed* 0
         *allocator-lock* (mezzano.supervisor:make-mutex "Allocator")
         *allocation-fudge* (* 8 1024 1024)
         sys.int::*generation-size-ratio* 2)
@@ -332,7 +344,7 @@
 
 #-(or x86-64 arm64)
 (defun %allocate-from-general-area (tag data words)
-  (sys.int::%atomic-fixnum-add-symbol '*general-allocation-count* 1)
+  (incf (mezzano.supervisor::cpu-general-allocation-count (mezzano.supervisor::local-cpu)) 1)
   (%slow-allocate-from-general-area tag data words))
 
 #-(or x86-64 arm64)
@@ -437,7 +449,31 @@
              (mezzano.supervisor:debug-print-line "A-M-R failed."))
            nil))))
 
+(defun %do-get-new-tlab ()
+  (let* ((size (* sys.int::+tlab-size+ 8))
+         (old-bump (sys.int::%atomic-fixnum-add-symbol 'sys.int::*general-area-young-gen-bump*
+                                                        size))
+         (new-bump (+ old-bump size)))
+    (and (<= new-bump sys.int::*general-area-young-gen-limit*)
+         old-bump)))
+
+(defun %get-new-tlab (words)
+  (when (or (zerop sys.int::*general-area-young-gen-bump*)
+            (> words sys.int::+tlab-object-size-limit+))
+    (return-from %get-new-tlab nil))
+  (let ((result (%do-get-new-tlab)))
+    (when result
+      (let ((thread (mezzano.supervisor::current-thread))
+            (limit (+ result (* sys.int::+tlab-size+ 8))))
+        (setf (mezzano.supervisor::thread-tlab-bump thread) result
+              (mezzano.supervisor::thread-tlab-limit thread) limit)
+        t))))
+
 (defun %slow-allocate-from-general-area (tag data words)
+    ;; TLAB ran out. Try getting a new one.
+  (when (%get-new-tlab words)
+    (return-from %slow-allocate-from-general-area
+      (%allocate-from-general-area tag data words)))
   (let ((gc-count 0)
         (start-time (mezzano.supervisor:get-high-precision-timer)))
     (tagbody
@@ -449,27 +485,29 @@
                (tagbody
                 INNER-LOOP
                   (multiple-value-bind (result ignore1 ignore2 failurep)
-                      (%do-allocate-from-general-area tag data words)
+                      (%do-slow-allocate-from-general-area tag data words)
                     (declare (ignore ignore1 ignore2))
                     (when (not failurep)
                       (update-allocation-time start-time)
+		      ;; (mezzano.supervisor::debug-print-line "what")
                       (return-from %slow-allocate-from-general-area
                         result)))
                   ;; No memory. If there's memory available, then expand the area, otherwise run the GC.
                   ;; Running the GC cannot be done when pseudo-atomic.
                   (cond ((expand-allocation-area :general
-                                                 (* words 8)
+                                                 (* sys.int::+tlab-size+ 8)
+                                                 ;; (* words 8)
                                                  '*general-area-expansion-granularity*
                                                  'sys.int::*general-area-young-gen-limit*
                                                  sys.int::+address-tag-general+)
-                         ;; Successfully expanded the area. Retry the allocation.
-                         (go INNER-LOOP))
-                        (t
-                         ;; No memory do expand, bail out and run the GC.
-                         ;; This cannot be done when pseudo-atomic.
-                         (when sys.int::*gc-enable-logging*
-                           (mezzano.supervisor:debug-print-line "General area expansion failed, performing GC."))
-                         (go DO-GC))))))))
+                     ;; Successfully expanded the area. Retry the allocation.
+                     (go INNER-LOOP))
+                    (t
+                     ;; No memory do expand, bail out and run the GC.
+                     ;; This cannot be done when pseudo-atomic.
+                     (when sys.int::*gc-enable-logging*
+                       (mezzano.supervisor:debug-print-line "General area expansion failed, performing GC."))
+                     (go DO-GC))))))))
      DO-GC
        ;; Must occur outside the locks.
        (when (> gc-count *maximum-allocation-attempts*)
@@ -486,12 +524,12 @@
     (when (oddp words)
       (incf words))
     (let ((bytes (* words 8)))
-      (sys.int::%atomic-fixnum-add-symbol '*bytes-consed* bytes)
-      ;; ### This won't accurately track if the thread gets footholded
-      ;; partway through the add...
+      (incf (mezzano.supervisor::cpu-bytes-consed (mezzano.supervisor::local-cpu))
+            bytes)
       (incf (mezzano.supervisor:thread-bytes-consed
              (mezzano.supervisor:current-thread))
             bytes))
+    ;; (mezzano.supervisor:debug-print-line "b " (mezzano.supervisor::thread-tlab-bump (mezzano.supervisor::current-thread)))
     (ecase area
       ((nil)
        (%allocate-from-general-area tag data words))
@@ -507,18 +545,21 @@
     ((nil)
      (cons car cdr))
     (:pinned
-     (log-allocation-profile-entry 2)
-     (sys.int::%atomic-fixnum-add-symbol '*bytes-consed* 32)
-     (%cons-in-pinned-area car cdr))
+      (log-allocation-profile-entry 2)
+      (incf (mezzano.supervisor::cpu-bytes-consed (mezzano.supervisor::local-cpu)) 32)
+      (incf (mezzano.supervisor:thread-bytes-consed (mezzano.supervisor:current-thread)) 32)
+      (%cons-in-pinned-area car cdr))
     (:wired
-     (log-allocation-profile-entry 2)
-     (sys.int::%atomic-fixnum-add-symbol '*bytes-consed* 32)
-     (%cons-in-wired-area car cdr))))
+      (log-allocation-profile-entry 2)
+      (incf (mezzano.supervisor::cpu-bytes-consed (mezzano.supervisor::local-cpu)) 32)
+      (incf (mezzano.supervisor:thread-bytes-consed (mezzano.supervisor:current-thread)) 32)
+      (%cons-in-wired-area car cdr))))
 
 #-(or x86-64 arm64)
 (defun cons (car cdr)
-  (sys.int::%atomic-fixnum-add-symbol '*cons-allocation-count* 1)
-  (sys.int::%atomic-fixnum-add-symbol '*bytes-consed* 16)
+  (incf (mezzano.supervisor::cpu-cons-allocation-count (mezzano.supervisor::local-cpu)) 1)
+  (incf (mezzano.supervisor::cpu-bytes-consed (mezzano.supervisor::local-cpu)) 16)
+  (incf (mezzano.supervisor:thread-bytes-consed (mezzano.supervisor:current-thread)) 16)
   (slow-cons car cdr))
 
 #-(or x86-64 arm64)
@@ -690,10 +731,12 @@
      with inhibit-gc = nil
      for i from 0 do
        (let ((result (%allocate-function-1 tag data words wiredp)))
-         (when result
-           (sys.int::%atomic-fixnum-add-symbol '*bytes-consed* (* words 8))
-           (update-allocation-time start-time)
-           (return result)))
+           (when result
+             (let ((cbytes (* words 8)))
+               (incf (mezzano.supervisor::cpu-bytes-consed (mezzano.supervisor::local-cpu)) cbytes)
+               (incf (mezzano.supervisor:thread-bytes-consed (mezzano.supervisor:current-thread)) cbytes))
+             (update-allocation-time start-time)
+            (return result)))
        (when (not (eql i 0))
          ;; The GC has been run at least once.
          (when (expand-function-area words wiredp)
@@ -886,7 +929,8 @@ This area exists below the stack and is never allocated or mapped.")
      :finalizer (lambda ()
                   (when stack-address
                     (release-memory-range stack-address size)
-                    (sys.int::%atomic-fixnum-add-symbol 'sys.int::*bytes-allocated-to-stacks* (- size))))
+                    ;; (sys.int::%atomic-fixnum-add-symbol 'sys.int::*bytes-allocated-to-stacks* (- size))
+		    ))
      :area :wired)
     (tagbody
      RETRY
@@ -920,7 +964,7 @@ This area exists below the stack and is never allocated or mapped.")
                     (if wired
                         (setf sys.int::*wired-stack-area-bump* (align-up (+ bump size) +stack-region-alignment+))
                         (setf sys.int::*stack-area-bump* (align-up (+ bump size) +stack-region-alignment+)))
-                    (sys.int::%atomic-fixnum-add-symbol 'sys.int::*bytes-allocated-to-stacks* size)
+                    ;; (sys.int::%atomic-fixnum-add-symbol 'sys.int::*bytes-allocated-to-stacks* size)
                     (setf (stack-base stack) addr
                           ;; Notify the finalizer that the stack has been allocated & should be freed.
                           stack-address addr)