changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: skel-vm

changeset 593: 7046f3bdb668
parent 592: 1d6e3bbdaebb
child 594: 5bd0eb9fa1fa
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 13 Aug 2024 22:05:23 -0400
files: lisp/lib/cli/tools/tmux.lisp lisp/lib/skel/core/pkg.lisp lisp/lib/skel/core/vm.lisp
description: skel-vm
     1.1--- a/lisp/lib/cli/tools/tmux.lisp	Mon Aug 12 22:24:31 2024 -0400
     1.2+++ b/lisp/lib/cli/tools/tmux.lisp	Tue Aug 13 22:05:23 2024 -0400
     1.3@@ -137,6 +137,8 @@
     1.4 (defun format-tmux-string (dst fmt &rest args)
     1.5   (apply #'format dst fmt (mapcar (lambda (a) (format nil "#{~A}" a)) args)))
     1.6 
     1.7+(defvar *tmux-var-table* (make-hash-table))
     1.8+
     1.9 (defmacro tmux-format (dst fmt &rest args)
    1.10   "Format a tmux string, replacing symbols in ARGS that match a member of
    1.11 *TMUX-VARIABLES* with their corresponding lower-case name."
     2.1--- a/lisp/lib/skel/core/pkg.lisp	Mon Aug 12 22:24:31 2024 -0400
     2.2+++ b/lisp/lib/skel/core/pkg.lisp	Tue Aug 13 22:05:23 2024 -0400
     2.3@@ -120,7 +120,23 @@
     2.4            :stack-op-type
     2.5            :*skel-op-types*
     2.6            :skel-op-type
     2.7-           :new-skel-arena))
     2.8+           :new-skel-arena
     2.9+           :with-skel-vm
    2.10+           :with-skel-scope
    2.11+           :skel-op
    2.12+           :make-skel-op
    2.13+           :skel-op-p
    2.14+           :copy-skel-op
    2.15+           :skel-op-scope
    2.16+           :skel-op-body
    2.17+           :*skel-stack-size*
    2.18+           :*skel-arena*
    2.19+           :*skel-scope*
    2.20+           :init-skel-op-scope
    2.21+           :*skel-arena-size*
    2.22+           :init-skel-scope
    2.23+           :init-skel-value-scope
    2.24+           :init-skel-function-scope))
    2.25 
    2.26 (defpackage :skel/core/print
    2.27   (:use :cl :std :skel/core/err :skel/core/obj :skel/core/types :skel/core/proto :skel/core/vars)
     3.1--- a/lisp/lib/skel/core/vm.lisp	Mon Aug 12 22:24:31 2024 -0400
     3.2+++ b/lisp/lib/skel/core/vm.lisp	Tue Aug 13 22:05:23 2024 -0400
     3.3@@ -6,26 +6,64 @@
     3.4 ;;; Code:
     3.5 (in-package :skel/core/vm)
     3.6 
     3.7-(defvar *skel-op-types*
     3.8-  (list :nop :eval :set :get :end :jump :pop :spawn :wait :print :let))
     3.9+(eval-always
    3.10+  (defvar *skel-op-types*
    3.11+    (vector :nil :eval :set :get :end :jump :pop :spawn :wait :print :let))
    3.12+  (defvar *skel-arena-size* (ash 1 16))
    3.13+  (defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*))
    3.14+  (defun init-skel-scope (&optional (map (sb-lockless:make-so-map/fixnum)))
    3.15+    (sb-lockless:so-insert map 0)
    3.16+    (sb-lockless:so-insert map 1)
    3.17+    (sb-lockless:so-insert map 2)
    3.18+    map))
    3.19 
    3.20-(deftype skel-op-type () `(member ,@*skel-op-types*))
    3.21+(defun init-skel-value-scope (scope &rest values)
    3.22+  (sb-lockless:so-insert
    3.23+   scope 1
    3.24+   (apply #'vector values)))
    3.25+
    3.26+(defun init-skel-function-scope (scope &rest functions)
    3.27+  (sb-lockless:so-insert
    3.28+   scope 2
    3.29+   (apply #'vector functions)))
    3.30+    
    3.31+(defvar *skel-arena* (new-skel-arena))
    3.32+
    3.33+(defvar *skel-stack-size* 128)
    3.34+
    3.35+(deftype skel-op-type () `(member ,@(coerce *skel-op-types* 'list)))
    3.36 
    3.37 (defstruct skel-op
    3.38-  (type :nop :type skel-op-type)
    3.39-  body)
    3.40-  
    3.41+  (type 0 :type unsigned-byte :read-only t)
    3.42+  (scope 0 :type (unsigned-byte 64) :read-only t)
    3.43+  (thunk #'identity :type function :read-only t))
    3.44+
    3.45 (defstruct skel-vm
    3.46-  (ip (make-stack-slot) :type stack-slot)
    3.47-  (stack (make-array 0) :type (array stack-slot)))
    3.48+  (ip 0 :type (integer 0 #.*skel-stack-size*)) ;; to be atomic type needs to be (unsigned-byte 64)
    3.49+  (stack (make-array *skel-stack-size* :element-type 'skel-op)
    3.50+   :type (vector skel-op)))
    3.51+
    3.52+(defvar *skel-scope*
    3.53+  (let ((scope (init-skel-scope)))
    3.54+    (init-skel-function-scope scope #'funcall)
    3.55+    (init-skel-value-scope scope nil t)
    3.56+    scope))
    3.57 
    3.58-(defvar *skel-arena-size* (ash 1 16))
    3.59-(defvar *skel-arenas* nil)
    3.60-
    3.61-(defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*))
    3.62+(defmacro with-skel-scope ((&optional (scope *skel-scope*)) &body body)
    3.63+  `(let ((*skel-scope* ,scope))
    3.64+     ,@body))
    3.65 
    3.66-(sb-ext:defglobal *skel-arena* (make-skel-arena))
    3.67-
    3.68-;; (defmacro with-skel-arena (arena &body body))
    3.69-;; (defmacro with-skel-stack ((stack &key arena) &body body))
    3.70-;; (defmacro with-skel-vm ((vm &optional arena) &body body))
    3.71+(defmacro with-skel-vm ((vm-sym &optional (vm (make-skel-vm))
    3.72+                                          (scope *skel-scope*)
    3.73+                                          (arena *skel-arena*))
    3.74+                        &body body)
    3.75+  `(sb-vm:with-arena (,arena)
    3.76+     (let ((*skel-scope* ,scope)
    3.77+           (*skel-arena* ,arena)
    3.78+           (,vm-sym ,vm))
    3.79+       (prog1
    3.80+           ,@body
    3.81+         (log:info! (format nil "skel-vm alloc-info: ~A/~A~%  userdata: ~A"
    3.82+                            (sb-vm:arena-bytes-used ,arena)
    3.83+                            (sb-vm:arena-length ,arena)
    3.84+                            (sb-vm:arena-userdata ,arena)))))))