mescc: Output performance hacks: use core:display.

[mes.git] / module / mes / M1.mes

diff --git a/module/mes/M1.mes b/module/mes/M1.mes
index 52ecd7045de81bb923146a971107d96e52d4e42f..7868ec46dfa889c99e5d81940c312cdecc428e6f 100644 (file)
--- a/module/mes/M1.mes
+++ b/module/mes/M1.mes
@@ -78,11 +78,11 @@
 
 (define (hex2:immediate o)
   (if hex? (string-append "%0x" (dec->hex o))
-      (format #f "%~a" o)))
+      (string-append "%" (number->string o))))
 
 (define (hex2:immediate1 o)
   (if hex? (string-append "!0x" (dec->hex o))
-      (format #f "!~a" o)))
+      (string-append "!" (number->string o))))
 
 (define (object->M1 o)
   (let* ((functions (assoc-ref o 'functions))
@@ -93,41 +93,45 @@
          (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names)))
     (define (string->label o)
       (let ((index (list-index (lambda (s) (equal? s o)) strings)))
-       (format #f "_string_~a_~a" file-name index)))
+        (if index
+            (string-append "_string_" file-name "_" (number->string index))
+            "")))
     (define (text->M1 o)
-      (pmatch o
-        ;; FIXME
-        ((#:address (#:string ,string)) (hex2:address (string->label `(#:string ,string))))
-        ((#:string (#:address ,address)) (hex2:address address))
-        ((#:address (#:address ,address)) (hex2:address address))
-
-        ((#:string ,string) (hex2:address (string->label o)))
-        ((#:address ,address) (hex2:address address))
-        ((#:offset ,offset) (hex2:offset offset))
-        ((#:offset1 ,offset1) (hex2:offset1 offset1))
-        ((#:immediate ,immediate) (hex2:immediate immediate))
-        ((#:immediate1 ,immediate1) (hex2:immediate1 immediate1))
-        (_ (cond ((char? o) (text->M1 (char->integer o)))
-                 ((string? o) (format #f "~a" o))
-                 ((number? o) (let ((o (if (< o #x80) o (- o #x100))))
-                                (if hex? (string-append "!0x"
-                                                        (if (and (>= o 0) (< o 16)) "0" "")
-                                                        (number->string o 16))
-                                    (string-append "!" (number->string o)))))
-                 (else (format #f "~a" o))))))
+      (cond
+       ((char? o) (text->M1 (char->integer o)))
+       ((string? o) o)
+       ((symbol? o) (symbol->string o))
+       ((number? o) (let ((o (if (< o #x80) o (- o #x100))))
+                      (if hex? (string-append "!0x"
+                                              (if (and (>= o 0) (< o 16)) "0" "")
+                                              (number->string o 16))
+                          (string-append "!" (number->string o)))))
+       ((and (pair? o) (keyword? (car o)))
+        (pmatch o
+         ;; FIXME
+         ((#:address (#:string ,string)) (hex2:address (string->label `(#:string ,string))))
+         ((#:string (#:address ,address)) (hex2:address address))
+         ((#:address (#:address ,address)) (hex2:address address))
+         ((#:string ,string) (hex2:address (string->label o)))
+         ((#:address ,address) (hex2:address address))
+         ((#:offset ,offset) (hex2:offset offset))
+         ((#:offset1 ,offset1) (hex2:offset1 offset1))
+         ((#:immediate ,immediate) (hex2:immediate immediate))
+         ((#:immediate1 ,immediate1) (hex2:immediate1 immediate1))))
+       ((pair? o) (string-join (map text->M1 o)))))
     (define (write-function o)
       (let ((name (car o))
             (text (cdr o)))
         (define (line->M1 o)
           (cond ((eq? (car o) #:label)
-                 (format #t ":~a" (cadr o)))
+                 (core:display (string-append ":" (cadr o))))
                 ((eq? (car o) #:comment)
-                 (format #t "\t\t\t\t\t# ~a" (cadr o)))
+                 (core:display (string-append "\t\t\t\t\t# " (text->M1 (cadr o)))))
                 ((or (string? (car o)) (symbol? (car o)))
-                 (format #t "\t~a" (string-join (map text->M1 o) " ")))
+                 (core:display (string-append "\t" (string-join (map text->M1 o) " "))))
                 (else (error "line->M1 invalid line:" o)))
           (newline))
-        (format #t "\n\n:~a\n" name)
+        (core:display (string-append "\n\n:" name "\n"))
         (for-each line->M1 (apply append text))))
     (define (write-global o)
       (define (labelize o)
@@ -137,11 +141,11 @@
                    (string-label (string->label label))
                    (string? (not (equal? string-label "_string_#f")))
                    (global? (member label global-names)))
-              (if (or global? string?) (format #f "&~a" label)
+              (if (or global? string?) (string-append "&" label)
                   (begin (if (not function?) (stderr "warning: unresolved label: ~s\n" label))
-                         (format #f "&~a" label))))))
+                         (string-append "&" label))))))
       (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
-                       (string->label (car o))))
+                        (string->label (car o))))
              (data (cdr o))
              (data (filter-map labelize data))
              (len (length data))