# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1459345474 0
# Node ID 8a18f9b3bb72dab062f0393aef269f26b60963bf
# Parent  894cac6a43fa50b28f5e08e80507d8be98dd2f2b
Add the code store to the WAM (unused right now)

diff -r 894cac6a43fa -r 8a18f9b3bb72 bones.asd
--- a/bones.asd	Wed Mar 30 00:30:33 2016 +0000
+++ b/bones.asd	Wed Mar 30 13:44:34 2016 +0000
@@ -22,11 +22,13 @@
                 :components ((:file "paip")
                              (:module "wam"
                               :components ((:file "constants")
+                                           (:file "types")
                                            (:file "topological-sort")
                                            (:file "cells")
+                                           (:file "opcodes")
                                            (:file "wam")
                                            (:file "instructions")
-                                           (:file "dump")
-                                           (:file "compile")))
+                                           (:file "compile")
+                                           (:file "dump")))
                              (:file "bones")))))
 
diff -r 894cac6a43fa -r 8a18f9b3bb72 src/wam/constants.lisp
--- a/src/wam/constants.lisp	Wed Mar 30 00:30:33 2016 +0000
+++ b/src/wam/constants.lisp	Wed Mar 30 13:44:34 2016 +0000
@@ -13,11 +13,16 @@
   :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+ (expt 2 +cell-value-width+)
+  ;; We can only address 2^value-bits cells.
+  :documentation "Maximum size of the WAM heap.")
+
 
-(define-constant +heap-limit+ +addressable-values+
-  :documentation "Maximum size of the WAM heap.")
+(define-constant +code-word-size+ 16
+  :documentation "Size (in bits) of each word in the code store.")
+
+(define-constant +code-limit+ (expt 2 +code-word-size+)
+  :documentation "Maximum size of the WAM code store.")
 
 
 (define-constant +tag-null+      #b00
@@ -46,3 +51,8 @@
 (define-constant +maximum-arity+ (1- (expt 2 +functor-arity-width+))
   :documentation "The maximum allowed arity of functors.")
 
+
+(define-constant +opcode-get-structure+ 1)
+(define-constant +opcode-unify-variable+ 2)
+(define-constant +opcode-unify-value+ 3)
+
diff -r 894cac6a43fa -r 8a18f9b3bb72 src/wam/dump.lisp
--- a/src/wam/dump.lisp	Wed Mar 30 00:30:33 2016 +0000
+++ b/src/wam/dump.lisp	Wed Mar 30 13:44:34 2016 +0000
@@ -21,10 +21,10 @@
       (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 "HEAP~%")
     (format t "  +------+-----+--------------+--------------------------------------+~%")
     (format t "  | ADDR | TYP |        VALUE | DEBUG                                |~%")
     (format t "  +------+-----+--------------+--------------------------------------+~%")
@@ -47,6 +47,22 @@
     (values)))
 
 
