changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: skel/vm work, added json benchmark

changeset 630: f4a464cc1628
parent 629: ab02408636b7
child 631: 0b82a2893d26
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 28 Aug 2024 22:08:42 -0400
files: emacs/lib/ulang.el lisp/bench/json.lisp lisp/lib/skel/core/vm.lisp lisp/lib/skel/tests.lisp
description: skel/vm work, added json benchmark
     1.1--- a/emacs/lib/ulang.el	Tue Aug 27 21:36:50 2024 -0400
     1.2+++ b/emacs/lib/ulang.el	Wed Aug 28 22:08:42 2024 -0400
     1.3@@ -33,6 +33,9 @@
     1.4 (defvar ulang-link-history nil)
     1.5 (defvar ulang-file-history nil)
     1.6 
     1.7+(defvar ulang-extra-properties
     1.8+  '("VERSION"))
     1.9+
    1.10 ;;;###autoload
    1.11 (defun dblock-insert-links (regexp)
    1.12   "Create dblock to insert links matching REGEXP."
    1.13@@ -54,13 +57,12 @@
    1.14       '((sequence "TBD(0!)" "TODO(t!)" "NEXT(n!)" "WIP(i!)" "|" "DONE(d!)")
    1.15         (sequence "HOLD(H@/!)" "WIP(!)" "|")
    1.16         (sequence "WAIT(W@/!)" "WIP(!)" "|")
    1.17-        (sequence "RESEARCH(s!)" "REPORT(c!)" "|")
    1.18+        (sequence "RESEARCH(s!)" "WIP(!)" "REPORT(c!)" "|")
    1.19         (sequence "OUTLINE(O!)" "DRAFT(M!)" "REVIEW(V!)" "|")
    1.20+        (sequence "FIXME(f!)" "WIP(!)" "TEST(T!)" "|")
    1.21         (type "FIND(q!)" "READ(r@!)" "WATCH(A@!)" "HACK(h!)"
    1.22               "CODE(c!)" "BENCH(b!)" "DEPLOY(D!)" "RUN(X!)"
    1.23-              "REFILE(w!)"
    1.24-              "LOG(L!)" "GOTO(g!)" "|")
    1.25-        (type "FIXME(f!)" "WIP(!)" "TEST(T!)" "|")
    1.26+              "REFILE(w!)" "LOG(L!)" "GOTO(g!)" "|")
    1.27         (type "PROJECT(p!)" "PRODUCT(P!)" "SPRINT(S!)" "RELEASE(R!)" "|")
    1.28         (sequence "|" "DONE(d!)" "NOPE(x@!)")))
    1.29 
    1.30@@ -70,8 +72,7 @@
    1.31         ("RELEASE" . (:foreground "maroon3" :weight bold))
    1.32         ("RESEARCH" . (:foreground "maroon2" :weight bold))
    1.33         ("HACK" . (:foreground "maroon3" :weight bold))
    1.34-        ("TBD" . (:foreground "darkred2" :weight bold))
    1.35-        ;; ("NOTE" . (:foreground "tomato2" :weight bold))
    1.36+        ("TBD" . (:foreground "brown" :weight bold))
    1.37         ("CODE" . (:foreground "bisque" :weight bold :background "midnightblue"))
    1.38         ("HOLD" . (:foreground "red1" :weight bold :background "yellow1"))
    1.39         ("WAIT" . (:foreground "red4" :weight bold :background "yellow1"))
     2.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2+++ b/lisp/bench/json.lisp	Wed Aug 28 22:08:42 2024 -0400
     2.3@@ -0,0 +1,10 @@
     2.4+;;; json.lisp --- DAT/JSON Benchmarks
     2.5+
     2.6+;;; Code:
     2.7+(defpackage :core/bench/json
     2.8+  (:nicknames :bench/json)
     2.9+  (:use :cl :std :rt :rt/bench :rt/cover :log :dat/proto :dat/json))
    2.10+
    2.11+(in-package :core/bench/json)
    2.12+(defsuite :json-bench)
    2.13+(in-suite :json-bench)
     3.1--- a/lisp/lib/skel/core/vm.lisp	Tue Aug 27 21:36:50 2024 -0400
     3.2+++ b/lisp/lib/skel/core/vm.lisp	Wed Aug 28 22:08:42 2024 -0400
     3.3@@ -1,68 +1,96 @@
     3.4 ;;; skel/core/vm.lisp --- The Skel Virtual Machine
     3.5 
     3.6-;; Stack slots refer to objects. a Stack is a sequence of objects
     3.7-;; which can be output to a stream using a specialized function.
     3.8+;;; Commentary:
     3.9+
    3.10+;; We have this idea that SBCL Arenas may be able to act as a sort of 'caution
    3.11+;; tape' in the heap while the VM is running, but the usefulness of it is TBD.
    3.12+
    3.13+;; The *SKEL-SCOPE* is currently a SO-MAP/FIXNUM (lockless structure) with
    3.14+;; keys being simple sequential IDs ('scope-id') and values being vectors.
    3.15+
    3.16+;; - 0 :: values
    3.17+;; - 1 :: functions
    3.18+;; - 2 :: user
    3.19+
    3.20+;; The remaining values will be filled with temporary scopes as required by
    3.21+;; the vm execution plan.
    3.22+
    3.23+;; The *SKEL-STACK*
    3.24 
    3.25 ;;; Code:
    3.26 (in-package :skel/core/vm)
    3.27 
    3.28 (eval-always
    3.29-  (defvar *skel-op-types*
    3.30-    (vector :nil :eval :set :get :end :jump :pop :spawn :wait :print :let))
    3.31   (defvar *skel-arena-size* (ash 1 16))
    3.32   (defvar *skel-stack-size* 128)
    3.33-  (defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*))
    3.34-  (defun init-skel-scope (&optional (map (sb-lockless:make-so-map/fixnum)))
    3.35-    (sb-lockless:so-insert map 0)
    3.36-    (sb-lockless:so-insert map 1)
    3.37-    (sb-lockless:so-insert map 2)
    3.38-    map))
    3.39+  (defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*)))
    3.40+
    3.41+(defun get-so-scope (so id)
    3.42+  (when-let ((found (sb-lockless:so-find so id)))
    3.43+    (sb-lockless:so-data found)))
    3.44 
    3.45-(defun init-skel-value-scope (scope &rest values)
    3.46-  (sb-lockless:so-insert
    3.47-   scope 1
    3.48-   (apply #'vector values)))
    3.49+(defun set-so-scope (so id env)
    3.50+  (sb-lockless:so-insert so id env))
    3.51 
    3.52-(defun init-skel-function-scope (scope &rest functions)
    3.53-  (sb-lockless:so-insert
    3.54-   scope 2
    3.55-   (apply #'vector functions)))
    3.56-    
    3.57+(defsetf get-so-scope set-so-scope)
    3.58+
    3.59 (defvar *skel-arena* (new-skel-arena))
    3.60 
    3.61-(deftype skel-op-type () `(member ,@(coerce *skel-op-types* 'list)))
    3.62+(defstruct (skel-op (:constructor make-skel-op (scope function)))
    3.63+  (scope nil :type list :read-only t)
    3.64+  (function #'identity :type function :read-only t))
    3.65+
    3.66+(declaim (inline %sk-call))
    3.67+(defun %sk-call (op) (funcall (skel-op-function op)))
    3.68+
    3.69+(defvar *skel-ops* nil)
    3.70 
    3.71-(defstruct skel-op
    3.72-  (type 0 :type unsigned-byte :read-only t)
    3.73-  (scope 0 :type (unsigned-byte 64) :read-only t)
    3.74-  (thunk #'identity :type function :read-only t))
    3.75+;; TODO 2024-08-28: do we need to store arity or can we get by without it
    3.76+;; being stored here?
    3.77+(defmacro define-skel-op (name scope lambda-list &body body)
    3.78+  "Define a SKEL-OP with a NAME TYPE, SCOPE and BODY which is compiled and stored
    3.79+as the function slot."
    3.80+  `(progn
    3.81+     (defun ,(symbolicate "%SK-" name) ,lambda-list
    3.82+       (make-skel-op ,scope
    3.83+                     (compile nil (lambda () ,@body))))
    3.84+     (pushnew ',(symbolicate "%SK-" name) *skel-ops*)))
    3.85+
    3.86+;; math
    3.87+(define-skel-op nil 0 () nil)
    3.88+(define-skel-op eval 1 (form) (eval form))
    3.89+(define-skel-op push 0 (val) (vector-push val *skel-stack*))
    3.90+(define-skel-op pop 0 (val) (vector-push val *skel-stack*))
    3.91+(define-skel-op clear 0 (scope) (sb-lockless:so-delete *skel-scope* scope))
    3.92+
    3.93+(defun make-skel-stack (&optional (size *skel-stack-size*))
    3.94+  (make-array size :element-type 'skel-op))
    3.95 
    3.96 (defstruct skel-vm
    3.97   (ip 0 :type (integer 0 #.*skel-stack-size*)) ;; to be atomic type needs to be (unsigned-byte 64)
    3.98-  (stack (make-array *skel-stack-size* :element-type 'skel-op)
    3.99-   :type (vector skel-op)))
   3.100+  (stack (make-skel-stack) :type (vector skel-op)))
   3.101 
   3.102 (defvar *skel-scope*
   3.103-  (let ((scope (init-skel-scope)))
   3.104-    (init-skel-function-scope scope #'funcall)
   3.105-    (init-skel-value-scope scope nil t)
   3.106+  (let ((scope (sb-lockless:make-so-map/fixnum)))
   3.107+    (set-so-scope scope 0 *skel-ops*)
   3.108+    (set-so-scope scope 1 nil)
   3.109     scope))
   3.110 
   3.111-(defmacro with-skel-scope ((&optional (scope *skel-scope*)) &body body)
   3.112-  `(let ((*skel-scope* ,scope))
   3.113-     ,@body))
   3.114+(defvar *skel-stack*)
   3.115 
   3.116 (defmacro with-skel-vm ((vm-sym &optional (vm (make-skel-vm))
   3.117                                           (scope *skel-scope*)
   3.118                                           (arena *skel-arena*))
   3.119                         &body body)
   3.120+  "Top-level entry to the SKEL-VM. *SKEL-SCOPE* and *SKEL-ARENA* are bound for
   3.121+the duration of BODY."
   3.122   `(sb-vm:with-arena (,arena)
   3.123      (let ((*skel-scope* ,scope)
   3.124            (*skel-arena* ,arena)
   3.125            (,vm-sym ,vm))
   3.126        (prog1
   3.127            ,@body
   3.128-         (log:info! (format nil "skel-vm alloc-info: ~A/~A~%  userdata: ~A"
   3.129+         (log:trace! (format nil "skel-vm alloc-info: ~A/~A~%  userdata: ~A"
   3.130                             (sb-vm:arena-bytes-used ,arena)
   3.131                             (sb-vm:arena-length ,arena)
   3.132                             (sb-vm:arena-userdata ,arena)))))))
     4.1--- a/lisp/lib/skel/tests.lisp	Tue Aug 27 21:36:50 2024 -0400
     4.2+++ b/lisp/lib/skel/tests.lisp	Wed Aug 28 22:08:42 2024 -0400
     4.3@@ -16,16 +16,6 @@
     4.4   (prog1 body
     4.5     (when (file-exists-p file) (delete-file file))))
     4.6 
     4.7-(defun skels (c)
     4.8-  (let ((s))
     4.9-    (loop for i from 1 to c
    4.10-	  do (push (id (make-instance 'sk-project :name (gensym))) s))
    4.11-    s))
    4.12-
    4.13-(deftest sanity ()
    4.14-  "IDs should be reasonably unique."
    4.15-  (is (eq t (apply #'/= (skels 1000)))))
    4.16-
    4.17 (deftest header-comments ()
    4.18   "Make sure header comments are generated correctly. 
    4.19 
    4.20@@ -75,14 +65,10 @@
    4.21 	       (mk1 (mk "test.mk")))
    4.22 	  (is (push-mk-rule r1 mk1))
    4.23 	  (is (push-mk-rule r2 mk1))
    4.24-	  ;; NOTE: not really useful yet
    4.25-	  ;; (is (push-rule r2 mk1 t))
    4.26-	  ;; (is (push-rule r1 mk1 t))
    4.27 	  (is (push-mk-directive 
    4.28 	       (cmd "ifeq ($(DEBUG),1) echo foo 
    4.29 endif")
    4.30 	       mk1))
    4.31-	  ;; (is (push-directive (cmd "") mk1))
    4.32 	  (is (push-mk-var '(a b) mk1))
    4.33 	  (is (push-mk-var '(b c) mk1))
    4.34 	  ;; FIXME
    4.35@@ -91,7 +77,10 @@
    4.36 
    4.37 (deftest vm ()
    4.38   "EXPERIMENTAL"
    4.39-  (is (make-skel-vm)))
    4.40+  (with-skel-vm (vm)
    4.41+    (is (sb-lockless::split-ordered-list-p *skel-scope*))
    4.42+    (is (sb-vm:arena-p *skel-arena*))
    4.43+    (is (skel-vm-p vm))))
    4.44 
    4.45 (deftest asd ()
    4.46   (let ((sk (make-instance 'sk-project :components '((:lisp "test")