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

mescc: trace M1 dumping.

Browse source 
* module/language/c99/compiler.mes (info->object): Add tracing.
* module/mes/M1.mes (object->M1): Add tracing.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-07 10:24:57 +02:00
parent f199694a66
commit 5e9c539f57
2 changed files with 12 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
module/language/c99/compiler.mes
View file

@ -2456,6 +2456,7 @@
info))) info)))
(define* (info->object o) (define* (info->object o)
(stderr "compiling: object\n")
`((functions . ,(.functions o)) `((functions . ,(.functions o))
(globals . ,(map (lambda (g) (cons (car g) (global:value (cdr g)))) (.globals o))))) (globals . ,(map (lambda (g) (cons (car g) (global:value (cdr g)))) (.globals o)))))

16
module/mes/M1.mes
View file

@ -85,6 +85,7 @@
(string-append "!" (number->string o)))) (string-append "!" (number->string o))))
(define (object->M1 o) (define (object->M1 o)
(stderr "dumping M1: object\n")
(let* ((functions (assoc-ref o 'functions)) (let* ((functions (assoc-ref o 'functions))
(function-names (map car functions)) (function-names (map car functions))
(file-name (car (or (assoc-ref o 'file-names) function-names))) (file-name (car (or (assoc-ref o 'file-names) function-names)))
@ -131,6 +132,7 @@
(core:display (string-append "\t" (string-join (map text->M1 o) " ")))) (core: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"))
(core:display (string-append "\n\n:" name "\n")) (core: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)
@ -150,17 +152,21 @@
(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)))
(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) (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)))
(display (string-append "\"" (list->string (list-head data (1- (length data)))) "\""))) (core:display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
(else (display (string-join (map text->M1 data) " ")))) (else (core:display (string-join (map text->M1 data) " "))))
(newline))) (newline)))
(core:display-error "M1: functions\n")
(for-each write-function (filter cdr functions)) (for-each write-function (filter cdr functions))
(when (assoc-ref functions "main") (when (assoc-ref functions "main")
(display "\n\n:ELF_data\n") ;; FIXME (core:display "\n\n:ELF_data\n") ;; FIXME
(display "\n\n:HEX2_data\n")) (core:display "\n\n:HEX2_data\n"))
(core:display-error "M1: globals\n")
(for-each write-global globals))) (for-each write-global globals)))