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

mescc: Trace globals.

Browse source 
* module/language/c99/compiler.mes (mescc:trace): New function.  Use
  throughout.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-07 12:56:17 +02:00
parent da724cdaa1
commit 5867ac4afe
1 changed files with 22 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -592,6 +592,9 @@
(define (make-local-entry name type pointer id) (define (make-local-entry name type pointer id)
(cons name (make-local type pointer id))) (cons name (make-local type pointer id)))
(define* (mescc:trace name #:optional (type ""))
(format (current-error-port) " :~a~a\n" name type))
(define (push-ident info) (define (push-ident info)
(lambda (o) (lambda (o)
(let ((local (assoc-ref (.locals info) o))) (let ((local (assoc-ref (.locals info) o)))
@ -1246,9 +1249,6 @@
(ptr-b (expr->pointer info b)) (ptr-b (expr->pointer info b))
(size-a (expr->size info a)) (size-a (expr->size info a))
(size-b (expr->size info b)) (size-b (expr->size info b))
;; (foo (stderr "assign ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))))
;; (foo (stderr " size-a: ~a, ptr=~a\n" size-a ptr-a))
;; (foo (stderr " size-b: ~a, ptr=~a\n" size-b ptr-b))
(info ((expr->accu info) b)) (info ((expr->accu info) b))
(info (if (equal? op "=") info (info (if (equal? op "=") info
(let* ((ptr (expr->pointer info a)) (let* ((ptr (expr->pointer info a))
@ -1802,7 +1802,8 @@
(locals (cons local locals)) (locals (cons local locals))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
info) info)
(let* ((globals (.globals info)) (let* ((foo (mescc:trace name " <g>"))
(globals (.globals info))
(count (expr->number info count)) (count (expr->number info count))
(size (ast-type->size info type)) (size (ast-type->size info type))
(pointer (expr->pointer info `(type-spec ,type))) (pointer (expr->pointer info `(type-spec ,type)))
@ -1824,7 +1825,8 @@
(locals (cons local locals)) (locals (cons local locals))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
info) info)
(let* ((globals (.globals info)) (let* ((foo (mescc:trace name " <g>"))
(globals (.globals info))
(count (expr->number info count)) (count (expr->number info count))
(size 4) (size 4)
(pointer (expr->pointer info `(type-spec ,type))) (pointer (expr->pointer info `(type-spec ,type)))
@ -1833,13 +1835,14 @@
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,array) (p-expr (fixed ,size))) (initzer (p-expr (string ,string)))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,size))) (initzer (p-expr (string ,string))))))
(if (.function info) (if (.function info)
(error "TODO: " o) (error "TODO: " o)
(let* ((globals (.globals info)) (let* ((foo (mescc:trace name " <g>"))
(globals (.globals info))
;; (count (cstring->number count)) ;; (count (cstring->number count))
;; (size (ast-type->size info type)) ;; (size (ast-type->size info type))
(array (make-global-entry array type -1 (string->list string))) (array (make-global-entry name type -1 (string->list string)))
(globals (append globals (list array)))) (globals (append globals (list array))))
(clone info #:globals globals)))) (clone info #:globals globals))))
@ -1896,6 +1899,7 @@
;; struct f = {...}; ;; struct f = {...};
;; LOCALS! ;; LOCALS!
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers))))) ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
(if (not (.function info)) (mescc:trace name " <g>"))
(let* ((info (append-text info (ast->comment o))) (let* ((info (append-text info (ast->comment o)))
(type (decl->ast-type type)) (type (decl->ast-type type))
(fields (ast-type->description info type)) (fields (ast-type->description info type))
@ -1941,6 +1945,7 @@
;; DECL ;; DECL
;; char *bla[] = {"a", "b"}; ;; char *bla[] = {"a", "b"};
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers))))) ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers)))))
(if (not (.function info)) (mescc:trace name " <g>"))
(let* ((type (decl->ast-type type)) (let* ((type (decl->ast-type type))
(pointer (pke "2pointer: " (expr->pointer info `(type-spec ,type)))) (pointer (pke "2pointer: " (expr->pointer info `(type-spec ,type))))
(pointer (pke "pointer: " (- -3 pointer))) (pointer (pke "pointer: " (- -3 pointer)))
@ -1977,6 +1982,7 @@
;; int foo[2] = { ... } ;; int foo[2] = { ... }
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) ,count) (initzer (initzer-list . ,initzers))))) ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) ,count) (initzer (initzer-list . ,initzers)))))
(if (not (.function info)) (mescc:trace name " <g>"))
(let* ((info (type->info info type)) (let* ((info (type->info info type))
(xtype type) (xtype type)
(type (decl->ast-type type)) (type (decl->ast-type type))
@ -2014,12 +2020,14 @@
(xtype type) (xtype type)
(type (decl->ast-type type)) (type (decl->ast-type type))
(name (init-declr->name init)) (name (init-declr->name init))
(pointer (pke "pointer:" (init-declr->pointer init))) (foo (if (not (.function info)) (mescc:trace name " <g>")))
(pointer (init-declr->pointer init))
(initzer-globals (if (null? initzer) '() (initzer-globals (if (null? initzer) '()
(filter identity (append-map (initzer->globals globals) initzer)))) (filter identity (append-map (initzer->globals globals) initzer))))
(global-names (map car globals)) (global-names (map car globals))
(initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals)) (initzer-globals (filter (lambda (g) (and g (not (member (car g) global-names)))) initzer-globals))
(initzer (if (null? initzer) '() ((initzer->non-const info) initzer))) (initzer (if (null? initzer) '() ((initzer->non-const info) initzer)))
;;FIXME: ridiculous performance hit with mes
(info (append-text info (ast->comment o))) (info (append-text info (ast->comment o)))
(globals (append globals initzer-globals)) (globals (append globals initzer-globals))
(info (clone info #:globals globals)) (info (clone info #:globals globals))
@ -2277,6 +2285,9 @@
(define (enum-def-list->constants constants fields) (define (enum-def-list->constants constants fields)
(let loop ((fields fields) (i 0) (constants constants)) (let loop ((fields fields) (i 0) (constants constants))
(if (pair? fields)
(let ((field (car fields)))
(mescc:trace (cadr (cadr field)) " <e>")))
(if (null? fields) constants (if (null? fields) constants
(let* ((field (car fields)) (let* ((field (car fields))
(name (pmatch field (name (pmatch field
@ -2356,6 +2367,7 @@
(define (type->info info o) (define (type->info info o)
(pmatch o (pmatch o
((struct-def (ident ,name) (field-list . ,fields)) ((struct-def (ident ,name) (field-list . ,fields))
(mescc:trace name " <t>")
(let ((type-entry (struct->type-entry name (map (struct-field info) fields)))) (let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
(clone info #:types (cons type-entry (.types info))))) (clone info #:types (cons type-entry (.types info)))))
(_ info))) (_ info)))
@ -2416,7 +2428,7 @@
(formals (.formals o)) (formals (.formals o))
(text (formals->text formals)) (text (formals->text formals))
(locals (formals->locals formals))) (locals (formals->locals formals)))
(format (current-error-port) " :~a\n" name) (mescc:trace name)
(let loop ((statements (.statements o)) (let loop ((statements (.statements o))
(info (clone info #:locals locals #:function (.name o) #:text text))) (info (clone info #:locals locals #:function (.name o) #:text text)))
(if (null? statements) (let* ((locals (.locals info)) (if (null? statements) (let* ((locals (.locals info))