Add code labels and implement the new program instructions
author |
Steve Losh <steve@stevelosh.com> |
date |
Sun, 10 Apr 2016 17:43:04 +0000 |
parents |
564c709801aa
|
children |
99abd362620a
|
branches/tags |
(none) |
files |
src/wam/compile.lisp src/wam/dump.lisp src/wam/instructions.lisp src/wam/wam.lisp |
Changes
--- a/src/wam/compile.lisp Sun Apr 10 16:02:54 2016 +0000
+++ b/src/wam/compile.lisp Sun Apr 10 17:43:04 2016 +0000
@@ -346,8 +346,7 @@
(handle-argument register target))
(`(:structure ,register ,functor ,arity)
(handle-structure register functor arity))
- (register (handle-register register)))
- ))))
+ (register (handle-register register)))))))
(defun compile-query-tokens (wam tokens functor arity store)
(compile-tokens wam tokens store :query)
@@ -356,7 +355,9 @@
(wam-ensure-functor-index wam (cons functor arity))))
(defun compile-program-tokens (wam tokens functor arity store)
- ; todo: add functor/arity into labels
+ ; todo: make this less ugly
+ (setf (wam-code-label wam (wam-ensure-functor-index wam (cons functor arity)))
+ (fill-pointer (wam-code wam)))
(compile-tokens wam tokens store :program)
(vector-push-extend +opcode-proceed+ store))
--- a/src/wam/dump.lisp Sun Apr 10 16:02:54 2016 +0000
+++ b/src/wam/dump.lisp Sun Apr 10 17:43:04 2016 +0000
@@ -161,6 +161,15 @@
(defun dump-wam-functors (wam)
(format t " FUNCTORS: ~S~%" (wam-functors wam)))
+(defun dump-labels (wam)
+ (format t "LABELS:~%~{ ~A -> ~4,'0X~^~%~}~%"
+ (loop :for functor-index
+ :being :the :hash-keys :of (wam-code-labels wam)
+ :using (hash-value address)
+ :nconc (list (pretty-functor functor-index
+ (wam-functors wam))
+ address))))
+
(defun dump-wam (wam from to highlight)
(format t " FAIL: ~A~%" (wam-fail wam))
@@ -172,6 +181,7 @@
(format t "~%")
(dump-heap wam from to highlight)
(format t "~%")
+ (dump-labels wam)
(dump-code wam))
(defun dump-wam-full (wam)
--- a/src/wam/instructions.lisp Sun Apr 10 16:02:54 2016 +0000
+++ b/src/wam/instructions.lisp Sun Apr 10 17:43:04 2016 +0000
@@ -67,7 +67,6 @@
(deref wam (cell-value (wam-heap-cell wam address)))
address))
-
(defun* bind! ((wam wam) (address-1 heap-index) (address-2 heap-index))
(:returns :void)
"Bind the unbound reference cell to the other.
@@ -90,7 +89,6 @@
(t (error "At least one cell must be an unbound reference when binding.")))
(values))
-
(defun* fail! ((wam wam) (reason string))
(:returns :void)
"Mark a failure in the WAM."
@@ -159,16 +157,20 @@
(defun* %put-variable ((wam wam)
(register register-index)
(argument register-index))
+ (:returns :void)
(->> (push-unbound-reference! wam)
(nth-value 1)
(setf (wam-register wam register))
- (setf (wam-register wam argument))))
+ (setf (wam-register wam argument)))
+ (values))
(defun* %put-value ((wam wam)
(register register-index)
(argument register-index))
- (setf (wam-register wam register)
- (wam-register wam argument)))
+ (:returns :void)
+ (setf (wam-register wam argument)
+ (wam-register wam register))
+ (values))
;;;; Program Instructions
@@ -231,8 +233,9 @@
(ecase (wam-mode wam)
(:read (setf (wam-register wam register)
(wam-s wam)))
- (:write (setf (wam-register wam register)
- (nth-value 1 (push-unbound-reference! wam)))))
+ (:write (->> (push-unbound-reference! wam)
+ (nth-value 1)
+ (setf (wam-register wam register)))))
(incf (wam-s wam))
(values))
@@ -240,12 +243,29 @@
(:returns :void)
(ecase (wam-mode wam)
(:read (unify! wam
- (cell-value (wam-register wam register))
+ (wam-register wam register)
(wam-s wam)))
- (:write (wam-heap-push! wam (wam-register wam register))))
+ (:write (wam-heap-push! wam (wam-register-cell wam register))))
(incf (wam-s wam))
(values))
+(defun* %get-variable ((wam wam)
+ (register register-index)
+ (argument register-index))
+ (:returns :void)
+ (setf (wam-register wam register)
+ (wam-register wam argument))
+ (values))
+
+(defun* %get-value ((wam wam)
+ (register register-index)
+ (argument register-index))
+ (:returns :void)
+ (unify! wam
+ (wam-register wam register)
+ (wam-register wam argument))
+ (values))
+
;;;; Running
(defmacro instruction-call (wam instruction code-store pc number-of-arguments)
@@ -284,3 +304,4 @@
(error "Fell off the end of the query code store!")))))
(values))
+
--- a/src/wam/wam.lisp Sun Apr 10 16:02:54 2016 +0000
+++ b/src/wam/wam.lisp Sun Apr 10 17:43:04 2016 +0000
@@ -22,9 +22,13 @@
:initform (make-array 64
:fill-pointer 0
:adjustable t
- :element-type 'functors)
+ :element-type 'functor)
:accessor wam-functors
:documentation "The array of functors in this WAM.")
+ (code-labels
+ :initform (make-hash-table)
+ :accessor wam-code-labels
+ :documentation "The mapping of functor indices -> code store addresses.")
(registers
:reader wam-registers
:initform (make-array +register-count+
@@ -148,6 +152,15 @@
(wam-code-push-word! wam arg))))
+(defun* wam-code-label ((wam wam)
+ (functor functor-index))
+ (:returns code-index)
+ (gethash functor (wam-code-labels wam)))
+
+(defun (setf wam-code-label) (new-value wam functor)
+ (setf (gethash functor (wam-code-labels wam)) new-value))
+
+
;;;; 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.