# HG changeset patch # User Steve Losh # Date 1459297833 0 # Node ID 894cac6a43fa50b28f5e08e80507d8be98dd2f2b # Parent 6b2403fb07d84fabe593986a49f63c373ea212de Make the WAM heap resizable May end up reverting this for performance in the end, but for now it makes my life easier and the debug output saner. diff -r 6b2403fb07d8 -r 894cac6a43fa src/wam/cells.lisp --- a/src/wam/cells.lisp Tue Mar 29 23:09:51 2016 +0000 +++ b/src/wam/cells.lisp Wed Mar 30 00:30:33 2016 +0000 @@ -38,7 +38,7 @@ (deftype heap-index () - `(integer 0 ,(1- array-total-size-limit))) + `(integer 0 ,(1- +heap-limit+))) (deftype register-index () `(integer 0 ,(1- +register-count+))) diff -r 6b2403fb07d8 -r 894cac6a43fa src/wam/constants.lisp --- a/src/wam/constants.lisp Tue Mar 29 23:09:51 2016 +0000 +++ b/src/wam/constants.lisp Wed Mar 30 00:30:33 2016 +0000 @@ -13,6 +13,13 @@ :documentation "Bitmask for masking the cell type tags.") +(define-constant +addressable-values+ (expt 2 +cell-value-width+) + :documentation "Number of addressable values, based on cell width.") + +(define-constant +heap-limit+ +addressable-values+ + :documentation "Maximum size of the WAM heap.") + + (define-constant +tag-null+ #b00 :documentation "An empty cell.") diff -r 6b2403fb07d8 -r 894cac6a43fa src/wam/dump.lisp --- a/src/wam/dump.lisp Tue Mar 29 23:09:51 2016 +0000 +++ b/src/wam/dump.lisp Wed Mar 30 00:30:33 2016 +0000 @@ -1,28 +1,38 @@ (in-package #:bones.wam) +(defun registers-pointing-to (wam addr) + (loop :for reg :across (wam-registers wam) + :for i :from 0 + :when (= reg addr) + :collect i)) + (defun heap-debug (wam addr cell) - (switch ((cell-type cell)) - (+tag-reference+ - (if (= addr (cell-value cell)) - "unbound variable" - (format nil "var pointer to ~D" (cell-value cell)))) - (+tag-functor+ - (format nil "~A/~D" - (wam-functor-lookup wam (cell-functor-index cell)) - (cell-functor-arity cell))) - (t ""))) + (format + nil "~A~{(X~A) ~}" + (switch ((cell-type cell)) + (+tag-reference+ + (if (= addr (cell-value cell)) + "unbound variable " + (format nil "var pointer to ~D " (cell-value cell)))) + (+tag-functor+ + (format nil "~A/~D " + (wam-functor-lookup wam (cell-functor-index cell)) + (cell-functor-arity cell))) + (t "")) + (registers-pointing-to wam addr))) + (defun dump-heap (wam from to highlight) ;; This code is awful, sorry. (let ((heap (wam-heap wam))) - (format t " +------+-----+--------------+----------------------------+~%") - (format t " | ADDR | TYP | VALUE | DEBUG |~%") - (format t " +------+-----+--------------+----------------------------+~%") + (format t " +------+-----+--------------+--------------------------------------+~%") + (format t " | ADDR | TYP | VALUE | DEBUG |~%") + (format t " +------+-----+--------------+--------------------------------------+~%") (when (> from 0) - (format t " | ⋮ | ⋮ | ⋮ | |~%")) + (format t " | ⋮ | ⋮ | ⋮ | |~%")) (flet ((print-cell (i cell) (let ((hi (= i highlight))) - (format t "~A ~4@A | ~A | ~12@A | ~26A ~A~%" + (format t "~A ~4@A | ~A | ~12@A | ~36A ~A~%" (if hi "==>" " |") i (cell-type-short-name cell) @@ -32,21 +42,24 @@ (loop :for i :from from :below to :do (print-cell i (aref heap i)))) (when (< to (length heap)) - (format t " | ⋮ | ⋮ | ⋮ | |~%")) - (format t " +------+-----+--------------+----------------------------+~%") + (format t " | ⋮ | ⋮ | ⋮ | |~%")) + (format t " +------+-----+--------------+--------------------------------------+~%") (values))) (defun dump-wam-registers (wam) (format t "REGISTERS:~%") - (format t "~5@A ->~4@A~%" "S" (wam-s wam)) + (format t "~5@A ->~6@A~%" "S" (wam-s wam)) (loop :for i :from 0 :for reg :across (wam-registers wam) - :for contents = (wam-register-cell wam i) - :do (format t "~5@A ->~4@A ~A~%" + :for contents = (when (not (= reg (1- +heap-limit+))) + (wam-register-cell wam i)) + :do (format t "~5@A ->~6@A ~A~%" (format nil "X~D" i) reg - (cell-aesthetic contents)))) + (if contents + (cell-aesthetic contents) + "unset")))) (defun dump-wam-functors (wam) (format t " FUNCTORS: ~S~%" (wam-functors wam))) @@ -72,7 +85,6 @@ addr)) - (defun extract-thing (wam &optional (address (wam-register wam 0))) (let ((cell (wam-heap-cell wam (deref wam address)))) (cond diff -r 6b2403fb07d8 -r 894cac6a43fa src/wam/wam.lisp --- a/src/wam/wam.lisp Tue Mar 29 23:09:51 2016 +0000 +++ b/src/wam/wam.lisp Wed Mar 30 00:30:33 2016 +0000 @@ -1,19 +1,14 @@ (in-package #:bones.wam) ;;;; WAM -(defparameter *wam-heap-size* 48) - (defclass wam () ((heap - :initform (make-array *wam-heap-size* + :initform (make-array 1024 + :fill-pointer 0 :initial-element (make-cell-null) :element-type 'heap-cell) :reader wam-heap :documentation "The actual heap (stack).") - (heap-pointer - :initform 0 - :accessor wam-heap-pointer - :documentation "The index of the first free cell on the heap (stack).") (functors :initform (make-array 16 :fill-pointer 0 @@ -24,9 +19,9 @@ (registers :reader wam-registers :initform (make-array +register-count+ - ;; Point at the last heap index by default, just to - ;; make it easier to read debug output. - :initial-element (1- *wam-heap-size*) + ;; Initialize to the last element in the heap for + ;; debugging purposes. + :initial-element (1- +heap-limit+) :element-type 'heap-index) :documentation "An array of the X_i registers.") (fail @@ -62,7 +57,6 @@ ;;; ;;; TODO: Consider using an adjustable array. There must still be a max size ;;; because you can only index so many addresses with N bits. - (defun* wam-heap-push! ((wam wam) (cell heap-cell)) (:returns (values heap-cell heap-index)) "Push the cell onto the WAM heap and increment the heap pointer. @@ -70,10 +64,15 @@ Returns the cell and the address it was pushed to. " - (with-slots (heap heap-pointer) wam - (setf (aref heap heap-pointer) cell) - (incf heap-pointer) - (values cell (1- heap-pointer)))) + (with-slots (heap) wam + (if (= +heap-limit+ (fill-pointer heap)) + (error "WAM heap exhausted.") + (values cell (vector-push-extend cell heap))))) + +(defun* wam-heap-pointer ((wam wam)) + (:returns heap-index) + "Return the current heap pointer of the WAM." + (fill-pointer (wam-heap wam))) (defun* wam-heap-cell ((wam wam) (address heap-index))