~ chicken-core (chicken-5) 82988ca4e4547a8d01c93f6b68192b035aa0e237
commit 82988ca4e4547a8d01c93f6b68192b035aa0e237
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Jan 7 17:19:04 2017 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sat Jan 7 17:19:04 2017 +0100
use link files instaed of file marks
diff --git a/batch-driver.scm b/batch-driver.scm
index ffdbd0b1..8f6000e2 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -359,6 +359,8 @@
(when (memq 'emit-external-prototypes-first options)
(set! external-protos-first #t))
(when (memq 'inline options) (set! inline-locally #t))
+ (and-let* ((elf (memq 'emit-link-file options)))
+ (set! emit-link-file (option-arg elf)))
(and-let* ((ifile (memq 'emit-inline-file options)))
(set! inline-locally #t) ; otherwise this option makes no sense
(set! local-definitions #t)
@@ -810,7 +812,15 @@
(prepare-for-code-generation node2 db)
(end-time "preparation")
(begin-time)
- ;; Code generation
+
+ ;; generate link file
+ (when emit-link-file
+ (dribble "generating link file `~a' ..." emit-link-file)
+ (with-output-to-file
+ emit-link-file
+ (cut pp linked-static-extensions)))
+
+ ;; Code generation
(let ((out (if outfile (open-output-file outfile) (current-output-port))) )
(dribble "generating `~A' ..." outfile)
(generate-code literals lliterals lambda-table out filename
diff --git a/c-backend.scm b/c-backend.scm
index 10800bc1..cd04e042 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -542,10 +542,6 @@
(gen #t " uses: ")
(gen-list used-units))
(gen #t "*/")
- (unless (null? linked-static-extensions)
- (gen #t "/*### (static-objects")
- (for-each (cut gen " \"" <> "\"") linked-static-extensions)
- (gen ") */" #t))
(gen #t "#include \"" target-include-file "\"")
(when external-protos-first
(generate-foreign-callback-stub-prototypes foreign-callback-stubs) )
diff --git a/c-platform.scm b/c-platform.scm
index fdf4a59e..1c21a40a 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -107,7 +107,7 @@
setup-mode no-module-registration) )
(define valid-compiler-options-with-argument
- '(debug
+ '(debug emit-link-file
output-file include-path heap-size stack-size unit uses module
keyword-style require-extension inline-limit profile-name
prelude postlude prologue epilogue nursery extend feature no-feature
diff --git a/core.scm b/core.scm
index 423da530..4901cd5a 100644
--- a/core.scm
+++ b/core.scm
@@ -287,7 +287,7 @@
optimize-leaf-routines standalone-executable undefine-shadowed-macros
verbose-mode local-definitions enable-specialization block-compilation
inline-locally inline-substitutions-enabled strict-variable-types
- static-extensions
+ static-extensions emit-link-file
;; These are set by the (batch) driver, and read by the (c) backend
disable-stack-overflow-checking emit-trace-info external-protos-first
@@ -396,6 +396,7 @@
(define strict-variable-types #f)
(define enable-specialization #f)
(define static-extensions #f)
+(define emit-link-file #f)
;;; Other global variables:
diff --git a/csc.scm b/csc.scm
index eb949739..4175805f 100644
--- a/csc.scm
+++ b/csc.scm
@@ -148,7 +148,7 @@
(define-constant complex-options
'(-debug -heap-size -nursery -stack-size -compiler -unit -uses -keyword-style
- -optimize-level -include-path -database-size -extend -prelude -postlude -prologue -epilogue
+ -optimize-level -include-path -database-size -extend -prelude -postlude -prologue -epilogue -emit-link-file
-inline-limit -profile-name
-emit-inline-file -consult-inline-file
-emit-type-file -consult-type-file
@@ -847,6 +847,10 @@ EOF
(append
extra-features
translate-options
+ (if static
+ (list "-emit-link-file"
+ (pathname-replace-extension f "link"))
+ '())
(cond (cpp-mode '("-feature" "chicken-scheme-to-c++"))
(objc-mode '("-feature" "chicken-scheme-to-objc"))
(else '()))
@@ -896,8 +900,6 @@ EOF
(set! ofiles (cons fo ofiles))))
rc-files)
(set! object-files (append (reverse ofiles) object-files)) ; put generated object files first
- ;; scan generated C files for mark indicating static extension files:
- (for-each process-generated-file-marks c-files)
(unless keep-files
(for-each $delete-file generated-c-files)
(for-each $delete-file generated-rc-files))))
@@ -910,36 +912,13 @@ EOF
compile-options) ) ) )
-;;; Process "marks" in generated C files
-;
-; used for mapping statically linked extensions to .o files
-
-(define (process-generated-file-marks cfile)
- (define (process-mark exp)
- (case (car exp)
- ((static-objects)
- (set! object-files (append object-files (cdr exp))))
- ;; ignore others
- ))
- (with-input-from-file cfile
- (lambda ()
- (let loop ()
- (let ((line (read-line)))
- (cond ((eof-object? line))
- ((string=? "" line)) ;; scan until empty line
- ((and (> (string-length line) 6)
- (string=? "/*### " (substring line 0 6)))
- (process-mark
- (with-input-from-string (substring line 6) read)))
- (else (loop))))))))
-
-
;;; Link object files and libraries:
(define (run-linking)
(let* ((files (map quotewrap object-files))
(target (quotewrap target-filename))
(targetdir #f))
+ (set! object-files (collect-linked-objects object-files))
(command
(string-intersperse
(cons* (cond (cpp-mode c++-linker)
@@ -966,6 +945,17 @@ EOF
(rez target)))
(unless keep-files (for-each $delete-file generated-object-files)) ) )
+(define (collect-linked-objects object-files)
+ (let loop ((os object-files) (os2 object-files))
+ (if (null? os)
+ (delete-duplicates (reverse os2) string=?)
+ (let* ((o (car os))
+ (lfile (pathname-replace-extension o "link")))
+ (loop (cdr os)
+ (if (file-exists? lfile)
+ (append (with-input-from-file lfile read) os2)
+ os2))))))
+
(define (lib-path)
(prefix ""
"lib"
@@ -990,10 +980,8 @@ EOF
((if windows-shell quotewrap-no-slash-trans quotewrap) to))))
(define (linker-options)
- (string-append
- (string-intersperse
- (append linking-optimization-options link-options))
- (if (and static (not mingw) (not osx)) " -static" "") ) )
+ (string-intersperse
+ (append linking-optimization-options link-options)))
(define (linker-libraries)
(string-intersperse
Trap