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