# HG changeset patch # User Steve Losh # Date 1460752115 0 # Node ID 1dd07907df493ada2145a1715dfe219e2a6810fe # Parent fa262e6111e915091c2e1a7726cce8bc80b3833b Implement the stack, register designators, and track permanent vars Still need to implement the machine code changes to handle permanent vars, as well as the allocation instructions. diff -r fa262e6111e9 -r 1dd07907df49 bones.asd --- a/bones.asd Thu Apr 14 17:16:20 2016 +0000 +++ b/bones.asd Fri Apr 15 20:28:35 2016 +0000 @@ -26,7 +26,7 @@ (:file "types") (:file "topological-sort") (:file "cells") - (:file "opcodes") + (:file "bytecode") (:file "wam") (:file "compile") (:file "instructions") diff -r fa262e6111e9 -r 1dd07907df49 src/wam/bytecode.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/wam/bytecode.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -0,0 +1,110 @@ +(in-package #:bones.wam) + +;;;; Opcodes +(defun* instruction-size ((opcode opcode)) + (: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+ 3) + (+opcode-unify-variable+ 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)) + (:returns string) + (eswitch (opcode) + (+opcode-get-structure+ "GET-STRUCTURE") + (+opcode-unify-variable+ "UNIFY-VARIABLE") + (+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") + + (+opcode-call+ "CALL") + (+opcode-proceed+ "PROCEED"))) + +(defun* opcode-short-name ((opcode opcode)) + (:returns string) + (eswitch (opcode) + (+opcode-get-structure+ "GETS") + (+opcode-unify-variable+ "UVAR") + (+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") + + (+opcode-call+ "CALL") + (+opcode-proceed+ "PROC"))) + + +;;;; Register Designators +;;; A register designator is a number that specifies a particular register. +;;; +;;; The register might be a local register (A_n or X_n in WAMspeak) for holding +;;; temporary things or a stack register (Y_n) for holding permanent variables. +;;; +;;; Internally register designators are implemented as a bitmasked value/tag: +;;; +;;; value tag bit +;;; rrrrrrrrrrrrrrrT +;;; +;;; But you should probably just use this interface to interact with them. + +(defun* register-designator-tag ((register-designator register-designator)) + (:returns register-designator-tag) + (logand register-designator +register-designator-tag-bitmask+)) + +(defun* register-designator-value ((register-designator register-designator)) + (:returns register-index) + (ash register-designator -1)) + + +(defun* register-designator-local-p ((register-designator register-designator)) + (:returns boolean) + (= +tag-local-register+ + (register-designator-tag register-designator))) + +(defun* register-designator-stack-p ((register-designator register-designator)) + (:returns boolean) + (= +tag-stack-register+ + (register-designator-tag register-designator))) + + +(defun* make-register-designator ((register register-index) + (tag register-designator-tag)) + (:returns register-designator) + (logior (ash register 1) + tag)) + +(defun* make-local-register-designator ((register register-index)) + (:returns register-designator) + (make-register-designator register +tag-local-register+)) + +(defun* make-stack-register-designator ((register register-index)) + (:returns register-designator) + (make-register-designator register +tag-stack-register+)) diff -r fa262e6111e9 -r 1dd07907df49 src/wam/cells.lisp --- a/src/wam/cells.lisp Thu Apr 14 17:16:20 2016 +0000 +++ b/src/wam/cells.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -67,7 +67,7 @@ (+tag-structure+ (format nil " ~D" (cell-value cell))) (+tag-functor+ - (format nil " functor ~D" + (format nil " ~D" (cell-functor-index cell))) (+tag-reference+ (format nil " ~D" (cell-value cell)))))) diff -r fa262e6111e9 -r 1dd07907df49 src/wam/compile.lisp --- a/src/wam/compile.lisp Thu Apr 14 17:16:20 2016 +0000 +++ b/src/wam/compile.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -71,7 +71,7 @@ (defun* pprint-assignments ((assignments register-assignment-list)) (format t "~{~A~%~}" (loop :for (register . contents) :in assignments :collect - (format nil "~A <- ~A" (register-to-string register) contents)))) + (format nil "~A <- ~S" (register-to-string register) contents)))) (defun* find-assignment ((register register) (assignments register-assignment-list)) @@ -143,7 +143,7 @@ ;;; A1 -> q(A1, X3) ;;; X2 -> B -(defun parse-term (term) +(defun parse-term (term permanent-variables) "Parse a term into a series of register assignments. Returns: @@ -168,30 +168,44 @@ (arity (length arguments)) ;; Preallocate enough registers for all of the arguments. ;; We'll fill them in later. - (registers (make-array 64 - :fill-pointer arity - :adjustable t - :initial-element nil))) + (local-registers (make-array 64 + :fill-pointer arity + :adjustable t + :initial-element nil)) + (stack-registers (make-array 64 + :fill-pointer 0 + :adjustable t + :initial-element nil))) (labels ((make-temporary-register (number) (make-register (if (< number arity) :argument :local) number)) + (make-permanent-register (number) + (make-register :permanent number)) (find-variable (var) - (let ((r (position var registers))) - (when r - (make-temporary-register r)))) + (let ((r (position var local-registers)) + (s (position var stack-registers))) + (cond + (r (make-temporary-register r)) + (s (make-permanent-register s)) + (t nil)))) + (store-variable (var) + (if (member var permanent-variables) + (make-permanent-register (vector-push-extend var stack-registers)) + (make-temporary-register (vector-push-extend var local-registers)))) (parse-variable (var) ;; If we've already seen this variable just return the register it's ;; in, otherwise allocate a register for it and return that. (or (find-variable var) - (make-temporary-register (vector-push-extend var registers)))) + (store-variable var))) (parse-structure (structure reg) (destructuring-bind (functor . arguments) structure ;; If we've been given a register to hold this structure (i.e. ;; we're parsing a top-level argument) use it. Otherwise allocate - ;; a fresh one. - (let ((reg (or reg (vector-push-extend nil registers)))) - (setf (aref registers reg) + ;; a fresh one. Note that structures always live in local + ;; registers, never permanent ones. + (let ((reg (or reg (vector-push-extend nil local-registers)))) + (setf (aref local-registers reg) (cons functor (mapcar #'parse arguments))) (make-temporary-register reg)))) (parse (term &optional register) @@ -199,20 +213,24 @@ ((variable-p term) (parse-variable term)) ((symbolp term) (parse (list term) register)) ; f -> f/0 ((listp term) (parse-structure term register)) - (t (error "Cannot parse term ~S." term))))) + (t (error "Cannot parse term ~S." term)))) + (make-assignment-list (registers register-maker) + (loop :for i :from 0 + :for contents :across registers + :collect + (cons (funcall register-maker i) + contents)))) ;; Arguments are handled specially. We parse the children as normal, ;; and then fill in the argument registers after each child. (loop :for argument :in arguments :for i :from 0 :for parsed = (parse argument i) ;; If the argument didn't fill itself in (structure), do it. - :when (not (aref registers i)) - :do (setf (aref registers i) parsed)) - (values (loop :for i :from 0 ; turn the register array into an assignment list - :for contents :across registers - :collect - (cons (make-temporary-register i) - contents)) + :when (not (aref local-registers i)) + :do (setf (aref local-registers i) parsed)) + (values (append + (make-assignment-list local-registers #'make-temporary-register) + (make-assignment-list stack-registers #'make-permanent-register)) predicate arity)))) @@ -322,7 +340,7 @@ (defun tokenize-term (term permanent-variables flattener) (multiple-value-bind (assignments functor arity) - (parse-term term) + (parse-term term permanent-variables) (values (->> assignments (funcall flattener) tokenize-assignments) diff -r fa262e6111e9 -r 1dd07907df49 src/wam/constants.lisp --- a/src/wam/constants.lisp Thu Apr 14 17:16:20 2016 +0000 +++ b/src/wam/constants.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -18,6 +18,19 @@ :documentation "Maximum size of the WAM heap.") +(define-constant +stack-word-size+ 16 + :documentation "Size (in bits) of each word in WAM stack.") + +(define-constant +stack-limit+ (expt 2 +stack-word-size+) + ;; We can only address 2^value-bits cells, and since stack address are + ;; themselves stored on the stack (e.g. the environment continuation pointer) + ;; they can only reference so much memory. + ;; + ;; todo: we might want to limit this further to prevent the stack from growing + ;; too large. + :documentation "Maximum size of the WAM stack.") + + (define-constant +code-word-size+ 16 :documentation "Size (in bits) of each word in the code store.") @@ -60,6 +73,16 @@ "The maximum size (in bytes of bytecode) a query may compile to.") +(define-constant +tag-local-register+ #b0 + :documentation "A local register (X_n or A_n).") + +(define-constant +tag-stack-register+ #b1 + :documentation "A stack register (Y_n).") + +(define-constant +register-designator-tag-bitmask+ #b1 + :documentation "Bitmask for the type tag of a register designator.") + + ;;;; Opcodes ;;; Program (define-constant +opcode-get-structure+ 1) diff -r fa262e6111e9 -r 1dd07907df49 src/wam/dump.lisp --- a/src/wam/dump.lisp Thu Apr 14 17:16:20 2016 +0000 +++ b/src/wam/dump.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -16,9 +16,9 @@ (+tag-reference+ (if (= addr (cell-value cell)) "unbound variable " - (format nil "var pointer to ~D " (cell-value cell)))) + (format nil "var pointer to ~4,'0X " (cell-value cell)))) (+tag-structure+ - (format nil "structure pointer to ~D " (cell-value cell))) + (format nil "structure pointer to ~4,'0X " (cell-value cell))) (+tag-functor+ (destructuring-bind (functor . arity) (wam-functor-lookup wam (cell-functor-index cell)) @@ -30,14 +30,14 @@ ;; This code is awful, sorry. (let ((heap (wam-heap wam))) (format t "HEAP~%") - (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 indent) (let ((hi (= i highlight))) - (format t "~A ~4@A | ~A | ~12@A | ~36A ~A~%" + (format t "~A ~4,'0X | ~A | ~8,'0X | ~36A ~A~%" (if hi "==>" " |") i (cell-type-short-name cell) @@ -55,11 +55,50 @@ (when (not (zerop indent)) (decf indent)))))) (when (< to (length heap)) - (format t " | ⋮ | ⋮ | ⋮ | |~%")) - (format t " +------+-----+--------------+--------------------------------------+~%") + (format t " | ⋮ | ⋮ | ⋮ | |~%")) + (format t " +------+-----+----------+--------------------------------------+~%") (values))) +(defun dump-stack (wam &optional (e (wam-environment-pointer wam))) + (format t "STACK~%") + (format t " +------+----------+-------------------------------+~%") + (format t " | ADDR | VALUE | |~%") + (format t " +------+----------+-------------------------------+~%") + (loop :with n = nil + :with arg = 0 + :for offset = 0 :then (1+ offset) + :for cell :across (wam-stack wam) + :for addr :from 0 :do + (format t " | ~4,'0X | ~8,'0X | ~30A|~A~A~%" + addr + cell + (cond + ((= offset 0) "CE ===========================") + ((= offset 1) "CP") + ((= offset 2) + (if (zerop cell) + (progn + (setf offset -1) + "N: EMPTY") + (progn + (setf n cell) + (format nil "N: ~D" cell)))) + ((< arg n) + (prog1 + (format nil " Y~D: ~4,'0X" + arg + ;; look up the actual cell in the heap + (cell-aesthetic (wam-heap-cell wam cell))) + (when (= n (incf arg)) + (setf offset -1 + n nil + arg 0))))) + (if (= addr (wam-environment-pointer wam)) " <- E" "") + (if (= addr e) " <- FRAME" ""))) + (format t " +------+----------+-------------------------------+~%")) + + (defun pretty-functor (functor-index functor-list) (when functor-list (destructuring-bind (symbol . arity) @@ -169,15 +208,12 @@ :for reg :across (wam-registers wam) :for contents = (when (not (= reg (1- +heap-limit+))) (wam-register-cell wam i)) - :do (format t "~5@A ->~6@A ~A ~A~%" + :when contents + :do (format t "~5@A ->~6@A ~10A ~A~%" (format nil "X~D" i) reg - (if contents - (cell-aesthetic contents) - "unset") - (if contents - (format nil "; ~A" (extract-thing wam reg)) - "")))) + (cell-aesthetic contents) + (format nil "; ~A" (extract-thing wam reg))))) (defun dump-wam-functors (wam) (format t " FUNCTORS: ~S~%" (wam-functors wam))) @@ -194,14 +230,18 @@ (defun dump-wam (wam from to highlight) (format t " FAIL: ~A~%" (wam-fail wam)) - (format t " MODE: ~A~%" (wam-mode wam)) + (format t " MODE: ~S~%" (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)) + (format t "CONT PTR: ~A~%" (wam-continuation-pointer wam)) + (format t "ENVIR PTR: ~A~%" (wam-environment-pointer wam)) (dump-wam-registers wam) (format t "~%") (dump-heap wam from to highlight) (format t "~%") + (dump-stack wam) + (format t "~%") (dump-labels wam) (dump-code wam)) diff -r fa262e6111e9 -r 1dd07907df49 src/wam/instructions.lisp --- a/src/wam/instructions.lisp Thu Apr 14 17:16:20 2016 +0000 +++ b/src/wam/instructions.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -276,7 +276,7 @@ (setf (wam-continuation-pointer wam) ; CP <- next instruction (+ (wam-program-counter wam) (instruction-size +opcode-call+)) - (wam-program-counter wam) ; PC <- target + (wam-program-counter wam) ; PC <- target target)) (fail! wam "Tried to call unknown procedure."))) (values)) diff -r fa262e6111e9 -r 1dd07907df49 src/wam/opcodes.lisp --- a/src/wam/opcodes.lisp Thu Apr 14 17:16:20 2016 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,65 +0,0 @@ -(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 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+ 3) - (+opcode-unify-variable+ 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)) - (:returns string) - (eswitch (opcode) - (+opcode-get-structure+ "GET-STRUCTURE") - (+opcode-unify-variable+ "UNIFY-VARIABLE") - (+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") - - (+opcode-call+ "CALL") - (+opcode-proceed+ "PROCEED"))) - -(defun* opcode-short-name ((opcode opcode)) - (:returns string) - (eswitch (opcode) - (+opcode-get-structure+ "GETS") - (+opcode-unify-variable+ "UVAR") - (+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") - - (+opcode-call+ "CALL") - (+opcode-proceed+ "PROC"))) diff -r fa262e6111e9 -r 1dd07907df49 src/wam/types.lisp --- a/src/wam/types.lisp Thu Apr 14 17:16:20 2016 +0000 +++ b/src/wam/types.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -13,6 +13,9 @@ (deftype heap-index () `(integer 0 ,(1- +heap-limit+))) +(deftype stack-index () + `(integer 0 ,(1- +stack-limit+))) + (deftype register-index () `(integer 0 ,(1- +register-count+))) @@ -34,5 +37,32 @@ ; either an address or the sentinal `(integer 0 ,(1- +code-limit+))) + (deftype opcode () '(integer 0 12)) + + +(deftype register-designator () + 'code-word) + +(deftype register-designator-tag () + `(member + ,+tag-stack-register+ + ,+tag-local-register+)) + + +(deftype stack-frame-size () + `(integer 0 ,+register-count+)) + +(deftype continuation-pointer () + 'code-index) + +(deftype environment-pointer () + 'stack-index) + +(deftype stack-cell () + '(or + environment-pointer ; CE + continuation-pointer ; CP + stack-frame-size ; N + heap-index)) ; YN diff -r fa262e6111e9 -r 1dd07907df49 src/wam/wam.lisp --- a/src/wam/wam.lisp Thu Apr 14 17:16:20 2016 +0000 +++ b/src/wam/wam.lisp Fri Apr 15 20:28:35 2016 +0000 @@ -34,9 +34,21 @@ :initform (make-array +register-count+ ;; Initialize to the last element in the heap for ;; debugging purposes. + ;; todo: don't do this :initial-element (1- +heap-limit+) :element-type 'heap-index) :documentation "An array of the X_i registers.") + (stack + :reader wam-stack + :initform (make-array 1024 + :adjustable t + :fill-pointer 0 + ;; Initialize to the last element in the heap for + ;; debugging purposes. + ;; todo: don't do this + :initial-element (1- +heap-limit+) + :element-type 'stack-cell) + :documentation "The local stack for storing stack frames.") (fail :accessor wam-fail :initform nil @@ -64,6 +76,11 @@ :initform 0 :type code-index :documentation "The Continuation Pointer into the WAM code store.") + (environment-pointer + :accessor wam-environment-pointer + :initform 0 + :type stack-index + :documentation "The Environment Pointer into the WAM stack.") (mode :accessor wam-mode :initform nil @@ -103,9 +120,101 @@ (setf (aref (wam-heap wam) address) new-value)) +;;;; Stack +;;; Stack frames are laid out like so: +;;; +;;; |PREV| +;;; | CE | <-- environment-pointer +;;; | CP | +;;; | N | +;;; | Y0 | +;;; | .. | +;;; | YN | +;;; |NEXT| <-- fill-pointer + +(defun* wam-stack-pointer ((wam wam)) + (:returns stack-index) + "Return the current stack pointer of the WAM." + (fill-pointer (wam-stack wam))) + + +(defun* wam-stack-cell ((wam wam) (address stack-index)) + (:returns stack-index) + "Return the stack cell at the given address." + (aref (wam-stack wam) address)) + +(defun (setf wam-stack-cell) (new-value wam address) + (setf (aref (wam-stack wam) address) new-value)) + + +(defun* wam-stack-frame-ce ((wam wam) + &optional + ((e environment-pointer) (wam-environment-pointer wam))) + (:returns environment-pointer) + (wam-stack-cell wam e)) + +(defun* wam-stack-frame-cp ((wam wam) + &optional + ((e environment-pointer) (wam-environment-pointer wam))) + (:returns continuation-pointer) + (wam-stack-cell wam (1+ e))) + +(defun* wam-stack-frame-n ((wam wam) + &optional + ((e environment-pointer) (wam-environment-pointer wam))) + (:returns register-index) + (wam-stack-cell wam (+ 2 e))) + +(defun* wam-stack-frame-arg ((wam wam) + (n register-index) + &optional + ((e environment-pointer) (wam-environment-pointer wam))) + (:returns heap-index) + (wam-stack-cell wam (+ 3 n e))) + +(defun* wam-stack-frame-arg-cell ((wam wam) + (n register-index) + &optional + ((e environment-pointer) (wam-environment-pointer wam))) + (:returns heap-cell) + (wam-heap-cell wam (wam-stack-frame-arg wam n e))) + + +(defun* wam-stack-frame-size ((wam wam) + &optional + ((e environment-pointer) (wam-environment-pointer wam))) + (:returns (integer 3 1024)) ; TODO: Type this better + "Return the size of the stack frame starting at environment pointer `e`." + (+ (wam-stack-frame-n wam e) 3)) + + +(defun* wam-stack-push! ((wam wam) (cell stack-cell)) + (:returns (values stack-cell stack-index)) + "Push the cell onto the WAM stack and increment the stack pointer. + + Returns the cell and the address it was pushed to. + + " + (with-slots (stack) wam + (if (= +stack-limit+ (fill-pointer stack)) + (error "WAM stack exhausted.") + (values cell (vector-push-extend cell stack))))) + +(defun* wam-stack-pop-environment! ((wam wam)) + "Pop an environment (stack frame) off the WAM stack." + (let ((frame-size (wam-stack-frame-size wam))) + (with-slots (stack environment-pointer) wam + (decf environment-pointer frame-size) + (decf (fill-pointer stack) frame-size)))) + + +;;;; Resetting (defun* wam-truncate-heap! ((wam wam)) (setf (fill-pointer (wam-heap wam)) 0)) +(defun* wam-truncate-stack! ((wam wam)) + (setf (fill-pointer (wam-stack wam)) 0)) + (defun* wam-reset-registers! ((wam wam)) (loop :for i :from 0 :below +register-count+ :do (setf (wam-register wam i) @@ -114,6 +223,7 @@ (defun* wam-reset! ((wam wam)) (wam-truncate-heap! wam) + (wam-truncate-stack! wam) (wam-reset-registers! wam) (setf (wam-program-counter wam) 0) (setf (wam-continuation-pointer wam) 0) @@ -188,8 +298,8 @@ ;;; A register contains the address of a cell in the heap. (defun* wam-register ((wam wam) (register register-index)) - (:returns heap-cell) - "Return the WAM register with the given index." + (:returns heap-index) + "Return the value of the WAM register with the given index." (aref (wam-registers wam) register)) (defun (setf wam-register) (new-value wam register)