# HG changeset patch # User Steve Losh # Date 1468549387 0 # Node ID c547c69d5405ee3f3ce47865df60b7a4cd46c4d8 # Parent 100ba597fd8575e364a2ec36f754ee6d0129057f Minor cleanup diff -r 100ba597fd85 -r c547c69d5405 src/wam/compiler.lisp --- a/src/wam/compiler.lisp Thu Jul 14 22:42:53 2016 +0000 +++ b/src/wam/compiler.lisp Fri Jul 15 02:23:07 2016 +0000 @@ -27,8 +27,8 @@ (defstruct (register (:constructor make-register (type number))) - (type :local :type register-type) - (number 0 :type register-number)) + (type (error "Type required.") :type register-type) + (number (error "Number required.") :type register-number)) (defun* make-temporary-register ((number register-number) (arity arity)) diff -r 100ba597fd85 -r c547c69d5405 src/wam/constants.lisp --- a/src/wam/constants.lisp Thu Jul 14 22:42:53 2016 +0000 +++ b/src/wam/constants.lisp Fri Jul 15 02:23:07 2016 +0000 @@ -32,10 +32,18 @@ (define-constant +register-count+ 2048 :documentation "The number of local registers the WAM has available.") - (define-constant +maximum-arity+ 1024 :documentation "The maximum allowed arity of functors.") + +;; TODO Make all this shit configurable at runtime +(define-constant +stack-limit+ 4096 + :documentation "Maximum size of the WAM stack.") + +(define-constant +stack-frame-size-limit+ (+ 7 +register-count+) + :documentation "The maximum size, in stack frame words, that a stack frame could be.") + + (define-constant +maximum-query-size+ 1024 :documentation "The maximum size (in bytes of bytecode) a query may compile to.") @@ -44,13 +52,11 @@ :documentation "The maximum number of code words an instruction (including opcode) might be.") +(define-constant +code-query-start+ 0 + :documentation "The address in the code store where the query code begins.") -;; TODO Make all this shit configurable at runtime -(define-constant +stack-limit+ 4096 - :documentation "Maximum size of the WAM stack.") - -(define-constant +stack-frame-size-limit+ (+ 7 +register-count+) - :documentation "The maximum size, in stack frame words, that a stack frame could be.") +(define-constant +code-main-start+ +maximum-query-size+ + :documentation "The address in the code store where the main program code begins.") (define-constant +stack-start+ +register-count+ diff -r 100ba597fd85 -r c547c69d5405 src/wam/wam.lisp --- a/src/wam/wam.lisp Thu Jul 14 22:42:53 2016 +0000 +++ b/src/wam/wam.lisp Fri Jul 15 02:23:07 2016 +0000 @@ -32,36 +32,47 @@ :initial-element 0 :element-type 'cell-value)) +(defun allocate-wam-unification-stack (size) + (make-array size + :fill-pointer 0 + :adjustable t + :element-type 'store-index)) -(defstruct (wam - (:print-function - (lambda (wam stream depth) - (declare (ignore depth)) - (print-unreadable-object - (wam stream :type t :identity t) - (format stream "an wam")))) - (:constructor make-wam%)) +(defun allocate-wam-trail (size) + (make-array size + :fill-pointer 0 + :adjustable t + :initial-element 0 + :element-type 'store-index)) + + +(defstruct (wam (:constructor make-wam%)) + ;; Data (type-store - (allocate-wam-type-store 0) + (error "Type store required.") :type type-store :read-only t) (value-store - (allocate-wam-value-store 0) + (error "Value store required.") :type value-store :read-only t) + (unification-stack + (error "Unification stack required.") + :type (vector store-index) + :read-only t) + (trail + (error "Trail required.") + :type (vector store-index) + :read-only t) + + ;; Code (code - (allocate-wam-code 0) + (error "Code store required.") :type (simple-array code-word (*)) :read-only t) (code-labels (make-hash-table :test 'eq) :read-only t) - (logic-stack - nil - :type list) - (logic-pool - nil - :type list) (functors (make-array 64 :fill-pointer 0 @@ -69,54 +80,51 @@ :element-type 'functor) :type (vector functor) :read-only t) - (unification-stack - (make-array 16 - :fill-pointer 0 - :adjustable t - :element-type 'store-index) - :type (vector store-index) - :read-only t) - (trail - (make-array 64 - :fill-pointer 0 - :adjustable t - :initial-element 0 - :element-type 'store-index) - :type (vector store-index) - :read-only t) + + ;; Logic Stack + (logic-stack nil :type list) + (logic-pool nil :type list) ;; Unique registers - (number-of-arguments 0 :type arity) ; NARGS - (subterm +heap-start+ :type heap-index) ; S - (program-counter 0 :type code-index) ; P - (code-pointer +maximum-query-size+ :type code-index) ; CODE - (heap-pointer (1+ +heap-start+) :type heap-index) ; H - (stack-pointer +stack-start+ :type stack-index) ; SP - (continuation-pointer 0 :type code-index) ; CP - (environment-pointer +stack-start+ :type environment-pointer) ; E - (backtrack-pointer +stack-start+ :type backtrack-pointer) ; B - (cut-pointer +stack-start+ :type backtrack-pointer) ; B0 - (heap-backtrack-pointer +heap-start+ :type heap-index) ; HB + (number-of-arguments 0 :type arity) ; NARGS + (subterm +heap-start+ :type heap-index) ; S + (program-counter 0 :type code-index) ; P + (code-pointer +code-main-start+ :type code-index) ; CODE + (heap-pointer (1+ +heap-start+) :type heap-index) ; H + (stack-pointer +stack-start+ :type stack-index) ; SP + (continuation-pointer 0 :type code-index) ; CP + (environment-pointer +stack-start+ :type environment-pointer) ; E + (backtrack-pointer +stack-start+ :type backtrack-pointer) ; B + (cut-pointer +stack-start+ :type backtrack-pointer) ; B0 + (heap-backtrack-pointer +heap-start+ :type heap-index) ; HB - ;; Other global "registers" + ;; Flags (fail nil :type boolean) (backtracked nil :type boolean) (mode nil :type (or null (member :read :write)))) +(defmethod print-object ((wam wam) stream) + (print-unreadable-object + (wam stream :type t :identity t) + (format stream "an wam"))) + + (defun* make-wam (&key (store-size (megabytes 10)) (code-size (megabytes 1))) (:returns wam) (make-wam% :code (allocate-wam-code code-size) :type-store (allocate-wam-type-store store-size) - :value-store (allocate-wam-value-store store-size))) + :value-store (allocate-wam-value-store store-size) + :unification-stack (allocate-wam-unification-stack 16) + :trail (allocate-wam-trail 64))) ;;;; Store ;;; The main store of the WAM is split into two separate arrays: ;;; -;;; * An array of cell types, packed into 4-bit bytes. +;;; * An array of cell types, each a fixnum. ;;; * An array of cell values, each being a fixnum or a normal Lisp pointer. ;;; ;;; The contents of the value depend on the type of cell.