Docs

.github/workflows/docs.yml

@@ -0,0 +1,60 @@
+# Generate the website with staple, and deploy it.
+name: Generate and deploy docs to Pages
+
+on:
+  push:
+    branches: ["main"]
+
+  # Allows you to run this workflow manually from the Actions tab
+  workflow_dispatch:
+
+# Sets permissions of the GITHUB_TOKEN to allow deployment to GitHub Pages
+permissions:
+  contents: read
+  pages: write
+  id-token: write
+
+# Allow one concurrent deployment - on new push, stop building old docs
+concurrency:
+  group: "pages"
+  cancel-in-progress: true
+
+jobs:
+  deploy-docs:
+    environment:
+      name: github-pages
+      url: ${{ steps.deployment.outputs.page_url }}
+    runs-on: ubuntu-latest
+    steps:
+      - name: Install SBCL
+        run: |
+          sudo apt-get update
+          sudo apt install -y sbcl
+      - name: Install Quicklisp
+        run: |
+          curl -kLO https://beta.quicklisp.org/quicklisp.lisp
+          sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))"
+      - name: Checkout repository
+        uses: actions/checkout@v4
+        with:
+          path: cvm
+      - name: Checkout Clostrum
+        uses: actions/checkout@v4
+        with:
+          repository: s-expressionists/Clostrum
+          path: Clostrum
+      - name: Configure ASDF to find everything
+        run: |
+          mkdir -p $HOME/.config/common-lisp/source-registry.conf.d
+          echo "(:TREE #P\"${{ github.workspace }}/\")" > $HOME/.config/common-lisp/source-registry.conf.d/cleavir.conf
+      - name: Generate site with Staple
+        run: | # We quickload external dependencies since Staple doesn't. KLUDGE.
+          sbcl --non-interactive --eval "(ql:quickload '(:staple-markdown :closer-mop :alexandria :trucler :ecclesia :eclector :ieee-floats :clostrum :clostrum-basic :clostrum-trucler))" --eval "(staple:generate :cvm :output-directory #p\"_site/\")"
+      - name: Upload artifact
+        uses: actions/upload-pages-artifact@v1
+        with:
+          # Upload entire repository
+          path: '_site/'
+      - name: Deploy to GitHub Pages
+        id: deployment
+        uses: actions/deploy-pages@v1

README.md

@@ -1,18 +1,14 @@
-Lisp implementation of Common Lisp VM used in Clasp and possibly for other purposes.
+CVM is an implementation of a Common Lisp evaluator, compiler, file compiler, and FASL loader, all written in portable Common Lisp. It compiles Lisp into a bytecode representation, which is interpreted by a simple virtual machine. The compiler is complete but simple, performing only easy optimizations; this makes it fast, and suited for code that does not necessarily need to run quickly, such as that evaluated just once.
 
