>From 1b6c8f6797ec4a142074c7408aada9d44d2e1674 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Thu, 2 Feb 2012 21:27:28 +0100
Subject: [PATCH 1/2] When preparing for compilations, don't keep re-appending the literals list each time a new literal is added, but keep a counter and traverse the list only once to reverse it, at the end.
 Also simplify by removing special handling for flonums and add a note about the counter-intuitive definition of the immediate? predicate.

---
 compiler-namespace.scm |    1 +
 compiler.scm           |   40 +++++++++++++++++++++-------------------
 support.scm            |    6 ++++++
 3 files changed, 28 insertions(+), 19 deletions(-)

diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 6e3c85e..89c7e7e 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -222,6 +222,7 @@
  perform-high-level-optimizations
  perform-inlining!
  perform-pre-optimization!
+ posv
  posq
  postponed-initforms
  pprint-expressions-to-file
diff --git a/compiler.scm b/compiler.scm
index b8d574b..4257062 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -2468,7 +2468,9 @@
   
 (define (prepare-for-code-generation node db)
   (let ((literals '())
+        (literal-count 0)
 	(lambda-info-literals '())
+        (lambda-info-literal-count 0)
         (lambdas '())
         (temporaries 0)
 	(ubtemporaries '())
@@ -2717,31 +2719,30 @@
 
     (define (literal x)
       (cond [(immediate? x) (immediate-literal x)]
-	    [(number? x)
-	     (or (and (inexact? x) 
-		      (list-index (lambda (y) (and (number? y) (inexact? y) (= x y)))
-				  literals) )
-		 (new-literal x)) ]
-	    ((##core#inline "C_lambdainfop" x)
-	     (let ((i (length lambda-info-literals)))
-	       (set! lambda-info-literals 
-		 (append lambda-info-literals (list x))) ;XXX see below
+            ;; Fixnums that don't fit in 32 bits are treated as non-immediates,
+            ;; that's why we do the (apparently redundant) C_blockp check here.
+	    ((and (##core#inline "C_blockp" x) (##core#inline "C_lambdainfop" x))
+	     (let ((i lambda-info-literal-count))
+	       (set! lambda-info-literals (cons x lambda-info-literals))
+               (set! lambda-info-literal-count (add1 lambda-info-literal-count))
 	       (vector i) ) )
-            [(posq x literals) => identity]
+            [(posv x literals) => (lambda (p) (fx- literal-count (fx+ p 1)))]
 	    [else (new-literal x)] ) )
 
     (define (new-literal x)
-      (let ([i (length literals)])
-	(set! literals (append literals (list x))) ;XXX could (should) be optimized
+      (let ([i literal-count])
+	(set! literals (cons x literals))
+        (set! literal-count (add1 literal-count))
 	i) )
 
     (define (blockvar-literal var)
-      (or (list-index
-	   (lambda (lit) 
-	     (and (block-variable-literal? lit)
-		  (eq? var (block-variable-literal-name lit)) ) )
-	   literals)
-	  (new-literal (make-block-variable-literal var)) ) )
+      (cond
+       ((list-index (lambda (lit) 
+                      (and (block-variable-literal? lit)
+                           (eq? var (block-variable-literal-name lit)) ) )
+                    literals)
+        => (lambda (p) (fx- literal-count (fx+ p 1))))
+       (else (new-literal (make-block-variable-literal var))) ) )
     
     (define (immediate-literal x)
       (if (eq? (void) x)
@@ -2763,4 +2764,5 @@
 	(debugging 'o "fast global references" fastrefs))
       (when (positive? fastsets)
 	(debugging 'o "fast global assignments" fastsets))
-      (values node2 literals lambda-info-literals lambdas) ) ) )
+      (values node2 (##sys#fast-reverse literals)
+              (##sys#fast-reverse lambda-info-literals) lambdas) ) ) )
diff --git a/support.scm b/support.scm
index fe85940..4c0a1e0 100644
--- a/support.scm
+++ b/support.scm
@@ -152,6 +152,12 @@
 	  [(eq? x (car lst)) i]
 	  [else (loop (cdr lst) (add1 i))] ) ) )
 
+(define (posv x lst)
+  (let loop ([lst lst] [i 0])
+    (cond [(null? lst) #f]
+	  [(eqv? x (car lst)) i]
+	  [else (loop (cdr lst) (add1 i))] ) ) )
+
 (define (stringify x)
   (cond ((string? x) x)
 	((symbol? x) (symbol->string x))
-- 
1.7.3.4