Handle global variables.

Global variables will be stored in an array which is kept in register 0.
The linker will later translate each library-ref into an integer, which
is used as an index into the globals table.

This design makes implementing eval quite straightforward, the eval
bytecode will accept a globals table and a bytevector of bytecode, save
the current set of registers, set register 0 to the new globals table,
and begin executing the given bytecode. When eval is finished, it will
restore the saved registers and return to the previous instruction
pointer. In this way, calling eval can create a call stack.

We could think about implementing function calls with eval, and it's
cool that it would work, but the CPS transformation mostly makes this
irrelevant. It's interesting to think about implementing an interpreter,
where a function call would simply eval the function's bytecode, and the
function call stack would be handled automatically.

3 files changed, 56 insertions, 24 deletions

diff --git a/csc/cps-test.csc b/csc/cps-test.csc
index 84b8b9a..5283c2b 100644
--- a/csc/cps-test.csc
+++ b/csc/cps-test.csc
@@ -25,12 +25,15 @@
           %branch
           %closure
           %fix
+          %globals
           %primitive
           %variable
+          *globals*
           apply?
           branch?
           closure?
           fix?
+          globals?
           make-apply
           make-atom
           make-branch
@@ -56,6 +59,7 @@
     (cons lexical-ref? %lexical-ref)
     (cons library-ref? %library-ref)
     (cons variable? %variable)
+    (cons globals? %globals)
     (cons primitive? %primitive)
     (cons branch? %branch)
     (cons apply? %apply)
@@ -88,8 +92,7 @@
 
 (test atom-library-ref
   (assert-equal
-    (make-primitive 'peek (list (make-library-ref 'var '(csc builtins)) (make-constant 0))
-                          (list (test-ref 'generated-symbol))
+    (make-primitive 'peek (list *globals* (make-library-ref 'var '(csc builtins))) (list (test-ref 'generated-symbol))
       (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol))))
     (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail)
     transform-ir2))
