changeset 592: |
1d6e3bbdaebb |
parent 591: |
f9279a1f2347 |
child 593: |
7046f3bdb668 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Mon, 12 Aug 2024 22:24:31 -0400 |
files: |
lisp/lib/skel/core/pkg.lisp lisp/lib/skel/core/vm.lisp |
description: |
some skel vm work |
1.1--- a/lisp/lib/skel/core/pkg.lisp Mon Aug 12 21:47:02 2024 -0400
1.2+++ b/lisp/lib/skel/core/pkg.lisp Mon Aug 12 22:24:31 2024 -0400
1.3@@ -106,7 +106,21 @@
1.4
1.5 (defpackage :skel/core/vm
1.6 (:use :cl :std :skel/core/err)
1.7- (:export :make-stack-slot :make-sk-vm :sks-ref :sks-pop :sks-push))
1.8+ (:export :make-stack-slot :make-sk-vm :sks-ref :sks-pop :sks-push
1.9+ :skel-vm
1.10+ :make-skel-vm
1.11+ :skel-vm-p
1.12+ :copy-skel-vm
1.13+ :skel-vm-ip
1.14+ :skel-vm-stack
1.15+ :*stack-slot-types*
1.16+ :stack-slot-type
1.17+ :stack-slot
1.18+ :*stack-op-types*
1.19+ :stack-op-type
1.20+ :*skel-op-types*
1.21+ :skel-op-type
1.22+ :new-skel-arena))
1.23
1.24 (defpackage :skel/core/print
1.25 (:use :cl :std :skel/core/err :skel/core/obj :skel/core/types :skel/core/proto :skel/core/vars)
2.1--- a/lisp/lib/skel/core/vm.lisp Mon Aug 12 21:47:02 2024 -0400
2.2+++ b/lisp/lib/skel/core/vm.lisp Mon Aug 12 22:24:31 2024 -0400
2.3@@ -6,28 +6,26 @@
2.4 ;;; Code:
2.5 (in-package :skel/core/vm)
2.6
2.7-(deftype stack-slot-kind () `(member :nop))
2.8+(defvar *skel-op-types*
2.9+ (list :nop :eval :set :get :end :jump :pop :spawn :wait :print :let))
2.10+
2.11+(deftype skel-op-type () `(member ,@*skel-op-types*))
2.12
2.13-(defstruct stack-slot
2.14- (kind :nop :type stack-slot-kind)
2.15- (spec nil :type sxp:form)
2.16- (form nil :type sxp:form))
2.17+(defstruct skel-op
2.18+ (type :nop :type skel-op-type)
2.19+ body)
2.20
2.21-(declaim (inline %make-sk-vm))
2.22-(defstruct (sk-vm (:constructor %make-sk-vm))
2.23- ;; TODO 2023-09-23: consider making this an open closure, call it in
2.24- ;; MAKE-SK-VM.
2.25+(defstruct skel-vm
2.26 (ip (make-stack-slot) :type stack-slot)
2.27 (stack (make-array 0) :type (array stack-slot)))
2.28
2.29-(defun make-sk-vm (size)
2.30- (let ((vm (%make-sk-vm :stack (make-array size :fill-pointer t :initial-element (make-stack-slot)))))
2.31- (with-slots (ip stack) vm
2.32- (setf ip (aref stack 0))
2.33- vm)))
2.34+(defvar *skel-arena-size* (ash 1 16))
2.35+(defvar *skel-arenas* nil)
2.36+
2.37+(defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*))
2.38
2.39-(defmethod sks-ref ((vm sk-vm)) (setf (sk-vm-ip vm) (aref (sk-vm-stack vm) 0)))
2.40+(sb-ext:defglobal *skel-arena* (make-skel-arena))
2.41
2.42-(defmethod sks-pop ((vm sk-vm)) (setf (sk-vm-ip vm) (vector-pop (sk-vm-stack vm))))
2.43-
2.44-(defmethod sks-push ((slot stack-slot) (vm sk-vm)) (vector-push slot (sk-vm-stack vm)))
2.45+;; (defmacro with-skel-arena (arena &body body))
2.46+;; (defmacro with-skel-stack ((stack &key arena) &body body))
2.47+;; (defmacro with-skel-vm ((vm &optional arena) &body body))