Fix def-label and at-addr by using macros

2 files changed, 20 insertions, 15 deletions

diff --git a/atk16_schasm/core.scm b/atk16_schasm/core.scm
index d03816c..08a0bd5 100644
--- a/atk16_schasm/core.scm
+++ b/atk16_schasm/core.scm
@@ -133,22 +133,28 @@
 
 ;; Directives
 
-(define (def-label sym . exprs)
-  (when (assoc sym *labels*)
-    (error "label already defined" sym))
+(define-syntax def-label
+  (syntax-rules ()
+    ((_ sym exprs* ...)
+     (begin
+       (when (assoc sym *labels*)
+	 (error "label already defined" sym))
+
+       (set! *labels* (cons (cons sym *cursor*) *labels*))
+       exprs* ...))))
 
-  (set! *labels* (cons (cons sym *cursor*) *labels*))
-  ;; don't do anything with exprs, it's there for allowing
-  ;; a nice appearance for labeled blocks
-  )
+(define-syntax at-addr
+  (syntax-rules ()
+    ((_ addr exprs* ...)
+     (begin
+       (unless (and (number? addr)
+		    (>= addr 0)
+		    (< addr (expt 2 16)))
+	 (error "invalid addr" addr))
 
-(define (at-addr addr)
-  (unless (and (number? addr)
-	       (>= addr 0)
-	       (< addr (expt 2 16)))
-    (error "invalid addr" addr))
+       (set! *cursor* addr)
 
-  (set! *cursor* addr))
+       exprs* ...))))
 
 ;; Value constructors and references
 
@@ -384,5 +390,5 @@
 		      `(2 . ,(val-of flag))
 		      `(1 . 0)
 		      `(1 . ,set))
-    (emit-deferred-sexpr `(label . (rel ,(val-of offset) ,(+ *cursor* 1)))))
+    (emit-deferred-sexpr `(label . (rel ,(val-of offset) ,(- *cursor* 1)))))
    (else (error "invalid offset" offset))))
diff --git a/atk16_schasm/macros.scm b/atk16_schasm/macros.scm
index 45d2167..d5343f3 100644
--- a/atk16_schasm/macros.scm
+++ b/atk16_schasm/macros.scm
@@ -81,4 +81,3 @@
 
        tb
        (def-label sym-end)))))
-