Fix function lco creation (create a *single* lco per function)

ast.scm

@@ -779,6 +779,18 @@
               (gen-return-cr cgc ctx)
               (gen-return-rp cgc ctx)))))
 
+(define fn-prologues (make-table test: eq?))
+(define (get-fn-prologues ast rest-param? nb-params)
+  (let ((r (table-ref fn-prologues ast #f)))
+    (or r
+        (let* ((lazy-ret (get-lazy-return))
+               (lazy-body (gen-ast (caddr ast) lazy-ret))
+               (lazy-prologue (get-lazy-prologue ast lazy-body rest-param?))
+               (lazy-prologue-gen (get-lazy-generic-prologue ast lazy-body rest-param? nb-params))
+               (prologues (list lazy-prologue lazy-prologue-gen)))
+          (table-set! fn-prologues ast prologues)
+          prologues))))
+
 ;;
 ;; Create fn entry stub
 (define (create-fn-stub ast fn-num fn-generator)
@@ -791,32 +803,27 @@
     (if rest-param
         (formal-params (cadr ast))
         (cadr ast)))
-  ;; Lazy lambda return
-  (define lazy-ret (get-lazy-return))
-  ;; Lazy lambda body
-  (define lazy-body (gen-ast (caddr ast) lazy-ret))
-
-  ;; Lazy function prologue
-  (define lazy-prologue (get-lazy-prologue ast lazy-body rest-param))
-
-  (list
-    lazy-prologue
-    (add-fn-callback
-      1
-      fn-num
-      (lambda (stack cc-idx cn-num ret-addr selector closure)
-
-        (cond ;; CASE 1 - Use entry point (no cctable)
-              ((eq? opt-entry-points #f)
-                 (let ((lazy-prologue-gen (get-lazy-generic-prologue ast lazy-body rest-param (length params))))
-                   (fn-generator closure lazy-prologue-gen #f cc-idx cn-num #f)))
-              ;; CASE 2 - Function is called using generic entry point
-              ((= selector 1)
-                 (let ((lazy-prologue-gen (get-lazy-generic-prologue ast lazy-body rest-param (length params))))
-                   (fn-generator #f lazy-prologue-gen #f cc-idx cn-num #t)))
-              ;; CASE 3 - Use multiple entry points
-              (else
-                 (fn-generator #f lazy-prologue stack cc-idx cn-num #f)))))))
+
+  (let* ((prologues (get-fn-prologues ast rest-param (length params)))
+         (lazy-prologue (car prologues))
+         (lazy-prologue-gen (cadr prologues)))
+
+    (list
+      lazy-prologue
+      (add-fn-callback
+        1
+        fn-num
+        (lambda (stack cc-idx cn-num ret-addr selector closure)
+
+          (cond ;; CASE 1 - Use entry point (no cctable)
+                ((eq? opt-entry-points #f)
+                   (fn-generator closure lazy-prologue-gen #f cc-idx cn-num #f))
+                ;; CASE 2 - Function is called using generic entry point
+                ((= selector 1)
+                   (fn-generator #f lazy-prologue-gen #f cc-idx cn-num #t))
+                ;; CASE 3 - Use multiple entry points
+                (else
+                   (fn-generator #f lazy-prologue stack cc-idx cn-num #f))))))))
 
 (define (get-entry-obj ast ctx fvars-imm fvars-late all-params bound-id)
 
@@ -2700,7 +2707,6 @@
                                     (lazy-code (and obj (cadr obj))))
                                (and lazy-code (not (lazy-code-rest? lazy-code)))))))
 
-
                (if (and inlined-call?
                         opt-regalloc-inlined-call)
 
@@ -2913,7 +2919,7 @@
   (define (get-cc-direct)
     (and lazy-code
          (let* ((stack call-stack)
-                (label (strat-label-from-stack lazy-code (append stack (list (make-ctx-tclo) (make-ctx-tret))))))
+                (label #f)) ;(strat-label-from-stack lazy-code (append stack (list (make-ctx-tclo) (make-ctx-tret))))))
            (if (and label
                     (not (lazy-code-rest? lazy-code)))
                (list 'ep (asm-label-pos label))

core.scm

@@ -1313,7 +1313,6 @@
 
   (define (generate-merge-code src-ctx dst-ctx label-dest)
     (let ((moves (ctx-regalloc-merge-moves src-ctx dst-ctx)))
-
       (if (and label-dest
                (null? moves))
           ;; No merge code is generated, return label-dest

strat1.scm

@@ -46,6 +46,10 @@
           (table-set! lco_versions lco versions)
           versions))))
 
+(define (lazy-code-versions-ctx lco)
+  (let ((ctxs (map car (keep cddr (table->list (lazy-code-versions lco))))))
+    ctxs))
+
 (define (lazy-code-nb-versions lazy-code)
   (table-length (lazy-code-versions lazy-code)))
 
@@ -144,13 +148,7 @@
        (let ((nb-versions (lazy-code-nb-real-versions lco)))
          (>= nb-versions opt-max-versions))))
 
-(define TOT 0)
 (define (strat-get-version lco ctx)
-  (let ((r (##exec-stats (lambda () (strat-get-version-h lco ctx)))))
-    (set! TOT (+ TOT (cdr (assoc 'user-time r))))
-    (cdr (assoc 'result r))))
-
-(define (strat-get-version-h lco ctx)
 
   ;; CASE 1: a version exists for this ctx, use it
   (define (case-use-version dst-ctx version)

stratunified.scm

@@ -265,7 +265,6 @@
 
 (define PORT (current-output-port))
 
-;;; TODO: placeholder for --stats
 (define (lazy-code-versions-ctx lco)
   (let ((versions (table-ref lco-generated-versions lco #f)))
     (if versions