~ chicken-core (chicken-5) a9fcaf7f59a3379fc5389534a9a605ed894f232f

commit a9fcaf7f59a3379fc5389534a9a605ed894f232f
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sun Jun 10 08:19:44 2018 +1200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jun 10 10:16:26 2018 +0200

    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.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

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