(zilch lang ninja build): add shared object stubs for linked libraries

This adds a second derivation containing a .so (stubbed) to all `.so.symbols`
edges, which represents a shared object stub. This stub is then used for all
linking afterwards, rather than the bubbled-up .so file, which was used as
workaround.

Change-Id: I6a6a69649ff04f8efe329c59e4d0172532aa7adb

lang/ninja/src/build.sld

@@ -8,10 +8,29 @@
   (srfi 128) (srfi 146) (srfi 152)
   (zilch lang ninja) (zilch lang ninja config))
 
- (export process-ninja-file)
+ (export process-ninja-file
+   built-edge-edge built-edge-out-drv
+   built-edge-lib-placeholder built-edge-phony-inputs)
 
  (begin
   (define coreutils (cdr (assoc "out" (nixpkgs "coreutils"))))
+  (define patchelf (cdr (assoc "out" (nixpkgs "patchelf"))))
+  (define llvm-bintools (cdr (assoc "out" (nixpkgs-eval "llvmPackages_latest.bintools-unwrapped"))))
+
+  (define-record-type <built-edge>
+    (make-built-edge edge out-drv lib-placeholder phony-inputs)
+    built-edge?
+    (edge built-edge-edge)
+    (out-drv built-edge-out-drv)
+    (lib-placeholder built-edge-lib-placeholder)
+    (phony-inputs built-edge-phony-inputs))
+
+  (define-record-type <build-env>
+    (make-build-env config vfs build-dir)
+    build-env?
+    (config build-env-config)
+    (vfs build-env-vfs)
+    (build-dir build-env-build-dir))
 
   ;; normalize a POSIX-y path. Ninja doesn't have an internal concept of path normalisation,
   ;; so this is necessary for proper file-finding behavior.
@@ -41,37 +60,69 @@
       "zilch-ninja"
       (string-map (lambda (c) (if (is-valid-store-path-char c) c #\-)) (if (> (string-length str) 211) (string-copy str 0 211) str))))
 
-
+  ;; Returns a derivation that runs the command for this edge,
-  (define (derivation-for-edge conf vfs-store-path relative-to-root edges current-edge)
+  ;; inside a Nix derivation with the correct inputs.
+  (define (derivation-for-edge env edges current-edge)
     (define resolved (build-edge-resolved current-edge))
     (when (build-rule-rspfile resolved) (error "rspfile not yet supported" current-edge))
     (define copy-input-files "")
+    (define is-meson-phony #f)
+
+    ; Appends a single input to the input of this edge's build command.
     (define (append-file path)
-      (define input-file (mapping-ref edges path (lambda () (mapping-ref/default edges (normalize-path path) #f))))
+      ; Normalize paths pointing into the build environment.
+      (cond
+       ((string-prefix? "/build/bdir/src/" path)
+        (set! path (string-append "../" (string-copy path 12))))
+       ((string-prefix? "/build/bdir/build/" path)
+        (set! path (string-copy path 18))))
+      (define input (mapping-ref edges path (lambda () (mapping-ref/default edges (normalize-path path) #f))))
+
+      (define input-file (and input (car input)))
+      (define input-edge (and input (force (cdr input))))
 
       (cond
         ; if input-file is 'base, this is part of the base vfs; we don't filter that right now.
         ((eq? input-file 'base) #f)
 
         ; Phony rule; pass through the inputs literally.
-        ((and (pair? input-file) (eq? (car input-file) 'phony)) (for-each append-file (cddr input-file)))
+        ((eq? input-file 'phony) (for-each append-file (built-edge-phony-inputs input-edge)))
 
         ; This file is produced by another build edge. Add it to our input vfs.
         (input-file
           (let ((prev-copy-input-files copy-input-files))
-            (set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" relative-to-root "/$($COREUTILS/dirname " path "); $COREUTILS/cp -rf " #$(force input-file) " bdir/" relative-to-root "/" path))))
+            (set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" (build-env-build-dir env) "/$($COREUTILS/dirname " path "); $COREUTILS/cp -rf " #$(force input-file) " bdir/" (build-env-build-dir env) "/" path))))
 
         (else
           (unless (string-prefix? "/nix/store" path)
-            (error "Path doesn't exist as build edge" path))))
+            (error "Path doesn't exist as build edge" (list path (build-edge-outputs current-edge))))))
 
       ; Workaround for Meson not adding the .so as build dependency when linking, instead using a .symbols file.
-      ; This makes sense, as it only relinks when symbols change, but it breaks the dependency link, and is the only
+      ; To replicate Meson's behavior, we use a .so stub generated when a .so.symbols path is seen; this serves
-      ; place this happens in Ninja file processing.
+      ; the same purpose.
-      ; TODO: how does nix-ninja handle this?
+      (when (and input-edge (built-edge-lib-placeholder input-edge))
-      (when (string-suffix? ".so.symbols" path)
+        (let* ((pair (force (built-edge-lib-placeholder input-edge)))
-        (let ((index (string-contains path ".p/")))
+               (so-path (car pair))
-          (append-file (string-copy path 0 index)))))
+               (so-file (cdr pair)))
+         (let ((prev-copy-input-files copy-input-files))
+          (set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" (build-env-build-dir env) "/$($COREUTILS/dirname " so-path "); $COREUTILS/cp -rf " #$so-file " bdir/" (build-env-build-dir env) "/" so-path)))))
+
+      ; Make sure we have all .so stubs transitively.
+      (when
+       (and input-edge (built-edge-lib-placeholder input-edge))
+       ; Depend on all .so.symbols files from the input's edge's dependencies too.
+       (let*
+        ((so-path (car (build-edge-inputs (built-edge-edge input-edge))))
+         (recursive-drv (mapping-ref edges so-path (lambda () (mapping-ref edges (normalize-path so-path)))))
+         (so-edge (built-edge-edge (force (cdr recursive-drv)))))
+        (for-each
+         (lambda (input)
+          (when (string-suffix? ".so.symbols" input)
+            (append-file input)))
+         (append (build-edge-inputs so-edge) (build-edge-implicit-dependencies so-edge) (build-edge-order-only-dependencies so-edge)))))
+
+      (when (string=? path "PHONY")
+       (set! is-meson-phony #t)))
 
     ; Add the inputs, implicit dependencies, _and_ order-only dependencies to our vfs.
     (for-each append-file (build-edge-inputs current-edge))
@@ -82,7 +133,7 @@
     (for-each
       (lambda (path)
         (define prev-copy-input-files copy-input-files)
-        (set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" relative-to-root "/$($COREUTILS/dirname " path ")")))
+        (set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" (build-env-build-dir env) "/$($COREUTILS/dirname " path ")")))
       (build-edge-outputs current-edge))
 
     ; Create the VFS.
@@ -92,7 +143,9 @@
     (define copy-output-files "")
     (define out-placeholder (make-placeholder "out"))
     (define (append-copy-command outpath)
-      (set! copy-output-files (string-append copy-output-files "\n" "$COREUTILS/mkdir -p " out-placeholder "/$($COREUTILS/dirname " outpath "); $COREUTILS/cp -rf " outpath " " out-placeholder "/" outpath)))
+      (if is-meson-phony
+       (set! copy-output-files (string-append copy-output-files "\n" "$COREUTILS/mkdir -p " out-placeholder "/$($COREUTILS/dirname " outpath "); $COREUTILS/cp -rf " outpath " " out-placeholder "/" outpath " || true"))
+       (set! copy-output-files (string-append copy-output-files "\n" "$COREUTILS/mkdir -p " out-placeholder "/$($COREUTILS/dirname " outpath "); $COREUTILS/cp -rf " outpath " " out-placeholder "/" outpath))))
     (for-each append-copy-command (build-edge-outputs current-edge))
     (for-each append-copy-command (build-edge-implicit-outputs current-edge))
 
@@ -102,7 +155,7 @@
       (define result (patch current-edge))
       (when result
         (set! patch-commands (cons result patch-commands))))
-     (ninja-build-config-patches conf))
+     (ninja-build-config-patches (build-env-config env)))
     (set! patch-commands (reverse patch-commands))
     (define processed-patch-commands
       #~,(string-join
@@ -117,7 +170,7 @@
     (define command
       #~,(string-append
           ; Copy over the VFS, as we have to make changes to it.
-          #$coreutils "/bin/cp -rf --no-preserve=ownership " #$vfs-store-path " bdir\n"
+          #$coreutils "/bin/cp -rf --no-preserve=ownership " #$(build-env-vfs env) " bdir\n"
           #$coreutils "/bin/chmod ugo+rw -R bdir\n"
 
           ; Copy over the other input files.
@@ -125,13 +178,13 @@
           #$coreutils "/bin/chmod ugo+rw -R bdir\n"
 
           ; Run any patches we have received.
-          "(cd bdir; _ZILCH_ROOT=" #$vfs-store-path "; PATH=\"" #$coreutils "/bin:$PATH\"; " #$processed-patch-commands ")\n"
+          "(cd bdir; _ZILCH_ROOT=" #$(build-env-vfs env) "; PATH=\"" #$coreutils "/bin:$PATH\"; " #$processed-patch-commands ")\n"
 
           ; Enter the build dir and then run the command for this build.
-          "(cd bdir/" relative-to-root "; " command-to-run ") || exit 1\n"
+          "(cd bdir/" (build-env-build-dir env) "; " command-to-run ") || exit 1\n"
 
           ; Create the output directory, and copyy over the output files.
-          "(COREUTILS=" #$coreutils"/bin; cd bdir/" relative-to-root "; $COREUTILS/mkdir " out-placeholder "\n" #$copy-output-files ")"))
+          "(COREUTILS=" #$coreutils"/bin; cd bdir/" (build-env-build-dir env) "; $COREUTILS/mkdir " out-placeholder "\n" #$copy-output-files ")"))
 
     ; Create the derivation. The rest of the code, that builds up the full list of edges, will extract each output from it.
     (define outpath
@@ -139,18 +192,46 @@
       (store-path-for-ca-drv*
        (make-valid-store-path-string (build-rule-description resolved))
        "x86_64-linux"
-       (list "/bin/sh" "-c" command)
+       '("/bin/sh" "-c" "exec /bin/sh $ZILCH_CMDPath")
-       (ninja-build-config-environment conf)
+       `(("ZILCH_CMD" . ,command) ("passAsFile" . "ZILCH_CMD") . ,(ninja-build-config-environment (build-env-config env)))
        '("out"))))
     outpath)
+  (define (ifs-for-shsym env edges current-edge)
+    (define implib (mapping-ref (build-edge-variables current-edge) "IMPLIB" (lambda () (error "SHSYM rule does not have IMPLIB variable"))))
+    (define input-path (car (build-edge-inputs current-edge)))
+
+    (define input-edge (mapping-ref edges input-path (lambda () (mapping-ref edges (normalize-path input-path) (lambda () (error "SHSYM input path does not exist"))))))
+
+    (define command
+      #~,(string-append #$llvm-bintools "/bin/llvm-ifs --output-elf=\"$out\" \"$input\"\n"
+           #$patchelf "/bin/patchelf --set-rpath \"$(" #$patchelf "/bin/patchelf --print-rpath \"$input\")\" \"$out\""))
+
+    (define processed
+     (cdar
+      (store-path-for-ca-drv*
+       (make-valid-store-path-string (string-append "SHSYM shim for " implib))
+       "x86_64-linux"
+       (list "/bin/sh" "-c" command)
+       #~(("input" . #$(force (car input-edge))))
+       '("out"))))
+    (cons implib processed))
+
+  (define (build-edge env edges current-edge)
+   (if (build-edge-resolved current-edge)
+    (let*
+     ((out-drv (delay (derivation-for-edge env edges current-edge)))
+      (is-shsym (string=? (build-edge-rule current-edge) "SHSYM"))
+      (shsym-ifs (and is-shsym (delay (ifs-for-shsym env edges current-edge)))))
+     (make-built-edge current-edge out-drv shsym-ifs '()))
+    (make-built-edge current-edge (delay (phony-edge edges current-edge)) #f (build-edge-inputs current-edge))))
 
   (define (phony-edge edges current-edge)
     (define copies (list))
     (define (process-input path)
      (define input-file (mapping-ref edges path (lambda () (mapping-ref/default edges (normalize-path path) #f))))
-     (if (and (pair? input-file) (eq? (car input-file) 'phony))
+     (if (eq? (car input-file) 'phony)
-       (for-each process-input (cddr input-file))
+       (for-each process-input (built-edge-phony-inputs (force (cdr input-file))))
-       (set! copies (cons #~,(string-append "mkdir -p \"$out/$(dirname " path ")\"; cp -rf " #$(force input-file) " $out/" path) copies))))
+       (set! copies (cons #~,(string-append "mkdir -p \"$out/$(dirname " path ")\"; cp -rf " #$(force (car input-file)) " $out/" path) copies))))
     (for-each process-input (build-edge-inputs current-edge))
 
     (define command
@@ -160,8 +241,8 @@
      (store-path-for-ca-drv*
       "zilch-ninja-phony-edge"
       "x86_64-linux"
-      (list "/bin/sh" "-c" command)
+      '("/bin/sh" "-c" "exec /bin/sh $ZILCH_CMDPath")
-      #~(("PATH" . ,(string-append #$coreutils "/bin")))
+      #~(("ZILCH_CMD" . #$command) ("passAsFile" . "ZILCH_CMD") ("PATH" . ,(string-append #$coreutils "/bin")))
       '("out"))))
 
 
@@ -184,27 +265,27 @@
         ((string=? relative-to "") #f)
         ((string-prefix? relative-to path) (set! path (string-copy path (string-length relative-to))))
         (else (set! path (string-append "../" path))))
-       (set! edges (mapping-set! edges path 'base)))
+       (set! edges (mapping-set! edges path (cons 'base #f))))
      (vfs-contents (ninja-build-config-root-dir conf)))
+
     (define vfs-store-path (vfs-to-store (ninja-build-config-root-dir conf)))
+    (define env (make-build-env conf vfs-store-path relative-to))
     (for-each
      (lambda (edge)
-      (define processed (delay (derivation-for-edge conf vfs-store-path relative-to edges edge)))
+      (define built-edge (delay (build-edge env edges edge)))
       (define all-outputs (append (build-edge-outputs edge) (build-edge-implicit-outputs edge)))
       (if (build-edge-resolved edge)
-        (for-each (lambda (v) (set! edges (mapping-set! edges v (delay #~,(string-append #$(force processed) "/" v)))))
+        (for-each (lambda (v) (set! edges (mapping-set! edges v (cons (delay #~,(string-append #$(force (built-edge-out-drv (force built-edge))) "/" v)) built-edge))))
           all-outputs)
 
         ; This edge is phony; mark the edge as having its outputs.
-        (for-each (lambda (v) (set! edges (mapping-set! edges v (cons 'phony (cons edge (build-edge-inputs edge))))))
+        (for-each (lambda (v) (set! edges (mapping-set! edges v (cons 'phony built-edge))))
           all-outputs)))
      (build-file-build-edges file))
 
     (define edge-ref
      (lambda (path)
-       (define edge (force (mapping-ref/default edges path #f)))
+       (define edge (mapping-ref/default edges path #f))
-       (if (and (pair? edge) (eq? (car edge) 'phony))
+       (cons (if (promise? (car edge)) (force (car edge)) (car edge)) (force (cdr edge)))))
-         (phony-edge edges (cadr edge))
-         edge)))
     (define defaults (build-file-default-targets file))
     (values edge-ref defaults))))