# HG changeset patch # User Steve Losh # Date 1459538183 0 # Node ID 6dc3f4e034548c41515d04b22fbe187d6e766f53 # Parent ea71bdab6baa2bbd0ebc5fca9fa64f3ced4ebe7b Start working on the bytecode generation diff -r ea71bdab6baa -r 6dc3f4e03454 src/wam/cells.lisp --- a/src/wam/cells.lisp Fri Apr 01 17:24:39 2016 +0000 +++ b/src/wam/cells.lisp Fri Apr 01 19:16:23 2016 +0000 @@ -27,29 +27,6 @@ ;;; symbol lives. Arity is the arity of the functor. -(deftype heap-cell () - `(unsigned-byte ,+cell-width+)) - -(deftype heap-cell-tag () - `(unsigned-byte ,+cell-tag-width+)) - -(deftype heap-cell-value () - `(unsigned-byte ,+cell-value-width+)) - - -(deftype heap-index () - `(integer 0 ,(1- +heap-limit+))) - -(deftype register-index () - `(integer 0 ,(1- +register-count+))) - -(deftype functor-index () - `(integer 0 ,(1- array-total-size-limit))) - -(deftype arity () - `(integer 0 ,+maximum-arity+)) - - (defun* cell-type ((cell heap-cell)) (:returns heap-cell-tag) (logand cell +cell-tag-bitmask+)) diff -r ea71bdab6baa -r 6dc3f4e03454 src/wam/compile.lisp --- a/src/wam/compile.lisp Fri Apr 01 17:24:39 2016 +0000 +++ b/src/wam/compile.lisp Fri Apr 01 19:16:23 2016 +0000 @@ -1,4 +1,5 @@ (in-package #:bones.wam) +(named-readtables:in-readtable :fare-quasiquote) ;;;; Parsing ;;; Turns p(A, q(A, B)) into something like: @@ -278,9 +279,9 @@ arity)) -;;;; Actions -;;; Once we have a tokenized stream we can generate the list of machine -;;; instructions from it. +;;;; Bytecode +;;; Once we have a tokenized stream we can generate the machine instructions +;;; from it. ;;; ;;; We turn: ;;; @@ -295,34 +296,59 @@ ;;; (#'%set-value 1) ;;; (#'%set-value 2) -(defun generate-actions (tokens structure-inst unseen-var-inst seen-var-inst) - "Generate a series of 'machine instructions' from a stream of tokens." +(defun generate-actions (tokens store mode) + "Generate a series of machine instructions from a stream of tokens." (let ((seen (list))) - (flet ((handle-structure (register functor arity) + (flet ((handle-argument (register target) + (if (member target seen) + (vector-push-extend (ecase mode + (:program +opcode-get-value+) + (:query +opcode-put-value+)) + store) + (progn + (push target seen) + (vector-push-extend (ecase mode + (:program +opcode-get-variable+) + (:query +opcode-put-variable+)) + store))) + (vector-push-extend target store) + (vector-push-extend register store)) + (handle-structure (register functor arity) (push register seen) - (list structure-inst functor arity register)) + (vector-push-extend (ecase mode + (:program +opcode-get-structure+) + (:query +opcode-put-structure+)) + store) + (vector-push-extend arity store) ; todo: add functor + (vector-push-extend register store)) (handle-register (register) (if (member register seen) - (list seen-var-inst register) + (progn + (vector-push-extend (ecase mode + (:program +opcode-get-value+) + (:query +opcode-set-value+)) + store) + (vector-push-extend register store)) (progn (push register seen) - (list unseen-var-inst register))))) - (loop :for token :in tokens - :collect (if (consp token) - (apply #'handle-structure token) - (handle-register token)))))) + (vector-push-extend (ecase mode + (:program +opcode-get-variable+) + (:query +opcode-set-variable+)) + store) + (vector-push-extend register store))))) + (loop :for token :in tokens :collect + (match token + (`(:argument ,register ,target) + (handle-argument register target)) + (`(:structure ,register ,functor ,arity) + (handle-structure register functor arity)) + (register (handle-register register))))))) -(defun generate-query-actions (tokens) - (generate-actions tokens - #'%put-structure - #'%set-variable - #'%set-value)) +(defun generate-query-actions (tokens store) + (generate-actions tokens store :query)) -(defun generate-program-actions (tokens) - (generate-actions tokens - #'%get-structure - #'%unify-variable - #'%unify-value)) +(defun generate-program-actions (tokens store) + (generate-actions tokens store :program)) ;;;; UI diff -r ea71bdab6baa -r 6dc3f4e03454 src/wam/constants.lisp --- a/src/wam/constants.lisp Fri Apr 01 17:24:39 2016 +0000 +++ b/src/wam/constants.lisp Fri Apr 01 19:16:23 2016 +0000 @@ -52,7 +52,21 @@ :documentation "The maximum allowed arity of functors.") +;;;; Opcodes +;;; Program (define-constant +opcode-get-structure+ 1) (define-constant +opcode-unify-variable+ 2) (define-constant +opcode-unify-value+ 3) +(define-constant +opcode-get-variable+ 4) +(define-constant +opcode-get-value+ 5) +;;; Query +(define-constant +opcode-put-structure+ 6) +(define-constant +opcode-set-variable+ 7) +(define-constant +opcode-set-value+ 8) +(define-constant +opcode-put-variable+ 9) +(define-constant +opcode-put-value+ 10) + +;;; Control +(define-constant +opcode-call+ 11) +(define-constant +opcode-proceed+ 12) diff -r ea71bdab6baa -r 6dc3f4e03454 src/wam/dump.lisp --- a/src/wam/dump.lisp Fri Apr 01 17:24:39 2016 +0000 +++ b/src/wam/dump.lisp Fri Apr 01 19:16:23 2016 +0000 @@ -52,15 +52,18 @@ (opcode-short-name (aref instruction 0)) (rest (coerce instruction 'list)))) -(defun dump-code (wam &optional (from 0) (to (length (wam-code wam)))) - (format t "CODE~%") +(defun dump-code-store (code-store &optional (from 0) (to (length code-store))) (let ((addr from)) (while (< addr to) (format t "; ~4,'0X: " addr) - (let ((instruction (wam-code-instruction wam addr))) + (let ((instruction (retrieve-instruction code-store addr))) (format t "~A~%" (instruction-aesthetic instruction)) (incf addr (length instruction)))))) +(defun dump-code (wam &optional (from 0) (to (length (wam-code wam)))) + (format t "CODE~%") + (dump-code-store (wam-code wam) from to)) + (defun dump-wam-registers (wam) (format t "REGISTERS:~%") diff -r ea71bdab6baa -r 6dc3f4e03454 src/wam/opcodes.lisp --- a/src/wam/opcodes.lisp Fri Apr 01 17:24:39 2016 +0000 +++ b/src/wam/opcodes.lisp Fri Apr 01 19:16:23 2016 +0000 @@ -5,16 +5,27 @@ (defun* instruction-size ((opcode opcode)) - (:returns (integer 0 4)) + (:returns (integer 0 3)) "Return the size of an instruction for the given opcode. The size includes one word for the opcode itself and one for each argument. " (eswitch (opcode) - (+opcode-get-structure+ 4) + (+opcode-get-structure+ 3) (+opcode-unify-variable+ 2) - (+opcode-unify-value+ 2))) + (+opcode-unify-value+ 2) + (+opcode-get-variable+ 3) + (+opcode-get-value+ 3) + + (+opcode-put-structure+ 3) + (+opcode-set-variable+ 2) + (+opcode-set-value+ 2) + (+opcode-put-variable+ 3) + (+opcode-put-value+ 3) + + (+opcode-call+ 2) + (+opcode-proceed+ 1))) (defun* opcode-name ((opcode opcode)) @@ -22,11 +33,27 @@ (eswitch (opcode) (+opcode-get-structure+ "GET-STRUCTURE") (+opcode-unify-variable+ "UNIFY-VARIABLE") - (+opcode-unify-value+ "UNIFY-VALUE"))) + (+opcode-unify-value+ "UNIFY-VALUE") + (+opcode-get-variable+ "GET-VARIABLE") + (+opcode-get-value+ "GET-VALUE") + + (+opcode-put-structure+ "PUT-STRUCTURE") + (+opcode-set-variable+ "SET-VARIABLE") + (+opcode-set-value+ "SET-VALUE") + (+opcode-put-variable+ "PUT-VARIABLE") + (+opcode-put-value+ "PUT-VALUE"))) (defun* opcode-short-name ((opcode opcode)) (:returns string) (eswitch (opcode) (+opcode-get-structure+ "GETS") (+opcode-unify-variable+ "UVAR") - (+opcode-unify-value+ "UVLU"))) + (+opcode-unify-value+ "UVLU") + (+opcode-get-variable+ "GVAR") + (+opcode-get-value+ "GVLU") + + (+opcode-put-structure+ "PUTS") + (+opcode-set-variable+ "SVAR") + (+opcode-set-value+ "SVLU") + (+opcode-put-variable+ "PVAR") + (+opcode-put-value+ "PVLU"))) diff -r ea71bdab6baa -r 6dc3f4e03454 src/wam/types.lisp --- a/src/wam/types.lisp Fri Apr 01 17:24:39 2016 +0000 +++ b/src/wam/types.lisp Fri Apr 01 19:16:23 2016 +0000 @@ -31,4 +31,4 @@ `(integer 0 ,(1- +code-limit+))) (deftype opcode () - '(integer 0 3)) + '(integer 0 12)) diff -r ea71bdab6baa -r 6dc3f4e03454 src/wam/wam.lisp --- a/src/wam/wam.lisp Fri Apr 01 17:24:39 2016 +0000 +++ b/src/wam/wam.lisp Fri Apr 01 19:16:23 2016 +0000 @@ -95,6 +95,15 @@ ;;;; Code +(defun* retrieve-instruction (code-store (address code-index)) + "Return the full instruction at the given address in the code store." + (make-array (instruction-size (aref code-store address)) + :displaced-to code-store + :displaced-index-offset address + :adjustable nil + :element-type 'code-word)) + + (defun* wam-code-word ((wam wam) (address code-index)) (:returns code-word) "Return the word at the given address in the code store." @@ -106,11 +115,7 @@ (defun* wam-code-instruction ((wam wam) (address code-index)) "Return the full instruction at the given address in the code store." - (make-array (instruction-size (wam-code-word wam address)) - :displaced-to (wam-code wam) - :displaced-index-offset address - :adjustable nil - :element-type 'code-word)) + (retrieve-instruction (wam-code wam) address)) (defun* wam-code-push-word! ((wam wam) (word code-word))