[<<][staapl][>>][..]
Thu Apr 9 09:28:40 CEST 2009

asm hygiene problems

Looks like there are a couple of problems with the current assembler
implementation: when introducing symbols, some lexical information
apparently gets lost.  Time to cleanup the lot.

Hygiene problems seem to be solved, but now the app/ tests have
changed code.

I'm going to revert the assembler sources to isolate the change that
breaks the tests.

See the offending change below.  I'm going to introduce just lexical
correctness, and see where it goes.

hunk ./staapl/asm/asmgen-tx.ss 28
+ "../tools/stx.ss"
hunk ./staapl/asm/asmgen-tx.ss 39
+(check-set-mode! 'report-failed)
hunk ./staapl/asm/asmgen-tx.ss 55
-;; (bitstring->list "0101 kkkk ffff ffff")
+;; Parse bitstring.
hunk ./staapl/asm/asmgen-tx.ss 61
+(check (bitstring->list "0101 kkkk ffff ffff")
+       => '(0 1 0 1 k k k k f f f f f f f f))
hunk ./staapl/asm/asmgen-tx.ss 65
-;; (bin->number '(1 1 0 0))
hunk ./staapl/asm/asmgen-tx.ss 68
+(check (bin->number '(1 1 0 0)) => 12)
hunk ./staapl/asm/asmgen-tx.ss 72
-;; (combine-bits '((k . 1) (k . 1) (k . 1)))
hunk ./staapl/asm/asmgen-tx.ss 79
-
+(check (combine-bits '((k . 1) (k . 1) (k . 1)
+                       (l . 1) (l . 1))) => '((k . 3) (l . 2)))
hunk ./staapl/asm/asmgen-tx.ss 93
+(check (split-opcode '(1 0 1 0 k k k k l l)) => '((10 . 4) (k . 4) (l . 2)))
hunk ./staapl/asm/asmgen-tx.ss 97
-(define (parse-opcode-proto str)
-  (split-opcode
-   (bitstring->list str)))
+(define (parse-opcode-proto str-stx)
+  ;; After parsing the string, the lexical information needs to be restored.
+  (define restore-lexical-info
+    (match-lambda
+     ((name . bits)
+      (cons
+       (if (symbol? name)
+           (datum->syntax str-stx
+                          name)
+           name)
+       bits))))
+  (map restore-lexical-info
+       (split-opcode
+        (bitstring->list
+         (syntax->datum str-stx)))))
hunk ./staapl/asm/asmgen-tx.ss 118
-(define (binary->proto row)
-  (match row
-         ((name proto . binary)
-          (append (list name proto)
-                  (map parse-opcode-proto binary)))))
+(define (binary->proto row-stx)
+  (syntax-case row-stx ()
+    ((name proto . binary)
+     (append (list #'name   ;; preserve name's lexical info
+                   #'proto)
+             (map parse-opcode-proto (syntax->list #'binary))))))
hunk ./staapl/asm/asmgen-tx.ss 126
-(check (binary->proto '(xorwf (f d a) "0001 10da ffff ffff"))
-       => '(xorwf (f d a) ((6 . 6) (d . 1) (a . 1) (f . 8))))
+(check (->sexp (binary->proto '(xorwf (f d a) "0001 10da ffff ffff")))
+       => `(xorwf (f d a) ((6 . 6) (d . 1) (a . 1) (f . 8))))
hunk ./staapl/asm/asmgen-tx.ss 159
+  (->sexp
hunk ./staapl/asm/asmgen-tx.ss 166
+  )
hunk ./staapl/asm/asmgen-tx.ss 198
-(define (instruction-set-tx asm! dasm! instructions)
-  (let ((protos
-         (map
-          binary->proto
-          (syntax->datum instructions))))
-    [_$_]
+(define (instruction-set-tx define-assembler dasm! instructions)
+  (let ((protos (map binary->proto (syntax->list instructions))))
hunk ./staapl/asm/asmgen-tx.ss 207
-                          (#,asm!
-                           '#,name
+                          (#,define-assembler
+                           #,name
hunk ./staapl/asm/asmgen.ss 36
-    ((_ asm! dasm! instructions ...)
-     (instruction-set-tx #'asm!
+    ((_ define-assembler dasm! instructions ...)
+     (instruction-set-tx #'define-assembler
hunk ./staapl/asm/asmgen.ss 42
-  (iset asm-register!
+  (iset define-assembler
hunk ./staapl/asm/asmgen.ss 50
-(let ((asm  #f)
-      (dasm #f))
-  (let ((asm!  (lambda (name fn)     (set! asm fn)))
-        (dasm! (lambda (opc bits fn) (set! dasm fn))))
-    (iset asm! dasm!
-     (testopc (a b R) "1010 RRRR aaaa bbbb"))
-    (parameterize
-        ((current-pointers #hasheq((code . (-1)))))
-      (check (asm  4 2 -1) => '(#xAF42))
-      (check (dasm #xAF42) => '(testopc (a . 4) (b . 2) (R . -1)))
-      (void))))
+
+'(let*
+    ((testopc #f)
+     (dasm #f)
+     (dasm! (lambda (opc bits fn) (set! dasm fn))))
+
+  (iset set!   ;; define-assembler
+        dasm!
+        (testopc (a b R) "1010 RRRR aaaa bbbb"))
+  (parameterize
+      ((current-pointers #hasheq((code . (-1)))))
+    (check (testopc 4 2 -1) => '(#xAF42))
+    (check (dasm #xAF42)    => '(testopc (a . 4) (b . 2) (R . -1)))
+    (void)))
hunk ./staapl/asm/dictionary.ss 23
- asm-register!  asm-find
+
+ [_$_]
+ ;; asm-register!  asm-find
+ define-assembler
+
+ [_$_]
hunk ./staapl/asm/dictionary.ss 31
- define-asm
+ define-asm   ;; FIXME: get rid of this
hunk ./staapl/asm/dictionary.ss 47
+
+
+(define-syntax-rule (define-assembler name fn) (asm-register! 'name fn))
+
+
+
+
hunk ./staapl/asm/dictionary.ss 119
+
+
hunk ./staapl/tools/stx.ss 15
+
+;; FIXME: doesn't handle all cases (i.e. vectors..)
hunk ./staapl/tools/stx.ss 21
+   ((pair? x)   (cons (->sexp (car x)) (->sexp (cdr x))))
+   ((null? x)   '())



[Reply][About]
[<<][staapl][>>][..]