-Specification is at https://github.com/clasp-developers/clasp/wiki/Virtual-machine-design
+Compilation and bytecode interpretation take place relative to specified environments. [Clostrum](https://github.com/s-expressionists/Clostrum) can be used to build a first-class environment to execute code in, meaning CVM can be used to execute code in an isolated environment, like a sandbox.
 
-# Design goals
+Bytecode functions exist as real functions, so they can be called the same as any other functions. Bytecode functions and native functions can coexist without difficulty and call each other.
 
-* Quick compilation of CL code (in more-or-less one pass)
-* Reasonably quick execution of the bytecode
-* Compatibility with native code, i.e. VM functions can call native functions and vice versa, with practical performance
-* Proper involvement of environments, so code can be compiled and/or loaded in artificial environments
-* Portability between implementations, i.e. bytecode compiled in one host Lisp can be loaded in any implementation of the VM
+The FASL format is simple and portable. Lisp source files can be compiled in one implementation and then loaded it into another, as long as the compilation and loading environments agree.
 
 # Quick start
 
-Load the `cvm` ASDF system. There is a dependency on [Clostrum](https://github.com/s-expressionists/Clostrum), which is not available on Quicklisp, so you'll need to set that up yourself.
+Load the `cvm` ASDF system. There is a dependency on Clostrum, which is not available on Quicklisp, so you'll need to set that up yourself.
 
 Before compiling or evaluating code, you need to set the client in order to inform Trucler how to get global definitions. On SBCL you can use the host environment as follows:
 
@@ -75,7 +71,7 @@ You can get a running trace of the machine state by binding `cvm.vm-native:*trac
 
 # First-class environments
 
-The `cvm/vm-cross` subsystem allows CVM to be used for compiling and running Lisp code in arbitrary first-class environments, in concert with [Clostrum](https://github.com/s-expressionists/Clostrum). Here is an example:
+The `cvm/vm-cross` subsystem allows CVM to be used for compiling and running Lisp code in arbitrary first-class environments, in concert with Clostrum. Here is an example:
 
 ```lisp
 ;;; cvm-cross does not itself load a global environment implementation,
@@ -95,10 +91,6 @@ The `cvm/vm-cross` subsystem allows CVM to be used for compiling and running Lis
 
 ;;; These new environments are totally devoid of bindings.
 ;;; To do anything useful, we have to define at least a few.
-;;; In this simple example, we will define CL:PROGN since it is used
-;;; by CVM.COMPILE:EVAL.
-(clostrum:make-special-operator cvm.machine:*client* *rte* 'progn t)
-
 ;;; We'll define + and *readtable* weirdly to emphasize that we are
 ;;; not operating in the host environment.
 (setf (clostrum:fdefinition cvm.machine:*client* *rte* '+) #'-)
@@ -145,4 +137,3 @@ Works. Except:
   * Contify?
   * Use multiple-value contexts for `multiple-value-call` with a lambda
 * Instructions for inline operations like `car`, possibly
-* Better syntax errors (required for serious use as a frontend)

compile-file/cmpltv.lisp

@@ -664,8 +664,7 @@
              :docstring (ensure-constant nil #+(or) (cmp:cfunction-doc value))
              :nlocals (cmp:cfunction-nlocals value)
              :nclosed (length (cmp:cfunction-closed value))
-             :entry-point (cmp:annotation-module-position
-                           (cmp:cfunction-entry-point value))
+             :entry-point (cmp:cfunction-final-entry-point value)
              :size (cmp:cfunction-final-size value)))))
     inst))
 

compile-file/compile-file.lisp

