Improve macros

1 files changed, 44 insertions, 8 deletions

diff --git a/atk16_schasm/macros.scm b/atk16_schasm/macros.scm
index 31cc91e..6b759b3 100644
--- a/atk16_schasm/macros.scm
+++ b/atk16_schasm/macros.scm
@@ -117,8 +117,15 @@
 (define *proc-scope* (make-parameter #f))
 
 (define (param pname)
-  (or (assocdr pname (*proc-scope*))
-      (error "no such param" pname)))
+  (let* ((scope (or (*proc-scope*)
+		    (error "cannot use params outside a procedure context"))))
+    (or (assocdr pname (*proc-scope*))
+	(error "no such param" pname))))
+
+(define-syntax %param
+  (syntax-rules ()
+    ((_ pname)
+     (param 'pname))))
 
 (define-syntax %def-proc
   (syntax-rules ()
@@ -126,9 +133,11 @@
      (let* ((name     (car `signature))
 	    (params   (cdr `signature))
 	    (bindings (zip params
-                           (map (@ reg) (iota (length params) 0)))))
+                           (map (@ reg) (iota (length params) 0))))
+	    (n-max-params 12))
+       (unless (<= (length params) n-max-params)
+	 (error (format "proc has too many params (~A > ~A)" (length params) n-max-params)))
        (%decl-proc signature)
-       (print name)
        (def-label name)
        (parameterize ((*proc-scope* bindings))
 	 body* ...)
@@ -137,22 +146,49 @@
 (define-syntax %call
   (syntax-rules ()
     ((_ name args* ...)
-     (let* ((params  (or (assocdr 'name *procedures*)
-			 (error "proc not defined" 'name)))
+     (let* ((params  (or (assocdr `name *procedures*)
+			 (error "proc not defined" `name)))
 	    (args    (list args* ...))
 	    (n       (next-unique))
 	    (sym-ret (string->symbol (format "~A-ret" n))))
 
        (unless (= (length params) (length args))
-	 (error (format "incorrect args, expected ~A, got ~A" params args)))
+	 (error (format "incorrect args to ~A, expected ~A, got ~A" `name params args)))
 
        (let loop ((i 0))
 	 (when (< i (length args))
+	   ;; check that there are no reg arguments in later positions
+	   ;; that would be clobered/invalidated by a move
+	   (let loop ((j (+ i 1)))
+	     (when (< j (length args))
+	       (let* ((jarg  (list-ref args j))
+		      (jtype (type-of jarg))
+		      (jval  (val-of  jarg)))
+		 (when (and (eq? 'reg jtype)
+			    (eq? i    jval))
+		   (error "proc call would clobber register before it is moved" jarg '(name args* ...))))
+	       (loop (+ j 1))))
+
+	   ;; move each argument to its designated register
+	   ;; first arg to R0, etc.
 	   (let* ((rn (reg i)))
 	     (ld rn (list-ref args i)))
 	   (loop (+ 1 i))))
 
        (st SP (label sym-ret) push: #t)
-       (ld PC (label 'name))
+       (ld PC (label `name))
        (def-label sym-ret)
        ))))
+
+(define (spush datum)
+  (cond
+   ((eq? 'reg (type-of datum))
+    (st datum SP push: #t))
+   (else
+    (ld *macro-scratch-reg* datum)
+    (st *macro-scratch-reg* SP push: #t indirect: 1))))
+
+(define (spop reg)
+  (unless (eq? 'reg (type-of reg))
+    (error "not a register" reg))
+  (ld reg SP pop: #t indirect: 1))