changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: some skel vm work

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))