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

9
module/mes/guile.mes
View file

@ -39,6 +39,7 @@
(mes-use-module (mes catch))
(mes-use-module (mes posix))
(mes-use-module (srfi srfi-16))
(mes-use-module (srfi srfi-26))
(mes-use-module (mes display))
(if #t ;;(not (defined? 'read-string))
@ -47,7 +48,7 @@
(if (eq? c #\*eof*) '()
(cons c (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")))
string)))
@ -67,7 +68,7 @@
(define save-peek-char peek-char)
(define save-read-char read-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")))
(let ((tell 0)
(end (string-length string)))
@ -129,7 +130,7 @@
(let ((save-set-current-input-port #f)
(string-port #f))
(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")))
(set! save-set-current-input-port set-current-input-port)
(set! string-port (cons '*string-port* (gensym)))
@ -140,7 +141,7 @@
(tell 0)
(end (string-length string)))
(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 port)
(core:display-error "\n"))