anchor.diff:  (defvar *allocator-lock*)
   (defvar *general-area-expansion-granularity* (* 4 1024 1024))
   (defvar *cons-area-expansion-granularity* (* 4 1024 1024))
  +
  +(defvar *maximum-allocation-attempts* 5
  +  "GC this many times before giving up on an allocation.")
   
   (defun freelist-entry-next (entry)
     (sys.int::memref-t entry 1))
  
positive.code:       (incf words))
      (ecase area
        ((nil)
         (tagbody
          OUTER-LOOP
            (mezzano.supervisor:without-footholds
              (mezzano.supervisor:with-mutex (*allocator-lock*)
                (tagbody
                 INNER-LOOP
                   (return-from %allocate-object
                     (mezzano.supervisor:with-pseudo-atomic
                         (when (> (+ sys.int::*general-area-bump* (* words 8)) sys.int::*general-area-limit*)
                           (go EXPAND-AREA))
                       ;; Enough size, allocate here.
                       (let ((addr (logior (ash sys.int::+address-tag-general+ sys.int::+address-tag-shift+)
                                           sys.int::*general-area-bump*
                                           sys.int::*dynamic-mark-bit*)))
                         (incf sys.int::*general-area-bump* (* words 8))
                         ;; Write array header.
                         (set-allocated-object-header addr tag data 0)
                         (sys.int::%%assemble-value addr sys.int::+tag-object+))))
                 EXPAND-AREA
                   ;; No memory. If there's memory available, then expand the area, otherwise run the GC.
                   ;; Cannot be done when pseudo-atomic.
                   ;; Divide granularity by two because this is a semispace area. Need twice as much memory.
                   (let ((expansion (logand (truncate *general-area-expansion-granularity* 2) (lognot #xFFF))))
                     (mezzano.supervisor::debug-print-line "Expanding general area by " expansion)
                     (when (< sys.int::*memory-expansion-remaining* (* expansion 2))
                       ;; Not enough memory, abandon ship, do a gc and then attempt the allocation again.
                       (go DO-GC))
                     (decf sys.int::*memory-expansion-remaining* (* expansion 2))
                     ;; Do new & oldspace allocations seperately, this interacts better with the freelist.
                     (mezzano.supervisor:allocate-memory-range
                      (logior sys.int::*dynamic-mark-bit*
                              (ash sys.int::+address-tag-general+
                                   sys.int::+address-tag-shift+)
                              sys.int::*general-area-limit*)
                      expansion
                      (logior sys.int::+block-map-present+
                              sys.int::+block-map-writable+
                              sys.int::+block-map-zero-fill+))
                     (mezzano.supervisor:allocate-memory-range
                      (logior (logxor sys.int::*dynamic-mark-bit*
                                      (ash 1 sys.int::+address-newspace/oldspace-bit+))
                              (ash sys.int::+address-tag-general+
                                   sys.int::+address-tag-shift+)
                              sys.int::*general-area-limit*)
                      expansion
                      sys.int::+block-map-zero-fill+)
                     (incf sys.int::*general-area-limit* expansion))
                   (go INNER-LOOP))))
          DO-GC
            ;; Must occur outside the locks.
            (sys.int::gc)
            (go OUTER-LOOP)))
        (:pinned
         (mezzano.supervisor:without-footholds
           (mezzano.supervisor:with-mutex (*allocator-lock*)
             (mezzano.supervisor:with-pseudo-atomic
               (when *paranoid-allocation*
                 (verify-freelist sys.int::*pinned-area-freelist* (* 2 1024 1024 1024) sys.int::*pinned-area-bump*))
               (sys.int::%%assemble-value
                (%allocate-from-pinned-area tag data words 'sys.int::*pinned-area-freelist*)
                sys.int::+tag-object+)))))
        (:wired
         (mezzano.supervisor::safe-without-interrupts (tag data words)
           (mezzano.supervisor:with-symbol-spinlock (*wired-allocator-lock*)
             (when *paranoid-allocation*
               (verify-freelist sys.int::*wired-area-freelist* (* 2 1024 1024) sys.int::*wired-area-bump*))
             (sys.int::%%assemble-value
              (%allocate-from-pinned-area tag data words 'sys.int::*wired-area-freelist*)
              sys.int::+tag-object+)))))))
  
  (defun sys.int::cons-in-area (car cdr &optional area)
    (when sys.int::*gc-in-progress*
      (mezzano.supervisor:panic "Allocating during GC!"))
    (ecase area
      ((nil) (cons car cdr))
      (:pinned
       (mezzano.supervisor:without-footholds
         (mezzano.supervisor:with-mutex (*allocator-lock*)
           (mezzano.supervisor:with-pseudo-atomic
             (when *paranoid-allocation*
               (verify-freelist sys.int::*pinned-area-freelist* (* 2 1024 1024 1024) sys.int::*pinned-area-bump*))
             (let ((val (sys.int::%%assemble-value
                         (+ (%allocate-from-pinned-area sys.int::+object-tag-cons+ 0 4 'sys.int::*pinned-area-freelist*) 16)
                         sys.int::+tag-cons+)))
               (setf (car val) car
                     (cdr val) cdr)
               val)))))
      (:wired
       (mezzano.supervisor::safe-without-interrupts (car cdr)
         (mezzano.supervisor:with-symbol-spinlock (*wired-allocator-lock*)
           (when *paranoid-allocation*
             (verify-freelist sys.int::*wired-area-freelist* (* 2 1024 1024) sys.int::*wired-area-bump*))
           (let ((val (sys.int::%%assemble-value
                       (+ (%allocate-from-pinned-area sys.int::+object-tag-cons+ 0 4 'sys.int::*wired-area-freelist*) 16)
                       sys.int::+tag-cons+)))
             (setf (car val) car
                   (cdr val) cdr)
             val))))))
  
  (sys.int::define-lap-function cons ((car cdr))
    ;; Attempt to quickly allocate a cons. Will call SLOW-CONS if things get too hairy.
  
negative.code: (defun slow-cons (car cdr)
    (when sys.int::*gc-in-progress*
      (mezzano.supervisor:panic "Allocating during GC!"))
    (let ((gc-count 0))
      (tagbody
       OUTER-LOOP
         (mezzano.supervisor:without-footholds
           (mezzano.supervisor:with-mutex (*allocator-lock*)
             (tagbody
              INNER-LOOP
                (return-from slow-cons
                  (mezzano.supervisor:with-pseudo-atomic
                    (when (> (+ sys.int::*cons-area-bump* 16) sys.int::*cons-area-limit*)
                      (go EXPAND-AREA))
                    ;; Enough size, allocate here.
                    (let* ((addr (logior (ash sys.int::+address-tag-cons+ sys.int::+address-tag-shift+)
                                         sys.int::*cons-area-bump*
                                         sys.int::*dynamic-mark-bit*))
                           (val (sys.int::%%assemble-value addr sys.int::+tag-cons+)))
                      (incf sys.int::*cons-area-bump* 16)
                      (setf (car val) car
                            (cdr val) cdr)
                      val)))
              EXPAND-AREA
                ;; No memory. If there's memory available, then expand the area, otherwise run the GC.
                ;; Cannot be done when pseudo-atomic.
                ;; Divide granularity by two because this is a semispace area. Need twice as much memory.
                (let ((expansion (logand (truncate *cons-area-expansion-granularity* 2) (lognot #xFFF))))
                  (mezzano.supervisor::debug-print-line "Expanding cons area by " expansion)
                  (when (< sys.int::*memory-expansion-remaining* (* expansion 2))
                    ;; Not enough memory, abandon ship, do a gc and then attempt the allocation again.
                    (go DO-GC))
                  (decf sys.int::*memory-expansion-remaining* (* expansion 2))
                  ;; Do new & oldspace allocations seperately, this interacts better with the freelist.
                  ;; Allocate newspace.
                  (mezzano.supervisor:allocate-memory-range
                   (logior sys.int::*dynamic-mark-bit*
                           (ash sys.int::+address-tag-cons+
                                sys.int::+address-tag-shift+)
                           sys.int::*cons-area-limit*)
                   expansion
                   (logior sys.int::+block-map-present+
                           sys.int::+block-map-writable+
                           sys.int::+block-map-zero-fill+))
                  ;; Allocate oldspace.
                  (mezzano.supervisor:allocate-memory-range
                   (logior (logxor sys.int::*dynamic-mark-bit*
                                   (ash 1 sys.int::+address-newspace/oldspace-bit+))
                           (ash sys.int::+address-tag-cons+
                                sys.int::+address-tag-shift+)
                           sys.int::*cons-area-limit*)
                   expansion
                   sys.int::+block-map-zero-fill+)
                  (incf sys.int::*cons-area-limit* expansion))
                (go INNER-LOOP))))
       DO-GC
         ;; Must occur outside the locks.
         (when (> gc-count *maximum-allocation-attempts*)
           (error 'storage-condition))
         (incf gc-count)
         (sys.int::gc)
         (go OUTER-LOOP))))
  
  (defun sys.int::make-simple-vector (size &optional area)
    (%allocate-object sys.int::+object-tag-array-t+ size size area))
  