artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Use display for dumping M1.

Browse source 
* 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
1 changed files with 14 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
module/mes/M1.mes
View file

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