>From 4ef70d02b9fccb169281ac9437698bf560891fe0 Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Sun, 10 Jun 2018 08:19:44 +1200
Subject: [PATCH] Link with static objects named "${x}.static.o" in setup mode

When building an egg, the generated installation script gives static
objects a "static.o" file extension, to avoid collisions with other
build artifacts. To account for this, teach csc.scm about setup-mode and
make it check for both "o" and "static.o" files when that's enabled.

Then, because link file entries do not actually correspond 1:1 with
filenames, drop the file extensions from that list and make them library
names instead. This makes them easier to transform into filenames when
looking for object files, and makes generating the link files simpler
too.

Finally, make sure generated object files are always given as the first
arguments to the linker by *prepending* the files for linked extensions
to the list of object-files, rather than appending (see csc.scm:923).

Fixes #1468.
---
 core.scm |  6 ++----
 csc.scm  | 38 +++++++++++++++++++++++++-------------
 eval.scm |  2 +-
 3 files changed, 28 insertions(+), 18 deletions(-)

diff --git a/core.scm b/core.scm
index f0c88f76..a09ba4af 100644
--- a/core.scm
+++ b/core.scm
@@ -1766,10 +1766,8 @@
 
 ;;; Register statically linked extension
 
-(define (register-static-extension id path)
-  (set! linked-static-extensions
-    (cons (pathname-strip-directory path)
-          linked-static-extensions)))
+(define (register-static-extension id)
+  (set! linked-static-extensions (cons id linked-static-extensions)))
 
 
 ;;; Create entry procedure:
diff --git a/csc.scm b/csc.scm
index c9d7c969..2c3c4ce6 100644
--- a/csc.scm
+++ b/csc.scm
@@ -107,6 +107,7 @@
 (define executable-extension "")
 (define compile-output-flag "-o ")
 (define shared-library-extension ##sys#load-dynamic-extension)
+(define static-object-extension (##sys#string-append "static." object-extension))
 (define default-translation-optimization-options '())
 (define pic-options (if (or mingw cygwin) '("-DPIC") '("-fPIC" "-DPIC")))
 (define generate-manifest #f)
@@ -148,7 +149,7 @@
     -analyze-only -keep-shadowed-macros -inline-global -ignore-repository
     -no-symbol-escape -no-parentheses-synonyms -r5rs-syntax
     -no-argc-checks -no-bound-checks -no-procedure-checks -no-compiler-syntax
-    -emit-all-import-libraries -setup-mode -no-elevation -no-module-registration
+    -emit-all-import-libraries -no-elevation -no-module-registration
     -no-procedure-checks-for-usual-bindings
     -specialize -strict-types -clustering -lfa2 -debug-info
     -no-procedure-checks-for-toplevel-bindings))
@@ -292,11 +293,14 @@
       (destination-repository 'target)))
 
 (define (find-object-file name)
-  (let ((o (make-pathname #f name object-extension)))
+  (let ((o (make-pathname #f name object-extension))
+	;; In setup mode, objects in build dir may also end with "static.o"
+	(static-o (make-pathname #f name static-object-extension)))
     (or (file-exists? o)
+	(and (eq? ##sys#setup-mode #t)
+	     (file-exists? static-o))
 	(and (not ignore-repository)
-	     (chicken.load#find-file o (repo-path)))
-	(stop "could not find linked extension: ~a" name))))
+	     (chicken.load#find-file o (repo-path))))))
 
 
 ;;; Display usage information:
@@ -553,7 +557,7 @@ EOF
 	     (exit) )
 	   (when (pair? linked-extensions)
 	     (set! object-files ; add objects from linked extensions
-	       (append object-files (map find-object-file linked-extensions))))
+	       (append (filter-map find-object-file linked-extensions) object-files)))
 	   (cond ((null? scheme-files)
 		  (when (and (null? c-files)
 			     (null? object-files))
@@ -660,6 +664,9 @@ EOF
 	       ((-ignore-repository)
 		(set! ignore-repository #t)
 		(t-options arg))
+	       ((-setup-mode)
+		(set! ##sys#setup-mode #t)
+		(t-options arg))
 	       ((-no-elevation)
 		(set! generate-manifest #t))
 	       [(-gui)
@@ -965,18 +972,23 @@ EOF
                 transient-link-files)))))
 
 (define (collect-linked-objects ofiles gen-ofiles)
-  (define (locate lst)
-    (map (lambda (ofile)
-	   (chicken.load#find-file ofile (repo-path)))
-	 lst))
+  (define (locate-link-file o)
+    (let* ((p (pathname-strip-extension o))
+	   ;; Also strip "static.o" extension when in setup mode:
+	   (f (if ##sys#setup-mode (string-chomp p ".static") p)))
+      (file-exists? (make-pathname #f f "link"))))
+  (define (locate-objects libs)
+    (map (lambda (id)
+	   (or (find-object-file id)
+	       (stop "could not find linked extension: ~A" id)))
+	 (map ->string libs)))
   (let loop ((os ofiles) (os2 ofiles))
     (cond ((null? os)
            (delete-duplicates (reverse os2) string=?))
           ((or static (not (member (car os) gen-ofiles)))
-           (let* ((o (car os))
-                  (lfile (pathname-replace-extension o "link"))
-                  (newos (if (file-exists? lfile)
-                             (locate (with-input-from-file lfile read))
+           (let* ((lfile (locate-link-file (car os)))
+                  (newos (if lfile
+                             (locate-objects (with-input-from-file lfile read))
                              '())))
              (loop (append newos (cdr os)) (append newos os2))))
           (else (loop (cdr os) (cons (car os) os2))))))
diff --git a/eval.scm b/eval.scm
index a615fa72..24cfd127 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1327,7 +1327,7 @@
 	   (values `(##sys#load-library (##core#quote ,id)) #f)))
       ((and compiling? static? (find-static-extension id)) =>
        (lambda (path)
-	 (mark-static id path)
+	 (mark-static id)
 	 (values `(##core#declare (uses ,id)) 'static)))
       (else
        (values `(chicken.load#load-extension
-- 
2.11.0