mescc: Remove debugging.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 7 Apr 2018 11:14:58 +0000 (13:14 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 7 Apr 2018 11:14:58 +0000 (13:14 +0200)
* module/language/c99/compiler.mes: Remove debugging.

module/language/c99/compiler.mes
module/mes/guile.mes

index eb052248e70ab9d48d17a2b98b66a5d7da10bd52..af0f8807e094dc4a8a4cd1eb5f81a5e5a9b7abc2 100644 (file)
 
 
         ((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 (pke "ptr" (expr->pointer info a)))
+         (let* ((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))
                             ((> ptr 1) 4)
                             ((and struct? (= ptr -2)) 4)
                 (size (cond ((= ptr 1) (expr->type-size info a))
                             ((> ptr 1) 4)
                             ((and struct? (= ptr -2)) 4)
                             (else 1)))
                 (info ((expr->accu info) a))
                 (value (cstring->number value))
                             (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)
            (append-text info (wrap-as (i386:accu+value value)))))
 
         ((add ,a ,b)
            (append-text info (wrap-as (i386:accu+value (- value))))))
 
         ((sub ,a ,b)
            (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))
                 (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))))
                 (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
            (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
                       (size (ast-type->size info type))
                       (pointer (expr->pointer info `(type-spec ,type)))
                       (pointer (- -1 pointer))
                       (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)
                       (locals (cons local locals))
                       (info (clone info #:locals locals)))
                  info)
                       (size (ast-type->size info type))
                       (pointer (expr->pointer info `(type-spec ,type)))
                       (pointer (- -1 pointer))
                       (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)))))
 
                       (globals (append globals (list array))))
                  (clone info #:globals globals)))))
 
                       (size 4)
                       (pointer (expr->pointer info `(type-spec ,type)))
                       (pointer (- -3 pointer))
                       (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)
                       (locals (cons local locals))
                       (info (clone info #:locals locals)))
                  info)
                       (size 4)
                       (pointer (expr->pointer info `(type-spec ,type)))
                       (pointer (- -3 pointer))
                       (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)))))
 
                       (globals (append globals (list global))))
                  (clone info #:globals globals)))))
 
         ((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))
         ((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))
                 (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))
            (if (.function info)
                (let* ((count (length initzers))
                       (local (car (add-local locals name type -1)))
            (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))
                       (locals (cons local locals))
                       (info (clone info #:locals locals))
                       (info (clone info #:globals globals))
                                        (wrap-as (append (i386:accu->base)))
                                        (.text ((expr->accu empty) initzer))
                                        (wrap-as (i386:accu->base-mem+n offset)))))))))
                                        (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)))))
 
                       (globals (append globals (list global))))
                  (clone info #:globals globals)))))
 
                 (size (* count type-size)))
            (if (.function info)
                (let* ((local (car (add-local locals name type 1)))
                 (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))
                       (locals (cons local locals))
                       (local (cdr local))
                       (info (clone info #:locals locals))
                                          (info ((accu->local+n info local) n)))
                                     (loop info (cdr initzers) (+ n type-size)))))))
                  info)
                                          (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)))))
 
                       (globals (append globals (list global))))
                  (clone info #:globals globals)))))
 
            (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)))
            (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)
                                     (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)))))
 
                       (globals (append globals (list global))))
                  (clone info #:globals globals)))))
 
index 2397d4c37bfa93d1a1ced4108ec738184f43b441..fa2c46affad3cd27d19adac24aeee98f58163ae3 100644 (file)
@@ -39,6 +39,7 @@
 (mes-use-module (mes catch))
 (mes-use-module (mes posix))
 (mes-use-module (srfi srfi-16))
 (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))
 (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 (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)))
 
             (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)
   (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)))
       (core:display-error (string-append "with-input-from-string: `" string "'\n")))
   (let ((tell 0)
         (end (string-length string)))
   (let ((save-set-current-input-port #f)
         (string-port #f))
     (lambda (string)
   (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)))
           (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)))
                   (tell 0)
                   (end (string-length string)))
               (lambda (port)
                   (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"))
                     (core:display-error (string-append "open-input-string: `" string "' save-set-current-input-port port="))
                     (core:display-error port)
                     (core:display-error "\n"))