# HG changeset patch # User Steve Losh # Date 1468280257 0 # Node ID cb3cc671d18dba55acb8de81a4beb81ca4c40d3e # Parent 401cba673bda74b98438207d81590fb4f486a589 Beef up the PAIP queues a bit and (ab)use them in the compiler This eliminates the other use of arrays in the register allocation process, which was eting a few percent of our total runtime. diff -r 401cba673bda -r cb3cc671d18d package.lisp --- a/package.lisp Mon Jul 11 22:33:25 2016 +0000 +++ b/package.lisp Mon Jul 11 23:37:37 2016 +0000 @@ -17,6 +17,7 @@ #:megabytes #:gethash-or-init #:define-lookup + #:queue #:make-queue #:enqueue #:dequeue diff -r 401cba673bda -r cb3cc671d18d src/utils.lisp --- a/src/utils.lisp Mon Jul 11 22:33:25 2016 +0000 +++ b/src/utils.lisp Mon Jul 11 23:37:37 2016 +0000 @@ -129,48 +129,45 @@ ;;;; Queues -;;; From PAIP (thanks, Norvig). +;;; Based on the PAIP queues (thanks, Norvig), but beefed up a little bit to add +;;; tracking of the queue size. + +(declaim (inline make-queue enqueue dequeue queue-empty-p)) -(deftype queue () '(cons list list)) -(declaim (inline queue-contents make-queue - enqueue dequeue - queue-empty-p queue-append)) +(defstruct (queue (:constructor make-queue%)) + (contents nil :type list) + (last nil :type list) + (size 0 :type fixnum)) -(defun* queue-contents ((q queue)) - (:returns list) - (cdr q)) - (defun* make-queue () (:returns queue) - (let ((q (cons nil nil))) - (setf (car q) q))) + (make-queue%)) + +(defun* queue-empty-p ((q queue)) + (:returns boolean) + (zerop (queue-size q))) (defun* enqueue ((item t) (q queue)) - (:returns queue) - (setf (car q) - (setf (rest (car q)) - (cons item nil))) - q) + (:returns fixnum) + (let ((cell (cons item nil))) + (setf (queue-last q) + (if (queue-empty-p q) + (setf (queue-contents q) cell) + (setf (cdr (queue-last q)) cell)))) + (incf (queue-size q))) (defun* dequeue ((q queue)) (:returns t) - (prog1 - (pop (cdr q)) - (if (null (cdr q)) - (setf (car q) q)))) - -(defun* queue-empty-p ((q queue)) - (:returns boolean) - (null (queue-contents q))) + (when (zerop (decf (queue-size q))) + (setf (queue-last q) nil)) + (pop (queue-contents q))) (defun* queue-append ((q queue) (l list)) - (:returns queue) - (when l - (setf (car q) - (last (setf (rest (car q)) - l)))) - q) + (:returns fixnum) ; todo make a structure sharing version of this + (loop :for item :in l + :for size = (enqueue item q) + :finally (return size))) ;;;; Lookup Tables diff -r 401cba673bda -r cb3cc671d18d src/wam/compiler.lisp --- a/src/wam/compiler.lisp Mon Jul 11 22:33:25 2016 +0000 +++ b/src/wam/compiler.lisp Mon Jul 11 23:37:37 2016 +0000 @@ -541,7 +541,7 @@ ;;; We now return you to your regularly scheduled Lisp code. (defstruct allocation-state - (local-registers (vector) :type (vector t *)) ; todo should this be a (vector symbol) instead? + (local-registers (make-queue) :type queue) (stack-registers nil :type list) (permanent-variables nil :type list) (anonymous-variables nil :type list) @@ -553,9 +553,12 @@ (defun* find-variable ((state allocation-state) (variable symbol)) (:returns (or register null)) "Return the register that already contains this variable, or `nil` otherwise." - (or (when-let (r (position variable (allocation-state-local-registers state))) + (or (when-let (r (position variable + (queue-contents + (allocation-state-local-registers state)))) (make-temporary-register r (allocation-state-actual-arity state))) - (when-let (s (position variable (allocation-state-stack-registers state))) + (when-let (s (position variable + (allocation-state-stack-registers state))) (make-permanent-register s)) nil)) @@ -572,7 +575,7 @@ " (make-register :local - (vector-push-extend variable (allocation-state-local-registers state)))) + (1- (enqueue variable (allocation-state-local-registers state))))) (defun* ensure-variable ((state allocation-state) (variable symbol)) (:returns register) @@ -605,7 +608,7 @@ ;; never need to look them up later (like we do with variables), so we'll just ;; shove a nil into the local registers array as a placeholder. (make-temporary-register - (vector-push-extend nil (allocation-state-local-registers state)) + (enqueue nil (allocation-state-local-registers state)) (allocation-state-actual-arity state))) @@ -650,13 +653,7 @@ (reserved-variables (when nead (clause-nead-vars clause-props))) (permanent-variables (clause-permanent-vars clause-props)) - ;; Preallocate enough registers for all of the arguments. We'll fill - ;; them in later. Note that things are more complicated in the head and - ;; first body term of a clause (see above). - (local-registers (make-array 64 - :fill-pointer (or reserved-arity actual-arity) - :adjustable t - :initial-element 0)) + (local-registers (make-queue)) ;; We essentially "preallocate" all the permanent variables up front ;; because we need them to always be in the same stack registers across ;; all the terms of our clause. @@ -673,10 +670,15 @@ :reserved-variables reserved-variables :reserved-arity reserved-arity :actual-arity actual-arity))) + ;; Preallocate enough registers for all of the arguments. We'll fill + ;; them in later. Note that things are more complicated in the head and + ;; first body term of a clause (see above). + (loop :repeat (or reserved-arity actual-arity) + :do (enqueue nil local-registers)) ;; Actually reserve the reserved (but non-permanent, see above) variables. ;; They need to live in consistent spots for the head and first body term. (loop :for variable :in reserved-variables - :do (vector-push-extend variable local-registers)) + :do (enqueue variable local-registers)) (recursively ((remaining (list node))) (when remaining (destructuring-bind (node . remaining) remaining