@@ -18,7 +18,7 @@
     (cmp:with-compilation-unit ()
       (with-constants ()
         ;; Read and compile the forms.
-        (loop with env = (cmp:coerce-to-lexenv environment)
+        (loop with env = (cmp:make-null-lexical-environment environment)
               with eof = (gensym "EOF")
               with *compile-time-too* = nil
               with *environment* = environment
@@ -53,4 +53,5 @@
                            :element-type '(unsigned-byte 8))
         (multiple-value-bind (out warningsp failurep)
             (apply #'compile-stream in out keys)
+	  (declare (ignore out))
           (values output-file warningsp failurep))))))

compile-file/documentation.lisp

@@ -0,0 +1,12 @@
+(in-package #:cvm.compile-file)
+
+(setf (documentation 'compile-file 'function)
+      "As CL:COMPILE-FILE. Compile the given file using CVM. All normal COMPILE-FILE semantics should apply, e.g. top level form processing. Outputs a bytecode FASL.
+Returns CL:COMPILE-FILE's usual three values of the output file, warningsp, and failurep.
+Besides the standard arguments, there are
+ENVIRONMENT: The compilation environment that should be used for compilation, as well as compile-time evaluation through EVAL-WHEN, #., etc. If not provided, defaults to NIL, meaning the host's global environment.
+READER-CLIENT: The client passed to Eclector to perform read operations."
+      (documentation 'compile-stream 'function)
+      "Like COMPILE-FILE, but operates on streams. INPUT must be a character stream and OUTPUT an (unsigned-byte 8) stream. The FASL will be written out to the OUTPUT stream. Returns the output stream as its primary value.
+
+See COMPILE-FILE")

compile-file/top-level-forms.lisp

@@ -37,7 +37,7 @@
 
 (defun compile-toplevel-locally (body env)
   (multiple-value-bind (body decls) (alexandria:parse-body body)
-    (let* ((new-env (cmp:add-specials (cmp:extract-specials decls) env)))
+    (let* ((new-env (cmp:add-declarations env decls)))
       (compile-toplevel-progn body new-env))))
 
 (defun compile-toplevel-macrolet (bindings body env)
@@ -51,18 +51,15 @@
              (info (cmp:make-local-macro name expander)))
         (push (cons name info) macros)))
     (compile-toplevel-locally
-     body (cmp:make-lexical-environment
-           env :funs (append macros (cmp:funs env))))))
+     body (cmp:add-macros env macros))))
 
 (defun compile-toplevel-symbol-macrolet (bindings body env)
   (let ((smacros
           (loop for (name expansion) in bindings
                 for info = (cmp:make-symbol-macro name expansion)
                 collect (cons name info))))
     (compile-toplevel-locally
-     body (cmp:make-lexical-environment
-           env
-           :vars (append (nreverse smacros) (cmp:vars env))))))
+     body (cmp:add-symbol-macros env (nreverse smacros)))))
 
 (defun compile-toplevel (form &optional env)
   (let ((form (cmp:macroexpand form env)))

compile/compile.lisp

@@ -6,14 +6,14 @@
 ;;;
 
 (defstruct (cfunction (:constructor make-cfunction (cmodule)))
-  cmodule
+  (cmodule (error "missing arg") :read-only t)
   ;; Bytecode vector for this function.
   (bytecode (make-array 0 :element-type '(unsigned-byte 8)
                           :fill-pointer 0 :adjustable t))
   ;; An ordered vector of annotations emitted in this function.
   (annotations (make-array 0 :fill-pointer 0 :adjustable t))
-  (nlocals 0)
-  (closed (make-array 0 :fill-pointer 0 :adjustable t))
+  (%nlocals 0)
+  (closed (make-array 0 :fill-pointer 0 :adjustable t) :read-only t)
   (entry-point (make-label))
   ;; The position of the start of this function in this module
   ;; (optimistic).
@@ -26,36 +26,42 @@
   index
   info)
 
+;;; Used in cmpltv.
+(defun cfunction-final-entry-point (cfunction)
+  (annotation-module-position (cfunction-entry-point cfunction)))
 (defun cfunction-final-size (cfunction)
   (+ (length (cfunction-bytecode cfunction)) (cfunction-extra cfunction)))
+;;; To avoid exporting the writer.
+(defun cfunction-nlocals (cfunction) (cfunction-%nlocals cfunction))
 
 (defstruct (cmodule (:constructor make-cmodule ()))
-  (cfunctions (make-array 1 :fill-pointer 0 :adjustable t))
+  (cfunctions (make-array 1 :fill-pointer 0 :adjustable t) :read-only t)
   ;; Each entry in this vector is either a constant-info, an ltv-info,
   ;; a global-function-reference, or a cfunction.
   ;; The compiler treats them all pretty identically, but the linker
   ;; needs to distinguish these things.
   ;; For example, a cfunction appearing literally in the code (for whatever
   ;; odd reason) gets a constant-info, distinguishing it from a cfunction
   ;; in the vector which will be linked to an actual function.
-  (literals (make-array 0 :fill-pointer 0 :adjustable t)))
+  (literals (make-array 0 :fill-pointer 0 :adjustable t) :read-only t))
 
 (defstruct (constant-info (:constructor make-constant-info (value)))
-  value)
+  (value (error "missing arg") :read-only t))
 
 (defstruct (ltv-info (:constructor make-ltv-info (form read-only-p)))
-  form read-only-p)
+  (form (error "missing arg") :read-only t)
+  (read-only-p (error "missing arg") :read-only t))
 
 ;;; Info about a name that we use for FDEFINITION.
 ;;; This is separate from CONSTANT-INFO because some clients can do better
 ;;; than a full call to CL:FDEFINITION on the actual name, e.g. with cells.
 (defstruct (fdefinition-info (:constructor make-fdefinition-info (name)))
-  name)
+  (name (error "missing arg") :read-only t))
 
 ;;; Info about a global symbol value.
 ;;; For example, the linker may want to make it a cell.
 (defstruct (value-cell-info (:constructor make-value-cell-info (name)))
-  name)
+  (name (error "missing arg") :read-only t))
 
 ;;; This info represents the loader environment. It is used for a few
 ;;; instructions that need to perform runtime name lookups.
@@ -458,15 +464,15 @@
                                 (:constructor %make-lexical-environment)
                                 (:conc-name nil))
   ;; An alist of (var . var-info) in the current environment.
-  (vars nil :type list)
+  (vars nil :type list :read-only t)
   ;; An alist of (tag tag-dynenv . label) in the current environment.
-  (tags nil :type list)
+  (tags nil :type list :read-only t)
   ;; An alist of (block block-dynenv . label) in the current environment.
-  (blocks nil :type list)
+  (blocks nil :type list :read-only t)
   ;; An alist of (fun . fun-var) in the current environment.
-  (funs nil :type list)
+  (funs nil :type list :read-only t)
   ;; Global environment, which we just pass to Trucler.
-  global-environment)
+  (global-environment (error "missing arg") :read-only t))
 
 ;;; We don't use Trucler's augmentation protocol internally since we often
 ;;; want to add a bunch of stuff at once, which is awkward in Trucler.
