mescc: trace M1 dumping.
[mes.git] / module / mes / M1.mes
index 72f09b0e74a38ecc50c431bd9cf12194845383ef..aa37be56b9711755b38ccac8c4d70e48efd7e508 100644 (file)
@@ -85,6 +85,7 @@
       (string-append "!" (number->string o))))
 
 (define (object->M1 o)
+  (stderr "dumping M1: object\n")
   (let* ((functions (assoc-ref o 'functions))
          (function-names (map car functions))
          (file-name (car (or (assoc-ref o 'file-names) function-names)))
                  (core:display (string-append "\t" (string-join (map text->M1 o) " "))))
                 (else (error "line->M1 invalid line:" o)))
           (newline))
+        (core:display-error (string-append "    :" name "\n"))
         (core:display (string-append "\n\n:" name "\n"))
         (for-each line->M1 (apply append text))))
     (define (write-global o)
              (data (filter-map labelize data))
              (len (length data))
              (string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 80)))
-        (display (string-append "\n:" label "\n"))
+        (if (not (eq? (car (string->list label)) #\_))
+            (core:display-error (string-append "    :" label "\n")))
+        (core:display (string-append "\n:" label "\n"))
         (cond ((and (< len string-max)
                     (char? (car data))
                     (eq? (last data) #\nul)
                     (not (find (cut memq <> '(#\nul #\backspace #\return #\" #\')) (list-head data (1- (length data)))))
                     (not (any (lambda (ch) (>= (char->integer ch) #x80)) data)))
-               (display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
-              (else (display (string-join (map text->M1 data) " "))))
+               (core:display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
+              (else (core:display (string-join (map text->M1 data) " "))))
         (newline)))
+    (core:display-error "M1: functions\n")
     (for-each write-function (filter cdr functions))
     (when (assoc-ref functions "main")
-      (display "\n\n:ELF_data\n") ;; FIXME
-      (display "\n\n:HEX2_data\n"))
+      (core:display "\n\n:ELF_data\n") ;; FIXME
+      (core:display "\n\n:HEX2_data\n"))
+    (core:display-error "M1: globals\n")
     (for-each write-global globals)))