From 6ffa3538cfeb5a97e967544bfbbcf907f4aa565f Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sat, 30 Jul 2022 13:31:05 -0700
Subject: Add call-builtin syntax.

This syntax allows calling opcodes directly from scheme code.
Very powerful technique.
---
 csc/cps.csc         |  2 +-
 csc/ir2.csc         |  1 +
 csc/macros-test.csc | 13 +++++++++++++
 csc/macros.csc      | 22 +++++++++++++++++++++-
 4 files changed, 36 insertions(+), 2 deletions(-)

diff --git a/csc/cps.csc b/csc/cps.csc
index 0dc8a96..f2a9c90 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -262,7 +262,7 @@
                   (lambda (v)
                     (make-apply f (list return-address v))))))))
         ((% %call-builtin op args)
-          (define returns-value? (not (symbol=? op 'poke)))
+          (define returns-value? (not (memq op '(poke exit))))
           (loop for arg in (reverse args)
                 with expr = (lambda (vals)
                               (if returns-value?
diff --git a/csc/ir2.csc b/csc/ir2.csc
index 800d3c0..888437f 100644
--- a/csc/ir2.csc
+++ b/csc/ir2.csc
@@ -150,6 +150,7 @@
     ;   - alloc: size -> result
     ;   - peek: pointer * offset -> result
     ;   - poke: word * pointer * offset -> ()
+    ;   - exit: code -> ()
     (define-match-record-type <primitive>
       (make-primitive operation arguments results continuation)
       primitive?
diff --git a/csc/macros-test.csc b/csc/macros-test.csc
index 6ee0596..531e3e2 100644
--- a/csc/macros-test.csc
+++ b/csc/macros-test.csc
@@ -5,6 +5,7 @@
             gensym?)
           (only (csc ir1)
             %call
+            %call-builtin
             %constant
             %define-syntax
             %if
@@ -15,6 +16,7 @@
             %library-define
             %library-ref
             %sequence
+            call-builtin?
             call?
             constant?
             define-syntax?
@@ -27,6 +29,7 @@
             lexical-set?
             library-define?
             library-ref?
+            make-call-builtin
             make-constant
             make-define-syntax
             make-lambda
@@ -52,6 +55,7 @@
         (cons define-syntax? %define-syntax)
         (cons if? %if)
         (cons call? %call)
+        (cons call-builtin? %call-builtin)
         (cons sequence? %sequence)
         (cons lambda? %lambda)
         (cons letrec? %letrec)
@@ -278,4 +282,13 @@
                 ((five _) 5)))
             (five 6))
           builtins-environment)
+        transform-ir1))
+
+
+    (test builtin-call-builtin
+      (assert-equal
+        (make-call-builtin 'bbb (list (make-constant 5)))
+        (expand-body 'main
+          '((call-builtin bbb 5))
+          builtins-environment)
         transform-ir1))))
diff --git a/csc/macros.csc b/csc/macros.csc
index 288865d..4559991 100644
--- a/csc/macros.csc
+++ b/csc/macros.csc
@@ -32,6 +32,7 @@
             library-ref-name
             library-ref?
             make-call
+            make-call-builtin
             make-constant
             make-define-syntax
             make-lambda
@@ -748,6 +749,24 @@
             (_ (raise-syntax-error "unexpected form in builtin-define-syntax" x))))))
 
 
+    (define builtin-call-builtin
+      (make-macro-transformer
+        (lambda (x)
+          (syntax-case x
+            ((_ op . args) when (identifier? op)
+              (make-call-builtin (identifier-name op)
+                                 (let loop ((args args)
+                                            (expanded-args '()))
+                                   (syntax-case args
+                                     ('() (reverse expanded-args))
+                                     ((head . tail)
+                                       (loop tail
+                                             (cons (expand-syntax-object head)
+                                                   expanded-args)))
+                                     (_ (raise-syntax-error "unexpected form in call-builtin"))))))
+            (_ (raise-syntax-error "unexpected form in call-builtin" x))))))
+
+
     (define builtins-environment
       (alist->substitutions
         (list (cons 'syntax-rules builtin-syntax-rules)
@@ -757,7 +776,8 @@
               (cons 'quote builtin-quote)
               (cons 'lambda builtin-lambda)
               (cons 'builtin-define builtin-define)
-              (cons 'define-syntax builtin-define-syntax))))
+              (cons 'define-syntax builtin-define-syntax)
+              (cons 'call-builtin builtin-call-builtin))))
 
 
     ; Expands the body of a library, or top level. expand-body can be thought
-- 
cgit v1.3.1