[Guile-commits] 14/19: Tree-IL-to-CPS lowers to high-level object reprs: atomic boxes

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 5c5af6bc78977012b9d3a51850861da53ad7119f
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Jun 22 11:22:52 2023 +0200

    Tree-IL-to-CPS lowers to high-level object reprs: atomic boxes
    
    * module/language/tree-il/compile-cps.scm: Lower to make-atomic-box,
    atomic-box-ref, and so on.
---
 module/language/tree-il/compile-cps.scm | 34 ++++-----------------------------
 1 file changed, 4 insertions(+), 30 deletions(-)

diff --git a/module/language/tree-il/compile-cps.scm 
b/module/language/tree-il/compile-cps.scm
index 578174314..e83192062 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1270,29 +1270,6 @@
 (define-primcall-converter rsh convert-shift)
 (define-primcall-converter lsh convert-shift)
 
-(define-primcall-converter make-atomic-box
-  (lambda (cps k src op param val)
-    (with-cps cps
-      (letv obj tag)
-      (letk kdone
-            ($kargs () ()
-              ($continue k src ($values (obj)))))
-      (letk kval
-            ($kargs () ()
-              ($continue kdone src
-                ($primcall 'atomic-scm-set!/immediate '(atomic-box . 1) (obj 
val)))))
-      (letk ktag1
-            ($kargs ('tag) (tag)
-              ($continue kval src
-                ($primcall 'word-set!/immediate '(atomic-box . 0) (obj tag)))))
-      (letk ktag0
-            ($kargs ('obj) (obj)
-              ($continue ktag1 src
-                ($primcall 'load-u64 %tc7-atomic-box ()))))
-      (build-term
-        ($continue ktag0 src
-          ($primcall 'allocate-words/immediate '(atomic-box . 2) ()))))))
-
 (define (ensure-atomic-box cps src op x is-atomic-box)
   (define bad-type
     (vector 'wrong-type-arg
@@ -1311,10 +1288,9 @@
      cps src 'atomic-box-ref x
      (lambda (cps)
        (with-cps cps
-         (letv val)
          (build-term
            ($continue k src
-             ($primcall 'atomic-scm-ref/immediate '(atomic-box . 1) (x)))))))))
+             ($primcall 'atomic-box-ref #f (x)))))))))
 
 (define-primcall-converter atomic-box-set!
   (lambda (cps k src op param x val)
@@ -1324,8 +1300,7 @@
        (with-cps cps
          (build-term
            ($continue k src
-             ($primcall 'atomic-scm-set!/immediate '(atomic-box . 1)
-                        (x val)))))))))
+             ($primcall 'atomic-box-set! #f (x val)))))))))
 
 (define-primcall-converter atomic-box-swap!
   (lambda (cps k src op param x val)
@@ -1335,8 +1310,7 @@
        (with-cps cps
          (build-term
            ($continue k src
-             ($primcall 'atomic-scm-swap!/immediate '(atomic-box . 1)
-                        (x val)))))))))
+             ($primcall 'atomic-box-swap! #f (x val)))))))))
 
 (define-primcall-converter atomic-box-compare-and-swap!
   (lambda (cps k src op param x expected desired)
@@ -1346,7 +1320,7 @@
        (with-cps cps
          (build-term
            ($continue k src
-             ($primcall 'atomic-scm-compare-and-swap!/immediate '(atomic-box . 
1)
+             ($primcall 'atomic-box-compare-and-swap! #f
                         (x expected desired)))))))))
 
 ;;; Guile's semantics are that a toplevel lambda captures a reference on