mescc: Use display for dumping M1.

* module/mes/M1.mes (object->M1): Use display for dumping M1.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-23 06:56:35 +02:00
parent 630718f134
commit 9936aa383b
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273

View file

@ -125,15 +125,15 @@
(text (cdr o)))
(define (line->M1 o)
(cond ((eq? (car o) #:label)
(core:display (string-append ":" (cadr o))))
(display (string-append ":" (cadr o))))
((eq? (car o) #:comment)
(core:display (string-append "\t\t\t\t\t# " (text->M1 (cadr o)))))
(display (string-append "\t\t\t\t\t# " (text->M1 (cadr o)))))
((or (string? (car o)) (symbol? (car o)))
(core:display (string-append "\t" (string-join (map text->M1 o) " "))))
(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"))
(display (string-append " :" name "\n") (current-error-port))
(display (string-append "\n\n:" name "\n"))
(for-each line->M1 (apply append text))))
(define (write-global o)
(define (labelize o)
@ -148,25 +148,25 @@
(string-append "&" label))))))
(let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
(string->label (car o))))
(foo (if (not (eq? (car (string->list label)) #\_))
(display (string-append " :" label "\n") (current-error-port))))
(data (cdr o))
(data (filter-map labelize data))
(len (length data))
(string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 80)))
(if (not (eq? (car (string->list label)) #\_))
(core:display-error (string-append " :" label "\n")))
(core:display (string-append "\n:" label "\n"))
(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)))
(core:display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
(else (core:display (string-join (map text->M1 data) " "))))
(display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
(else (display (string-join (map text->M1 data) " "))))
(newline)))
(core:display-error "M1: functions\n")
(display "M1: functions\n" (current-error-port))
(for-each write-function (filter cdr functions))
(when (assoc-ref functions "main")
(core:display "\n\n:ELF_data\n") ;; FIXME
(core:display "\n\n:HEX2_data\n"))
(core:display-error "M1: globals\n")
(display "\n\n:ELF_data\n") ;; FIXME
(display "\n\n:HEX2_data\n"))
(display "M1: globals\n" (current-error-port))
(for-each write-global globals)))