Coverage report: /home/ellis/comp/core/app/skel/core/vm.lisp

KindCoveredAll%
expression574 6.8
branch02 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; skel/core/vm.lisp --- The Skel Virtual Machine
2
 
3
 ;;; Commentary:
4
 
5
 ;; We have this idea that SBCL Arenas may be able to act as a sort of 'caution
6
 ;; tape' in the heap while the VM is running, but the usefulness of it is TBD.
7
 
8
 ;; The *SKEL-SCOPE* is currently a SO-MAP/FIXNUM (lockless structure) with
9
 ;; keys being simple sequential IDs ('scope-id') and values being vectors.
10
 
11
 ;; - 0 :: values
12
 ;; - 1 :: functions
13
 ;; - 2 :: user
14
 
15
 ;; The remaining values will be filled with temporary scopes as required by
16
 ;; the vm execution plan.
17
 
18
 ;; The *SKEL-STACK*
19
 
20
 ;;; Code:
21
 (in-package :skel/core/vm)
22
 
23
 (eval-always
24
   (defvar *skel-arena-size* (ash 1 16))
25
   (defvar *skel-stack-size* 128)
26
   (defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*)))
27
 
28
 (defun get-so-scope (so id)
29
   (when-let ((found (sb-lockless:so-find so id)))
30
     (sb-lockless:so-data found)))
31
 
32
 (defun set-so-scope (so id env)
33
   (sb-lockless:so-insert so id env))
34
 
35
 (defsetf get-so-scope set-so-scope)
36
 
37
 (defvar *skel-arena*)
38
 
39
 (defvar *skel-ops* nil)
40
 
41
 (defvar *skel-scope*
42
   (let ((scope (sb-lockless:make-so-map/fixnum)))
43
     (set-so-scope scope 0 *skel-ops*)
44
     (set-so-scope scope 1 nil)
45
     scope))
46
 
47
 (defvar *skel-stack*)
48
 
49
 (defstruct (skel-op (:constructor make-skel-op (scope function)))
50
   (scope nil :type list :read-only t)
51
   (function #'identity :type function :read-only t))
52
 
53
 (declaim (inline %sk-call))
54
 (defun %sk-call (op) (funcall (skel-op-function op)))
55
 
56
 ;; TODO 2024-08-28: do we need to store arity or can we get by without it
57
 ;; being stored here?
58
 (defmacro define-skel-op (name scope lambda-list &body body)
59
   "Define a SKEL-OP with a NAME TYPE, SCOPE and BODY which is compiled and stored
60
 as the function slot."
61
   `(progn
62
      (defun ,(symbolicate "%SK-" name) ,lambda-list
63
        (make-skel-op ,scope
64
                      (compile nil (lambda () ,@body))))
65
      (pushnew ',(symbolicate "%SK-" name) *skel-ops*)))
66
 
67
 ;; math
68
 (define-skel-op nil 0 () nil)
69
 (define-skel-op eval 1 (form) (eval form))
70
 (define-skel-op push 0 (val) (vector-push val *skel-stack*))
71
 (define-skel-op pop 0 (val) (vector-push val *skel-stack*))
72
 (define-skel-op clear 0 (scope) (sb-lockless:so-delete *skel-scope* scope))
73
 
74
 (defun make-skel-stack (&optional (size *skel-stack-size*))
75
   (make-array size :element-type 'skel-op))
76
 
77
 (defstruct skel-vm
78
   (ip 0 :type (integer 0 #.*skel-stack-size*)) ;; to be atomic type needs to be (unsigned-byte 64)
79
   (stack (make-skel-stack) :type (vector skel-op)))
80
 
81
 (defmacro with-skel-vm ((vm-sym &optional (vm (make-skel-vm))
82
                                           (scope *skel-scope*)
83
                                           (arena *skel-arena*))
84
                         &body body)
85
   "Top-level entry to the SKEL-VM. *SKEL-SCOPE* and *SKEL-ARENA* are bound for
86
 the duration of BODY."
87
   `(sb-vm:with-arena (,arena)
88
      (let ((*skel-scope* ,scope)
89
            (*skel-arena* ,arena)
90
            (,vm-sym ,vm))
91
        (prog1
92
            ,@body
93
          (log:trace! (format nil "skel-vm alloc-info: ~A/~A~%  userdata: ~A"
94
                             (sb-vm:arena-bytes-used ,arena)
95
                             (sb-vm:arena-length ,arena)
96
                             (sb-vm:arena-userdata ,arena)))))))