diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index eb052248..af0f8807 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -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 " ")) (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))))) diff --git a/module/mes/guile.mes b/module/mes/guile.mes index 2397d4c3..fa2c46af 100644 --- a/module/mes/guile.mes +++ b/module/mes/guile.mes @@ -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"))