@@ -478,6 +484,10 @@
    :vars vars :tags tags :blocks blocks :funs funs
    :global-environment (global-environment parent)))
 
+(defun make-null-lexenv (global-compilation-environment)
+  (%make-lexical-environment
+   :global-environment global-compilation-environment))
+
 ;;; We don't actually use Trucler's query protocol internally, since the
 ;;; environments are necessarily ours (they include bytecode-specific
 ;;; information, etc.)
@@ -591,8 +601,8 @@
          (var-count (length vars))
          (frame-end (+ frame-start var-count))
          (function (context-function context)))
-    (setf (cfunction-nlocals function)
-          (max (cfunction-nlocals function) frame-end))
+    (setf (cfunction-%nlocals function)
+          (max (cfunction-%nlocals function) frame-end))
     (do ((index frame-start (1+ index))
          (vars vars (rest vars))
          (new-vars (vars env)
@@ -611,8 +621,8 @@
          (fun-count (length funs))
          (frame-end (+ frame-start fun-count))
          (function (context-function context)))
-    (setf (cfunction-nlocals function)
-          (max (cfunction-nlocals function) frame-end))
+    (setf (cfunction-%nlocals function)
+          (max (cfunction-%nlocals function) frame-end))
     (do ((index frame-start (1+ index))
          (funs funs (rest funs))
          (new-vars (funs env)
@@ -623,6 +633,12 @@
          (values (make-lexical-environment env :funs new-vars)
                  (new-context context :frame-end fun-count))))))
 
+(defun add-macros (env macros)
+  (make-lexical-environment env :funs (append macros (funs env))))
+
+(defun add-symbol-macros (env symbol-macros)
+  (make-lexical-environment env :vars (append symbol-macros (vars env))))
+
 (deftype lambda-expression () '(cons (eql lambda) (cons list list)))
 (deftype function-name () '(or symbol (cons (eql setf) (cons symbol null))))
 
@@ -659,18 +675,19 @@
                      env)))
 
 ;;; As CL:COMPILE, but doesn't mess with function bindings.
-(defun compile (lambda-expression &optional env (m:*client* m:*client*))
+(defun compile (lambda-expression
+		&optional environment (m:*client* m:*client*))
   (with-compilation-results
     (with-compilation-unit ()
-      (compile-link lambda-expression env))))
+      (compile-link lambda-expression environment))))
 
 ;;; Evaluate FORMS as a progn without relying on PROGN to be bound.
-(defun eval-progn (forms &optional env (m:*client* m:*client*))
-  (funcall (compile-link `(lambda () ,@forms) env :forms-only t)))
+(defun eval-progn (forms &optional environment (m:*client* m:*client*))
+  (funcall (compile-link `(lambda () ,@forms) environment :forms-only t)))
 
 ;;; As CL:EVAL.
-(defun eval (form &optional env (m:*client* m:*client*))
-  (eval-progn `(,form) env))
+(defun eval (form &optional environment (m:*client* m:*client*))
+  (eval-progn `(,form) environment))
 
 (defun compile-form (form env context)
   (typecase form
@@ -847,7 +864,7 @@
 
 (defun compile-locally (body env context)
   (multiple-value-bind (body decls) (parse-body body)
-    (compile-progn body (add-specials (extract-specials decls) env) context)))
+    (compile-progn body (add-declarations env decls) context)))
 
 (defun fun-name-block-name (fun-name)
   (typecase fun-name
@@ -893,6 +910,9 @@
              (push var specials))))))
     specials))
 
+(defun add-declarations (env declarations)
+  (add-specials (extract-specials declarations) env))
+
 (defun canonicalize-binding (binding)
   (if (consp binding)
       (destructure-syntax (binding name value) (binding :rest nil)
@@ -920,7 +940,9 @@
             (cond ((or (member var specials)
                        (globally-special-p var env))
                    (incf special-binding-count)
-                   (emit-special-bind context var))
+                   (emit-special-bind context var)
+		   (setf context
+			 (new-context context :dynenv '(:special))))
                   (t
                    (setf (values post-binding-env context)
                          (bind-vars (list var) post-binding-env context))
@@ -1860,7 +1882,7 @@
                    (m:make-bytecode-function
                     m:*client*
                     bytecode-module
-                    (cfunction-nlocals cfunction)
+                    (cfunction-%nlocals cfunction)
                     (length (cfunction-closed cfunction))
                     (annotation-module-position
                      (cfunction-entry-point cfunction))