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

mescc: Remove debugging.

Browse source 
* module/language/c99/compiler.mes: Remove debugging.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-07 13:14:58 +02:00
parent 83549786ed
commit cd0e3f8ba5
2 changed files with 24 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1091,10 +1091,9 @@
((add ,a (p-expr (fixed ,value))) ((add ,a (p-expr (fixed ,value)))
;;(stderr "add ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))) (let* ((ptr (expr->pointer info a))
(let* ((ptr (pke "ptr" (expr->pointer info a)))
(type0 (expr->type info a)) (type0 (expr->type info a))
(struct? (pke "struct" (memq (type:type (ast-type->type info type0)) '(struct union)))) (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
(size (cond ((= ptr 1) (expr->type-size info a)) (size (cond ((= ptr 1) (expr->type-size info a))
((> ptr 1) 4) ((> ptr 1) 4)
((and struct? (= ptr -2)) 4) ((and struct? (= ptr -2)) 4)
@ -1102,8 +1101,7 @@
(else 1))) (else 1)))
(info ((expr->accu info) a)) (info ((expr->accu info) a))
(value (cstring->number value)) (value (cstring->number value))
(value (pke "VALUE" (* size value)))) (value (* size value)))
(pke "size" size)
(append-text info (wrap-as (i386:accu+value value))))) (append-text info (wrap-as (i386:accu+value value)))))
((add ,a ,b) ((add ,a ,b)
@ -1139,17 +1137,15 @@
(append-text info (wrap-as (i386:accu+value (- value)))))) (append-text info (wrap-as (i386:accu+value (- value))))))
((sub ,a ,b) ((sub ,a ,b)
;;(stderr "sub ~s\n"(with-output-to-string (lambda () (pretty-print-c99 o)))) (let* ((ptr (expr->pointer info a))
(let* ((ptr (pke "ptr" (expr->pointer info a))) (ptr-b (expr->pointer info b))
(ptr-b (pke "ptr-b" (expr->pointer info b)))
(type0 (expr->type info a)) (type0 (expr->type info a))
(struct? (pke "struct?" (memq (type:type (ast-type->type info type0)) '(struct union)))) (struct? (memq (type:type (ast-type->type info type0)) '(struct union)))
(size (cond ((= ptr 1) (expr->type-size info a)) (size (cond ((= ptr 1) (expr->type-size info a))
((> ptr 1) 4) ((> ptr 1) 4)
((and struct? (= ptr -2)) 4) ((and struct? (= ptr -2)) 4)
((and struct? (= ptr 2)) 4) ((and struct? (= ptr 2)) 4)
(else 1)))) (else 1))))
(pke "size" size)
(if (or (= size 1) (or (= ptr-b -2) (= ptr-b 1))) (if (or (= size 1) (or (= ptr-b -2) (= ptr-b 1)))
(let ((info ((binop->accu info) a b (i386:accu-base)))) (let ((info ((binop->accu info) a b (i386:accu-base))))
(if (and (not (= ptr-b -2)) (not (= ptr-b 1))) info (if (and (not (= ptr-b -2)) (not (= ptr-b 1))) info
@ -1799,7 +1795,7 @@
(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)))
(pointer (- -1 pointer)) (pointer (- -1 pointer))
(local (pke "0local: " (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))) (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
(locals (cons local locals)) (locals (cons local locals))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
info) info)
@ -1809,7 +1805,7 @@
(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)))
(pointer (- -1 pointer)) (pointer (- -1 pointer))
(array (pke "0global: " (make-global-entry name type pointer (string->list (make-string (* count size) #\nul))))) (array (make-global-entry name type pointer (string->list (make-string (* count size) #\nul))))
(globals (append globals (list array)))) (globals (append globals (list array))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1822,7 +1818,7 @@
(size 4) (size 4)
(pointer (expr->pointer info `(type-spec ,type))) (pointer (expr->pointer info `(type-spec ,type)))
(pointer (- -3 pointer)) (pointer (- -3 pointer))
(local (pke "1local:" (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))) (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
(locals (cons local locals)) (locals (cons local locals))
(info (clone info #:locals locals))) (info (clone info #:locals locals)))
info) info)
@ -1832,7 +1828,7 @@
(size 4) (size 4)
(pointer (expr->pointer info `(type-spec ,type))) (pointer (expr->pointer info `(type-spec ,type)))
(pointer (- -3 pointer)) (pointer (- -3 pointer))
(global (pke "1global: " (make-global-entry name type pointer (string->list (make-string (* count size) #\nul))))) (global (make-global-entry name type pointer (string->list (make-string (* count size) #\nul))))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1948,8 +1944,8 @@
((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>")) (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 (expr->pointer info `(type-spec ,type)))
(pointer (pke "pointer: " (- -3 pointer))) (pointer (- -3 pointer))
(entries (filter identity (append-map (initzer->globals globals) initzers))) (entries (filter identity (append-map (initzer->globals globals) initzers)))
(global-names (map car globals)) (global-names (map car globals))
(entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries)) (entries (filter (lambda (g) (and g (not (member (car g) global-names)))) entries))
@ -1960,7 +1956,7 @@
(if (.function info) (if (.function info)
(let* ((count (length initzers)) (let* ((count (length initzers))
(local (car (add-local locals name type -1))) (local (car (add-local locals name type -1)))
(local (pke "2local: " (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (1+ count))))) (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (1+ count))))
(locals (cons local locals)) (locals (cons local locals))
(info (clone info #:locals locals)) (info (clone info #:locals locals))
(info (clone info #:globals globals)) (info (clone info #:globals globals))
@ -1977,7 +1973,7 @@
(wrap-as (append (i386:accu->base))) (wrap-as (append (i386:accu->base)))
(.text ((expr->accu empty) initzer)) (.text ((expr->accu empty) initzer))
(wrap-as (i386:accu->base-mem+n offset))))))))) (wrap-as (i386:accu->base-mem+n offset)))))))))
(let* ((global (pke "2global: " (make-global-entry name type pointer (append-map (initzer->data info) initzers)))) (let* ((global (make-global-entry name type pointer (append-map (initzer->data info) initzers)))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -2002,7 +1998,7 @@
(size (* count type-size))) (size (* count type-size)))
(if (.function info) (if (.function info)
(let* ((local (car (add-local locals name type 1))) (let* ((local (car (add-local locals name type 1)))
(local (pke "3local: " (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))) (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4))))
(locals (cons local locals)) (locals (cons local locals))
(local (cdr local)) (local (cdr local))
(info (clone info #:locals locals)) (info (clone info #:locals locals))
@ -2012,7 +2008,7 @@
(info ((accu->local+n info local) n))) (info ((accu->local+n info local) n)))
(loop info (cdr initzers) (+ n type-size))))))) (loop info (cdr initzers) (+ n type-size)))))))
info) info)
(let* ((global (pke "3global:" (make-global-entry name type pointer (append-map (initzer->data info) initzers)))) (let* ((global (make-global-entry name type pointer (append-map (initzer->data info) initzers)))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -2043,15 +2039,15 @@
(if (.function info) (if (.function info)
(let* ((locals (if (or (> pointer 0) (<= size 4)) (add-local locals name type pointer) (let* ((locals (if (or (> pointer 0) (<= size 4)) (add-local locals name type pointer)
(let* ((local (car (add-local locals name type 1))) (let* ((local (car (add-local locals name type 1)))
(local (pke "4local:" (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4)))))) (local (make-local-entry name type pointer (+ (local:id (cdr local)) -1 (quotient (+ size 3) 4)))))
(cons local locals)))) (cons local locals))))
(info (clone info #:locals locals)) (info (clone info #:locals locals))
(info (if (null? initzer) info ((initzer->accu info) (car initzer)))) (info (if (null? initzer) info ((initzer->accu info) (car initzer))))
;; FIXME array...struct? ;; FIXME array...struct?
(info (if (null? initzer) info (append-text info ((accu->ident info) name))))) (info (if (null? initzer) info (append-text info ((accu->ident info) name)))))
info) info)
(let* ((global (pke "4global:" (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul)) (let* ((global (make-global-entry name type pointer (if (null? initzer) (string->list (make-string size #\nul))
(append-map (initzer->data info) initzer))))) (append-map (initzer->data info) initzer))))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))

9
module/mes/guile.mes
View file

@ -39,6 +39,7 @@
(mes-use-module (mes catch)) (mes-use-module (mes catch))
(mes-use-module (mes posix)) (mes-use-module (mes posix))
(mes-use-module (srfi srfi-16)) (mes-use-module (srfi srfi-16))
(mes-use-module (srfi srfi-26))
(mes-use-module (mes display)) (mes-use-module (mes display))
(if #t ;;(not (defined? 'read-string)) (if #t ;;(not (defined? 'read-string))
@ -47,7 +48,7 @@
(if (eq? c #\*eof*) '() (if (eq? c #\*eof*) '()
(cons c (read-string (read-char))))) (cons c (read-string (read-char)))))
(let ((string (list->string (read-string (read-char))))) (let ((string (list->string (read-string (read-char)))))
(if (getenv "MES_DEBUG") (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
(core:display-error (string-append "drained: `" string "'\n"))) (core:display-error (string-append "drained: `" string "'\n")))
string))) string)))
@ -67,7 +68,7 @@
(define save-peek-char peek-char) (define save-peek-char peek-char)
(define save-read-char read-char) (define save-read-char read-char)
(define save-unread-char unread-char) (define save-unread-char unread-char)
(if (getenv "MES_DEBUG") (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
(core:display-error (string-append "with-input-from-string: `" string "'\n"))) (core:display-error (string-append "with-input-from-string: `" string "'\n")))
(let ((tell 0) (let ((tell 0)
(end (string-length string))) (end (string-length string)))
@ -129,7 +130,7 @@
(let ((save-set-current-input-port #f) (let ((save-set-current-input-port #f)
(string-port #f)) (string-port #f))
(lambda (string) (lambda (string)
(if (getenv "MES_DEBUG") (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
(core:display-error (string-append "open-input-string: `" string "'\n"))) (core:display-error (string-append "open-input-string: `" string "'\n")))
(set! save-set-current-input-port set-current-input-port) (set! save-set-current-input-port set-current-input-port)
(set! string-port (cons '*string-port* (gensym))) (set! string-port (cons '*string-port* (gensym)))
@ -140,7 +141,7 @@
(tell 0) (tell 0)
(end (string-length string))) (end (string-length string)))
(lambda (port) (lambda (port)
(when (getenv "MES_DEBUG") (when (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
(core:display-error (string-append "open-input-string: `" string "' save-set-current-input-port port=")) (core:display-error (string-append "open-input-string: `" string "' save-set-current-input-port port="))
(core:display-error port) (core:display-error port)
(core:display-error "\n")) (core:display-error "\n"))