bootstrap: Regenerate.
[mes.git] / module / language / c99 / compiler.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; This file is part of Mes.
7 ;;;
8 ;;; Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; compiler.mes produces an i386 binary from the C produced by
24 ;;; Nyacc c99.
25
26 ;;; Code:
27
28 (cond-expand
29  (guile-2
30   (set-port-encoding! (current-output-port) "ISO-8859-1"))
31  (guile)
32  (mes
33   (mes-use-module (mes pmatch))
34   (mes-use-module (nyacc lang c99 parser))
35   (mes-use-module (mes elf-util))
36   (mes-use-module (mes elf))
37   (mes-use-module (mes as-i386))
38   (mes-use-module (mes libc))
39   (mes-use-module (mes optargs))))
40
41 (define (logf port string . rest)
42   (apply format (cons* port string rest))
43   (force-output port)
44   #t)
45
46 (define (stderr string . rest)
47   (apply logf (cons* (current-error-port) string rest)))
48
49 (define (mescc)
50   (parse-c99
51    #:inc-dirs (string-split (getenv "C_INCLUDE_PATH") #\:)
52    #:cpp-defs `(
53                 "_POSIX_SOURCE=0"
54                 "__GNUC__=0"
55                 "__MESC__=1"
56                 "__NYACC__=1" ;; REMOVEME
57                 "STDIN=0"
58                 "STDOUT=1"
59                 "STDERR=2"
60                 "O_RDONLY=0"
61
62                 "INT_MIN=-2147483648"
63                 "INT_MAX=2147483647"
64
65                 ,(string-append "DATADIR=\"" %datadir "\"")
66                 ,(string-append "DOCDIR=\"" %docdir "\"")
67                 ,(string-append "PREFIX=\"" %prefix "\"")
68                 ,(string-append "MODULEDIR=\"" %moduledir "\"")
69                 ,(string-append "VERSION=\"" %version "\"")
70                 )
71    #:mode 'code))
72
73 (define (write-any x)
74   (write-char (cond ((char? x) x)
75                     ((and (number? x) (< (+ x 256) 0)) (format (current-error-port) "***BROKEN*** x=~a ==> ~a\n" x (dec->hex x)) (integer->char #xaa))
76                     ((number? x) (integer->char (if (>= x 0) x (+ x 256))))
77                     ((procedure? x)
78                      (stderr "write-any: proc: ~a\n" x)
79                      (stderr "  ==> ~a\n" (map dec->hex (x '() '() 0 0)))
80                      barf)
81                     (else (stderr "write-any: ~a\n" x) barf))))
82
83 (define (ast:function? o)
84   (and (pair? o) (eq? (car o) 'fctn-defn)))
85
86 (define (.name o)
87   (pmatch o
88     ((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
89     ((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) _) name)
90     ((param-decl _ (param-declr (ident ,name))) name)
91     ((param-decl _ (param-declr (ptr-declr (pointer) (ident ,name)))) name)
92     ((param-decl _ (param-declr (ptr-declr (pointer) (array-of (ident ,name))))) name)
93     (_
94      (format (current-error-port) "SKIP: .name =~a\n" o))))
95
96 (define (.type o)
97   (pmatch o
98     ((param-decl (decl-spec-list (type-spec ,type)) _) (decl->type type))
99     ((param-decl ,type _) type)
100     (_
101      (format (current-error-port) "SKIP: .type =~a\n" o))))
102
103 (define (.statements o)
104   (pmatch o
105     ((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements)
106     ((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)))
107
108 (define <info> '<info>)
109 (define <types> '<types>)
110 (define <constants> '<constants>)
111 (define <functions> '<functions>)
112 (define <globals> '<globals>)
113 (define <init> '<init>)
114 (define <locals> '<locals>)
115 (define <function> '<function>)
116 (define <text> '<text>)
117
118 (define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (init '()) (locals '()) (function #f) (text '()))
119   (pmatch o
120     (<info> (list <info>
121                   (cons <types> types)
122                   (cons <constants> constants)
123                   (cons <functions> functions)
124                   (cons <globals> globals)
125                   (cons <init> init)
126                   (cons <locals> locals)
127                   (cons <function> function)
128                   (cons <text> text)))))
129
130 (define (.types o)
131   (pmatch o
132     ((<info> . ,alist) (assq-ref alist <types>))))
133
134 (define (.constants o)
135   (pmatch o
136     ((<info> . ,alist) (assq-ref alist <constants>))))
137
138 (define (.functions o)
139   (pmatch o
140     ((<info> . ,alist) (assq-ref alist <functions>))))
141
142 (define (.globals o)
143   (pmatch o
144     ((<info> . ,alist) (assq-ref alist <globals>))))
145
146 (define (.init o)
147   (pmatch o
148     ((<info> . ,alist) (assq-ref alist <init>))))
149
150 (define (.locals o)
151   (pmatch o
152     ((<info> . ,alist) (assq-ref alist <locals>))))
153
154 (define (.function o)
155   (pmatch o
156     ((<info> . ,alist) (assq-ref alist <function>))))
157
158 (define (.text o)
159   (pmatch o
160     ((<info> . ,alist) (assq-ref alist <text>))))
161
162 (define (info? o)
163   (and (pair? o) (eq? (car o) <info>)))
164
165 (define (clone o . rest)
166   (cond ((info? o)
167          (let ((types (.types o))
168                (constants (.constants o))
169                (functions (.functions o))
170                (globals (.globals o))
171                (init (.init o))
172                (locals (.locals o))
173                (function (.function o))
174                (text (.text o)))
175            (let-keywords rest
176                          #f
177                          ((types types)
178                           (constants constants)
179                           (functions functions)
180                           (globals globals)
181                           (init init)
182                           (locals locals)
183                           (function function)
184                           (text text))
185                          (make <info> #:types types #:constants constants #:functions functions #:globals globals #:init init #:locals locals #:function function #:text text))))))
186
187 (define (push-global globals)
188   (lambda (o)
189     (list
190      (lambda (f g ta t d)
191        (i386:push-global (+ (data-offset o g) d))))))
192
193 (define (push-local locals)
194   (lambda (o)
195     (list
196      (lambda (f g ta t d)
197        (i386:push-local (local:id o))))))
198
199 (define (push-global-address globals)
200   (lambda (o)
201     (list
202      (lambda (f g ta t d)
203        (i386:push-global-address (+ (data-offset o g) d))))))
204
205 (define (push-local-address locals)
206   (lambda (o)
207     (list
208      (lambda (f g ta t d)
209        (i386:push-local-address (local:id o))))))
210
211 (define push-global-de-ref push-global)
212
213 (define (push-local-de-ref locals)
214   (lambda (o)
215     (list
216      (lambda (f g ta t d)
217        (i386:push-local-de-ref (local:id o))))))
218
219 (define (string->global string)
220   (make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul))))
221
222 (define (ident->global name type pointer value)
223   (make-global name type pointer (int->bv32 value)))
224
225 (define (make-local name type pointer id)
226   (cons name (list type pointer id)))
227 (define local:type car)
228 (define local:pointer cadr)
229 (define local:id caddr)
230
231 (define (push-ident info)
232   (lambda (o)
233     (let ((local (assoc-ref (.locals info) o)))
234       (if local ((push-local (.locals info)) local)
235           (let ((global (assoc-ref (.globals info) o)))
236             (if global
237                 ((push-global (.globals info)) o) ;; FIXME: char*/int
238                 (let ((constant (assoc-ref (.constants info) o)))
239                   (if constant
240                       (list (lambda (f g ta t d)
241                               (append
242                                (i386:value->accu constant)
243                                (i386:push-accu))))
244                       TODO:push-function))))))))
245
246 (define (push-ident-address info)
247   (lambda (o)
248     (let ((local (assoc-ref (.locals info) o)))
249       (if local ((push-local-address (.locals info)) local)
250           ((push-global-address (.globals info)) o)))))
251
252 (define (push-ident-de-ref info)
253   (lambda (o)
254     (let ((local (assoc-ref (.locals info) o)))
255       (if local ((push-local-de-ref (.locals info)) local)
256           ((push-global-de-ref (.globals info)) o)))))
257
258 (define (expr->arg info)
259   (lambda (o)
260     (let ((info ((expr->accu info) o)))
261       (clone info #:text (append (.text info)
262                                  (list (lambda (f g ta t d)
263                                          (i386:push-accu))))))))
264
265 (define (expr->arg info) ;; FIXME: get Mes curried-definitions
266   (lambda (o)
267     (let ((text (.text info)))
268       ;;(stderr  "expr->arg o=~s\n" o)
269       (pmatch o
270
271         ((p-expr (string ,string))
272          (clone info #:text (append text ((push-global-address info) (add-s:-prefix string)))))
273
274         ((p-expr (ident ,name))
275          (clone info #:text (append text ((push-ident info) name))))
276
277         ((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
278                           (abs-declr (pointer)))
279                ,cast)
280          ((expr->arg info) cast))
281
282         ((de-ref (p-expr (ident ,name)))
283          (clone info #:text (append text ((push-ident-de-ref info) name))))
284
285         ((ref-to (p-expr (ident ,name)))
286          (clone info #:text (append text ((push-ident-address info) name))))
287
288         (_ (let* ((info ((expr->accu info) o))
289                   (text (.text info)))
290              (clone info #:text (append text
291                                         (list (lambda (f g ta t d)
292                                                 (i386:push-accu)))))))))))
293
294 ;; FIXME: see ident->base
295 (define (ident->accu info)
296   (lambda (o)
297     (let ((local (assoc-ref (.locals info) o))
298           (global (assoc-ref (.globals info) o))
299           (constant (assoc-ref (.constants info) o)))
300       ;; (stderr "ident->accu: local[~a]: ~a\n" o (and local (local:id local)))
301       ;; (stderr "ident->accu: global[~a]: ~a\n" o global)
302       ;; (stderr "globals: ~a\n" (.globals info))
303       ;; (if (and (not global) (not (local:id local)))
304       ;;     (stderr "globals: ~a\n" (map car (.globals info))))
305       (if local
306           (let* ((ptr (local:pointer local))
307                  (type (ident->type info o))
308                  (size (and type (type->size info type))))
309             ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr)
310             ;;(stderr "type: ~s\n" type)
311             ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr)
312             ;;(stderr "locals: ~s\n" locals)
313             (case ptr
314               ((-1) (list (lambda (f g ta t d)
315                             (i386:local-ptr->accu (local:id local)))))
316               ((1) (list (lambda (f g ta t d)
317                            (i386:local->accu (local:id local)))))
318               (else
319                (list (lambda (f g ta t d)
320                        (if (= size 1)
321                            (i386:byte-local->accu (local:id local))
322                            (i386:local->accu (local:id local))))))))
323           (if global
324               (let ((ptr (ident->pointer info o)))
325                 ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr)
326                 (case ptr
327                   ((-1) (list (lambda (f g ta t d)
328                                 (i386:global->accu (+ (data-offset o g) d)))))
329                   (else (list (lambda (f g ta t d)
330                                 (i386:global-address->accu (+ (data-offset o g) d)))))))
331               (if constant
332                   (list (lambda (f g ta t d)
333                           (i386:value->accu constant)))
334                   (list (lambda (f g ta t d)
335                           (i386:global->accu (+ ta (function-offset o f)))))))))))
336
337 (define (value->accu v)
338   (list (lambda (f g ta t d)
339           (i386:value->accu v))))
340
341 (define (accu->ident info)
342   (lambda (o)
343     (let ((local (assoc-ref (.locals info) o)))
344       (if local
345           (list (lambda (f g ta t d)
346                   (i386:accu->local (local:id local))))
347           (list (lambda (f g ta t d)
348                   (i386:accu->global (+ (data-offset o g) d))))))))
349
350 (define (base->ident info)
351   (lambda (o)
352     (let ((local (assoc-ref (.locals info) o)))
353       (if local
354           (list (lambda (f g ta t d)
355                   (i386:base->local (local:id local))))
356           (list (lambda (f g ta t d)
357                   (i386:base->global (+ (data-offset o g) d))))))))
358
359 (define (base->ident-address info)
360   (lambda (o)
361     (let ((local (assoc-ref (.locals info) o)))
362       (if local
363           (list (lambda (f g ta t d)
364                   (append
365                    (i386:local->accu (local:id local))
366                    (i386:byte-base->accu-address))))
367           TODO:base->ident-address-global))))
368
369 (define (value->ident info)
370   (lambda (o value)
371     (let ((local (assoc-ref (.locals info) o)))
372       (if local
373           (list (lambda (f g ta t d)
374                   (i386:value->local (local:id local) value)))
375           (list (lambda (f g ta t d)
376                   (i386:value->global (+ (data-offset o g) d) value)))))))
377
378 (define (ident-add info)
379   (lambda (o n)
380     (let ((local (assoc-ref (.locals info) o)))
381       (if local
382           (list (lambda (f g ta t d)
383                   (i386:local-add (local:id local) n)))
384           (list (lambda (f g ta t d)
385                   (i386:global-add (+ (data-offset o g) d) n)))))))
386
387 ;; FIXME: see ident->accu
388 (define (ident->base info)
389   (lambda (o)
390     (let ((local (assoc-ref (.locals info) o)))
391       ;;(stderr "ident->base: local[~a]: ~a\n" o (and local (local:id local)))
392       (if local
393           (let* ((ptr (local:pointer local))
394                  (type (ident->type info o))
395                  (size (and type (type->size info type))))
396             (case ptr
397               ((-1) (list (lambda (f g ta t d)
398                             (i386:local-ptr->base (local:id local)))))
399               ((1) (list (lambda (f g ta t d)
400                            (i386:local->base (local:id local)))))
401               (else
402                (list (lambda (f g ta t d)
403                        (if (= size 1)
404                            (i386:byte-local->base (local:id local))
405                            (i386:local->base (local:id local))))))))
406           (let ((global (assoc-ref (.globals info) o) ))
407             (if global
408                 (let ((ptr (ident->pointer info o)))
409                   ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr)
410                 (case ptr
411                   ((-1) (list (lambda (f g ta t d)
412                                 (i386:global->base (+ (data-offset o g) d)))))
413                   (else (list (lambda (f g ta t d)
414                                 (i386:global-address->base (+ (data-offset o g) d)))))))
415                 (let ((constant (assoc-ref (.constants info) o)))
416                   (if constant
417                       (list (lambda (f g ta t d)
418                               (i386:value->base constant)))
419                       (list (lambda (f g ta t d)
420                               (i386:global->base (+ ta (function-offset o f)))))))))))))
421
422 (define (expr->accu info)
423   (lambda (o)
424     (let ((locals (.locals info))
425           (constants (.constants info))
426           (text (.text info))
427           (globals (.globals info)))
428       (define (add-local locals name type pointer)
429         (let* ((id (1+ (length (filter local? (map cdr locals)))))
430                (locals (cons (make-local name type pointer id) locals)))
431           locals))
432       ;; (stderr "expr->accu o=~a\n" o)
433       (pmatch o
434         ((p-expr (string ,string))
435          (clone info #:text (append text (list (lambda (f g ta t d)
436                                                  ;;(stderr "OFF[~a]: ~a\n" string (data-offset string globals))
437                                                  ;;(stderr "globals: ~s\n" (map car globals))
438                                                  (i386:global->accu (+ (data-offset (add-s:-prefix string) globals) d)))))))
439         ((p-expr (fixed ,value))
440          (clone info #:text (append text (value->accu (cstring->number value)))))
441         ((p-expr (ident ,name))
442          (clone info #:text (append text ((ident->accu info) name))))
443         ((not (fctn-call . _)) ((ast->info info) o))
444         ((neg (p-expr (fixed ,value)))
445          (clone info #:text (append text (value->accu (- (cstring->number value))))))
446         
447         ((initzer ,initzer) ((expr->accu info) initzer))
448         ((ref-to (p-expr (ident ,name)))
449          (clone info #:text
450                 (append (.text info)
451                         ((ident->accu info) name))))
452
453         ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
454          (let* ((type (list "struct" name))
455                 (fields (or (type->description info type) '()))
456                 (size (type->size info type)))
457            (clone info #:text
458                   (append text
459                         (list (lambda (f g ta t d)
460                                 (append
461                                  (i386:value->accu size))))))))
462         
463         ;; c+p expr->arg
464         ;; g_cells[<expr>]
465         ((array-ref ,index (p-expr (ident ,array)))
466          (let* ((info ((expr->accu info) index))
467                 (type (ident->type info array))
468                 (size (type->size info type)))
469            (clone info #:text
470                   (append (.text info)
471                           ;; immediate: (i386:value->accu (* size index))
472                           ;; * size cells: * length * 4 = * 12
473                           (list (lambda (f g ta t d)
474                                   (append
475                                    (i386:accu->base)
476                                    (if (eq? size 1) '()
477                                        (append
478                                         (if (> size 4) (i386:accu+accu) '())
479                                         (if (> size 8) (i386:accu+base) '())
480                                         (i386:accu-shl 2))))))
481                           ((ident->base info) array)
482                           (list (lambda (f g ta t d)
483                                   (append
484                                    (case size
485                                      ((1) (i386:byte-base-mem->accu))
486                                      ((4) (i386:base-mem->accu))
487                                      (else (i386:accu+base))))))))))
488
489         ;; f.field
490         ((d-sel (ident ,field) (p-expr (ident ,array)))
491          (let* ((type (ident->type info array))
492                 (fields (type->description info type))
493                 (field-size 4) ;; FIXME:4, not fixed
494                 (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
495                 (text (.text info)))
496            (clone info #:text
497                   (append text
498                           ((ident->accu info) array)
499                           (list (lambda (f g ta t d)
500                                   (i386:mem+n->accu offset)))))))
501
502         ;; g_cells[10].type
503         ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
504          (let* ((type (ident->type info array))
505                 (fields (or (type->description info type) '()))
506                 (size (type->size info type))
507                 (count (length fields))
508                 (field-size 4) ;; FIXME:4, not fixed
509                 (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
510                 (index (cstring->number index))
511                 (text (.text info)))
512            (clone info #:text
513                   (append text
514                           (list (lambda (f g ta t d)
515                                   (append
516                                    (i386:value->base index)
517                                    (i386:base->accu)
518                                    (if (> count 1) (i386:accu+accu) '())
519                                    (if (= count 3) (i386:accu+base) '())
520                                    (i386:accu-shl 2))))
521                           ((ident->base info) array)
522                           (list (lambda (f g ta t d)
523                                   (i386:base-mem+n->accu offset)))))))
524         
525         ;; g_cells[x].type
526         ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
527          (let* ((type (ident->type info array))
528                 (fields (or (type->description info type) '()))
529                 (size (type->size info type))
530                 (count (length fields))
531                 (field-size 4) ;; FIXME:4, not fixed
532                 (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
533                       (text (.text info)))
534                  (clone info #:text
535                         (append text
536                                 ((ident->base info) index)
537                                 (list (lambda (f g ta t d)
538                                         (append
539                                          (i386:base->accu)
540                                          (if (> count 1) (i386:accu+accu) '())
541                                          (if (= count 3) (i386:accu+base) '())
542                                          (i386:accu-shl 2))))
543                                 ((ident->base info) array)
544                                 (list (lambda (f g ta t d)
545                                         (i386:base-mem+n->accu offset)))))))
546
547         ;; g_functions[g_cells[fn].cdr].arity
548         ;; INDEX0: g_cells[fn].cdr
549
550         ;;; index: (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells))))
551         ;;((d-sel (ident ,arity) (array-ref (d-sel (ident ,cdr) (array-ref (p-expr (ident ,fn)) (p-expr (ident ,g_cells)))) (p-expr (ident ,g_functions)))))
552         ((d-sel (ident ,field) (array-ref ,index (p-expr (ident ,array))))
553          (let* ((empty (clone info #:text '()))
554                 (index ((expr->accu empty) index))
555                 (type (ident->type info array))
556                 (fields (or (type->description info type) '()))
557                 (size (type->size info type))
558                 (count (length fields))
559                 (field-size 4) ;; FIXME:4, not fixed
560                 (rest (or (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))
561                           (begin
562                             (stderr "no field:~a\n" field)
563                            '())))
564                 (offset (* field-size (1- (length rest))))
565                 (text (.text info)))
566            (clone info #:text
567                   (append text
568                           (.text index)
569                           (list (lambda (f g ta t d)
570                                   (append
571                                    (i386:accu->base)
572                                    (if (> count 1) (i386:accu+accu) '())
573                                    (if (= count 3) (i386:accu+base) '())
574                                    (i386:accu-shl 2))))
575                           ((ident->base info) array)
576                           (list (lambda (f g ta t d)
577                                   (i386:base-mem+n->accu offset)))))))
578         
579         ;;; FIXME: FROM INFO ...only zero?!
580         ((p-expr (fixed ,value))
581          (let ((value (cstring->number value)))
582           (clone info #:text
583                  (append text
584                          (list (lambda (f g ta t d)
585                                  (i386:value->accu value)))))))
586
587         ((p-expr (char ,char))
588          (let ((char (char->integer (car (string->list char)))))
589           (clone info #:text
590                  (append text
591                          (list (lambda (f g ta t d)
592                                  (i386:value->accu char)))))))
593
594         ((p-expr (ident ,name))
595          (clone info #:text
596                 (append text
597                         ((ident->accu info) name))))
598
599         ((de-ref (p-expr (ident ,name)))
600          (let* ((type (ident->type info name))
601                 (size (and type (type->size info type))))
602           (clone info #:text
603                  (append text
604                          ((ident->accu info) name)
605                          (list (lambda (f g ta t d)
606                                  (if (= size 1)
607                                      (i386:byte-mem->accu)
608                                      (i386:mem->accu))))))))
609
610         ((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
611          (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
612                                    (clone info #:text (append text (list (lambda (f g ta t d) (asm->hex arg0))))))
613              (let* ((globals (append globals (filter-map expr->global expr-list)))
614                     (info (clone info #:globals globals))
615                     (text-length (length text))
616                     (args-info (let loop ((expressions (reverse expr-list)) (info info))
617                                  (if (null? expressions) info
618                                      (loop (cdr expressions) ((expr->arg info) (car expressions))))))
619                     (text (.text args-info))
620                     (n (length expr-list)))
621                (if (and (not (assoc-ref locals name))
622                         (assoc-ref (.functions info) name))
623                    (clone args-info #:text
624                           (append text
625                                   (list (lambda (f g ta t d)
626                                           (i386:call f g ta t d (+ t (function-offset name f)) n))))
627                           #:globals globals)
628                    (let* ((empty (clone info #:text '()))
629                           (accu ((expr->accu empty) `(p-expr (ident ,name)))))
630                      (clone args-info #:text
631                             (append text
632                                     (.text accu)
633                                     (list (lambda (f g ta t d)
634                                             (i386:call-accu f g ta t d n))))
635                             #:globals globals))))))
636
637         ((fctn-call ,function (expr-list . ,expr-list))
638          (let* ((globals (append globals (filter-map expr->global expr-list)))
639                 (info (clone info #:globals globals))
640                 (text-length (length text))
641                 (args-info (let loop ((expressions (reverse expr-list)) (info info))
642                              (if (null? expressions) info
643                                  (loop (cdr expressions) ((expr->arg info) (car expressions))))))
644                 (text (.text args-info))
645                 (n (length expr-list))
646                 (empty (clone info #:text '()))
647                 (accu ((expr->accu empty) function)))
648            (clone info #:text
649                   (append text
650                           (.text accu)
651                           (list (lambda (f g ta t d)
652                                   (i386:call-accu f g ta t d n))))
653                   #:globals globals)))
654
655         ((cond-expr . ,cond-expr)
656          ((ast->info info) `(expr-stmt ,o)))
657
658         ;; FIXME
659         ;;((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
660         ((post-inc (p-expr (ident ,name)))
661          (clone info #:text
662                 (append text
663                         ((ident->accu info) name)
664                         ((ident-add info) name 1))))
665
666         ;; GRR --> info again??!?
667         ((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
668         ((post-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
669         ((pre-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
670         ((pre-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
671
672         ((add (p-expr (ident ,name)) ,b)
673          (let* ((empty (clone info #:text '()))
674                 (base ((expr->base empty) b)))
675            (clone info #:text
676                   (append text
677                           (.text base)
678                           ((ident->accu info) name)
679                           (list (lambda (f g ta t d)
680                                   (i386:accu+base)))))))
681
682         ((add ,a ,b)
683          (let* ((empty (clone info #:text '()))
684                 (accu ((expr->accu empty) a))
685                 (base ((expr->base empty) b)))
686            (clone info #:text
687                   (append text
688                           (.text accu)
689                           (.text base)
690                           (list (lambda (f g ta t d)
691                                   (i386:accu+base)))))))        
692
693         ((sub ,a ,b)
694          (let* ((empty (clone info #:text '()))
695                 (accu ((expr->accu empty) a))
696                 (base ((expr->base empty) b)))
697            (clone info #:text
698                   (append text
699                           (.text accu)
700                           (.text base)
701                           (list (lambda (f g ta t d)
702                                   (i386:accu-base)))))))        
703
704         ((bitwise-or ,a ,b)
705          (let* ((empty (clone info #:text '()))
706                 (accu ((expr->accu empty) a))
707                 (base ((expr->base empty) b)))
708            (clone info #:text
709                   (append text
710                           (.text accu)
711                           (.text base)
712                           (list (lambda (f g ta t d)
713                                   (i386:accu-or-base)))))))
714
715         ((lshift ,a ,b)
716          (let* ((empty (clone info #:text '()))
717                 (accu ((expr->accu empty) a))
718                 (base ((expr->base empty) b)))
719            (clone info #:text
720                   (append text
721                           (.text accu)
722                           (.text base)
723                           (list (lambda (f g ta t d)
724                                   (i386:accu<<base)))))))
725
726         ((rshift ,a ,b)
727          (let* ((empty (clone info #:text '()))
728                 (accu ((expr->accu empty) a))
729                 (base ((expr->base empty) b)))
730            (clone info #:text
731                   (append text
732                           (.text accu)
733                           (.text base)
734                           (list (lambda (f g ta t d)
735                                   (i386:accu>>base)))))))
736
737         ((div ,a ,b)
738          (let* ((empty (clone info #:text '()))
739                 (accu ((expr->accu empty) a))
740                 (base ((expr->base empty) b)))
741            (clone info #:text
742                   (append text
743                           (.text accu)
744                           (.text base)
745                           (list (lambda (f g ta t d)
746                                   (i386:accu/base)))))))
747
748         ((mod ,a ,b)
749          (let* ((empty (clone info #:text '()))
750                 (accu ((expr->accu empty) a))
751                 (base ((expr->base empty) b)))
752            (clone info #:text
753                   (append text ;;FIXME:empty
754                           (.text accu)
755                           (.text base)
756                           (list (lambda (f g ta t d)
757                                   (i386:accu%base)))))))
758
759         ((mul ,a ,b)
760          (let* ((empty (clone info #:text '()))
761                 (accu ((expr->accu empty) a))
762                 (base ((expr->base empty) b)))
763            (clone info #:text
764                   (append text
765                           (.text accu)
766                           (.text base)
767                           (list (lambda (f g ta t d)
768                                   (i386:accu*base)))))))
769
770         ;; FIXME: c/p ast->info
771         ((eq ,a ,b)
772          (let* ((base ((expr->base info) a))
773                 (empty (clone base #:text '()))
774                 (accu ((expr->accu empty) b)))
775            (clone info #:text
776                   (append (.text base)
777                           (list (lambda (f g ta t d)
778                                   (i386:push-base)))
779                           (.text accu)
780                           (list (lambda (f g ta t d)
781                                   (i386:pop-base)))
782                           (list (lambda (f g ta t d)
783                                   (i386:sub-base)))))))
784
785         ;; FIXME: c/p ast->info
786         ((lt ,a ,b)
787          (let* ((base ((expr->base info) a))
788                 (empty (clone base #:text '()))
789                 (accu ((expr->accu empty) b)))
790            (clone info #:text
791                   (append (.text base)
792                           (.text accu)
793                           (list (lambda (f g ta t d)
794                                   (i386:base-sub)))))))
795
796         ;; FIXME: ...c/p ast->info
797         ((neg (p-expr (ident ,name)))
798          (clone info #:text (append text
799                                     ((ident->base info) name)
800                                     (list (lambda (f g ta t d)
801                                             (i386:value->accu 0)))
802                                     (list (lambda (f g ta t d)
803                                             (i386:sub-base))))))
804
805         ;;((cast (type-name (decl-spec-list (type-spec (typename "SCM"))) (abs-declr (declr-fctn (declr-scope (abs-declr (pointer))) (param-list (param-decl (decl-spec-list (type-spec (typename "SCM")))))))) (d-sel (ident "function") (array-ref (d-sel (ident "cdr") (array-ref (p-expr (ident "fn")) (p-expr (ident "g_cells")))) (p-expr (ident "functions"))))))
806         ((cast ,cast ,o)
807          ((expr->accu info) o))
808
809         ((assn-expr (p-expr (ident ,name)) ,op ,expr)
810          (let ((info ((ast->info info) o)))
811            (clone info #:text (append (.text info)
812                                       ((ident->accu info) name)))))
813
814         (_
815          (format (current-error-port) "SKIP: expr->accu=~s\n" o)
816          barf
817          info)))))
818
819 (define (expr->base info)
820   (lambda (o)
821     (let ((info ((expr->accu info) o)))
822       (clone info
823              #:text (append
824                      (list (lambda (f g ta t d)
825                              (i386:push-accu)))
826                      (.text info)
827                      (list (lambda (f g ta t d)
828                              (append
829                               (i386:accu->base)
830                               (i386:pop-accu)))))))))
831
832 (define (expr->accu* info)
833   (lambda (o)
834     (pmatch o
835       ;;(stderr "expr->accu* o=~s\n" o)
836       ;; g_cells[10].type
837       ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
838        (let* ((type (ident->type info array))
839               (fields (or (type->description info type) '()))
840               (size (type->size info type))
841               (count (length fields))
842               (field-size 4) ;; FIXME:4, not fixed
843               (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
844               (index (cstring->number index))
845               (text (.text info)))
846          (clone info #:text
847                 (append text
848                         (list (lambda (f g ta t d)
849                                 (append
850                                  (i386:value->base index)
851                                  (i386:base->accu)
852                                  (if (> count 1) (i386:accu+accu) '())
853                                  (if (= count 3) (i386:accu+base) '())
854                                  (i386:accu-shl 2))))
855                         ;; de-ref: g_cells, non: arena
856                         ;;((ident->base info) array)
857                         ((ident->base info) array)
858                         (list (lambda (f g ta t d)
859                                 (append
860                                  (i386:accu+base)
861                                  (i386:accu+value offset))))))))
862
863       ;; g_cells[x].type
864       ((d-sel (ident ,field) (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))))
865        (let* ((type (ident->type info array))
866               (fields (or (type->description info type) '()))
867               (size (type->size info type))
868               (count (length fields))
869               (field-size 4) ;; FIXME:4, not fixed
870               (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
871               (text (.text info)))
872          (clone info #:text
873                 (append text
874                         ((ident->base info) index)
875                         (list (lambda (f g ta t d)
876                                 (append
877                                  (i386:base->accu)
878                                  (if (> count 1) (i386:accu+accu) '())
879                                  (if (= count 3) (i386:accu+base) '())
880                                  (i386:accu-shl 2))))
881                         ;; de-ref: g_cells, non: arena
882                         ;;((ident->base info) array)
883                         ((ident->base info) array)
884                         (list (lambda (f g ta t d)
885                                 (append
886                                  (i386:accu+base)
887                                  (i386:accu+value offset))))))))
888
889       ;;((d-sel (ident "cdr") (p-expr (ident "scm_make_cell"))))
890       ((d-sel (ident ,field) (p-expr (ident ,name)))
891        (let* ((type (ident->type info name))
892               (fields (or (type->description info type) '()))
893               (field-size 4) ;; FIXME
894               (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))
895               (text (.text info)))
896          (clone info #:text
897                 (append text
898                         ((ident->accu info) name)
899                         (list (lambda (f g ta t d)
900                                 (i386:accu+value offset)))))))
901
902       (_
903        (format (current-error-port) "SKIP: expr->accu*=~s\n" o)
904        barf
905        info)
906       )))
907
908 (define (ident->constant name value)
909   (cons name value))
910
911 (define (make-type name type size description)
912   (cons name (list type size description)))
913
914 (define (enum->type name fields)
915   (make-type name 'enum 4 fields))
916
917 (define (struct->type name fields)
918   (make-type name 'struct (* 4 (length fields)) fields)) ;; FIXME
919
920 (define (decl->type o)
921   (pmatch o
922     ((fixed-type ,type) type)
923     ((struct-ref (ident ,name)) (list "struct" name))
924     ((decl (decl-spec-list (type-spec (struct-ref (ident ,name)))));; "scm"
925      (list "struct" name)) ;; FIXME
926     ((typename ,name) name)
927     (_
928      (stderr "SKIP: decl type=~s\n" o)
929      barf
930      o)))
931
932 (define (expr->global o)
933   (pmatch o
934     ((p-expr (string ,string)) (string->global string))
935     (_ #f)))
936
937 (define (initzer->global o)
938   (pmatch o
939     ((initzer ,initzer) (expr->global initzer))
940     (_ #f)))
941
942 (define (byte->hex o)
943   (string->number (string-drop o 2) 16))
944
945 (define (asm->hex o)
946   (let ((prefix ".byte "))
947     (if (not (string-prefix? prefix o)) (begin (stderr "SKIP:~s\n" o)'())
948         (let ((s (string-drop o (string-length prefix))))
949           (map byte->hex (string-split s #\space))))))
950
951 (define (case->jump-info info)
952   (define (jump n)
953     (list (lambda (f g ta t d) (i386:Xjump n))))
954   (define (jump-nz n)
955     (list (lambda (f g ta t d) (i386:Xjump-nz n))))
956   (define (statement->info info body-length)
957     (lambda (o)
958       (pmatch o
959         ((break) (clone info #:text (append (.text info) (jump body-length)
960 )))
961         (_
962          ((ast->info info) o)))))
963   (lambda (o)
964     (pmatch o
965       ((case (p-expr (ident ,constant)) (compd-stmt (block-item-list . ,elements)))
966        (lambda (body-length)
967
968          (define (test->text value clause-length)
969            (append (list (lambda (f g ta t d) (i386:accu-cmp-value value)))
970                    (jump-nz clause-length)))
971          (let* ((value (assoc-ref (.constants info) constant))
972                 (test-info
973                  (clone info #:text (append (.text info) (test->text value 0))))
974                 (text-length (length (.text test-info)))
975                 (clause-info (let loop ((elements elements) (info test-info))
976                                (if (null? elements) info
977                                    (loop (cdr elements) ((statement->info info body-length) (car elements))))))
978                 (clause-text (list-tail (.text clause-info) text-length))
979                 (clause-length (length (text->list clause-text))))
980            (clone info #:text (append
981                                (.text info)
982                                (test->text value clause-length)
983                                clause-text)
984                   #:globals (.globals clause-info)))))
985
986       ((case (p-expr (fixed ,value)) (compd-stmt (block-item-list . ,elements)))
987        (lambda (body-length)
988
989          (define (test->text value clause-length)
990            (append (list (lambda (f g ta t d) (i386:accu-cmp-value value)))
991                    (jump-nz clause-length)))
992          (let* ((value (cstring->number value))
993                 (test-info
994                  (clone info #:text (append (.text info) (test->text value 0))))
995                 (text-length (length (.text test-info)))
996                 (clause-info (let loop ((elements elements) (info test-info))
997                                (if (null? elements) info
998                                    (loop (cdr elements) ((statement->info info body-length) (car elements))))))
999                 (clause-text (list-tail (.text clause-info) text-length))
1000                 (clause-length (length (text->list clause-text))))
1001            (clone info #:text (append
1002                                (.text info)
1003                                (test->text value clause-length)
1004                                clause-text)
1005                   #:globals (.globals clause-info)))))
1006
1007       ((case (neg (p-expr (fixed ,value))) ,statement)
1008        ((case->jump-info info) `(case (p-expr (fixed ,(string-append "-" value))) ,statement)))
1009
1010       ((default (compd-stmt (block-item-list . ,elements)))
1011        (lambda (body-length)
1012          (let ((text-length (length (.text info))))
1013           (let loop ((elements elements) (info info))
1014             (if (null? elements) info
1015                 (loop (cdr elements) ((statement->info info body-length) (car elements))))))))
1016
1017       ((case (p-expr (ident ,constant)) ,statement)
1018        ((case->jump-info info) `(case (p-expr (ident ,constant)) (compd-stmt (block-item-list ,statement)))))
1019
1020       ((case (p-expr (fixed ,value)) ,statement)
1021        ((case->jump-info info) `(case (p-expr (fixed ,value)) (compd-stmt (block-item-list ,statement)))))
1022
1023       ((default ,statement)
1024        ((case->jump-info info) `(default (compd-stmt (block-item-list ,statement)))))
1025
1026       (_ (stderr "no case match: ~a\n" o) barf)
1027       )))
1028
1029 (define (test->jump->info info)
1030   (define (jump type . test)
1031     (lambda (o)
1032       (let* ((text (.text info))
1033              (info (clone info #:text '()))
1034              (info ((ast->info info) o))
1035              (jump-text (lambda (body-length)
1036                           (list (lambda (f g ta t d) (type body-length))))))
1037        (lambda (body-length)
1038          (clone info #:text
1039                 (append text
1040                         (.text info)
1041                         (if (null? test) '() (car test))
1042                         (jump-text body-length)))))))
1043   (lambda (o)
1044     (pmatch o
1045       ;; unsigned
1046       ;; ((le ,a ,b) ((jump i386:Xjump-ncz) o)) ; ja
1047       ;; ((lt ,a ,b) ((jump i386:Xjump-nc) o))  ; jae
1048       ;; ((ge ,a ,b) ((jump i386:Xjump-ncz) o))
1049       ;; ((gt ,a ,b) ((jump i386:Xjump-nc) o))
1050
1051       ((le ,a ,b) ((jump i386:Xjump-g) o))
1052       ((lt ,a ,b) ((jump i386:Xjump-ge) o))
1053       ((ge ,a ,b) ((jump i386:Xjump-g) o))
1054       ((gt ,a ,b) ((jump i386:Xjump-ge) o))
1055
1056       ((ne ,a ,b) ((jump i386:Xjump-nz) o))
1057       ((eq ,a ,b) ((jump i386:Xjump-nz) o))
1058       ((not _) ((jump i386:Xjump-z) o))
1059       ((and ,a ,b)
1060        (let* ((text (.text info))
1061               (info (clone info #:text '()))
1062
1063               (a-jump ((test->jump->info info) a))
1064               (a-text (.text (a-jump 0)))
1065               (a-length (length (text->list a-text)))
1066
1067               (b-jump ((test->jump->info info) b))
1068               (b-text (.text (b-jump 0)))
1069               (b-length (length (text->list b-text))))
1070
1071          (lambda (body-length)
1072            (clone info #:text
1073                   (append text
1074                           (.text (a-jump (+ b-length body-length)))
1075                           (.text (b-jump body-length)))))))
1076       ((or ,a ,b)
1077        (let* ((text (.text info))
1078               (info (clone info #:text '()))
1079
1080               (a-jump ((test->jump->info info) a))
1081               (a-text (.text (a-jump 0)))
1082               (a-length (length (text->list a-text)))
1083
1084               (jump-text (list (lambda (f g ta t d) (i386:Xjump 0))))
1085               (jump-length (length (text->list jump-text)))
1086
1087               (b-jump ((test->jump->info info) b))
1088               (b-text (.text (b-jump 0)))
1089               (b-length (length (text->list b-text)))
1090
1091               (jump-text (list (lambda (f g ta t d) (i386:Xjump b-length)))))
1092
1093          (lambda (body-length)
1094            (clone info #:text
1095                   (append text
1096                           (.text (a-jump jump-length))
1097                           jump-text
1098                           (.text (b-jump body-length)))))))
1099
1100       ((array-ref . _) ((jump i386:jump-byte-z
1101                               (list (lambda (f g ta t d) (i386:accu-zero?)))) o))
1102
1103       ((de-ref _) ((jump i386:jump-byte-z
1104                          (list (lambda (f g ta t d) (i386:accu-zero?)))) o))
1105
1106       ((assn-expr (p-expr (ident ,name)) ,op ,expr)
1107        ((jump i386:Xjump-z
1108               (append
1109                ((ident->accu info) name)
1110                (list (lambda (f g ta t d) (i386:accu-zero?))))) o))
1111
1112       (_ ((jump i386:Xjump-z (list (lambda (f g ta t d) (i386:accu-zero?)))) o)))))
1113
1114 (define (cstring->number s)
1115   (cond ((string-prefix? "0x" s) (string->number (string-drop s 2) 16))
1116         ((string-prefix? "0" s) (string->number s 8))
1117         (else (string->number s))))
1118
1119 (define (struct-field o)
1120   (pmatch o
1121     ((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
1122                 (comp-declr-list (comp-declr (ident ,name))))
1123      (cons type name))
1124     ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
1125      (cons type name))
1126     ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
1127      (cons type name))
1128     ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list (param-decl (decl-spec-list (type-spec (void)))))))))
1129      (cons type name)) ;; FIXME function / int
1130     ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
1131      (cons type name)) ;; FIXME: ptr/char
1132     (_ (stderr "struct-field: no match: ~s\n" o) barf)))
1133
1134 (define (ast->type o)
1135   (pmatch o
1136     ((fixed-type ,type)
1137      type)
1138     ((struct-ref (ident ,type))
1139      (list "struct" type))
1140     (_ (stderr "SKIP: type=~s\n" o)
1141        "int")))
1142
1143 (define i386:type-alist
1144   '(("char" . (builtin 1 #f))
1145     ("int" . (builtin 4 #f))))
1146
1147 (define (type->size info o)
1148   ;;(stderr  "types=~s\n" (.types info))
1149   ;;(stderr  "type->size o=~s => ~s\n" o   (cadr (assoc-ref (.types info) o)))
1150   (pmatch o
1151     ((decl-spec-list (type-spec (fixed-type ,type)))
1152      (type->size info type))
1153     ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
1154      (type->size info type))
1155     (_ (let ((type (assoc-ref (.types info) o)))
1156          (if type (cadr type)
1157              (begin
1158                (stderr "***TYPE NOT FOUND**: o=~s\n" o)
1159                barf
1160                4))))))
1161
1162 (define (ident->decl info o)
1163   ;; (stderr "ident->decl o=~s\n" o)
1164   ;; (stderr "  types=~s\n" (.types info))
1165   ;; (stderr "  local=~s\n" (assoc-ref (.locals info) o))
1166   ;; (stderr "  global=~s\n" (assoc-ref (.globals info) o))
1167   (or (assoc-ref (.locals info) o)
1168       (assoc-ref (.globals info) o)
1169       (begin
1170         (stderr "NO IDENT: ~a\n" (assoc-ref (.functions info) o))
1171         (assoc-ref (.functions info) o))))
1172
1173 (define (ident->type info o)
1174   (and=> (ident->decl info o) car))
1175
1176 (define (ident->pointer info o)
1177   (let ((local (assoc-ref (.locals info) o)))
1178     (if local (local:pointer local)
1179         (or (and=> (ident->decl info o) global:pointer) 0))))
1180
1181 (define (type->description info o)
1182   ;; (stderr  "type->description =~s\n" o)  
1183   ;; (stderr  "types=~s\n" (.types info))
1184   ;; (stderr  "type->description o=~s ==> ~s\n" o  (caddr (assoc-ref (.types info) o)))
1185   ;; (stderr  "  assoc ~a\n" (assoc-ref (.types info) o))
1186   (pmatch o
1187     ((decl-spec-list (type-spec (fixed-type ,type)))
1188      (type->description info type))
1189     ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
1190      (type->description info type))
1191     (_ (caddr (assoc-ref (.types info) o)))))
1192
1193 (define (local? o) ;; formals < 0, locals > 0
1194   (positive? (local:id o)))
1195
1196 (define (ast->info info)
1197   (lambda (o)
1198     (let ((globals (.globals info))
1199           (locals (.locals info))
1200           (constants (.constants info))
1201           (text (.text info)))
1202       (define (add-local locals name type pointer)
1203         (let* ((id (1+ (length (filter local? (map cdr locals)))))
1204                (locals (cons (make-local name type pointer id) locals)))
1205           locals))
1206
1207       ;; (stderr "\n ast->info=~s\n" o)
1208       ;; (stderr "  globals[~a=>~a]: ~a\n" (length globals) (length (append-map cdr globals)) (map (lambda (s) (if (string? s) (string-delete #\newline s))) (map car globals)))
1209       ;; (stderr "  text=~a\n" text)
1210       ;; (stderr "   info=~a\n" info)
1211       ;; (stderr "   globals=~a\n" globals)
1212       (pmatch o
1213         (((trans-unit . _) . _)
1214          ((ast-list->info info)  o))
1215         ((trans-unit . ,elements)
1216          ((ast-list->info info) elements))
1217         ((fctn-defn . _) ((function->info info) o))
1218         ((comment . _) info)
1219         ((cpp-stmt (define (name ,name) (repl ,value)))
1220          info)
1221
1222         ((cast (type-name (decl-spec-list (type-spec (void)))) _)
1223          info)
1224
1225         ;; FIXME: expr-stmt wrapper?
1226         (trans-unit info)
1227         ((expr-stmt) info)
1228         ((assn-expr . ,assn-expr)
1229          ((ast->info info) `(expr-stmt ,o)))
1230
1231         ((d-sel . ,d-sel)
1232          (let ((expr ((expr->accu info) `(d-sel ,@d-sel))))
1233            expr))
1234
1235         ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
1236         
1237         ((if ,test ,body)
1238          (let* ((text-length (length text))
1239
1240                 (test-jump->info ((test->jump->info info) test))
1241                 (test+jump-info (test-jump->info 0))
1242                 (test-length (length (.text test+jump-info)))
1243
1244                 (body-info ((ast->info test+jump-info) body))
1245                 (text-body-info (.text body-info))
1246                 (body-text (list-tail text-body-info test-length))
1247                 (body-length (length (text->list body-text)))
1248
1249                 (text+test-text (.text (test-jump->info body-length)))
1250                 (test-text (list-tail text+test-text text-length)))
1251
1252            (clone info #:text
1253                   (append text
1254                           test-text
1255                           body-text)
1256                   #:globals (.globals body-info))))
1257
1258         ((if ,test ,then ,else)
1259          (let* ((text-length (length text))
1260
1261                 (test-jump->info ((test->jump->info info) test))
1262                 (test+jump-info (test-jump->info 0))
1263                 (test-length (length (.text test+jump-info)))
1264
1265                 (then-info ((ast->info test+jump-info) then))
1266                 (text-then-info (.text then-info))
1267                 (then-text (list-tail text-then-info test-length))
1268                 (then-jump-text (list (lambda (f g ta t d) (i386:Xjump 0))))
1269                 (then-jump-length (length (text->list then-jump-text)))
1270                 (then-length (+ (length (text->list then-text)) then-jump-length))
1271
1272                 (then+jump-info (clone then-info #:text (append text-then-info then-jump-text)))
1273                 (else-info ((ast->info then+jump-info) else))
1274                 (text-else-info (.text else-info))
1275                 (else-text (list-tail text-else-info (length (.text then+jump-info))))
1276                 (else-length (length (text->list else-text)))
1277
1278                 (text+test-text (.text (test-jump->info then-length)))
1279                 (test-text (list-tail text+test-text text-length))
1280                 (then-jump-text (list (lambda (f g ta t d) (i386:Xjump else-length)))))
1281
1282            (clone info #:text
1283                   (append text
1284                           test-text
1285                           then-text
1286                           then-jump-text
1287                           else-text)
1288                   #:globals (append (.globals then-info)
1289                                     (list-tail (.globals else-info) (length globals))))))
1290
1291         ((expr-stmt (cond-expr ,test ,then ,else))
1292          (let* ((text-length (length text))
1293
1294                 (test-jump->info ((test->jump->info info) test))
1295                 (test+jump-info (test-jump->info 0))
1296                 (test-length (length (.text test+jump-info)))
1297
1298                 (then-info ((ast->info test+jump-info) then))
1299                 (text-then-info (.text then-info))
1300                 (then-text (list-tail text-then-info test-length))
1301                 (then-length (length (text->list then-text)))
1302
1303                 (jump-text (list (lambda (f g ta t d) (i386:Xjump 0))))
1304                 (jump-length (length (text->list jump-text)))
1305
1306                 (test+then+jump-info
1307                  (clone then-info
1308                         #:text (append (.text then-info) jump-text)))
1309
1310                 (else-info ((ast->info test+then+jump-info) else))
1311                 (text-else-info (.text else-info))
1312                 (else-text (list-tail text-else-info (length (.text test+then+jump-info))))
1313                 (else-length (length (text->list else-text)))
1314
1315                 (text+test-text (.text (test-jump->info (+ then-length jump-length))))
1316                 (test-text (list-tail text+test-text text-length))
1317                 (jump-text (list (lambda (f g ta t d) (i386:Xjump else-length)))))
1318
1319            (clone info #:text
1320                   (append text
1321                           test-text
1322                           then-text
1323                           jump-text
1324                           else-text)
1325                   #:globals (.globals else-info))))
1326
1327         ((switch ,expr (compd-stmt (block-item-list . ,cases)))
1328          (let* ((expr ((expr->accu info) expr))
1329                 (empty (clone info #:text '()))
1330                 (case-infos (map (case->jump-info empty) cases))
1331                 (case-lengths (map (lambda (c-j) (length (text->list (.text (c-j 0))))) case-infos))
1332                 (cases-info (let loop ((cases cases) (info expr) (lengths case-lengths))
1333                               (if (null? cases) info
1334                                   (let ((c-j ((case->jump-info info) (car cases))))
1335                                     (loop (cdr cases) (c-j (apply + (cdr lengths))) (cdr lengths)))))))
1336            cases-info))
1337
1338         ((for ,init ,test ,step ,body)
1339          (let* ((info (clone info #:text '())) ;; FIXME: goto in body...
1340
1341                 (info ((ast->info info) init))
1342
1343                 (init-text (.text info))
1344                 (init-locals (.locals info))
1345                 (info (clone info #:text '()))
1346
1347                 (body-info ((ast->info info) body))
1348                 (body-text (.text body-info))
1349                 (body-length (length (text->list body-text)))
1350
1351                 (step-info ((ast->info info) `(expr-stmt ,step)))
1352                 (step-text (.text step-info))
1353                 (step-length (length (text->list step-text)))
1354
1355                 (test-jump->info ((test->jump->info info) test))
1356                 (test+jump-info (test-jump->info 0))
1357                 (test-length (length (text->list (.text test+jump-info))))
1358
1359                 (skip-body-text (list (lambda (f g ta t d)
1360                                         (i386:Xjump (+ body-length step-length)))))
1361
1362                 (jump-text (list (lambda (f g ta t d)
1363                                    (i386:Xjump (- (+ body-length step-length test-length))))))
1364                 (jump-length (length (text->list jump-text)))
1365
1366                 (test-text (.text (test-jump->info jump-length))))
1367
1368            (clone info #:text
1369                   (append text
1370                           init-text
1371                           skip-body-text
1372                           body-text
1373                           step-text
1374                           test-text
1375                           jump-text)
1376                   #:globals (append globals (list-tail (.globals body-info) (length globals)))
1377                   #:locals locals)))
1378
1379         ;; FIXME: support break statement (see switch/case)
1380         ((while ,test ,body)
1381          (let* ((skip-info (lambda (body-length)
1382                              (clone info #:text (append text
1383                                                         (list (lambda (f g ta t d) (i386:Xjump body-length)))))))
1384                 (text (.text (skip-info 0)))
1385                 (text-length (length text))
1386
1387                 (body-info (lambda (body-length)
1388                              ((ast->info (skip-info body-length)) body)))
1389                 (body-text (list-tail (.text (body-info 0)) text-length))
1390                 (body-length (length (text->list body-text)))
1391
1392                 (body-info (body-info body-length))
1393
1394                 (empty (clone info #:text '()))
1395                 (test-jump->info ((test->jump->info empty) test))
1396                 (test+jump-info (test-jump->info 0))
1397                 (test-length (length (text->list (.text test+jump-info))))
1398
1399                 (jump-text (list (lambda (f g ta t d)
1400                                    (i386:Xjump (- (+ body-length test-length))))))
1401                 (jump-length (length (text->list jump-text)))
1402
1403                 (test-text (.text (test-jump->info jump-length))))
1404            (clone info #:text
1405                   (append
1406                    (.text body-info)
1407                    test-text
1408                    jump-text)
1409                   #:globals (.globals body-info))))
1410
1411         ((do-while ,body ,test)
1412          (let* ((text-length (length text))
1413
1414                 (body-info ((ast->info info) body))
1415                 (body-text (list-tail (.text body-info) text-length))
1416                 (body-length (length (text->list body-text)))
1417
1418                 (empty (clone info #:text '()))
1419                 (test-jump->info ((test->jump->info empty) test))
1420                 (test+jump-info (test-jump->info 0))
1421                 (test-length (length (text->list (.text test+jump-info))))
1422
1423                 (jump-text (list (lambda (f g ta t d)
1424                                    (i386:Xjump (- (+ body-length test-length))))))
1425                 (jump-length (length (text->list jump-text)))
1426
1427                 (test-text (.text (test-jump->info jump-length))))
1428            (clone info #:text
1429                   (append
1430                    (.text body-info)
1431                    test-text
1432                    jump-text)
1433                   #:globals (.globals body-info))))
1434
1435         ((labeled-stmt (ident ,label) ,statement)
1436          (let ((info (clone info #:text (append text (list label)))))
1437            ((ast->info info) statement)))
1438
1439         ((goto (ident ,label))
1440          (let* ((jump (lambda (n) (i386:XXjump n)))
1441                 (offset (+ (length (jump 0)) (length (text->list text)))))
1442            (clone info #:text
1443                   (append text
1444                           (list (lambda (f g ta t d)
1445                                   (jump (- (label-offset (.function info) label f) offset))))))))
1446
1447         ;;; FIXME: only zero?!
1448         ((p-expr (ident ,name))
1449          (clone info #:text
1450                 (append text
1451                         ((ident->accu info) name)
1452                         (list (lambda (f g ta t d)
1453                                 (append
1454                                  (i386:accu-zero?)))))))
1455
1456         ((p-expr (fixed ,value))
1457          (let ((value (cstring->number value)))
1458           (clone info #:text
1459                  (append text
1460                          (list (lambda (f g ta t d)
1461                                  (append
1462                                   (i386:value->accu value)
1463                                   (i386:accu-zero?))))))))
1464
1465         ((de-ref (p-expr (ident ,name)))
1466          (clone info #:text
1467                 (append text
1468                         ((ident->accu info) name)
1469                         (list (lambda (f g ta t d)
1470                                 (append
1471                                  (i386:byte-mem->accu)))))))
1472
1473         ((fctn-call . ,call)
1474          (let ((info ((expr->accu info) o)))
1475            (clone info #:text
1476                   (append (.text info)
1477                           (list (lambda (f g ta t d)
1478                                   (i386:accu-zero?)))))))
1479
1480         ;; FIXME
1481         ;;((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
1482         ((post-inc (p-expr (ident ,name)))
1483          (clone info #:text
1484                 (append text
1485                         ((ident->accu info) name)
1486                         ((ident-add info) name 1)
1487                         (list (lambda (f g ta t d)
1488                                 (append
1489                                  (i386:accu-zero?)))))))
1490         ((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
1491         ((post-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
1492         ((pre-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
1493         ((pre-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
1494
1495         ;; i++
1496         ((expr-stmt (post-inc (p-expr (ident ,name))))
1497          (clone info #:text (append text ((ident-add info) name 1))))
1498
1499         ;; ++i
1500         ((expr-stmt (pre-inc (p-expr (ident ,name))))
1501          (or (assoc-ref locals name) (begin (stderr "++i ~a\n" name) barf))
1502          (clone info #:text
1503                 (append text
1504                         ((ident-add info) name 1)
1505                         ((ident->accu info) name)
1506                         (list (lambda (f g ta t d)
1507                                 (append
1508                                  ;;(i386:local->accu (local:id (assoc-ref locals name)))
1509                                  (i386:accu-zero?)))))))
1510
1511         ;; i--
1512         ((expr-stmt (post-dec (p-expr (ident ,name))))
1513          (or (assoc-ref locals name) (begin (stderr "i-- ~a\n" name) barf))
1514          (clone info #:text
1515                 (append text
1516                         ((ident->accu info) name)
1517                         ((ident-add info) name -1)
1518                         (list (lambda (f g ta t d)
1519                                 (append
1520                                  ;;(i386:local-add (local:id (assoc-ref locals name)) -1)
1521                                  (i386:accu-zero?)))))))
1522
1523         ;; --i
1524         ((expr-stmt (pre-dec (p-expr (ident ,name))))
1525          (or (assoc-ref locals name) (begin (stderr "--i ~a\n" name) barf))
1526          (clone info #:text
1527                 (append text
1528                         ((ident-add info) name -1)
1529                         ((ident->accu info) name)
1530                         (list (lambda (f g ta t d)
1531                                 (append
1532                                  ;;(i386:local-add (local:id (assoc-ref locals name)) -1)
1533                                  ;;(i386:local->accu (local:id (assoc-ref locals name)))
1534                                  (i386:accu-zero?)))))))
1535
1536         ((not ,expr)
1537          (let* ((test-info ((ast->info info) expr)))
1538            (clone info #:text
1539                   (append (.text test-info)
1540                           (list (lambda (f g ta t d)
1541                                   (append
1542                                    (i386:accu-not)
1543                                    (i386:accu-zero?)))))
1544                   #:globals (.globals test-info))))
1545
1546         ((eq ,a ,b)
1547          (let* ((base ((expr->base info) a))
1548                 (empty (clone base #:text '()))
1549                 (accu ((expr->accu empty) b)))
1550            (clone info #:text
1551                   (append text
1552                           (.text base)
1553                           (list (lambda (f g ta t d)
1554                                   (i386:push-base)))
1555                           (.text accu)
1556                           (list (lambda (f g ta t d)
1557                                   (i386:pop-base)))
1558                           (list (lambda (f g ta t d)
1559                                   (i386:sub-base)))))))
1560
1561         ((ge ,a ,b)
1562          (let* ((base ((expr->base info) a))
1563                 (empty (clone base #:text '()))
1564                 (accu ((expr->accu empty) b)))
1565            (clone info #:text
1566                   (append text
1567                           (.text base)
1568                           (list (lambda (f g ta t d)
1569                                   (i386:push-base)))
1570                           (.text accu)
1571                           (list (lambda (f g ta t d)
1572                                   (i386:pop-base)))
1573                           (list (lambda (f g ta t d)
1574                                   (i386:sub-base)))))))
1575
1576         ((gt ,a ,b)
1577          (let* ((base ((expr->base info) a))
1578                 (empty (clone base #:text '()))
1579                 (accu ((expr->accu empty) b)))
1580            (clone info #:text
1581                   (append text
1582                           (.text base)
1583                           (list (lambda (f g ta t d)
1584                                   (i386:push-base)))
1585                           (.text accu)
1586                           (list (lambda (f g ta t d)
1587                                   (i386:pop-base)))
1588                           (list (lambda (f g ta t d)
1589                                   (i386:sub-base)))))))
1590
1591         ((ne ,a ,b)
1592          (let* ((base ((expr->base info) a))
1593                 (empty (clone base #:text '()))
1594                 (accu ((expr->accu empty) b)))
1595            (clone info #:text
1596                   (append text
1597                           (.text base)
1598                           (list (lambda (f g ta t d)
1599                                   (i386:push-base)))
1600                           (.text accu)
1601                           (list (lambda (f g ta t d)
1602                                   (i386:pop-base)))
1603                           (list (lambda (f g ta t d)
1604                                   (append 
1605                                    (i386:sub-base)
1606                                    (i386:xor-zf))))))))
1607
1608         ((le ,a ,b)
1609          (let* ((base ((expr->base info) a))
1610                 (empty (clone base #:text '()))
1611                 (accu ((expr->accu empty) b)))
1612            (clone info #:text
1613                   (append text
1614                           (.text base)
1615                           (list (lambda (f g ta t d)
1616                                   (i386:push-base)))
1617                           (.text accu)
1618                           (list (lambda (f g ta t d)
1619                                   (i386:pop-base)))
1620                           (list (lambda (f g ta t d)
1621                                   (i386:base-sub)))))))
1622
1623         ((lt ,a ,b)
1624          (let* ((base ((expr->base info) a))
1625                 (empty (clone base #:text '()))
1626                 (accu ((expr->accu empty) b)))
1627            (clone info #:text
1628                   (append text
1629                           (.text base)
1630                           (list (lambda (f g ta t d)
1631                                   (i386:push-base)))
1632                           (.text accu)
1633                           (list (lambda (f g ta t d)
1634                                   (i386:pop-base)))
1635                           (list (lambda (f g ta t d)
1636                                   (i386:base-sub)))))))
1637
1638         ;; HMM
1639         ((lshift . _) ((expr->accu info) o))
1640         ((rshift . _) ((expr->accu info) o))
1641
1642         ;; TODO: byte dinges
1643         ((Xsub ,a ,b)
1644          (let* ((base ((expr->base info) a))
1645                 (empty (clone base #:text '()))
1646                 (accu ((expr->accu empty) b)))
1647            (clone info #:text
1648                   (append text
1649                           (.text base)
1650                           (list (lambda (f g ta t d)
1651                                   (i386:push-base)))
1652                           (.text accu)
1653                           (list (lambda (f g ta t d)
1654                                   (i386:pop-base)))
1655                           (list (lambda (f g ta t d)
1656                                   (i386:base-sub)))))))
1657
1658         ((Xsub (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
1659          (clone info #:text
1660                 (append text
1661                         (list (lambda (f g ta t d)
1662                                 (append
1663                                  (i386:local->accu (local:id (assoc-ref locals a)))
1664                                  (i386:byte-mem->base)
1665                                  (i386:local->accu (local:id (assoc-ref locals b)))
1666                                  (i386:byte-mem->accu)
1667                                  (i386:byte-sub-base)))))))
1668
1669         ;; g_cells[0]
1670         ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
1671          (let* ((value (cstring->number value))
1672                 (type (ident->type info array))
1673                 (size (type->size info type)))
1674            (clone info #:text
1675                   (append text
1676                         ((ident->base info) array)
1677                         (list (lambda (f g ta t d)
1678                                 (append
1679                                  (i386:value->accu (* size index))
1680                                  (if (eq? size 1)
1681                                      (i386:byte-base-mem->accu)
1682                                      (i386:base-mem->accu)))))))))
1683         
1684         ;; g_cells[a]
1685         ((array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))
1686          (let* ((type (ident->type info array))
1687                 (size (type->size info type)))
1688            (clone info #:text
1689                   (append text
1690                           ((ident->base info) index)
1691                           (list (lambda (f g ta t d)
1692                                   (append
1693                                    (i386:base->accu)
1694                                    (if (< size 4) '()
1695                                        (append
1696                                          (i386:accu+accu)
1697                                          (if (= size 12) (i386:accu+base) '())
1698                                          (i386:accu-shl 2))))))
1699                           ((ident->base info) array)
1700                           (list (lambda (f g ta t d)
1701                                  (if (eq? size 1)
1702                                      (i386:byte-base-mem->accu)
1703                                      (i386:base-mem->accu))))))))
1704         
1705         ((return ,expr)
1706          (let ((accu ((expr->accu info) expr)))
1707            (clone accu #:text
1708                   (append (.text accu) (list (lambda (f g ta t d) (i386:ret)))))))
1709
1710         ;; int i;
1711         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
1712          (if (.function info)
1713              (clone info #:locals (add-local locals name type 0))
1714              (clone info #:globals (append globals (list (ident->global name type 0 0))))))
1715
1716         ;; int i = 0;
1717         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
1718          (let ((value (cstring->number value)))
1719            (if (.function info)
1720                (let* ((locals (add-local locals name type 0))
1721                       (info (clone info #:locals locals)))
1722                  (clone info #:text
1723                         (append text
1724                                 ((value->ident info) name value))))
1725                (clone info #:globals (append globals (list (ident->global name type 0 value)))))))
1726
1727         ;; char c = 'A';
1728         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (char ,value))))))
1729          (if (not (.function info)) decl-barf0)
1730          (let* ((locals (add-local locals name type 0))
1731                 (info (clone info #:locals locals))
1732                 (value (char->integer (car (string->list value)))))
1733            (clone info #:text
1734                   (append text
1735                           ((value->ident info) name value)))))
1736
1737         ;; int i = -1;
1738         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (neg (p-expr (fixed ,value)))))))
1739          (let ((value (- (cstring->number value))))
1740            (if (.function info)
1741                (let* ((locals (add-local locals name type 0))
1742                       (info (clone info #:locals locals)))
1743                  (clone info #:text
1744                         (append text
1745                                 ((value->ident info) name value))))
1746                (clone info #:globals (append globals (list (ident->global name type 0 value)))))))
1747
1748         ;; int i = argc;
1749         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
1750          (if (not (.function info)) decl-barf2)
1751          (let* ((locals (add-local locals name type 0))
1752                 (info (clone info #:locals locals)))
1753            (clone info #:text
1754                   (append text
1755                           ((ident->accu info) local)
1756                           ((accu->ident info) name)))))
1757
1758         ;; char *p = "t.c";
1759         ;;(decl (decl-spec-list (type-spec (fixed-type "char"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "p")) (initzer (p-expr (string "t.c\n"))))))
1760         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,string))))))
1761          (when (not (.function info))
1762              (stderr "o=~s\n" o)
1763              decl-barf3)
1764          (let* ((locals (add-local locals name type 1))
1765                 (globals (append globals (list (string->global string))))
1766                 (info (clone info #:locals locals #:globals globals)))
1767            (clone info #:text
1768                   (append text
1769                           (list (lambda (f g ta t d)
1770                                   (append
1771                                    (i386:global->accu (+ (data-offset (add-s:-prefix string) g) d)))))
1772                           ((accu->ident info) name)))))
1773         
1774         ;; char *p = 0;
1775         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (fixed ,value))))))
1776          (let ((value (cstring->number value)))
1777            (if (.function info)
1778                (let* ((locals (add-local locals name type 1))
1779                       (info (clone info #:locals locals)))
1780                  (clone info #:text
1781                         (append text
1782                                 (list (lambda (f g ta t d)
1783                                         (i386:value->accu value)))
1784                                 ((accu->ident info) name))))
1785                (clone info #:globals (append globals (list (ident->global name type 0 value)))))))
1786
1787         ;; char arena[20000];
1788         ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
1789          (let ((type (ast->type type)))
1790            (if (.function info)
1791                TODO:decl-array 
1792                (let* ((globals (.globals info))
1793                       (count (cstring->number count))
1794                       (size (type->size info type))
1795                       ;;;;(array (make-global name type -1 (string->list (make-string (* count size) #\nul))))
1796                       (array (make-global name type -1 (string->list (make-string (* count size) #\nul))))
1797                       (globals (append globals (list array))))
1798                  (clone info
1799                         #:globals globals)))))
1800
1801         ;;struct scm *g_cells = (struct scm*)arena;
1802         ((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (struct-ref (ident ,=type)))) (abs-declr (pointer))) (p-expr (ident ,value)))))))
1803          ;;(stderr "0TYPE: ~s\n" type)
1804          (if (.function info)
1805              (let* ((locals (add-local locals name type 1))
1806                     (info (clone info #:locals locals)))
1807                (clone info #:text
1808                       (append text
1809                               ((ident->accu info) name)
1810                               ((accu->ident info) value)))) ;; FIXME: deref?
1811              (let* ((globals (append globals (list (ident->global name type 1 0))))
1812                     (info (clone info #:globals globals)))
1813                (clone info #:text
1814                       (append text
1815                               ((ident->accu info) name)
1816                               ((accu->ident info) value)))))) ;; FIXME: deref?
1817
1818         ;; SCM tmp;
1819         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name))))
1820          ;;(stderr  "1TYPE: ~s\n" type)
1821          (if (.function info)
1822              (clone info #:locals (add-local locals name type 0))
1823              (clone info #:globals (append globals (list (ident->global name type 0 0))))))
1824
1825         ;; SCM g_stack = 0;
1826         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
1827          ;;(stderr  "2TYPE: ~s\n" type)
1828          (let ((value (cstring->number value)))
1829           (if (.function info)
1830               (let* ((locals (add-local locals name type 0))
1831                      (info (clone info #:locals locals)))
1832                 (clone info #:text
1833                        (append text
1834                                ((value->ident info) name value))))
1835               (let ((globals (append globals (list (ident->global name type 0 value)))))
1836                 (clone info #:globals globals)))))
1837
1838         ;; SCM g_stack = 0; // comment
1839         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident _) (initzer (p-expr (fixed _))))) (comment _))
1840          ((ast->info info) (list-head o (- (length o) 1))))
1841
1842         ;; SCM i = argc;
1843         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
1844          ;;(stderr  "3TYPE: ~s\n" type)
1845          (if (.function info)
1846              (let* ((locals (add-local locals name type 0))
1847                     (info (clone info #:locals locals)))
1848                (clone info #:text
1849                       (append text
1850                               ((ident->accu info) local)
1851                               ((accu->ident info) name))))
1852              (let* ((globals (append globals (list (ident->global name type 0 0))))
1853                     (info (clone info #:globals globals)))
1854                (clone info #:text
1855                       (append text
1856                               ((ident->accu info) local)
1857                               ((accu->ident info) name))))))
1858
1859         ;; int (*function) (void) = g_functions[g_cells[fn].cdr].function;
1860         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)) (initzer ,initzer))))
1861          (let* ((locals (add-local locals name type 1))
1862                 (info (clone info #:locals locals))
1863                 (empty (clone info #:text '()))
1864                 (accu ((expr->accu empty) initzer)))
1865            (clone info
1866                   #:text
1867                   (append text
1868                           (.text accu)
1869                           ((accu->ident info) name)
1870                           (list (lambda (f g ta t d)
1871                                   (append
1872                                    ;;(i386:value->base t)
1873                                    ;;(i386:accu+base)
1874                                    (i386:value->base ta)
1875                                    (i386:accu+base)))))
1876                   #:locals locals)))
1877
1878         ;; char *p = (char*)g_cells;
1879         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (fixed-type ,=type))) (abs-declr (pointer))) (p-expr (ident ,value)))))))
1880          ;;(stderr  "6TYPE: ~s\n" type)
1881          (if (.function info)
1882              (let* ((locals (add-local locals name type 1))
1883                     (info (clone info #:locals locals)))
1884                (clone info #:text
1885                       (append text
1886                               ((ident->accu info) value)
1887                               ((accu->ident info) name))))
1888              (let* ((globals (append globals (list (ident->global name type 1 0))))
1889                     (here (data-offset name globals))
1890                     (there (data-offset value globals)))
1891                (clone info
1892                       #:globals globals
1893                       #:init (append (.init info)
1894                                      (list (lambda (functions globals ta t d data)
1895                                              (append
1896                                               (list-head data here)
1897                                               ;;; FIXME: type
1898                                               ;;; char *x = arena;
1899                                               (int->bv32 (+ d (data-offset value globals)))
1900                                               ;;; char *y = x;
1901                                               ;;;(list-head (list-tail data there) 4)
1902                                               (list-tail data (+ here 4))))))))))
1903
1904         ;; char *p = g_cells;
1905         ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value))))))
1906          ;;(stderr  "7TYPE: ~s\n" type)
1907          (let ((type (decl->type type)))
1908            ;;(stderr "0DECL: ~s\n" type)
1909            (if (.function info)
1910                (let* ((locals (add-local locals name type  1))
1911                       (info (clone info #:locals locals)))
1912                  (clone info #:text
1913                         (append text
1914                                 ((ident->accu info) value)
1915                                 ((accu->ident info) name))))
1916                (let* ((globals (append globals (list (ident->global name type 1 0))))
1917                       (here (data-offset name globals)))
1918                  (clone info
1919                         #:globals globals
1920                         #:init (append (.init info)
1921                                        (list (lambda (functions globals ta t d data)
1922                                                (append
1923                                                 (list-head data here)
1924                                               ;;; FIXME: type
1925                                               ;;; char *x = arena;p
1926                                                 (int->bv32 (+ d (data-offset value globals)))
1927                                                 (list-tail data (+ here 4)))))))))))
1928
1929         ;; enum 
1930         ((decl (decl-spec-list (type-spec (enum-def (ident ,name) (enum-def-list . ,fields)))))
1931          (let ((type (enum->type name fields))
1932                (constants (map ident->constant (map cadadr fields) (iota (length fields)))))
1933            (clone info
1934                   #:types (append (.types info) (list type))
1935                   #:constants (append constants (.constants info)))))
1936
1937         ;; struct
1938         ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields)))))
1939          (let* ((type (struct->type (list "struct" name) (map struct-field fields))))
1940            ;;(stderr "type: ~a\n" type)
1941            (clone info #:types (append (.types info) (list type)))))
1942
1943         ;; *p++ = b;
1944         ((expr-stmt (assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b))
1945          (when (not (equal? op "="))
1946            (stderr "OOOPS0.0: op=~s\n" op)
1947            barf)
1948          (let* ((empty (clone info #:text '()))
1949                 (base ((expr->base empty) b)))
1950            (clone info #:text
1951                   (append text
1952                           (.text base)
1953                           ((base->ident-address info) name)
1954                           ((ident-add info) name 1)))))
1955
1956         ;; *p-- = b;
1957         ((expr-stmt (assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b))
1958          (when (not (equal? op "="))
1959            (stderr "OOOPS0.0: op=~s\n" op)
1960            barf)
1961          (let* ((empty (clone info #:text '()))
1962                 (base ((expr->base empty) b)))
1963            (clone info #:text
1964                   (append text
1965                           (.text base)
1966                           ((base->ident-address info) name)
1967                           ((ident-add info) name -1)))))
1968
1969         ;; CAR (x) = 0
1970         ;; TYPE (x) = PAIR;
1971         ((expr-stmt (assn-expr (d-sel (ident ,field) . ,d-sel) (op ,op) ,b))
1972          (when (not (equal? op "="))
1973            (stderr "OOOPS0: op=~s\n" op)
1974            barf)
1975          (let* ((empty (clone info #:text '()))
1976                 (expr ((expr->accu* empty) `(d-sel (ident ,field) ,@d-sel))) ;; <-OFFSET
1977                 (base ((expr->base empty) b))
1978                 (type (list "struct" "scm")) ;; FIXME
1979                 (fields (type->description info type))
1980                 (size (type->size info type))
1981                 (field-size 4) ;; FIXME:4, not fixed
1982                 (offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b))))))))                )
1983            (clone info #:text (append text
1984                                       (.text expr)
1985                                       (.text base)
1986                                       (list (lambda (f g ta t d)
1987                                               ;;(i386:byte-base->accu-ref) ;; FIXME: size
1988                                               (i386:base->accu-address)
1989                                               ))))))
1990
1991
1992         ;; i = 0;
1993         ;; c = f ();
1994         ;; i = i + 48;
1995         ;; p = g_cell;
1996         ((expr-stmt (assn-expr (p-expr (ident ,name)) (op ,op) ,b))
1997          (when (and (not (equal? op "="))
1998                     (not (equal? op "+="))
1999                     (not (equal? op "-=")))
2000            (stderr "OOOPS1: op=~s\n" op)
2001            barf)
2002          (let* ((empty (clone info #:text '()))
2003                 (base ((expr->base empty) b)))
2004            (clone info #:text (append text
2005                                       (.text base)
2006                                       (if (equal? op "=") '()
2007                                           (append ((ident->accu info) name)
2008                                                   (list (lambda (f g ta t d)
2009                                                           (append
2010                                                            (if (equal? op "+=")
2011                                                                (i386:accu+base)
2012                                                                (i386:accu-base))
2013                                                            (i386:accu->base))))))
2014                                       ;;assign:
2015                                       ((base->ident info) name)))))
2016         
2017         ;; *p = 0;
2018         ((expr-stmt (assn-expr (de-ref (p-expr (ident ,array))) (op ,op) ,b))
2019          (when (not (equal? op "="))
2020            (stderr "OOOPS2: op=~s\n" op)
2021            barf)
2022          (let* ((empty (clone info #:text '()))
2023                 (base ((expr->base empty) b)))
2024            (clone info #:text (append text
2025                                       (.text base)
2026                                       ;;assign:
2027                                       ((base->ident-address info) array)))))
2028
2029         ;; g_cells[0] = 65;
2030         ((expr-stmt (assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))) (op ,op) ,b))
2031          (when (not (equal? op "="))
2032            (stderr "OOOPS3: op=~s\n" op)
2033            barf)
2034          (let* ((index (cstring->number index))
2035                 (empty (clone info #:text '()))
2036                 (base ((expr->base empty) b))
2037                 (type (ident->type info array))
2038                 (size (type->size info type))
2039                 (ptr (ident->pointer info array)))
2040            (clone info #:text
2041                   (append text
2042                          (.text base)
2043                          (list (lambda (f g ta t d)
2044                                  (i386:push-base)))
2045                          (list (lambda (f g ta t d)
2046                                  (append
2047                                   (i386:value->base index)
2048                                   (i386:base->accu)
2049                                   (if (eq? size 1) '()
2050                                       (append
2051                                         (if (> size 4) (i386:accu+accu) '())
2052                                         (if (> size 8) (i386:accu+base) '())
2053                                         (i386:accu-shl 2))))))
2054                          ((ident->base info) array)
2055                          (list (lambda (f g ta t d)
2056                                  (i386:accu+base)))
2057                          (list (lambda (f g ta t d)
2058                                  (i386:pop-base)))
2059                          (if (eq? size 1) (list (lambda (f g ta t d)
2060                                                   (i386:byte-base->accu-address)))
2061                              (append
2062                               (list (lambda (f g ta t d)
2063                                       (i386:base-address->accu-address)))
2064                               (if (> size 4)
2065                                   (list (lambda (f g ta t d)
2066                                           (append
2067                                            (i386:accu+n 4)
2068                                            (i386:base+n 4)
2069                                            (i386:base-address->accu-address))))
2070                                   '())
2071                               (if (> size 8)
2072                                   (list (lambda (f g ta t d)
2073                                           (append
2074                                            (i386:accu+n 4)
2075                                            (i386:base+n 4)
2076                                            (i386:base-address->accu-address))))
2077                                   '())))))))
2078
2079         ;; g_cells[i] = c;
2080         ((expr-stmt (assn-expr (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))) (op ,op) ,b))
2081          ;;(stderr "pointer_cells4[]: ~s\n" array)
2082          (when (not (equal? op "="))
2083            (stderr "OOOPS4: op=~s\n" op)
2084            barf)
2085          (let* ((empty (clone info #:text '()))
2086                 (base ((expr->base empty) b))
2087                 (type (ident->type info array))
2088                 (size (type->size info type))
2089                 (ptr (ident->pointer info array)))
2090            (clone info #:text
2091                   (append text
2092                           (.text base)
2093                           (list (lambda (f g ta t d)
2094                                   (i386:push-base)))
2095                           ((ident->base info) index)
2096                           (list (lambda (f g ta t d)
2097                                   (append
2098                                    (i386:base->accu)
2099                                    (if (eq? size 1) '()
2100                                        (append
2101                                          (if (> size 4) (i386:accu+accu) '())
2102                                          (if (> size 8) (i386:accu+base) '())
2103                                          (i386:accu-shl 2))))))
2104                           ((ident->base info) array)
2105                           (list (lambda (f g ta t d)
2106                                   (i386:accu+base)))
2107                          (list (lambda (f g ta t d)
2108                                  (i386:pop-base)))
2109                          (if (eq? size 1) (list (lambda (f g ta t d)
2110                                                   (i386:byte-base->accu-address)))
2111                              (append
2112                               (list (lambda (f g ta t d)
2113                                       (i386:base-address->accu-address)))
2114                               (if (> size 4)
2115                                   (list (lambda (f g ta t d)
2116                                           (append
2117                                            (i386:accu+n 4)
2118                                            (i386:base+n 4)
2119                                            (i386:base-address->accu-address))))
2120                                   '())
2121                               (if (> size 8)
2122                                   (list (lambda (f g ta t d)
2123                                           (append
2124                                            (i386:accu+n 4)
2125                                            (i386:base+n 4)
2126                                            (i386:base-address->accu-address))))
2127                                   '())))))))
2128
2129         ;; g_functions[g_function++] = g_foo;
2130         ((expr-stmt (assn-expr (array-ref (post-inc (p-expr (ident ,index))) (p-expr (ident ,array))) (op ,op) ,b))
2131          (when (not (equal? op "="))
2132            (stderr "OOOPS5: op=~s\n" op)
2133            barf)
2134          (let* ((empty (clone info #:text '()))
2135                 (base ((expr->base empty) b))
2136                 (type (ident->type info array))
2137                 (size (type->size info type))
2138                 (ptr (ident->pointer info array)))
2139            (clone info #:text
2140                   (append text
2141                           (.text base)
2142                           (list (lambda (f g ta t d)
2143                                   (i386:push-base)))
2144                           ((ident->base info) index)
2145                           (list (lambda (f g ta t d)
2146                                   (append
2147                                    (i386:base->accu)
2148                                    (if (eq? size 1) '()
2149                                        (append
2150                                          (if (> size 4) (i386:accu+accu) '())
2151                                          (if (> size 8) (i386:accu+base) '())
2152                                          (i386:accu-shl 2))))))
2153                           ((ident->base info) array)
2154                           (list (lambda (f g ta t d)
2155                                   (i386:accu+base)))
2156                          (list (lambda (f g ta t d)
2157                                  (i386:pop-base)))
2158                          (if (eq? size 1) (list (lambda (f g ta t d)
2159                                                   (i386:byte-base->accu-address)))
2160                              (append
2161                               (list (lambda (f g ta t d)
2162                                       (i386:base-address->accu-address)))
2163                               (if (> size 4)
2164                                   (list (lambda (f g ta t d)
2165                                           (append
2166                                            (i386:accu+n 4)
2167                                            (i386:base+n 4)
2168                                            (i386:base-address->accu-address))))
2169                                   '())
2170                               (if (> size 8)
2171                                   (list (lambda (f g ta t d)
2172                                           (append
2173                                            (i386:accu+n 4)
2174                                            (i386:base+n 4)
2175                                            (i386:base-address->accu-address))))
2176                                   '())))
2177                          ((ident-add info) index 1)))))
2178
2179         ((expr-stmt ,expression)
2180          ((expr->accu info) expression))
2181
2182         ;; DECL
2183         ;;
2184         ;; struct f = {...};
2185         ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
2186          (let* ((type (decl->type type))
2187                 ;;(foo (stderr "1DECL: ~s\n" type))
2188                 (fields (type->description info type))
2189                 (size (type->size info type))
2190                 (field-size 4))  ;; FIXME:4, not fixed
2191            ;;(stderr  "7TYPE: ~s\n" type)
2192            (if (.function info)
2193                (let* ((globals (append globals (filter-map initzer->global initzers)))
2194                       (locals (let loop ((fields (cdr fields)) (locals locals))
2195                                 (if (null? fields) locals
2196                                     (loop (cdr fields) (add-local locals "foobar" "int" 0)))))
2197                       (locals (add-local locals name type -1))
2198                       (info (clone info #:locals locals #:globals globals))
2199                       (empty (clone info #:text '())))
2200                  (let loop ((fields (iota (length fields))) (initzers initzers) (info info))
2201                    (if (null? fields) info
2202                        (let ((offset (* field-size (car fields)))
2203                              (initzer (car initzers)))
2204                          (loop (cdr fields) (cdr initzers)
2205                                (clone info #:text
2206                                       (append
2207                                        (.text info)
2208                                        ((ident->accu info) name)
2209                                        (list (lambda (f g ta t d)
2210                                                (append
2211                                                 (i386:accu->base))))
2212                                        (.text ((expr->accu empty) initzer))
2213                                        (list (lambda (f g ta t d)
2214                                                (i386:accu->base-address+n offset))))))))))
2215                (let* ((globals (append globals (filter-map initzer->global initzers)))
2216                       (global (make-global name type -1 (string->list (make-string size #\nul))))
2217                       (globals (append globals (list global)))
2218                       (here (data-offset name globals))
2219                       (info (clone info #:globals globals))
2220                       (field-size 4))
2221                  (let loop ((fields (iota (length fields))) (initzers initzers) (info info))
2222                    (if (null? fields) info
2223                        (let ((offset (* field-size (car fields)))
2224                              (initzer (car initzers)))
2225                          (loop (cdr fields) (cdr initzers)
2226                                (clone info #:init
2227                                       (append
2228                                        (.init info)
2229                                        (list (lambda (functions globals ta t d data)
2230                                                (append
2231                                                 (list-head data (+ here offset))
2232                                                 (initzer->data info functions globals ta t d (car initzers))
2233                                                 (list-tail data (+ here offset field-size)))))))))))))))
2234
2235
2236         ;;char cc = g_cells[c].cdr;  ==> generic?
2237         ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer ,initzer))))
2238          (let ((type (decl->type type)))
2239            (if (.function info)
2240                (let* ((locals (add-local locals name type 0))
2241                       (info (clone info #:locals locals)))
2242                  (clone info #:text
2243                         (append (.text ((expr->accu info) initzer))
2244                                 ((accu->ident info) name))))
2245                (let* ((globals (append globals (list (ident->global name type 1 0))))
2246                       (here (data-offset name globals)))
2247                  (clone info
2248                         #:globals globals
2249                         #:init (append (.init info)
2250                                        (list (lambda (functions globals ta t d data)
2251                                                (append
2252                                                 (list-head data here)
2253                                                 (initzer->data info functions globals ta t d initzer)
2254                                                 (list-tail data (+ here 4)))))))))))
2255
2256
2257         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
2258          info)
2259
2260         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))) (comment ,comment))
2261          info)
2262
2263         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
2264          (let ((types (.types info)))
2265            (clone info #:types (cons (cons name (assoc-ref types type)) types))))
2266
2267         ((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name)
2268          (format (current-error-port) "SKIP: typedef=~s\n" o)
2269          info)
2270
2271         ((decl (@ ,at))
2272          (format (current-error-port) "SKIP: at=~s\n" o)
2273          info)
2274
2275         ((decl . _)
2276          (format (current-error-port) "SKIP: decl statement=~s\n" o)
2277          barf
2278          info)
2279
2280         (_
2281          (format (current-error-port) "SKIP: statement=~s\n" o)
2282          barf
2283          info)))))
2284
2285 (define (initzer->data info functions globals ta t d o)
2286   (pmatch o
2287     ((initzer (p-expr (fixed ,value))) (int->bv32 (cstring->number value)))
2288     ((initzer (neg (p-expr (fixed ,value)))) (int->bv32 (- (cstring->number value))))
2289     ((initzer (ref-to (p-expr (ident ,name))))
2290      ;;(stderr "INITZER[~a] => 0x~a\n" o (dec->hex (+ ta (function-offset name functions))))
2291      (int->bv32 (+ ta (function-offset name functions))))
2292     ((initzer (p-expr (ident ,name)))
2293      (let ((value (assoc-ref (.constants info) name)))
2294        (int->bv32 value)))
2295     ((initzer (p-expr (string ,string)))
2296      (int->bv32 (+ (data-offset (add-s:-prefix string) globals) d)))
2297     (_ (stderr "initzer->data:SKIP: ~s\n" o)
2298        barf
2299      (int->bv32 0))))
2300
2301 (define (info->exe info)
2302   (display "dumping elf\n" (current-error-port))
2303   (for-each write-any (make-elf (.functions info) (.globals info) (.init info))))
2304
2305 (define (.formals o)
2306   (pmatch o
2307     ((fctn-defn _ (ftn-declr _ ,formals) _) formals)
2308     ((fctn-defn _ (ptr-declr (pointer) (ftn-declr _ ,formals)) _) formals)
2309     (_ (format (current-error-port) ".formals: no match: ~a\n" o)
2310        barf)))
2311
2312 (define (formal->text n)
2313   (lambda (o i)
2314     ;;(i386:formal i n)
2315     '()
2316     ))
2317
2318 (define (formals->text o)
2319   (pmatch o
2320     ((param-list . ,formals)
2321      (let ((n (length formals)))
2322        (list (lambda (f g ta t d)
2323                (append
2324                 (i386:function-preamble)
2325                 (append-map (formal->text n) formals (iota n))
2326                 (i386:function-locals))))))
2327     (_ (format (current-error-port) "formals->text: no match: ~a\n" o)
2328        barf)))
2329
2330 (define (formal:ptr o)
2331   (pmatch o
2332     ((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) . _)))
2333      1)
2334     ((param-decl (decl-spec-list . ,decl) (param-declr (ident ,name)))
2335      0)
2336     (_
2337      (stderr "formal:ptr[~a] => 0\n" o)
2338      0)))
2339
2340 (define (formals->locals o)
2341   (pmatch o
2342     ((param-list . ,formals)
2343      (let ((n (length formals)))
2344        (map make-local (map .name formals) (map .type formals) (map formal:ptr formals) (iota n -2 -1))))
2345     (_ (format (current-error-port) "formals->info: no match: ~a\n" o)
2346        barf)))
2347
2348 (define (function->info info)
2349   (lambda (o)
2350     ;;(stderr "function->info o=~s\n" o)
2351     ;;(stderr "formals=~s\n" (.formals o))
2352     (let* ((name (.name o))
2353            (formals (.formals o))
2354            (text (formals->text formals))
2355            (locals (formals->locals formals)))
2356       (format (current-error-port) "compiling ~s\n" name)
2357       ;;(stderr "locals=~s\n" locals)
2358       (let loop ((statements (.statements o))
2359                  (info (clone info #:locals locals #:function (.name o) #:text text)))
2360         (if (null? statements) (clone info
2361                                       #:function #f
2362                                       #:functions (append (.functions info) (list (cons name (.text info)))))
2363             (let* ((statement (car statements)))
2364               (loop (cdr statements)
2365                     ((ast->info info) (car statements)))))))))
2366
2367 (define (ast-list->info info)
2368   (lambda (elements)
2369     (let loop ((elements elements) (info info))
2370       (if (null? elements) info
2371           (loop (cdr elements) ((ast->info info) (car elements)))))))
2372
2373 (define (compile)
2374   (stderr "COMPILE\n")
2375   (let* ((ast (mescc))
2376          (info (make <info>
2377                  #:functions i386:libc
2378                  #:types i386:type-alist))
2379          (ast (append libc ast))
2380          (info ((ast->info info) ast))
2381          (info ((ast->info info) _start)))
2382     (info->exe info)))