source: project/wiki/chicken-compilation-process @ 36653

Last change on this file since 36653 was 35392, checked in by svnwiki, 2 years ago

Anonymous wiki edit for IP [120.151.231.140]: Minor edits to grammar.

File size: 55.2 KB
Line 
1[[toc:]]
2[[tags: internals]]
3
4== A guide to the CHICKEN compilation process
5
6This document describes the compilation process used by the CHICKEN
7Scheme to C compiler by explaining the different compilation stages on
8a simple example program.
9
10CHICKEN uses a compilation strategy called ''Cheney-on-the-MTA'' after
11a paper by Henry Baker[1]. The basic idea is quite simple: compile
12Scheme to C by first transforming a program into ''Continuation
13Passing Style'' (CPS) and then directly generate C code in CPS as
14functions that never return and call a stack-allocated continuation
15record instead (that also holds a pointer to the code of a continuation
16procedure). Allocation is done simply by creating data
17structures on the stack - since functions never return, the allocated
18data will stay "live". As this would build up stack-frames endlessly,
19the stack-pointer is checked at regular times (currently on every
20function entry) whether a predetermined limit is reached and once the
21limit is exceeded, the current arguments and continuation is saved and
22all live data is copied into the heap (effectively a second heap
23generation in a generational garbage collection scheme).  This copying
24traverses all data that can be reached from the current dynamic state
25of the program (which is just the continuation, the arguments passed
26to the current procedure plus the current closure). Unreachable data
27is never touched and thus the time required for copying is
28proportional to the amount of live data on the stack.
29
30Allocation can be extremely fast as we basically can
31use the machine's stack-pointer as a dedicated allocation pointer
32register. Another advantage is that through the CPS conversion
33(combined with a ''flat'' closure representation) a minimum of garbage
34is retained: only data in free variables that are guaranteed to be
35used is stored in continuation closure records, at a sub-procedure
36level.  As continuations are explicit and inherent under this
37strategy, code that uses continuations heavily pays no performance
38penalty. This is particularly important when threads are implemented
39on top of continuations.
40
41A disadvantage is that a lot of allocation takes place and that the
42CPS representation puts certain contraints on interfacing to foreign
43code (especially when callbacks are involved).
44
45Ok, let's start with an example: the well-known ''N-queens'' problem.
46We present the code as it is transformed by the various compilation
47stages:
48
49=== Source
50
51<enscript highlight=scheme>
52;;; NQUEENS -- Compute number of solutions to 8-queens problem.
53
54(define (nqueens n)
55
56  (define (dec-to n)
57    (let loop ((i n) (l '()))
58      (if (= i 0) l (loop (- i 1) (cons i l)))))
59
60  (define (try x y z)
61    (if (null? x)
62      (if (null? y)
63        1
64        0)
65      (+ (if (ok? (car x) 1 z)
66           (try (append (cdr x) y) '() (cons (car x) z))
67           0)
68         (try (cdr x) (cons (car x) y) z))))
69
70  (define (ok? row dist placed)
71    (if (null? placed)
72      #t
73      (and (not (= (car placed) (+ row dist)))
74           (not (= (car placed) (- row dist)))
75           (ok? row (+ dist 1) (cdr placed)))))
76
77  (try (dec-to n) '() '()))
78
79(nqueens 8)
80</enscript>
81
82=== Canonicalized
83
84First comes ''canonicalization'', which means macro expansion and
85some basic source normalization.  Get this output using {{csc -debug 2}}:
86
87<enscript highlight=scheme>
88(##core#callunit "library")
89(##core#callunit "eval")
90(##core#callunit "extras")
91(##core#undefined)
92(##core#undefined)
93(set! nqueens
94  (lambda (n0)
95    (let ((dec-to1 (##core#undefined))
96          (try2 (##core#undefined))
97          (ok?3 (##core#undefined)))
98      (let ((t15 (set! dec-to1
99                   (lambda (n4)
100                     (##core#app
101                       (let ((loop5 (##core#undefined)))
102                         (let ((t8 (set! loop5
103                                     (lambda (i6 l7)
104                                       (if (= i6 '0) l7 (loop5 (- i6 '1) (cons i6 l7)))))))
105                           (let () loop5)))
106                       n4
107                       '())))))
108        (let ((t16 (set! try2
109                     (lambda (x9 y10 z11)
110                       (if (null? x9)
111                         (if (null? y10) '1 '0)
112                         (+ (if (ok?3 (car x9) '1 z11)
113                              (try2 (append (cdr x9) y10)
114                                    '()
115                                    (cons (car x9) z11))
116                              '0)
117                            (try2 (cdr x9) (cons (car x9) y10) z11)))))))
118          (let ((t17 (set! ok?3
119                       (lambda (row12 dist13 placed14)
120                         (if (null? placed14)
121                           '#t
122                           (if (not (= (car placed14) (+ row12 dist13)))
123                             (if (not (= (car placed14) (- row12 dist13)))
124                               (ok?3 row12 (+ dist13 '1) (cdr placed14))
125                               '#f)
126                             '#f))))))
127            (try2 (dec-to1 n0) '() '())))))))
128(nqueens '8)
129((##sys#implicit-exit-handler))
130(##core#undefined)
131</enscript>
132
133You'll note some administrative forms at the start and the end of the
134program - they ensure termination will call some setup- and cleanup code.
135Toplevel-definitions are also replaced by assignment and lexical
136identifiers are renamed (''alpha-converted'').
137
138=== CPS converted
139
140The next step is converting to CPS - you see that this generates quite
141a lot of code - the code has been slightly re-formatted to fit into
142this page. Note that the compiler operates on an abstract syntax tree
143now, the s-expression notation can be reconstructed by entering
144{{csc -debug 3}}:
145
146<enscript highlight=scheme>
147(lambda (k26)
148  (let ((k27 (##core#lambda (r28)
149  (let ((t19 r28))
150  (let ((k30 (##core#lambda (r31)
151  (let ((t20 r31))
152  (let ((k33 (##core#lambda (r34)
153  (let ((t21 r34))
154  (let ((t36 (set! nqueens
155  (lambda (k38 n0)
156  (let ((dec-to1 (##core#undefined)))
157  (let ((try2 (##core#undefined)))
158  (let ((ok?3 (##core#undefined)))
159  (let ((t39 (set! dec-to1
160  (lambda (k41 n4)
161  (let ((k42 (##core#lambda (r43) (k41 r43))))
162  (let ((loop5 (##core#undefined)))
163  (let ((t45 (set! loop5
164  (lambda (k47 i6 l7)
165  (let ((k48 (##core#lambda (r49) (k47 r49))))
166  (let ((k51 (##core#lambda (r52)
167  (if r52
168  (k48 l7)
169  (let ((k54 (##core#lambda (r55) (k48 r55))))
170  (let ((k58 (##core#lambda (r59)
171  (let ((a57 r59))
172  (let ((k62 (##core#lambda (r63)
173  (let ((a61 r63)) (loop5 k54 a57 a61)))))
174  (cons k62 i6 l7))))))
175  (- k58 i6 '1)))))))
176  (= k51 i6 '0)))))))
177  (let ((t8 t45)) (loop5 k42 n4 '())))))))))
178  (let ((t15 t39))
179  (let ((t65 (set! try2
180  (lambda (k67 x9 y10 z11)
181  (let ((k68 (##core#lambda (r69) (k67 r69))))
182  (let ((k71 (##core#lambda (r72)
183  (if r72
184  (let ((k74 (##core#lambda (r75) (k68 r75))))
185  (let ((k77 (##core#lambda (r78) (if r78 (k74 '1) (k74 '0)))))
186  (null? k77 y10)))
187  (let ((k80 (##core#lambda (r81) (k68 r81))))
188  (let ((k84 (##core#lambda (r85)
189  (let ((a83 r85))
190  (let ((k88 (##core#lambda (r89)
191  (let ((a87 r89)) (+ k80 a83 a87)))))
192  (let ((k92 (##core#lambda (r93)
193  (let ((a91 r93))
194  (let ((k96 (##core#lambda (r97)
195  (let ((a95 r97)) (try2 k88 a91 a95 z11)))))
196  (let ((k100 (##core#lambda (r101)
197  (let ((a99 r101)) (cons k96 a99 y10)))))
198  (car k100 x9)))))))
199  (cdr k92 x9)))))))
200  (let ((k103 (##core#lambda (r104)
201  (if r104
202  (let ((k106 (##core#lambda (r107) (k84 r107))))
203  (let ((k110 (##core#lambda (r111)
204  (let ((a109 r111))
205  (let ((k114 (##core#lambda (r115)
206  (let ((a113 r115)) (try2 k106 a109 '() a113)))))
207  (let ((k118 (##core#lambda (r119)
208  (let ((a117 r119)) (cons k114 a117 z11)))))
209  (car k118 x9)))))))
210  (let ((k122 (##core#lambda (r123)
211  (let ((a121 r123)) (append k110 a121 y10)))))
212  (cdr k122 x9))))
213  (k84 '0)))))
214  (let ((k126 (##core#lambda (r127)
215  (let ((a125 r127)) (ok?3 k103 a125 '1 z11)))))
216  (car k126 x9)))))))))
217  (null? k71 x9)))))))
218  (let ((t16 t65))
219  (let ((t129 (set! ok?3
220  (lambda (k131 row12 dist13 placed14)
221  (let ((k132 (##core#lambda (r133) (k131 r133))))
222  (let ((k135 (##core#lambda (r136)
223  (if r136
224  (k132 '#t)
225  (let ((k138 (##core#lambda (r139) (k132 r139))))
226  (let ((k141 (##core#lambda (r142)
227  (if r142
228  (let ((k144 (##core#lambda (r145) (k138 r145))))
229  (let ((k147 (##core#lambda (r148)
230  (if r148
231  (let ((k150 (##core#lambda (r151) (k144 r151))))
232  (let ((k154 (##core#lambda (r155)
233  (let ((a153 r155))
234  (let ((k158 (##core#lambda (r159)
235  (let ((a157 r159)) (ok?3 k150 row12 a153 a157)))))
236  (cdr k158 placed14))))))
237  (+ k154 dist13 '1)))
238  (k144 '#f)))))
239  (let ((k162 (##core#lambda (r163)
240  (let ((a161 r163)) (not k147 a161)))))
241  (let ((k166 (##core#lambda (r167)
242  (let ((a165 r167))
243  (let ((k170 (##core#lambda (r171)
244  (let ((a169 r171)) (= k162 a165 a169)))))
245  (- k170 row12 dist13))))))
246  (car k166 placed14)))))
247  (k138 '#f)))))
248  (let ((k174 (##core#lambda (r175)
249  (let ((a173 r175)) (not k141 a173)))))
250  (let ((k178 (##core#lambda (r179)
251  (let ((a177 r179))
252  (let ((k182 (##core#lambda (r183)
253  (let ((a181 r183)) (= k174 a177 a181)))))
254  (+ k182 row12 dist13))))))
255  (car k178 placed14)))))))))
256  (null? k135 placed14)))))))
257  (let ((t17 t129))
258  (let ((k185 (##core#lambda (r186) (k38 r186))))
259  (let ((k189 (##core#lambda (r190)
260  (let ((a188 r190)) (try2 k185 a188 '() '())))))
261  (dec-to1 k189 n0))))))))))))))))
262  (let ((t22 t36))
263  (let ((k192 (##core#lambda (r193)
264  (let ((t23 r193))
265  (let ((k195 (##core#lambda (r196)
266  (let ((t24 r196)) (k26 (##core#undefined))))))
267  (let ((k198 (##core#lambda (r199) (r199 k195))))
268  (##sys#implicit-exit-handler k198)))))))
269  (nqueens k192 '8))))))))
270  (##core#callunit "extras" k33))))))
271  (##core#callunit "eval" k30))))))
272  (##core#callunit "library" k27)))
273</enscript>
274
275{{##core#lambda}} refers to lambda forms introduced by the CPS conversion.
276{{##core#undefined}} is an internal variant of {{void}}.
277
278=== Optimization (1)
279
280Optimization is now performed, iteratively until the program is stable:
281two occurrences of {{not}} have been removed by exchanging the branches
282of the conditional operator ({{if}}).
283
284<enscript highlight=scheme>
285(lambda (k26)
286  (let ((k27 (##core#lambda (r28)
287  (let ((t19 r28))
288  (let ((k30 (##core#lambda (r31)
289  (let ((t20 r31))
290  (let ((k33 (##core#lambda (r34)
291  (let ((t21 r34))
292  (let ((t36 (set! nqueens
293  (lambda (k38 n0)
294  (let ((dec-to1 (##core#undefined)))
295  (let ((try2 (##core#undefined)))
296  (let ((ok?3 (##core#undefined)))
297  (let ((t39 (set! dec-to1
298  (lambda (k41 n4)
299  (let ((k42 (##core#lambda (r43) (k41 r43))))
300  (let ((loop5 (##core#undefined)))
301  (let ((t45 (set! loop5
302  (lambda (k47 i6 l7)
303  (let ((k48 (##core#lambda (r49) (k47 r49))))
304  (let ((k51 (##core#lambda (r52)
305  (if r52
306  (k48 l7)
307  (let ((k54 (##core#lambda (r55) (k48 r55))))
308  (let ((k58 (##core#lambda (r59)
309  (let ((a57 r59))
310  (let ((k62 (##core#lambda (r63)
311  (let ((a61 r63)) (loop5 k54 a57 a61)))))
312  (cons k62 i6 l7))))))
313  (- k58 i6 '1)))))))
314  (= k51 i6 '0)))))))
315  (let ((t8 t45)) (loop5 k42 n4 '())))))))))
316  (let ((t15 t39))
317  (let ((t65 (set! try2
318  (lambda (k67 x9 y10 z11)
319  (let ((k68 (##core#lambda (r69) (k67 r69))))
320  (let ((k71 (##core#lambda (r72)
321  (if r72
322  (let ((k74 (##core#lambda (r75) (k68 r75))))
323  (let ((k77 (##core#lambda (r78) (if r78 (k74 '1) (k74 '0)))))
324  (null? k77 y10)))
325  (let ((k80 (##core#lambda (r81) (k68 r81))))
326  (let ((k84 (##core#lambda (r85)
327  (let ((a83 r85))
328  (let ((k88 (##core#lambda (r89)
329  (let ((a87 r89)) (+ k80 a83 a87)))))
330  (let ((k92 (##core#lambda (r93)
331  (let ((a91 r93))
332  (let ((k96 (##core#lambda (r97)
333  (let ((a95 r97)) (try2 k88 a91 a95 z11)))))
334  (let ((k100 (##core#lambda (r101)
335  (let ((a99 r101)) (cons k96 a99 y10)))))
336  (car k100 x9)))))))
337  (cdr k92 x9)))))))
338  (let ((k103 (##core#lambda (r104)
339  (if r104
340  (let ((k106 (##core#lambda (r107) (k84 r107))))
341  (let ((k110 (##core#lambda (r111)
342  (let ((a109 r111))
343  (let ((k114 (##core#lambda (r115)
344  (let ((a113 r115)) (try2 k106 a109 '() a113)))))
345  (let ((k118 (##core#lambda (r119)
346  (let ((a117 r119)) (cons k114 a117 z11)))))
347  (car k118 x9)))))))
348  (let ((k122 (##core#lambda (r123)
349  (let ((a121 r123)) (append k110 a121 y10)))))
350  (cdr k122 x9))))
351  (k84 '0)))))
352  (let ((k126 (##core#lambda (r127)
353  (let ((a125 r127)) (ok?3 k103 a125 '1 z11)))))
354  (car k126 x9)))))))))
355  (null? k71 x9)))))))
356  (let ((t16 t65))
357  (let ((t129 (set! ok?3
358  (lambda (k131 row12 dist13 placed14)
359  (let ((k132 (##core#lambda (r133) (k131 r133))))
360  (let ((k135 (##core#lambda (r136)
361  (if r136
362  (k132 '#t)
363  (let ((k138 (##core#lambda (r139) (k132 r139))))
364  (let ((k141 (##core#lambda (r142)
365  (if r142
366  (k138 '#f)
367  (let ((k144 (##core#lambda (r145) (k138 r145))))
368  (let ((k147 (##core#lambda (r148)
369  (if r148
370  (k144 '#f)
371  (let ((k150 (##core#lambda (r151) (k144 r151))))
372  (let ((k154 (##core#lambda (r155)
373  (let ((a153 r155))
374  (let ((k158 (##core#lambda (r159)
375  (let ((a157 r159)) (ok?3 k150 row12 a153 a157)))))
376  (cdr k158 placed14))))))
377  (+ k154 dist13 '1)))))))
378  (let ((k162 (##core#lambda (r163)
379  (let ((a161 r163)) (k147 a161)))))
380  (let ((k166 (##core#lambda (r167)
381  (let ((a165 r167))
382  (let ((k170 (##core#lambda (r171)
383  (let ((a169 r171)) (= k162 a165 a169)))))
384  (- k170 row12 dist13))))))
385  (car k166 placed14)))))))))
386  (let ((k174 (##core#lambda (r175)
387  (let ((a173 r175)) (k141 a173)))))
388  (let ((k178 (##core#lambda (r179)
389  (let ((a177 r179))
390  (let ((k182 (##core#lambda (r183)
391  (let ((a181 r183)) (= k174 a177 a181)))))
392  (+ k182 row12 dist13))))))
393  (car k178 placed14)))))))))
394  (null? k135 placed14)))))))
395  (let ((t17 t129))
396  (let ((k185 (##core#lambda (r186) (k38 r186))))
397  (let ((k189 (##core#lambda (r190)
398  (let ((a188 r190)) (try2 k185 a188 '() '())))))
399  (dec-to1 k189 n0))))))))))))))))
400  (let ((t22 t36))
401  (let ((k192 (##core#lambda (r193)
402  (let ((t23 r193))
403  (let ((k195 (##core#lambda (r196)
404  (let ((t24 r196)) (k26 (##core#undefined))))))
405  (let ((k198 (##core#lambda (r199) (r199 k195))))
406  (##sys#implicit-exit-handler k198)))))))
407  (nqueens k192 '8))))))))
408  (##core#callunit "extras" k33))))))
409  (##core#callunit "eval" k30))))))
410  (##core#callunit "library" k27)))
411</enscript>
412
413=== Optimization (2)
414
415Next round. This time {{k141}}, {{k147}} and {{dec-to1}} have been
416''contracted'', which means inlining procedures that are called only once
417(an optimization that guarantees the program will not grow). Some
418variables and bindings have been removed as they are unnecessary:
419
420<enscript highlight=scheme>
421(lambda (k26)
422  (let ((k27 (##core#lambda (r28)
423  (let ((k30 (##core#lambda (r31)
424  (let ((k33 (##core#lambda (r34)
425  (let ((t36 (set! nqueens
426  (lambda (k38 n0)
427  (let ((try2 (##core#undefined)))
428  (let ((ok?3 (##core#undefined)))
429  (let ((t39 (##core#undefined)))
430  (let ((t65 (set! try2
431  (lambda (k67 x9 y10 z11)
432  (let ((k71 (##core#lambda (r72)
433  (if r72
434  (let ((k77 (##core#lambda (r78) (if r78 (k67 '1) (k67 '0)))))
435  (null? k77 y10))
436  (let ((k84 (##core#lambda (r85)
437  (let ((k88 (##core#lambda (r89) (+ k67 r85 r89))))
438  (let ((k92 (##core#lambda (r93)
439  (let ((k96 (##core#lambda (r97) (try2 k88 r93 r97 z11))))
440  (let ((k100 (##core#lambda (r101) (cons k96 r101 y10))))
441  (car k100 x9))))))
442  (cdr k92 x9))))))
443  (let ((k103 (##core#lambda (r104)
444  (if r104
445  (let ((k110 (##core#lambda (r111)
446  (let ((k114 (##core#lambda (r115) (try2 k84 r111 '() r115))))
447  (let ((k118 (##core#lambda (r119) (cons k114 r119 z11))))
448  (car k118 x9))))))
449  (let ((k122 (##core#lambda (r123) (append k110 r123 y10))))
450  (cdr k122 x9)))
451  (k84 '0)))))
452  (let ((k126 (##core#lambda (r127) (ok?3 k103 r127 '1 z11))))
453  (car k126 x9))))))))
454  (null? k71 x9))))))
455  (let ((t129 (set! ok?3
456  (lambda (k131 row12 dist13 placed14)
457  (let ((k135 (##core#lambda (r136)
458  (if r136
459  (k131 '#t)
460  (let ((k174 (##core#lambda (r175)
461  (let ((r142 r175))
462  (if r142
463  (k131 '#f)
464  (let ((k162 (##core#lambda (r163)
465  (let ((r148 r163))
466  (if r148
467  (k131 '#f)
468  (let ((k154 (##core#lambda (r155)
469  (let ((k158 (##core#lambda (r159)
470  (ok?3 k131 row12 r155 r159))))
471  (cdr k158 placed14)))))
472  (+ k154 dist13 '1)))))))
473  (let ((k166 (##core#lambda (r167)
474  (let ((k170 (##core#lambda (r171) (= k162 r167 r171))))
475  (- k170 row12 dist13)))))
476  (car k166 placed14))))))))
477  (let ((k178 (##core#lambda (r179)
478  (let ((k182 (##core#lambda (r183) (= k174 r179 r183))))
479  (+ k182 row12 dist13)))))
480  (car k178 placed14)))))))
481  (null? k135 placed14))))))
482  (let ((k189 (##core#lambda (r190) (try2 k38 r190 '() '()))))
483  (let ((k41 k189))
484  (let ((n4 n0))
485  (let ((loop5 (##core#undefined)))
486  (let ((t45 (set! loop5
487  (lambda (k47 i6 l7)
488  (let ((k51 (##core#lambda (r52)
489  (if r52
490  (k47 l7)
491  (let ((k58 (##core#lambda (r59)
492  (let ((k62 (##core#lambda (r63) (loop5 k47 r59 r63))))
493  (cons k62 i6 l7)))))
494  (- k58 i6 '1))))))
495  (= k51 i6 '0))))))
496  (loop5 k41 n4 '())))))))))))))))
497  (let ((k192 (##core#lambda (r193)
498  (let ((k195 (##core#lambda (r196) (k26 (##core#undefined)))))
499  (let ((k198 (##core#lambda (r199) (r199 k195))))
500  (##sys#implicit-exit-handler k198))))))
501  (nqueens k192 '8))))))
502  (##core#callunit "extras" k33)))))
503  (##core#callunit "eval" k30)))))
504  (##core#callunit "library" k27)))
505</enscript>
506
507=== Optimization (3)
508
509More elimination of local variables:
510
511<enscript highlight=scheme>
512(lambda (k26)
513  (let ((k27 (##core#lambda (r28)
514  (let ((k30 (##core#lambda (r31)
515  (let ((k33 (##core#lambda (r34)
516  (let ((t36 (set! nqueens
517  (lambda (k38 n0)
518  (let ((try2 (##core#undefined)))
519  (let ((ok?3 (##core#undefined)))
520  (let ((t65 (set! try2
521  (lambda (k67 x9 y10 z11)
522  (let ((k71 (##core#lambda (r72)
523  (if r72
524  (let ((k77 (##core#lambda (r78) (if r78 (k67 '1) (k67 '0)))))
525  (null? k77 y10))
526  (let ((k84 (##core#lambda (r85)
527  (let ((k88 (##core#lambda (r89) (+ k67 r85 r89))))
528  (let ((k92 (##core#lambda (r93)
529  (let ((k96 (##core#lambda (r97) (try2 k88 r93 r97 z11))))
530  (let ((k100 (##core#lambda (r101) (cons k96 r101 y10))))
531  (car k100 x9))))))
532  (cdr k92 x9))))))
533  (let ((k103 (##core#lambda (r104)
534  (if r104
535  (let ((k110 (##core#lambda (r111)
536  (let ((k114 (##core#lambda (r115) (try2 k84 r111 '() r115))))
537  (let ((k118 (##core#lambda (r119) (cons k114 r119 z11))))
538  (car k118 x9))))))
539  (let ((k122 (##core#lambda (r123) (append k110 r123 y10))))
540  (cdr k122 x9)))
541  (k84 '0)))))
542  (let ((k126 (##core#lambda (r127) (ok?3 k103 r127 '1 z11))))
543  (car k126 x9))))))))
544  (null? k71 x9))))))
545  (let ((t129 (set! ok?3
546  (lambda (k131 row12 dist13 placed14)
547  (let ((k135 (##core#lambda (r136)
548  (if r136
549  (k131 '#t)
550  (let ((k174 (##core#lambda (r175)
551  (if r175
552  (k131 '#f)
553  (let ((k162 (##core#lambda (r163)
554  (if r163
555  (k131 '#f)
556  (let ((k154 (##core#lambda (r155)
557  (let ((k158 (##core#lambda (r159)
558  (ok?3 k131 row12 r155 r159))))
559  (cdr k158 placed14)))))
560  (+ k154 dist13 '1))))))
561  (let ((k166 (##core#lambda (r167)
562  (let ((k170 (##core#lambda (r171) (= k162 r167 r171))))
563  (- k170 row12 dist13)))))
564  (car k166 placed14)))))))
565  (let ((k178 (##core#lambda (r179)
566  (let ((k182 (##core#lambda (r183) (= k174 r179 r183))))
567  (+ k182 row12 dist13)))))
568  (car k178 placed14)))))))
569  (null? k135 placed14))))))
570  (let ((k189 (##core#lambda (r190) (try2 k38 r190 '() '()))))
571  (let ((loop5 (##core#undefined)))
572  (let ((t45 (set! loop5
573  (lambda (k47 i6 l7)
574  (let ((k51 (##core#lambda (r52)
575  (if r52
576  (k47 l7)
577  (let ((k58 (##core#lambda (r59)
578  (let ((k62 (##core#lambda (r63) (loop5 k47 r59 r63))))
579  (cons k62 i6 l7)))))
580  (- k58 i6 '1))))))
581  (= k51 i6 '0))))))
582  (loop5 k189 n0 '()))))))))))))
583  (let ((k192 (##core#lambda (r193)
584  (let ((k195 (##core#lambda (r196) (k26 (##core#undefined)))))
585  (let ((k198 (##core#lambda (r199) (r199 k195))))
586  (##sys#implicit-exit-handler k198))))))
587  (nqueens k192 '8))))))
588  (##core#callunit "extras" k33)))))
589  (##core#callunit "eval" k30)))))
590  (##core#callunit "library" k27)))
591</enscript>
592
593=== Optimization (4)
594
595After this pass no more basic optimizations have been
596performed, so we enable simplification of builtin primitives
597by replacing them with more primitive forms:
598
599<enscript highlight=scheme>
600(lambda (k26)
601  (let ((k27 (##core#lambda (r28)
602  (let ((k30 (##core#lambda (r31)
603  (let ((k33 (##core#lambda (r34)
604  (let ((t36 (set! nqueens
605  (lambda (k38 n0)
606  (let ((try2 (##core#undefined)))
607  (let ((ok?3 (##core#undefined)))
608  (let ((t65 (set! try2
609  (lambda (k67 x9 y10 z11)
610  (let ((k71 (##core#lambda (r72)
611  (if r72
612  (let ((k77 (##core#lambda (r78)
613  (k67 (##core#cond r78 '1 '0)))))
614  (k77 (##core#inline "C_i_nullp" y10)))
615  (let ((k84 (##core#lambda (r85)
616  (let ((k88 (##core#lambda (r89)
617  (k67 (##core#inline_allocate "C_a_i_plus" 4 r85 r89)))))
618  (let ((k92 (##core#lambda (r93)
619  (let ((k96 (##core#lambda (r97) (try2 k88 r93 r97 z11))))
620  (let ((k100 (##core#lambda (r101)
621  (k96 (##core#inline_allocate "C_a_i_cons" 3 r101 y10)))))
622  (k100 (##core#inline "C_i_car" x9)))))))
623  (k92 (##core#inline "C_i_cdr" x9)))))))
624  (let ((k103 (##core#lambda (r104)
625  (if r104
626  (let ((k110 (##core#lambda (r111)
627  (let ((k114 (##core#lambda (r115) (try2 k84 r111 '() r115))))
628  (let ((k118 (##core#lambda (r119)
629  (k114 (##core#inline_allocate "C_a_i_cons" 3 r119 z11)))))
630  (k118 (##core#inline "C_i_car" x9)))))))
631  (let ((k122 (##core#lambda (r123) (append k110 r123 y10))))
632  (k122 (##core#inline "C_i_cdr" x9))))
633  (k84 '0)))))
634  (let ((k126 (##core#lambda (r127) (ok?3 k103 r127 '1 z11))))
635  (k126 (##core#inline "C_i_car" x9)))))))))
636  (k71 (##core#inline "C_i_nullp" x9)))))))
637  (let ((t129 (set! ok?3
638  (lambda (k131 row12 dist13 placed14)
639  (let ((k135 (##core#lambda (r136)
640  (if r136
641  (k131 '#t)
642  (let ((k174 (##core#lambda (r175)
643  (if r175
644  (k131 '#f)
645  (let ((k162 (##core#lambda (r163)
646  (if r163
647  (k131 '#f)
648  (let ((k154 (##core#lambda (r155)
649  (let ((k158 (##core#lambda (r159)
650  (ok?3 k131 row12 r155 r159))))
651  (k158 (##core#inline "C_i_cdr" placed14))))))
652  (k154 (##core#inline_allocate "C_a_i_plus" 4 dist13 '1)))))))
653  (let ((k166 (##core#lambda (r167)
654  (let ((k170 (##core#lambda (r171)
655  (k162 (##core#inline "C_i_nequalp" r167 r171)))))
656  (k170 (##core#inline_allocate "C_a_i_minus" 4 row12 dist13))))))
657  (k166 (##core#inline "C_i_car" placed14))))))))
658  (let ((k178 (##core#lambda (r179)
659  (let ((k182 (##core#lambda (r183)
660  (k174 (##core#inline "C_i_nequalp" r179 r183)))))
661  (k182 (##core#inline_allocate "C_a_i_plus" 4 row12 dist13))))))
662  (k178 (##core#inline "C_i_car" placed14))))))))
663  (k135 (##core#inline "C_i_nullp" placed14)))))))
664  (let ((k189 (##core#lambda (r190) (try2 k38 r190 '() '()))))
665  (let ((loop5 (##core#undefined)))
666  (let ((t45 (set! loop5
667  (lambda (k47 i6 l7)
668  (let ((k51 (##core#lambda (r52)
669  (if r52
670  (k47 l7)
671  (let ((k58 (##core#lambda (r59)
672  (let ((k62 (##core#lambda (r63) (loop5 k47 r59 r63))))
673  (k62 (##core#inline_allocate "C_a_i_cons" 3 i6 l7))))))
674  (k58 (##core#inline_allocate "C_a_i_minus" 4 i6 '1)))))))
675  (k51 (##core#inline "C_i_nequalp" i6 '0)))))))
676  (loop5 k189 n0 '()))))))))))))
677  (let ((k192 (##core#lambda (r193)
678  (let ((k195 (##core#lambda (r196) (k26 (##core#undefined)))))
679  (let ((k198 (##core#lambda (r199) (r199 k195))))
680  (##sys#implicit-exit-handler k198))))))
681  (nqueens k192 '8))))))
682  (##core#callunit "extras" k33)))))
683  (##core#callunit "eval" k30)))))
684  (##core#callunit "library" k27)))
685</enscript>
686
687=== Optimization (5)
688
689More contractions, which have now been enabled by the
690previous optimizations, additionally some bindings
691could be removed:
692
693<enscript highlight=scheme>
694(lambda (k26)
695  (let ((k27 (##core#lambda (r28)
696  (let ((k30 (##core#lambda (r31)
697  (let ((k33 (##core#lambda (r34)
698  (let ((t36 (set! nqueens
699  (lambda (k38 n0)
700  (let ((try2 (##core#undefined)))
701  (let ((ok?3 (##core#undefined)))
702  (let ((t65 (set! try2
703  (lambda (k67 x9 y10 z11)
704  (if (##core#inline "C_i_nullp" x9)
705  (let ((r78 (##core#inline "C_i_nullp" y10)))
706  (k67 (##core#cond r78 '1 '0)))
707  (let ((k84 (##core#lambda (r85)
708  (let ((k88 (##core#lambda (r89)
709  (k67 (##core#inline_allocate "C_a_i_plus" 4 r85 r89)))))
710  (let ((r93 (##core#inline "C_i_cdr" x9)))
711  (let ((r101 (##core#inline "C_i_car" x9)))
712  (let ((r97 (##core#inline_allocate "C_a_i_cons" 3 r101 y10)))
713  (try2 k88 r93 r97 z11))))))))
714  (let ((k103 (##core#lambda (r104)
715  (if r104
716  (let ((k110 (##core#lambda (r111)
717  (let ((r119 (##core#inline "C_i_car" x9)))
718  (let ((r115 (##core#inline_allocate "C_a_i_cons" 3 r119 z11)))
719  (try2 k84 r111 '() r115))))))
720  (let ((r123 (##core#inline "C_i_cdr" x9)))
721  (append k110 r123 y10)))
722  (k84 '0)))))
723  (let ((r127 (##core#inline "C_i_car" x9)))
724  (ok?3 k103 r127 '1 z11)))))))))
725  (let ((t129 (set! ok?3
726  (lambda (k131 row12 dist13 placed14)
727  (if (##core#inline "C_i_nullp" placed14)
728  (k131 '#t)
729  (let ((r179 (##core#inline "C_i_car" placed14)))
730  (let ((r183 (##core#inline_allocate "C_a_i_plus" 4 row12 dist13)))
731  (if (##core#inline "C_i_nequalp" r179 r183)
732  (k131 '#f)
733  (let ((r167 (##core#inline "C_i_car" placed14)))
734  (let ((r171 (##core#inline_allocate "C_a_i_minus" 4 row12 dist13)))
735  (if (##core#inline "C_i_nequalp" r167 r171)
736  (k131 '#f)
737  (let ((r155 (##core#inline_allocate "C_a_i_plus" 4 dist13 '1)))
738  (let ((r159 (##core#inline "C_i_cdr" placed14)))
739  (ok?3 k131 row12 r155 r159))))))))))))))
740  (let ((k189 (##core#lambda (r190) (try2 k38 r190 '() '()))))
741  (let ((loop5 (##core#undefined)))
742  (let ((t45 (set! loop5
743  (lambda (k47 i6 l7)
744  (if (##core#inline "C_i_nequalp" i6 '0)
745  (k47 l7)
746  (let ((r59 (##core#inline_allocate "C_a_i_minus" 4 i6 '1)))
747  (let ((r63 (##core#inline_allocate "C_a_i_cons" 3 i6 l7)))
748  (loop5 k47 r59 r63))))))))
749  (loop5 k189 n0 '()))))))))))))
750  (let ((k192 (##core#lambda (r193)
751  (let ((k195 (##core#lambda (r196) (k26 (##core#undefined)))))
752  (let ((k198 (##core#lambda (r199) (r199 k195))))
753  (##sys#implicit-exit-handler k198))))))
754  (nqueens k192 '8))))))
755  (##core#callunit "extras" k33)))))
756  (##core#callunit "eval" k30)))))
757  (##core#callunit "library" k27)))
758</enscript>
759
760=== Closure conversion
761
762Now procedures are transformed into explicit creation and
763access code for closures:
764
765<enscript highlight=scheme>
766(##core#closure (2)
767  (lambda (c239 k26)
768  (let ((k27 (##core#closure (2)
769  (##core#lambda (c241 r28)
770  (let ((k30 (##core#closure (2)
771  (##core#lambda (c243 r31)
772  (let ((k33 (##core#closure (2)
773  (##core#lambda (c245 r34)
774  (let ((t36 (set! nqueens
775  (##core#closure (2)
776  (lambda (c247 k38 n0)
777  (let ((try2248 (##core#undefined)))
778  (let ((try2 (##core#box try2248)))
779  (let ((ok?3249 (##core#undefined)))
780  (let ((ok?3 (##core#box ok?3249)))
781  (let ((t65 (##core#updatebox
782  try2
783  (##core#closure (4)
784  (lambda (c251 k67 x9 y10 z11)
785  (if (##core#inline "C_i_nullp" x9)
786  (let ((r78 (##core#inline "C_i_nullp" y10)))
787  (k67 (##core#cond r78 '1 '0)))
788  (let ((k84 (##core#closure (6)
789  (##core#lambda (c254 r85)
790  (let ((k88 (##core#closure (3)
791  (##core#lambda (c256 r89)
792  ((##core#ref c256 (2))
793  (##core#inline_allocate "C_a_i_plus" 4 (##core#ref c256 (1)) r89)))
794  r85
795  (##core#ref c254 (5)))))
796  (let ((r93 (##core#inline "C_i_cdr" (##core#ref c254 (4)))))
797  (let ((r101 (##core#inline "C_i_car" (##core#ref c254 (4)))))
798  (let ((r97 (##core#inline_allocate "C_a_i_cons" 3 r101 (##core#ref c254 (3)))))
799  ((##core#unbox (##core#ref c254 (2)) ())
800  k88
801  r93
802  r97
803  (##core#ref c254 (1))))))))
804  z11
805  (##core#ref c251 (2))
806  y10
807  x9
808  k67)))
809  (let ((k103 (##core#closure (6)
810  (##core#lambda (c261 r104)
811  (if r104
812  (let ((k110 (##core#closure (5)
813  (##core#lambda (c263 r111)
814  (let ((r119 (##core#inline "C_i_car" (##core#ref c263 (4)))))
815  (let ((r115 (##core#inline_allocate "C_a_i_cons" 3 r119 (##core#ref c263 (3)))))
816  ((##core#unbox (##core#ref c263 (2)) ())
817  (##core#ref c263 (1))
818  r111
819  '()
820  r115))))
821  (##core#ref c261 (2))
822  (##core#ref c261 (3))
823  (##core#ref c261 (4))
824  (##core#ref c261 (5)))))
825  (let ((r123 (##core#inline "C_i_cdr" (##core#ref c261 (5)))))
826  (append k110 r123 (##core#ref c261 (1)))))
827  ((##core#ref c261 (2)) '0)))
828  y10
829  k84
830  (##core#ref c251 (2))
831  z11
832  x9)))
833  (let ((r127 (##core#inline "C_i_car" x9)))
834  ((##core#unbox (##core#ref c251 (1)) ())
835  k103
836  r127
837  '1
838  z11))))))
839  ok?3
840  try2
841  '#<lambda info (try x9 y10 z11)#>))))
842  (let ((t129 (##core#updatebox
843  ok?3
844  (##core#closure
845  (3)
846  (lambda (c269 k131 row12 dist13 placed14)
847  (if (##core#inline "C_i_nullp" placed14)
848  (k131 '#t)
849  (let ((r179 (##core#inline "C_i_car" placed14)))
850  (let ((r183 (##core#inline_allocate "C_a_i_plus" 4 row12 dist13)))
851  (if (##core#inline "C_i_nequalp" r179 r183)
852  (k131 '#f)
853  (let ((r167 (##core#inline "C_i_car" placed14)))
854  (let ((r171 (##core#inline_allocate "C_a_i_minus" 4 row12 dist13)))
855  (if (##core#inline "C_i_nequalp" r167 r171)
856  (k131 '#f)
857  (let ((r155 (##core#inline_allocate "C_a_i_plus" 4 dist13 '1)))
858  (let ((r159 (##core#inline "C_i_cdr" placed14)))
859  ((##core#unbox (##core#ref c269 (1)) ())
860  k131
861  row12
862  r155
863  r159)))))))))))
864  ok?3
865  '#<lambda info (ok? row12 dist13 placed14)#>))))
866  (let ((k189 (##core#closure (3)
867  (##core#lambda (c277 r190)
868  ((##core#unbox (##core#ref c277 (2)) ())
869  (##core#ref c277 (1))
870  r190
871  '()
872  '()))
873  k38
874  try2)))
875  (let ((loop5278 (##core#undefined)))
876  (let ((loop5 (##core#box loop5278)))
877  (let ((t45 (##core#updatebox
878  loop5
879  (##core#closure (3)
880  (lambda (c280 k47 i6 l7)
881  (if (##core#inline "C_i_nequalp" i6 '0)
882  (k47 l7)
883  (let ((r59 (##core#inline_allocate "C_a_i_minus" 4 i6 '1)))
884  (let ((r63 (##core#inline_allocate "C_a_i_cons" 3 i6 l7)))
885  ((##core#unbox (##core#ref c280 (1)) ())
886  k47
887  r59
888  r63)))))
889  loop5
890  '#<lambda info (loop i6 l7)#>))))
891  ((##core#unbox loop5 ()) k189 n0 '()))))))))))))
892  '#<lambda info (nqueens n0)#>))))
893  (let ((k192 (##core#closure (2)
894  (##core#lambda (c284 r193)
895  (let ((k195 (##core#closure (2)
896  (##core#lambda (c286 r196)
897  ((##core#ref c286 (1)) (##core#undefined)))
898  (##core#ref c284 (1)))))
899  (let ((k198 (##core#closure (2)
900  (##core#lambda (c288 r199)
901  (r199 (##core#ref c288 (1))))
902  k195)))
903  (##sys#implicit-exit-handler k198))))
904  (##core#ref c245 (1)))))
905  (nqueens k192 '8))))
906  (##core#ref c243 (1)))))
907  (##core#callunit "extras" k33)))
908  (##core#ref c241 (1)))))
909  (##core#callunit "eval" k30)))
910  k26)))
911  (##core#callunit "library" k27)))
912'#<lambda info (toplevel)#>)
913</enscript>
914
915=== Code generation
916
917Here the output of the compiler in it's full glory. First the
918header:
919
920<enscript highlight=c>
921/* Generated from nqueens.scm by the CHICKEN compiler
922   http://www.call-with-current-continuation.org
923   2007-05-27 22:05
924   Version 2.615 - macosx-unix-gnu-ppc - [ libffi dload ptables applyhook ]
925   command line: nqueens.scm -output-file nqueens.c -quiet -optimize-level 2
926   used units: library eval extras
927*/
928
929#include "chicken.h"
930</enscript>
931
932Now function prototypes for library ''units'' that we use follow
933(these are the default ''library units'' used):
934
935<enscript highlight=c>
936static C_PTABLE_ENTRY *create_ptable(void);
937C_noret_decl(C_library_toplevel)
938C_externimport void C_ccall C_library_toplevel(C_word c,C_word d,C_word k) C_noret;
939C_noret_decl(C_eval_toplevel)
940C_externimport void C_ccall C_eval_toplevel(C_word c,C_word d,C_word k) C_noret;
941C_noret_decl(C_extras_toplevel)
942C_externimport void C_ccall C_extras_toplevel(C_word c,C_word d,C_word k) C_noret;
943</enscript>
944
945The static global {{lf}} holds literal (constant) data that should not be
946garbage collected and is used in the compiled program. It also holds non-exported
947(''hidden'') toplevel variables:
948
949<enscript highlight=c>
950static C_TLS C_word lf[8];
951</enscript>
952
953More prototypes, this time for the functions generated:
954
955<enscript highlight=c>
956C_noret_decl(C_toplevel)
957C_externexport void C_ccall C_toplevel(C_word c,C_word t0,C_word t1) C_noret;
958C_noret_decl(f_29)
959static void C_ccall f_29(C_word c,C_word t0,C_word t1) C_noret;
960C_noret_decl(f_32)
961static void C_ccall f_32(C_word c,C_word t0,C_word t1) C_noret;
962C_noret_decl(f_35)
963static void C_ccall f_35(C_word c,C_word t0,C_word t1) C_noret;
964C_noret_decl(f_194)
965static void C_ccall f_194(C_word c,C_word t0,C_word t1) C_noret;
966C_noret_decl(f_200)
967static void C_ccall f_200(C_word c,C_word t0,C_word t1) C_noret;
968C_noret_decl(f_197)
969static void C_ccall f_197(C_word c,C_word t0,C_word t1) C_noret;
970C_noret_decl(f_37)
971static void C_ccall f_37(C_word c,C_word t0,C_word t1,C_word t2) C_noret;
972C_noret_decl(f_46)
973static void C_fcall f_46(C_word t0,C_word t1,C_word t2,C_word t3) C_noret;
974C_noret_decl(f_191)
975static void C_ccall f_191(C_word c,C_word t0,C_word t1) C_noret;
976C_noret_decl(f_130)
977static void C_fcall f_130(C_word t0,C_word t1,C_word t2,C_word t3,C_word t4) C_noret;
978C_noret_decl(f_66)
979static void C_fcall f_66(C_word t0,C_word t1,C_word t2,C_word t3,C_word t4) C_noret;
980C_noret_decl(f_105)
981static void C_ccall f_105(C_word c,C_word t0,C_word t1) C_noret;
982C_noret_decl(f_112)
983static void C_ccall f_112(C_word c,C_word t0,C_word t1) C_noret;
984C_noret_decl(f_86)
985static void C_ccall f_86(C_word c,C_word t0,C_word t1) C_noret;
986C_noret_decl(f_90)
987static void C_ccall f_90(C_word c,C_word t0,C_word t1) C_noret;
988</enscript>
989
990Here the ''trampolines'' are declared and defined. For every
991generated C function from the CPS representation, we need a
992trampoline function that has a fixed calling convention and
993can be passed to the garbage collector when the stack is exhausted
994(the allocation limit we mentioned above). The trampoline for
995a given function will call the original function with the
996restored arguments, continuation and closure record. The trampolines
997starting with {{trf_}} are ''custom'': the associated functions
998have been detected during optimization to be ''customizable'' and
999follow a slightly different calling convention and thus need
1000a specific trampoline. The trampolines starting with {{tr_}}
1001are general ones and can be re-used for all functions with the
1002matching number of arguments.
1003
1004<enscript highlight=c>
1005C_noret_decl(trf_46)
1006static void C_fcall trf_46(void *dummy) C_regparm C_noret;
1007C_regparm static void C_fcall trf_46(void *dummy){
1008/* pick arguments and continuation from "temporary stack": */
1009C_word t3=C_pick(0);
1010C_word t2=C_pick(1);
1011C_word t1=C_pick(2);
1012C_word t0=C_pick(3);
1013/* pop values from temporary stack: */
1014C_adjust_stack(-4);
1015f_46(t0,t1,t2,t3);}
1016
1017C_noret_decl(trf_130)
1018static void C_fcall trf_130(void *dummy) C_regparm C_noret;
1019C_regparm static void C_fcall trf_130(void *dummy){
1020C_word t4=C_pick(0);
1021C_word t3=C_pick(1);
1022C_word t2=C_pick(2);
1023C_word t1=C_pick(3);
1024C_word t0=C_pick(4);
1025C_adjust_stack(-5);
1026f_130(t0,t1,t2,t3,t4);}
1027
1028C_noret_decl(trf_66)
1029static void C_fcall trf_66(void *dummy) C_regparm C_noret;
1030C_regparm static void C_fcall trf_66(void *dummy){
1031C_word t4=C_pick(0);
1032C_word t3=C_pick(1);
1033C_word t2=C_pick(2);
1034C_word t1=C_pick(3);
1035C_word t0=C_pick(4);
1036C_adjust_stack(-5);
1037f_66(t0,t1,t2,t3,t4);}
1038
1039C_noret_decl(tr3)
1040static void C_fcall tr3(C_proc3 k) C_regparm C_noret;
1041C_regparm static void C_fcall tr3(C_proc3 k){
1042C_word t2=C_pick(0);
1043C_word t1=C_pick(1);
1044C_word t0=C_pick(2);
1045C_adjust_stack(-3);
1046(k)(3,t0,t1,t2);}
1047
1048C_noret_decl(tr2)
1049static void C_fcall tr2(C_proc2 k) C_regparm C_noret;
1050C_regparm static void C_fcall tr2(C_proc2 k){
1051C_word t1=C_pick(0);
1052C_word t0=C_pick(1);
1053C_adjust_stack(-2);
1054(k)(2,t0,t1);}
1055</enscript>
1056
1057Here comes the ''toplevel'', the procedure holding the compiled
1058toplevel expressions that are not contained in user procedures.
1059
1060But first the trampoline for the toplevel:
1061
1062<enscript highlight=c>
1063/* toplevel */
1064static C_TLS int toplevel_initialized=0;
1065C_main_entry_point
1066C_noret_decl(toplevel_trampoline)
1067static void C_fcall toplevel_trampoline(void *dummy) C_regparm C_noret;
1068C_regparm static void C_fcall toplevel_trampoline(void *dummy){
1069/* just invoke toplevel with continuation: */
1070C_toplevel(2,C_SCHEME_UNDEFINED,C_restore);}
1071</enscript>
1072
1073And now the body:
1074
1075<enscript highlight=c>
1076void C_ccall C_toplevel(C_word c,C_word t0,C_word t1){
1077C_word tmp;
1078C_word t2;
1079C_word t3;
1080C_word *a;
1081/* was this compilation unit already executed? then return to caller: */
1082if(toplevel_initialized) C_kontinue(t1,C_SCHEME_UNDEFINED);
1083/* else note entry (this will output the start of executing the compilation
1084   unit toplevel when debug mode is enabled with the "-:d" runtime option): */
1085else C_toplevel_entry(C_text("toplevel"));
1086/* resize nursery (first heap generation) to value given to compiler (here
1087   it is the default): */
1088C_resize_stack(131072);
1089/* check whether the nursery has generally least enough space for all literals
1090   we create in this unit: */
1091C_check_nursery_minimum(3);
1092/* Is the current level (as opposed to the total capacity) of the nursery ok: */
1093if(!C_demand(3)){
1094  /* no - save temporaries and invoke a minor (nursery) garbage collection,
1095     passing the proper trampoline to re-enter the function: */
1096C_save(t1);
1097C_reclaim((void*)toplevel_trampoline,NULL);}
1098/* otherwise mark as initialized: */
1099toplevel_initialized=1;
1100/* check whether the second-generation heap is big enough for all literals
1101   defined here: */
1102if(!C_demand_2(30)){
1103  /* no - invoke major GC with minimum space required: */
1104C_save(t1);
1105C_rereclaim2(30*sizeof(C_word), 1);
1106/* restore temporaries (pop from temporary stack): */
1107t1=C_restore;}
1108/* allocate storage for the data we create in the nursery (on the
1109stack). This is only the closure, the rest is already created in the
1110second generation (in the heap), since it will live forever anyway: */
1111a=C_alloc(3);
1112/* initialize a literal frame record: */
1113C_initialize_lf(lf,8);
1114/* intern symbols that we are going to us as toplevel variables: */
1115lf[0]=C_h_intern(&lf[0],7,"nqueens");
1116lf[1]=C_h_intern(&lf[1],6,"append");
1117/* these "lambda-info" strings are used to show more meaningful output
1118   when printing a procedure: */
1119lf[2]=C_static_lambda_info(C_heaptop,16,"(try x9 y10 z11)");
1120lf[3]=C_static_lambda_info(C_heaptop,27,"(ok\077 row12 dist13 placed14)");
1121lf[4]=C_static_lambda_info(C_heaptop,12,"(loop i6 l7)");
1122lf[5]=C_static_lambda_info(C_heaptop,12,"(nqueens n0)");
1123lf[6]=C_h_intern(&lf[6],25,"\003sysimplicit-exit-handler");
1124lf[7]=C_static_lambda_info(C_heaptop,10,"(toplevel)");
1125/* register literal frame globally to be traversed on every major GC-.
1126This also creates the "procedure table" for serialization (if enabled): */
1127C_register_lf2(lf,8,create_ptable());
1128/* allocate our first closure record - there are going to be more of those...
1129   (note the store of temporary "t1", which is the continuation of the call
1130   to this toplevel procedure). "f_29" is "k27" below: */
1131t2=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_29,a[2]=t1,tmp=(C_word)a,a+=3,tmp);
1132/* Invoke the "library" unit (done by default by compiled code, unless
1133   the "-explicit-use" option is given): */
1134C_library_toplevel(2,C_SCHEME_UNDEFINED,t2);}
1135</enscript>
1136
1137Next the code for user procedures and continuation closures
1138introduced by the CPS conversion:
1139
1140<enscript highlight=c>
1141/* k27 */
1142static void C_ccall f_29(C_word c,C_word t0,C_word t1){
1143C_word tmp;
1144C_word t2;
1145C_word t3;
1146C_word ab[3],*a=ab;
1147/* a continuation closure - it checks for interrupts (signals or
1148   timer-interrupts) first. If an interrupt occurred, the stack-limit
1149   is temporarily set to the maximum to trigger a GC (which will discover
1150   that we actually have an interrupt situation and handle accordingly): */
1151C_check_for_interrupt;
1152/* check stack level (we don't allocate, but check): */
1153if(!C_stack_probe(&a)){
1154  /* nursery exhausted - GC: */
1155C_save_and_reclaim((void*)tr2,(void*)f_29,2,t0,t1);}
1156/* allocate continuation and invoke "eval" unit, another default library: */
1157t2=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_32,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1158C_eval_toplevel(2,C_SCHEME_UNDEFINED,t2);}
1159
1160/* k30 in k27 */
1161static void C_ccall f_32(C_word c,C_word t0,C_word t1){
1162C_word tmp;
1163C_word t2;
1164C_word t3;
1165C_word ab[3],*a=ab;
1166/* nothing new, call "extras" unit: */
1167C_check_for_interrupt;
1168if(!C_stack_probe(&a)){
1169C_save_and_reclaim((void*)tr2,(void*)f_32,2,t0,t1);}
1170t2=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_35,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1171C_extras_toplevel(2,C_SCHEME_UNDEFINED,t2);}
1172
1173/* k33 in k30 in k27 */
1174static void C_ccall f_35(C_word c,C_word t0,C_word t1){
1175C_word tmp;
1176C_word t2;
1177C_word t3;
1178C_word t4;
1179C_word ab[6],*a=ab;
1180C_check_for_interrupt;
1181if(!C_stack_probe(&a)){
1182C_save_and_reclaim((void*)tr2,(void*)f_35,2,t0,t1);}
1183/* an assignment! we set the "nqueens" variable to a procedure value, which we
1184   allocate right away. We actually mutate slot #0 (offset 1) of the symbol
1185   "nqueens": */
1186t2=C_mutate((C_word*)lf[0]+1,(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_37,a[2]=lf[5],
1187                              tmp=(C_word)a,a+=3,tmp));
1188/* allocate yet another continuation closure: */
1189t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_194,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1190/* write string into trace-buffer to give us a call-chain on errors: */
1191C_trace("nqueens.scm: 28   nqueens");
1192/* retrieve the value and call "nqueens" with the argument "8": */
1193t4=*((C_word*)lf[0]+1);
1194((C_proc3)C_retrieve_proc(t4))(3,t4,t3,C_fix(8));}
1195
1196/* k192 in k33 in k30 in k27 */
1197static void C_ccall f_194(C_word c,C_word t0,C_word t1){
1198C_word tmp;
1199C_word t2;
1200C_word t3;
1201C_word t4;
1202C_word ab[6],*a=ab;
1203/* this the continuation of the "(nqueens 8)" call - it invokes
1204   the "##sys#implicit-exit-handler", which is responsible for
1205   cleaning up, when a program just "falls off the end": */
1206C_check_for_interrupt;
1207if(!C_stack_probe(&a)){
1208C_save_and_reclaim((void*)tr2,(void*)f_194,2,t0,t1);}
1209/* 2 continuations? Indeed as we call the result of calling the
1210   handler: */
1211t2=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_197,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1212t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_200,a[2]=t2,tmp=(C_word)a,a+=3,tmp);
1213C_trace("##sys#implicit-exit-handler");
1214t4=C_retrieve(lf[6]);
1215((C_proc2)C_retrieve_proc(t4))(2,t4,t3);}
1216
1217/* k198 in k192 in k33 in k30 in k27 */
1218static void C_ccall f_200(C_word c,C_word t0,C_word t1){
1219C_word tmp;
1220C_word t2;
1221C_word *a;
1222/* a "trivial" continuation - we omit checking stack or interrupts here: */
1223t2=t1;
1224((C_proc2)C_retrieve_proc(t2))(2,t2,((C_word*)t0)[2]);}
1225
1226/* k195 in k192 in k33 in k30 in k27 */
1227static void C_ccall f_197(C_word c,C_word t0,C_word t1){
1228C_word tmp;
1229C_word t2;
1230C_word *a;
1231t2=((C_word*)t0)[2];
1232((C_proc2)(void*)(*((C_word*)t2+1)))(2,t2,C_SCHEME_UNDEFINED);}
1233
1234/* nqueens in k33 in k30 in k27 */
1235static void C_ccall f_37(C_word c,C_word t0,C_word t1,C_word t2){
1236C_word tmp;
1237C_word t3;
1238C_word t4;
1239C_word t5;
1240C_word t6;
1241C_word t7;
1242C_word t8;
1243C_word t9;
1244C_word t10;
1245C_word t11;
1246C_word t12;
1247C_word t13;
1248C_word ab[23],*a=ab;
1249/* here we go. First, check argument count: */
1250if(c!=3) C_bad_argc_2(c,3,t0);
1251C_check_for_interrupt;
1252if(!C_stack_probe(&a)){
1253C_save_and_reclaim((void*)tr3,(void*)f_37,3,t0,t1,t2);}
1254/* here we create and fill "boxes": mutable cells that hold "letrec" bound
1255   lexical variables: */
1256t3=C_SCHEME_UNDEFINED;
1257t4=(*a=C_VECTOR_TYPE|1,a[1]=t3,tmp=(C_word)a,a+=2,tmp);
1258t5=C_SCHEME_UNDEFINED;
1259t6=(*a=C_VECTOR_TYPE|1,a[1]=t5,tmp=(C_word)a,a+=2,tmp);
1260t7=C_set_block_item(t4,0,(*a=C_CLOSURE_TYPE|4,a[1]=(C_word)f_66,a[2]=t6,a[3]=t4,
1261                          a[4]=lf[2],tmp=(C_word)a,a+=5,tmp));
1262t8=C_set_block_item(t6,0,(*a=C_CLOSURE_TYPE|3,a[1]=(C_word)f_130,a[2]=t6,a[3]=lf[3],
1263                          tmp=(C_word)a,a+=4,tmp));
1264t9=(*a=C_CLOSURE_TYPE|3,a[1]=(C_word)f_191,a[2]=t1,a[3]=t4,tmp=(C_word)a,a+=4,tmp);
1265t10=C_SCHEME_UNDEFINED;
1266t11=(*a=C_VECTOR_TYPE|1,a[1]=t10,tmp=(C_word)a,a+=2,tmp);
1267t12=C_set_block_item(t11,0,(*a=C_CLOSURE_TYPE|3,a[1]=(C_word)f_46,a[2]=t11,a[3]=lf[4],
1268                            tmp=(C_word)a,a+=4,tmp));
1269t13=((C_word*)t11)[1];
1270/* invoke the loop - since this procedure is "known", we can call
1271   it directly: */
1272f_46(t13,t9,t2,C_SCHEME_END_OF_LIST);}
1273
1274/* loop in nqueens in k33 in k30 in k27 */
1275static void C_fcall f_46(C_word t0,C_word t1,C_word t2,C_word t3){
1276C_word tmp;
1277C_word t4;
1278C_word t5;
1279C_word t6;
1280C_word t7;
1281C_word t8;
1282C_word t9;
1283C_word *a;
1284/* the loop could be optimized, since enough information was available
1285   to the compiler: */
1286loop:
1287a=C_alloc(7);
1288C_check_for_interrupt;
1289if(!C_stack_probe(a)){
1290C_save_and_reclaim((void*)trf_46,NULL,4,t0,t1,t2,t3);}
1291/* a conditional expression, translated to C: */
1292if(C_truep((C_word)C_i_nequalp(t2,C_fix(0)))){
1293t4=t1;
1294((C_proc2)(void*)(*((C_word*)t4+1)))(2,t4,t3);}
1295else{
1296  /* primitive operations: */
1297t4=(C_word)C_a_i_minus(&a,2,t2,C_fix(1));
1298t5=(C_word)C_a_i_cons(&a,2,t2,t3);
1299C_trace("nqueens.scm: 7    loop");
1300/* a self-recursive tail call, just shuffle arguments around
1301   and jump: */
1302t7=t1;
1303t8=t4;
1304t9=t5;
1305t1=t7;
1306t2=t8;
1307t3=t9;
1308goto loop;}}
1309
1310/* k189 in nqueens in k33 in k30 in k27 */
1311static void C_ccall f_191(C_word c,C_word t0,C_word t1){
1312C_word tmp;
1313C_word t2;
1314C_word *a;
1315C_trace("nqueens.scm: 26   try");
1316/* we refer to a lexical variable nested in the closure record
1317   "t0", and boxed (so an indirect reference): */
1318t2=((C_word*)((C_word*)t0)[3])[1];
1319f_66(t2,((C_word*)t0)[2],t1,C_SCHEME_END_OF_LIST,C_SCHEME_END_OF_LIST);}
1320
1321/* ok? in nqueens in k33 in k30 in k27 */
1322static void C_fcall f_130(C_word t0,C_word t1,C_word t2,C_word t3,C_word t4){
1323C_word tmp;
1324C_word t5;
1325C_word t6;
1326C_word t7;
1327C_word t8;
1328C_word t9;
1329C_word t10;
1330C_word t11;
1331C_word t12;
1332C_word t13;
1333C_word t14;
1334C_word t15;
1335C_word *a;
1336/* this should be familiar by now: */
1337loop:
1338a=C_alloc(12);
1339C_check_for_interrupt;
1340if(!C_stack_probe(a)){
1341C_save_and_reclaim((void*)trf_130,NULL,5,t0,t1,t2,t3,t4);}
1342if(C_truep((C_word)C_i_nullp(t4))){
1343t5=t1;
1344/* an ugly way to call the function pointer in the continuation
1345   closure record: */
1346((C_proc2)(void*)(*((C_word*)t5+1)))(2,t5,C_SCHEME_TRUE);}
1347else{
1348  /* primitives and more conditionals - see the source code above
1349     to correlate the translation to the s-expressions: */
1350t5=(C_word)C_i_car(t4);
1351t6=(C_word)C_a_i_plus(&a,2,t2,t3);
1352if(C_truep((C_word)C_i_nequalp(t5,t6))){
1353t7=t1;
1354((C_proc2)(void*)(*((C_word*)t7+1)))(2,t7,C_SCHEME_FALSE);}
1355else{
1356t7=(C_word)C_i_car(t4);
1357t8=(C_word)C_a_i_minus(&a,2,t2,t3);
1358if(C_truep((C_word)C_i_nequalp(t7,t8))){
1359t9=t1;
1360((C_proc2)(void*)(*((C_word*)t9+1)))(2,t9,C_SCHEME_FALSE);}
1361else{
1362t9=(C_word)C_a_i_plus(&a,2,t3,C_fix(1));
1363t10=(C_word)C_i_cdr(t4);
1364C_trace("nqueens.scm: 24   ok?");
1365t12=t1;
1366t13=t2;
1367t14=t9;
1368t15=t10;
1369t1=t12;
1370t2=t13;
1371t3=t14;
1372t4=t15;
1373goto loop;}}}}
1374</enscript>
1375
1376It goes on like this, we just show it for completeness:
1377
1378<enscript highlight=c>
1379/* try in nqueens in k33 in k30 in k27 */
1380static void C_fcall f_66(C_word t0,C_word t1,C_word t2,C_word t3,C_word t4){
1381C_word tmp;
1382C_word t5;
1383C_word t6;
1384C_word t7;
1385C_word t8;
1386C_word t9;
1387C_word ab[14],*a=ab;
1388C_check_for_interrupt;
1389if(!C_stack_probe(&a)){
1390C_save_and_reclaim((void*)trf_66,NULL,5,t0,t1,t2,t3,t4);}
1391if(C_truep((C_word)C_i_nullp(t2))){
1392t5=(C_word)C_i_nullp(t3);
1393t6=t1;
1394((C_proc2)(void*)(*((C_word*)t6+1)))(2,t6,(C_truep(t5)?C_fix(1):C_fix(0)));}
1395else{
1396t5=(*a=C_CLOSURE_TYPE|6,a[1]=(C_word)f_86,a[2]=t4,a[3]=((C_word*)t0)[3],
1397    a[4]=t3,a[5]=t2,a[6]=t1,tmp=(C_word)a,a+=7,tmp);
1398t6=(*a=C_CLOSURE_TYPE|6,a[1]=(C_word)f_105,a[2]=t3,a[3]=t5,
1399    a[4]=((C_word*)t0)[3],a[5]=t4,a[6]=t2,tmp=(C_word)a,a+=7,tmp);
1400t7=(C_word)C_i_car(t2);
1401C_trace("nqueens.scm: 14   ok?");
1402t8=((C_word*)((C_word*)t0)[2])[1];
1403f_130(t8,t6,t7,C_fix(1),t4);}}
1404
1405/* k103 in try in nqueens in k33 in k30 in k27 */
1406static void C_ccall f_105(C_word c,C_word t0,C_word t1){
1407C_word tmp;
1408C_word t2;
1409C_word t3;
1410C_word t4;
1411C_word ab[6],*a=ab;
1412C_check_for_interrupt;
1413if(!C_stack_probe(&a)){
1414C_save_and_reclaim((void*)tr2,(void*)f_105,2,t0,t1);}
1415if(C_truep(t1)){
1416t2=(*a=C_CLOSURE_TYPE|5,a[1]=(C_word)f_112,a[2]=((C_word*)t0)[3],a[3]=((C_word*)t0)[4],
1417    a[4]=((C_word*)t0)[5],a[5]=((C_word*)t0)[6],tmp=(C_word)a,a+=6,tmp);
1418t3=(C_word)C_i_cdr(((C_word*)t0)[6]);
1419C_trace("nqueens.scm: 15   append");
1420t4=*((C_word*)lf[1]+1);
1421((C_proc4)C_retrieve_proc(t4))(4,t4,t2,t3,((C_word*)t0)[2]);}
1422else{
1423t2=((C_word*)t0)[3];
1424f_86(2,t2,C_fix(0));}}
1425
1426/* k110 in k103 in try in nqueens in k33 in k30 in k27 */
1427static void C_ccall f_112(C_word c,C_word t0,C_word t1){
1428C_word tmp;
1429C_word t2;
1430C_word t3;
1431C_word t4;
1432C_word ab[3],*a=ab;
1433C_check_for_interrupt;
1434if(!C_stack_probe(&a)){
1435C_save_and_reclaim((void*)tr2,(void*)f_112,2,t0,t1);}
1436t2=(C_word)C_i_car(((C_word*)t0)[5]);
1437t3=(C_word)C_a_i_cons(&a,2,t2,((C_word*)t0)[4]);
1438C_trace("nqueens.scm: 15   try");
1439t4=((C_word*)((C_word*)t0)[3])[1];
1440f_66(t4,((C_word*)t0)[2],t1,C_SCHEME_END_OF_LIST,t3);}
1441
1442/* k84 in try in nqueens in k33 in k30 in k27 */
1443static void C_ccall f_86(C_word c,C_word t0,C_word t1){
1444C_word tmp;
1445C_word t2;
1446C_word t3;
1447C_word t4;
1448C_word t5;
1449C_word t6;
1450C_word ab[7],*a=ab;
1451C_check_for_interrupt;
1452if(!C_stack_probe(&a)){
1453C_save_and_reclaim((void*)tr2,(void*)f_86,2,t0,t1);}
1454t2=(*a=C_CLOSURE_TYPE|3,a[1]=(C_word)f_90,a[2]=t1,a[3]=((C_word*)t0)[6],tmp=(C_word)a,a+=4,tmp);
1455t3=(C_word)C_i_cdr(((C_word*)t0)[5]);
1456t4=(C_word)C_i_car(((C_word*)t0)[5]);
1457t5=(C_word)C_a_i_cons(&a,2,t4,((C_word*)t0)[4]);
1458C_trace("nqueens.scm: 17   try");
1459t6=((C_word*)((C_word*)t0)[3])[1];
1460f_66(t6,t2,t3,t5,((C_word*)t0)[2]);}
1461
1462/* k88 in k84 in try in nqueens in k33 in k30 in k27 */
1463static void C_ccall f_90(C_word c,C_word t0,C_word t1){
1464C_word tmp;
1465C_word t2;
1466C_word ab[4],*a=ab;
1467C_check_for_interrupt;
1468if(!C_stack_probe(&a)){
1469C_save_and_reclaim((void*)tr2,(void*)f_90,2,t0,t1);}
1470t2=((C_word*)t0)[3];
1471((C_proc2)(void*)(*((C_word*)t2+1)))(2,t2,(C_word)C_a_i_plus(&a,2,((C_word*)t0)[2],t1));}
1472</enscript>
1473
1474Finally, the procedure table:
1475
1476<enscript highlight=c>
1477#ifdef C_ENABLE_PTABLES
1478static C_PTABLE_ENTRY ptable[17] = {
1479{"toplevelnqueens.scm",(void*)C_toplevel},
1480{"f_29nqueens.scm",(void*)f_29},
1481{"f_32nqueens.scm",(void*)f_32},
1482{"f_35nqueens.scm",(void*)f_35},
1483{"f_194nqueens.scm",(void*)f_194},
1484{"f_200nqueens.scm",(void*)f_200},
1485{"f_197nqueens.scm",(void*)f_197},
1486{"f_37nqueens.scm",(void*)f_37},
1487{"f_46nqueens.scm",(void*)f_46},
1488{"f_191nqueens.scm",(void*)f_191},
1489{"f_130nqueens.scm",(void*)f_130},
1490{"f_66nqueens.scm",(void*)f_66},
1491{"f_105nqueens.scm",(void*)f_105},
1492{"f_112nqueens.scm",(void*)f_112},
1493{"f_86nqueens.scm",(void*)f_86},
1494{"f_90nqueens.scm",(void*)f_90},
1495{NULL,NULL}};
1496#endif
1497
1498static C_PTABLE_ENTRY *create_ptable(void){
1499#ifdef C_ENABLE_PTABLES
1500return ptable;
1501#else
1502return NULL;
1503#endif
1504}
1505</enscript>
1506
1507Phew. Done.
1508
1509<enscript highlight=c>
1510/* end of file */
1511</enscript>
1512
1513=== Another example
1514
1515No, you are not quite through yet. Let's look at a simpler example,
1516with full optimizations turned on and with safety checks disabled.
1517The example program is the {{takl}} benchmark from the Gabriel
1518benchmark suite[2] (translated to Scheme by Will Clinger):
1519
1520<enscript highlight=scheme>
1521(define (listn n)
1522  (if (= 0 n)
1523      '()
1524      (cons n (listn (- n 1)))) )
1525 
1526(define 18l (listn 18))
1527(define 12l (listn 12))
1528(define  6l (listn 6))
1529 
1530(define (mas x y z)
1531  (if (not (shorterp y x))
1532      z
1533      (mas (mas (cdr x)
1534                y z)
1535           (mas (cdr y)
1536                z x)
1537           (mas (cdr z)
1538                x y))))
1539 
1540(define (shorterp x y)
1541  (and (pair? y)
1542       (or (null? x)
1543           (shorterp (cdr x)
1544                     (cdr y)))) )
1545 
1546(mas 18l 12l 6l)
1547</enscript>
1548
1549After canonicalization:
1550
1551<enscript highlight=scheme>
1552(##core#callunit "library")
1553(##core#callunit "eval")
1554(##core#callunit "extras")
1555(##core#undefined)
1556(##core#undefined)
1557(set! listn (lambda (n0) (if (= '0 n0) '() (cons n0 (listn (- n0 '1))))))
1558(set! 18l (listn '18))
1559(set! 12l (listn '12))
1560(set! 6l (listn '6))
1561(set! mas
1562  (lambda (x1 y2 z3)
1563    (if (not (shorterp y2 x1))
1564      z3
1565      (mas (mas (cdr x1) y2 z3) (mas (cdr y2) z3 x1) (mas (cdr z3) x1 y2)))))
1566(set! shorterp
1567  (lambda (x4 y5)
1568    (if (pair? y5)
1569      (let ((g67 (null? x4))) (if g67 g67 (shorterp (cdr x4) (cdr y5))))
1570      '#f)))
1571(mas 18l 12l 6l)
1572((##sys#implicit-exit-handler))
1573(##core#undefined)
1574</enscript>
1575
1576The generated C code looks like this (we have omitted less interesting
1577parts):
1578
1579<enscript highlight=c>
1580/* k22 */
1581static void C_ccall f_24(C_word c,C_word t0,C_word t1){
1582C_word tmp;
1583C_word t2;
1584C_word t3;
1585C_word ab[3],*a=ab;
1586if(!C_stack_probe(&a)){
1587C_save_and_reclaim((void*)tr2,(void*)f_24,2,t0,t1);}
1588t2=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_27,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1589C_eval_toplevel(2,C_SCHEME_UNDEFINED,t2);}
1590
1591/* k25 in k22 */
1592static void C_ccall f_27(C_word c,C_word t0,C_word t1){
1593C_word tmp;
1594C_word t2;
1595C_word t3;
1596C_word ab[3],*a=ab;
1597if(!C_stack_probe(&a)){
1598C_save_and_reclaim((void*)tr2,(void*)f_27,2,t0,t1);}
1599t2=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_30,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1600C_extras_toplevel(2,C_SCHEME_UNDEFINED,t2);}
1601
1602/* k28 in k25 in k22 */
1603static void C_ccall f_30(C_word c,C_word t0,C_word t1){
1604C_word tmp;
1605C_word t2;
1606C_word t3;
1607C_word t4;
1608C_word ab[5],*a=ab;
1609if(!C_stack_probe(&a)){
1610C_save_and_reclaim((void*)tr2,(void*)f_30,2,t0,t1);}
1611/* we use the literal frame slot directly for "listn": since this is compiled in block mode,
1612   we don't use normal symbols as toplevel variables, as they are not to
1613   be accessed from outside: */
1614t2=C_mutate(&lf[0],(*a=C_CLOSURE_TYPE|1,a[1]=(C_word)f_32,tmp=(C_word)a,a+=2,tmp));
1615t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_54,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1616/* takl.scm: 9    listn */
1617f_32(t3,C_fix(18));}
1618
1619/* k52 in k28 in k25 in k22 */
1620static void C_ccall f_54(C_word c,C_word t0,C_word t1){
1621C_word tmp;
1622C_word t2;
1623C_word t3;
1624C_word t4;
1625C_word ab[3],*a=ab;
1626if(!C_stack_probe(&a)){
1627C_save_and_reclaim((void*)tr2,(void*)f_54,2,t0,t1);}
1628/* here we store the result in "18l": */
1629t2=C_mutate(&lf[1],t1);
1630t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_58,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1631/* takl.scm: 10   listn */
1632f_32(t3,C_fix(12));}
1633
1634/* k56 in k52 in k28 in k25 in k22 */
1635static void C_ccall f_58(C_word c,C_word t0,C_word t1){
1636C_word tmp;
1637C_word t2;
1638C_word t3;
1639C_word t4;
1640C_word ab[3],*a=ab;
1641if(!C_stack_probe(&a)){
1642C_save_and_reclaim((void*)tr2,(void*)f_58,2,t0,t1);}
1643/* ... "12l" ... */
1644t2=C_mutate(&lf[2],t1);
1645t3=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_62,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1646/* takl.scm: 11   listn */
1647f_32(t3,C_fix(6));}
1648
1649/* k60 in k56 in k52 in k28 in k25 in k22 */
1650static void C_ccall f_62(C_word c,C_word t0,C_word t1){
1651C_word tmp;
1652C_word t2;
1653C_word t3;
1654C_word t4;
1655C_word t5;
1656C_word t6;
1657C_word t7;
1658C_word t8;
1659C_word ab[10],*a=ab;
1660if(!C_stack_probe(&a)){
1661C_save_and_reclaim((void*)tr2,(void*)f_62,2,t0,t1);}
1662/* ... and "6l": */
1663t2=C_mutate(&lf[3],t1);
1664/* set "mas" and "shorterp": */
1665t3=C_mutate(&lf[4],(*a=C_CLOSURE_TYPE|1,a[1]=(C_word)f_64,tmp=(C_word)a,a+=2,tmp));
1666t4=C_mutate(&lf[5],(*a=C_CLOSURE_TYPE|1,a[1]=(C_word)f_104,tmp=(C_word)a,a+=2,tmp));
1667/* and call "mas", directly: */
1668t5=f_64(lf[1],lf[2],lf[3]);
1669t6=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_134,a[2]=((C_word*)t0)[2],tmp=(C_word)a,a+=3,tmp);
1670t7=(*a=C_CLOSURE_TYPE|2,a[1]=(C_word)f_137,a[2]=t6,tmp=(C_word)a,a+=3,tmp);
1671/* ##sys#implicit-exit-handler */
1672t8=*((C_word*)lf[6]+1);
1673((C_proc2)(void*)(*((C_word*)t8+1)))(2,t8,t7);}
1674
1675/* shorterp in k60 in k56 in k52 in k28 in k25 in k22 */
1676static C_word C_fcall f_104(C_word t1,C_word t2){
1677C_word tmp;
1678C_word t3;
1679C_word t4;
1680C_word t5;
1681C_word t6;
1682C_word t7;
1683C_word t8;
1684/* tight code: */
1685loop:
1686if(C_truep((C_word)C_i_pairp(t2))){
1687t3=(C_word)C_i_nullp(t1);
1688if(C_truep(t3)){
1689return(t3);}
1690else{
1691t4=(C_word)C_slot(t1,C_fix(1));
1692t5=(C_word)C_slot(t2,C_fix(1));
1693t7=t4;
1694t8=t5;
1695t1=t7;
1696t2=t8;
1697goto loop;}}
1698else{
1699return(C_SCHEME_FALSE);}}
1700
1701/* mas in k60 in k56 in k52 in k28 in k25 in k22 */
1702static C_word C_fcall f_64(C_word t1,C_word t2,C_word t3){
1703C_word tmp;
1704C_word t4;
1705C_word t5;
1706C_word t6;
1707C_word t7;
1708C_word t8;
1709C_word t9;
1710C_word t10;
1711C_word t11;
1712C_word t12;
1713C_word t13;
1714C_word t14;
1715/* more tight code: */
1716loop:
1717t4=f_104(t2,t1);
1718if(C_truep(t4)){
1719t5=(C_word)C_slot(t1,C_fix(1));
1720t6=f_64(t5,t2,t3);
1721t7=(C_word)C_slot(t2,C_fix(1));
1722t8=f_64(t7,t3,t1);
1723t9=(C_word)C_slot(t3,C_fix(1));
1724t10=f_64(t9,t1,t2);
1725t12=t6;
1726t13=t8;
1727t14=t10;
1728t1=t12;
1729t2=t13;
1730t3=t14;
1731goto loop;}
1732else{
1733return(t3);}}
1734
1735/* listn in k28 in k25 in k22 */
1736static void C_fcall f_32(C_word t1,C_word t2){
1737C_word tmp;
1738C_word t3;
1739C_word t4;
1740C_word t5;
1741C_word t6;
1742C_word t7;
1743C_word t8;
1744C_word t9;
1745C_word *a;
1746/* "listn" allocates, so not quite as tight: */
1747loop:
1748a=C_alloc(4);
1749if(!C_stack_probe(a)){
1750C_save_and_reclaim((void*)trf_32,NULL,2,t1,t2);}
1751t3=t2;
1752t4=(C_word)C_eqp(C_fix(0),t3);
1753if(C_truep(t4)){
1754t5=t1;
1755((C_proc2)(void*)(*((C_word*)t5+1)))(2,t5,C_SCHEME_END_OF_LIST);}
1756else{
1757t5=(*a=C_CLOSURE_TYPE|3,a[1]=(C_word)f_46,a[2]=t2,a[3]=t1,tmp=(C_word)a,a+=4,tmp);
1758t6=(C_word)C_u_fixnum_difference(t2,C_fix(1));
1759/* takl.scm: 7    listn */
1760t8=t5;
1761t9=t6;
1762t1=t8;
1763t2=t9;
1764goto loop;}}
1765</enscript>
1766
1767== References
1768
1769[1] "[[http://home.pipeline.com/~hbaker1/CheneyMTA.html|Cheney on the MTA or CONS should not cons its arguments]]", Henry Baker
1770
1771[2] "[[http://www.dreamsongs.com/Files/Timrep.pdf|Performance and Evaluation of Lisp Systems]]", Richard Gabriel
Note: See TracBrowser for help on using the repository browser.