@@ -209,7 +212,7 @@
                       (make-fix (list (make-closure (test-ref 'generated-symbol)
                                                     (list (test-ref 'generated-symbol))
                                         (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
-                        (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                        (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
                           (make-apply (test-ref 'generated-symbol)
                                       (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))
                       (make-fix (list (make-closure (test-ref 'generated-symbol)
@@ -230,7 +233,7 @@
                                               (make-fix
                                                 (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                                                         (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
-                                                (make-primitive 'peek (list (make-library-ref 'vector->list '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                                                (make-primitive 'peek (list *globals* (make-library-ref 'vector->list '(csc based))) (list (test-ref 'generated-symbol))
                                                   (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
                               (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol))
                                 (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))))))
@@ -267,7 +270,7 @@
                   (make-fix
                     (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                             (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
-                    (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                    (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
                       (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
       (make-fix
         (list
@@ -326,7 +329,7 @@
                       (make-fix
                         (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                                 (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
-                        (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                        (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
                           (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
       (make-apply (test-ref 'tail) (list (make-constant 10))))
     (ir1->ir2
@@ -362,7 +365,7 @@
                     (make-fix
                       (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                               (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
-                      (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                      (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
                         (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
         (make-fix
           (list
@@ -418,7 +421,7 @@
                   (make-fix
                     (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                             (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
-                    (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                    (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
                       (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
       (make-apply (test-ref 'tail) (list (make-constant 5))))
     (ir1->ir2 (make-letrec
@@ -447,7 +450,7 @@
                         (make-fix
                           (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))
                                   (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)))))
-                          (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol))
+                          (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol))
                             (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))
         (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'f) (make-constant 0)) '()
           (make-primitive 'poke (list (make-constant 5) (test-ref 'f) (make-constant 0)) '()
diff --git a/csc/cps.csc b/csc/cps.csc
index 1f58287..230a1c4 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -23,6 +23,7 @@
             %lexical-ref
             %lexical-set
             %library-define
+            %library-ref
             %sequence
             call?
             constant?
@@ -54,6 +55,8 @@
             %branch
             %fix
             %primitive
+            *globals*
+            branch-atom
             closure-arguments
             closure-body
             closure-name
@@ -205,9 +208,14 @@
     (define (to-cps expr continuation)
       (match expr
         (_ when (or (constant? expr)
-                    (lexical-ref? expr)
-                    (library-ref? expr))
+                    (lexical-ref? expr))
           (continuation expr))
+        ((% %library-ref . _)
+          (unless (library-ref? expr)
+            (error "wtf"))
+          (define temp (new-ref))
+          (make-primitive 'peek (list *globals* expr) (list temp)
+            (continuation temp)))
         ((% %lexical-set ref arg)
           (to-cps
             arg
@@ -343,10 +351,9 @@
     (define (box-conversion expr)
       (define boxed-refs (get-boxed expr))
       (define (boxed? ref)
-        (or (library-ref? ref) ; globals are always boxed
-            (and (lexical-ref? ref)
-                 (guard (e ((key-not-found-error? e) #f))
-                   (lookup boxed-refs ref)))))
+        (and (lexical-ref? ref)
+             (guard (e ((key-not-found-error? e) #f))
+               (lookup boxed-refs ref))))
       (define (convert-arg-list args)
         (define boxed-args (loop for arg in args
                                  if (boxed? arg)
@@ -363,7 +370,10 @@
         (values new-args boxed-args vars))
       (let convert ((expr expr))
         (match expr
-          ((% %update ref atom continuation)
+          ((% %update ref atom continuation) when (library-ref? ref)
+            (make-primitive 'poke (list atom *globals* ref) '()
+              (convert continuation)))
+          ((% %update ref atom continuation) when (lexical-ref? ref)
             (make-primitive 'poke (list atom ref (make-constant 0)) '() (convert continuation)))
           ((% %primitive op args res continuation)
             ; Note that no reference in res can be boxed.
@@ -374,12 +384,16 @@
                   do (set! new-expr (make-primitive 'peek (list arg (make-constant 0)) (list var)
                                       new-expr))
                   finally (return new-expr)))
+          ((% %branch atom true false) when (boxed? atom)
+            (define temp (new-ref))
+            (make-primitive 'peek (list atom (make-constant 0)) (list temp)
+              (make-branch temp
+                (convert true)
+                (convert false))))
           ((% %branch atom true false)
-            (if (boxed? atom)
-              (let ((var (new-ref)))
-                (make-primitive 'peek (list atom (make-constant 0)) (list var)
-                                (make-branch var (convert true) (convert false))))
-              (make-branch atom (convert true) (convert false))))
+            (make-branch atom
+              (convert true)
+              (convert false)))
           ((% %apply proc args)
             (define-values (new-params boxed-params vars) (convert-arg-list (cons proc args)))
             (define new-expr (make-apply (car new-params) (cdr new-params)))
diff --git a/csc/ir2.csc b/csc/ir2.csc
index 331aa4c..30fb5a3 100644
--- a/csc/ir2.csc
+++ b/csc/ir2.csc
@@ -4,8 +4,10 @@
     %branch
     %closure
     %fix
+    %globals
     %primitive
     %variable
+    *globals*
     apply-arguments
     apply-procedure
     apply?
@@ -27,6 +29,7 @@
     fix-body
     fix-functions
     fix?
+    globals?
     kargs-expression
     kargs-refs
     kargs?
@@ -101,10 +104,10 @@
     ;   Atoms consist of
     ;     - constant,
     ;     - lexical-ref,
-    ;     - or library-ref
+    ;     - library-ref,
+    ;     - or globals.
     ;   After closure conversion, there are no more lexical refs.
-    ;   Each lexical ref will be converted to one of the following
-    ;   data types.
+    ;   Each lexical ref will be converted to a <variable>.
 
 
     ; A function argument or local variable.
@@ -115,6 +118,18 @@
       (gensym variable-gensym))
 
 
+    ; The globals array. This will eventually be stored in register 0.
+    (define-match-record-type <globals>
+      (make-globals)
+      globals?
+      %globals)
+
+
+    ; A global instance of <globals>.
+    ; Considered equal to calling (make-globals).
+    (define *globals* (make-globals))
+
+
     ; CPS expressions:
     ;   CPS expressions are similar to IR1 expressions,
     ;   but constrained not to have any subexpressions except atoms.