1.1--- a/lisp/lib/skel/core/vm.lisp Mon Aug 12 21:47:02 2024 -0400
1.2+++ b/lisp/lib/skel/core/vm.lisp Mon Aug 12 22:24:31 2024 -0400
1.3@@ -6,28 +6,26 @@
1.4 ;;; Code:
1.5 (in-package :skel/core/vm)
1.6
1.7-(deftype stack-slot-kind () `(member :nop))
1.8+(defvar *skel-op-types*
1.9+ (list :nop :eval :set :get :end :jump :pop :spawn :wait :print :let))
1.10+
1.11+(deftype skel-op-type () `(member ,@*skel-op-types*))
1.12
1.13-(defstruct stack-slot
1.14- (kind :nop :type stack-slot-kind)
1.15- (spec nil :type sxp:form)
1.16- (form nil :type sxp:form))
1.17+(defstruct skel-op
1.18+ (type :nop :type skel-op-type)
1.19+ body)
1.20
1.21-(declaim (inline %make-sk-vm))
1.22-(defstruct (sk-vm (:constructor %make-sk-vm))
1.23- ;; TODO 2023-09-23: consider making this an open closure, call it in
1.24- ;; MAKE-SK-VM.
1.25+(defstruct skel-vm
1.26 (ip (make-stack-slot) :type stack-slot)
1.27 (stack (make-array 0) :type (array stack-slot)))
1.28
1.29-(defun make-sk-vm (size)
1.30- (let ((vm (%make-sk-vm :stack (make-array size :fill-pointer t :initial-element (make-stack-slot)))))
1.31- (with-slots (ip stack) vm
1.32- (setf ip (aref stack 0))
1.33- vm)))
1.34+(defvar *skel-arena-size* (ash 1 16))
1.35+(defvar *skel-arenas* nil)
1.36+
1.37+(defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*))
1.38
1.39-(defmethod sks-ref ((vm sk-vm)) (setf (sk-vm-ip vm) (aref (sk-vm-stack vm) 0)))
1.40+(sb-ext:defglobal *skel-arena* (make-skel-arena))
1.41
1.42-(defmethod sks-pop ((vm sk-vm)) (setf (sk-vm-ip vm) (vector-pop (sk-vm-stack vm))))
1.43-
1.44-(defmethod sks-push ((slot stack-slot) (vm sk-vm)) (vector-push slot (sk-vm-stack vm)))
1.45+;; (defmacro with-skel-arena (arena &body body))
1.46+;; (defmacro with-skel-stack ((stack &key arena) &body body))
1.47+;; (defmacro with-skel-vm ((vm &optional arena) &body body))