+(defun instruction-aesthetic (instruction)
+  (format nil "~A~{ ~4,'0X~}"
+          (opcode-short-name (aref instruction 0))
+          (rest (coerce instruction 'list))))
+
+(defun dump-code (wam)
+  (let ((code (wam-code wam)))
+    (format t "CODE~%")
+    (let ((addr 0))
+      (while (< addr (length code))
+        (format t "; ~4,'0X: " addr)
+        (let ((instruction (wam-code-instruction wam addr)))
+          (format t "~A~%" (instruction-aesthetic instruction))
+          (incf addr (length instruction)))))))
+
+
 (defun dump-wam-registers (wam)
   (format t "REGISTERS:~%")
   (format t  "~5@A ->~6@A~%" "S" (wam-s wam))
@@ -70,9 +86,12 @@
   (format t "     MODE: ~A~%" (wam-mode wam))
   (dump-wam-functors wam)
   (format t "HEAP SIZE: ~A~%" (length (wam-heap wam)))
+  (format t "PROGRAM C: ~A~%" (wam-program-counter wam))
   (dump-wam-registers wam)
   (format t "~%")
-  (dump-heap wam from to highlight))
+  (dump-heap wam from to highlight)
+  (format t "~%")
+  (dump-code wam))
 
 (defun dump-wam-full (wam)
   (dump-wam wam 0 (length (wam-heap wam)) -1))
diff -r 894cac6a43fa -r 8a18f9b3bb72 src/wam/opcodes.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/wam/opcodes.lisp	Wed Mar 30 13:44:34 2016 +0000
@@ -0,0 +1,32 @@
+(in-package #:bones.wam)
+
+;;; This file contains some basic helpers for working with opcodes themselves.
+;;; For the actual implementation of the instructions, see instructions.lisp.
+
+
+(defun* instruction-size ((opcode opcode))
+  (:returns (integer 0 4))
+  "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-unify-variable+ 2)
+    (+opcode-unify-value+ 2)))
+
+
+(defun* opcode-name ((opcode opcode))
+  (:returns string)
+  (eswitch (opcode)
+    (+opcode-get-structure+ "GET-STRUCTURE")
+    (+opcode-unify-variable+ "UNIFY-VARIABLE")
+    (+opcode-unify-value+ "UNIFY-VALUE")))
+
+(defun* opcode-short-name ((opcode opcode))
+  (:returns string)
+  (eswitch (opcode)
+    (+opcode-get-structure+ "GETS")
+    (+opcode-unify-variable+ "UVAR")
+    (+opcode-unify-value+ "UVLU")))
diff -r 894cac6a43fa -r 8a18f9b3bb72 src/wam/types.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/wam/types.lisp	Wed Mar 30 13:44:34 2016 +0000
@@ -0,0 +1,34 @@
+(in-package #:bones.wam)
+
+(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+))
+
+
+(deftype code-word ()
+  `(unsigned-byte ,+code-word-size+))
+
+(deftype code-index ()
+  `(integer 0 ,(1- +code-limit+)))
+
+(deftype opcode ()
+  '(integer 0 3))
diff -r 894cac6a43fa -r 8a18f9b3bb72 src/wam/wam.lisp
--- a/src/wam/wam.lisp	Wed Mar 30 00:30:33 2016 +0000
+++ b/src/wam/wam.lisp	Wed Mar 30 13:44:34 2016 +0000
@@ -5,10 +5,19 @@
   ((heap
      :initform (make-array 1024
                            :fill-pointer 0
+                           :adjustable t
                            :initial-element (make-cell-null)
                            :element-type 'heap-cell)
      :reader wam-heap
      :documentation "The actual heap (stack).")
+   (code
+     :initform (make-array 1024
+                           :fill-pointer 0
+                           :adjustable t
+                           :initial-element 0
+                           :element-type 'code-word)
+     :reader wam-code
+     :documentation "The code store.")
    (functors
      :initform (make-array 16
                            :fill-pointer 0
@@ -41,6 +50,11 @@
      :initform nil
      :type (or null heap-index)
      :documentation "The S register (address of next subterm to match).")
+   (program-counter
+     :accessor wam-program-counter
+     :initform 0
+     :type 'code-index
+     :documentation "The Program Counter for the WAM code store.")
    (mode
      :accessor wam-mode
      :initform nil
@@ -53,10 +67,6 @@
 
 
 ;;;; Heap
-;;; The WAM heap is a fixed-length array of cells and a heap pointer.
-;;;
-;;; 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.
@@ -84,6 +94,55 @@
   (setf (aref (wam-heap wam) address) new-value))
 
 
+;;;; Code
+(defun* wam-code-word ((wam wam) (address code-index))
+  (:returns code-word)
+  "Return the word at the given address in the code store."
+  (aref (wam-code wam) address))
+
+(defun (setf wam-code-word) (word wam address)
+  (setf (aref (wam-code wam) address) word))
+
+
+(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))
+
+
+(defun* wam-code-push-word! ((wam wam) (word code-word))
+  "Push the given word into the code store and return its new address."
+  (:returns code-index)
+  (with-slots (code) wam
+    (if (= +code-limit+ (fill-pointer code))
+      (error "WAM code store exhausted.")
+      (vector-push-extend word code))))
+
+(defun* wam-code-push! ((wam wam) (opcode opcode) &rest (arguments code-word))
+  "Push the given instruction into the code store and return its new address.
+
+  The address will be the address of the start of the instruction (i.e. the
+  address of the opcode).
+
+  "
+  (:returns code-index)
+  (assert (= (length arguments)
+             (1- (instruction-size opcode)))
+          (arguments)
+          "Cannot push opcode ~A with ~D arguments ~S, it requires exactly ~D."
+          (opcode-name opcode)
+          (length arguments)
+          arguments
+          (instruction-size opcode))
+  (prog1
+      (wam-code-push-word! wam opcode)
+    (dolist (arg arguments)
+      (wam-code-push-word! wam arg))))
+
+
 ;;;; Registers
 ;;; WAM registers are implemented as an array of a fixed number of registers.
 ;;; A register contains the address of a cell in the heap.