mescc: Remove jump calculation, use labels: prepare.
[mes.git] / module / mes / hex2.mes
index 2c5096a97727ca9e380a9feea3d1532dd0dece32..e311ff2f7d1b1bd36a34a636ec9d374f0d68b73b 100644 (file)
                                          16)))
             ((char? o) (dec->hex (char->integer o)))
             ((and (pair? o) (eq? (car o) #:string))
-             (format #f "&~a" (string->label (cadr o))))
+             (format #f "&~a" (string->label o)))
             ((string? o) (format #f "~a" o))
             (else (format #f "~a" o))))
-    (define (write-line o)
-      (newline)
-      (cond ((not (pair? o))
-             (display (dec->hex o)))
-            ((number? (car o))
-             ;;(display (string-join (map dec->hex (filter identity o)) " "))
-             (let ((text (let loop ((text o))
-                           (if (null? text) '()
-                               (let ((label (car text)))
-                                 (if (number? label) (cons label (loop (cdr text)))
-                                     (if (and (pair? label) (member (car label) '(#:comment #:label))) (loop (cdr text))
-                                         (let* ((prefix (if (and (pair? (cdr text))
-                                                                 (pair? (cddr text))
-                                                                 (boolean? (caddr text))) 4
-                                                                 2))
-                                                (address? (and (pair? label) (eq? (car label) #:address)))
-                                                (local? (and (pair? label) (eq? (car label) #:local)))
-                                                (relative? (and (pair? label) (eq? (car label) #:relative)))
-                                                (label (if (or address? local? relative?) (cadr label) label))
-                                                (function? (member label function-names))
-                                                (string-label (string->label label))
-                                                (string? (not (equal? string-label "string_#f")))
-                                                (global? (member label global-names)))
-                                           (cons (cond
-                                                  ((eq? prefix 1) (format #f "!~a" label))
-                                                  ((eq? prefix 2) (format #f "@~a" label))
-                                                  (local? (format #f "%local_~a" label))
-                                                  (function? (format #f "%~a" label))
-                                                  (string? (format #f "&~a" string-label))
-                                                  (global? (format #f "&~a" label))
-                                                  (else (format #f "%~a" label)))
-                                                 (loop (list-tail text prefix)))))))))))
-               (display (string-join (map dec->hex text) " "))))
-            ((member (car o) '(#:comment))
-             (format #t "# ~a" (cadr o)))
-            ((eq? (car o) #:label)
-             (format #t ":~a\n" (cadr o)))
-            ((and (pair? (car o)) (eq? (caar o) #:label))
-             (format #t ":~a\n" (cadar o)))
-            ((and (pair? (car o)) (member (caar o) '(#:comment)))
-             (format #t "# ~a" (cadar o)))
-            ((and (pair? (car o)) (member (caar o) '(#:comment #:label)))
-             (write (car o)))
-            (else (error "write-line LINE:" o))))
+    (define (write-line function)
+      (lambda (o)
+        (newline)
+        (cond ((not (pair? o))
+               (display (dec->hex o)))
+              ((number? (car o))
+               ;;(display (string-join (map dec->hex (filter identity o)) " "))
+               ;; FIXME: c&p from elf-util: function->text
+               (let ((text (let loop ((text o))
+                             (if (null? text) '()
+                                 (let ((label (car text)))
+                                   (if (number? label) (cons label (loop (cdr text)))
+                                       (if (and (pair? label) (member (car label) '(#:comment #:label))) (loop (cdr text))
+                                           (let* ((prefix (cond ((and (pair? (cdr text))
+                                                                      (pair? (cddr text))
+                                                                      (boolean? (caddr text))) 4)
+                                                                ((and (pair? (cdr text))
+                                                                      (boolean? (cadr text))) 2)
+                                                                (else 1)))
+                                                  (address? (and (pair? label) (eq? (car label) #:address)))
+                                                  (local? (and (pair? label) (eq? (car label) #:local)))
+                                                  (relative? (and (pair? label) (eq? (car label) #:relative)))
+                                                  (label (if (or address? local? relative?) (cadr label) label))
+                                                  (function? (member label function-names))
+                                                  (string-label (string->label label))
+                                                  (string? (not (equal? string-label "string_#f")))
+                                                  (global? (member label global-names))
+                                                  (label (if local? (string-append "local_" function "_" label) label)))
+                                             (cons (cond
+                                                    ((eq? prefix 1) (format #f "!~a" label))
+                                                    ((eq? prefix 2) (format #f "@~a" label))
+                                                    (local? (format #f "%~a" label))
+                                                    (function? (if address? (format #f "&~a" label)
+                                                                   (format #f "%~a" label)))
+                                                    (string? (format #f "&~a" string-label))
+                                                    (global? (format #f "&~a" label))
+                                                    (else (format #f "%~a" label)))
+                                                   (loop (list-tail text prefix)))))))))))
+                 (display (string-join (map dec->hex text) " "))))
+              ((member (car o) '(#:comment))
+               (format #t "# ~s" (cadr o)))
+              ((eq? (car o) #:label)
+               (format #t ":local_~a_~a\n" function (cadr o)))
+              ((and (pair? (car o)) (eq? (caar o) #:label))
+               (format #t ":local_~a\n" (cadar o)))
+              ((and (pair? (car o)) (member (caar o) '(#:comment)))
+               (format #t "# ~s" (cadar o)))
+              ((and (pair? (car o)) (member (caar o) '(#:comment #:label)))
+               (write (car o)))
+              (else (error "write-line LINE:" o)))))
     (define (write-function o)
       (format #t "\n\n:~a" (car o))
-      (if (pair? (cadr o)) (for-each write-line (cdr o))
-          (write-line (cdr o))))
+      (if (pair? (cadr o)) (for-each (write-line (car o)) (cdr o))
+          ((write-line (car o)) (cdr o))))
     (define (write-global o)
-      (let ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
-                       (string->label (car o)))))
+      (define (labelize o)
+        (if (not (string? o)) o
+            (let* ((label o)
+                   (function? (member label function-names))
+                   (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)
+                  (begin (if (not function?) (stderr "warning: unresolved label: ~s\n" label))
+                         (format #f "&~a" label))))))
+      (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
+                       (string->label (car o))))
+             (data (cdr o))
+             (data (filter-map labelize data)))
         (format #t "\n:~a\n" label)
-        (display (string-join (map dec->hex (cdr o)) " "))
+        (display (string-join (map dec->hex data) " "))
         (newline)))
     (display "### stage0's hex2 format for x86\n")
     (display "###    !<label>          1 byte relative\n")