bug#20272: Support reproducible builds

[Jan Nieuwenhuizen]

Hi!

[sent to guile-devel yesterday, probably should have gone here]

I have rebased Mark's patch to master and added a fix on top of that,
needed on 2.1 to pass make check.

Also, I found that to pass make check these patches depend on
(yesterday's) latest master commit

    Use atomics for async interrupts

that patch seems to depend on (at least git rebase-wise)

     Deprecate user asyncs
     Deprecate arbiters
     Fold 2.1.4 news into 2.2 news

Having these 6 patches on top op 2.1.4 has guile produce deterministic
.go files...mostly.

My client code is seems to be happy with this, however Guix tells me
that some files are still not deterministic:

    lib/guile/2.2/ccache/ice-9/peg/cache.go
    lib/guile/2.2/ccache/system/repl/coop-server.go
    lib/libguile-2.2.so.0.0.0

and in Guix's debug output (only after I removed this hoping to get
guile-next reproducible, guix informed me about the plain output
nondeterminism?)

    lib/guile/2.2/ccache/ice-9/peg/cache.go.debug
    lib/guile/2.2/ccache/web/server/http.go.debug

Any ideas on what's causing this remaining nondeterminism?

Greetings,
Jan.

>From a52fe09b584a99ff39997c47c5aa7f4c0ca428db Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Fri, 12 Feb 2016 11:19:38 -0500
Subject: [PATCH 1/2] PRELIMINARY: psyntax: Remove uses of syntax-session-id.

This is an attempted fix for <https://debbugs.gnu.org/20272>,
but I'm not yet confident in its correctness.

* module/ice-9/boot-9.scm (module-generate-unique-id!): New procedure.
  (module): Add 'next-unique-id' field.
  (the-root-module): Inherit 'next-unique-id' value from early stub.
  (make-module, make-autoload-interface): Adjust calls to
  module-constructor.
* module/ice-9/psyntax.scm (gen-label, new-mark): Generate unique
  identifiers from the module name and the per-module unique-id.
---
 module/ice-9/boot-9.scm     | 25 +++++++++++++++++++++----
 module/ice-9/psyntax-pp.scm | 15 +++++++++++++--
 module/ice-9/psyntax.scm    | 13 ++++++++++---
 3 files changed, 44 insertions(+), 9 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7f62097..f1d684d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
-;;;; Copyright (C) 1995-2014  Free Software Foundation, Inc.
+;;;; Copyright (C) 1995-2014, 2016  Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -374,6 +374,12 @@ a-cont
 (define (module-ref module sym)
   (let ((v (module-variable module sym)))
     (if v (variable-ref v) (error "badness!" (pk module) (pk sym)))))
+(define module-generate-unique-id!
+  (let ((next-id 0))
+    (lambda (m)
+      (let ((i next-id))
+        (set! next-id (+ i 1))
+        i))))
 (define (resolve-module . args)
   #f)
 
@@ -1973,7 +1979,8 @@ written into the port is returned."
      submodules
      submodule-binder
      public-interface
-     filename)))
+     filename
+     next-unique-id)))
 
 
 ;; make-module &opt size uses binder
@@ -1997,7 +2004,7 @@ written into the port is returned."
                       (make-hash-table)
                       '()
                       (make-weak-key-hash-table 31) #f
-                      (make-hash-table 7) #f #f #f))
+                      (make-hash-table 7) #f #f #f 0))
 
 
 
@@ -2579,6 +2586,11 @@ written into the port is returned."
   (let ((m (make-module 0)))
     (set-module-obarray! m (%get-pre-modules-obarray))
     (set-module-name! m '(guile))
+
+    ;; Inherit next-unique-id from preliminary stub of
+    ;; %module-get-next-unique-id! defined above.
+    (set-module-next-unique-id! m (module-generate-unique-id! #f))
+
     m))
 
 ;; The root interface is a module that uses the same obarray as the
@@ -2607,6 +2619,11 @@ written into the port is returned."
       the-root-module
       (error "unexpected module to resolve during module boot" name)))
 
+(define (module-generate-unique-id! m)
+  (let ((i (module-next-unique-id m)))
+    (set-module-next-unique-id! m (+ i 1))
+    i))
+
 ;; Cheat.  These bindings are needed by modules.c, but we don't want
 ;; to move their real definition here because that would be unnatural.
 ;;
@@ -2936,7 +2953,7 @@ written into the port is returned."
               #:warning "Failed to autoload ~a in ~a:\n" sym name))))
     (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f
                         (make-hash-table 0) '() (make-weak-value-hash-table 
31) #f
-                        (make-hash-table 0) #f #f #f)))
+                        (make-hash-table 0) #f #f #f 0)))
 
 (define (module-autoload! module . args)
   "Have @var{module} automatically load the module named @var{name} when one
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index d797665..207d534 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -297,7 +297,12 @@
          (values x (car w)))))
    (gen-label
      (lambda ()
-       (string-append "l-" (session-id) (symbol->string (gensym "-")))))
+       (let ((mod (current-module)))
+         (simple-format
+           #f
+           "l-~s~s"
+           (module-generate-unique-id! mod)
+           (module-name mod)))))
    (gen-labels
      (lambda (ls)
        (if (null? ls) '() (cons (gen-label) (gen-labels (cdr ls))))))
@@ -1001,7 +1006,13 @@
              (lambda ()
                (rebuild-macro-output
                  (p (source-wrap e (anti-mark w) s mod))
-                 (gensym (string-append "m-" (session-id) "-")))))))))
+                 (let ((mod (current-module)))
+                   (string->symbol
+                     (simple-format
+                       #f
+                       "m-~s~s"
+                       (module-generate-unique-id! mod)
+                       (module-name mod)))))))))))
    (expand-body
      (lambda (body outer-form r w mod)
        (let* ((r (cons '("placeholder" placeholder) r))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 88df4c7..8fa0ff3 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1,7 +1,7 @@
 ;;;; -*-scheme-*-
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011,
-;;;;   2012, 2013, 2015 Free Software Foundation, Inc.
+;;;;   2012, 2013, 2015, 2016 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -632,7 +632,10 @@
     ;; labels must be comparable with "eq?", have read-write invariance,
     ;; and distinct from symbols.
     (define (gen-label)
-      (string-append "l-" (session-id) (symbol->string (gensym "-"))))
+      (let ((mod (current-module)))
+        (simple-format #f "l-~s~s"
+                       (module-generate-unique-id! mod)
+                       (module-name mod))))
 
     (define gen-labels
       (lambda (ls)
@@ -661,7 +664,11 @@
                    (cons 'shift (wrap-subst w)))))
 
     (define-syntax-rule (new-mark)
-      (gensym (string-append "m-" (session-id) "-")))
+      (let ((mod (current-module)))
+        (string->symbol
+         (simple-format #f "m-~s~s"
+                        (module-generate-unique-id! mod)
+                        (module-name mod)))))
 
     ;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
     ;; internal definitions, in which the ribcages are built incrementally
-- 
2.10.1

>From ff6ddce535d5cc02a6574fe3baf238cf6533d218 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
Date: Tue, 1 Nov 2016 15:10:01 +0100
Subject: [PATCH 2/2] psyntax: fix gen-label for unset module.

* module/ice-9/boot-9.scm (generate-unique-id!): New function.
  (module-generate-unique-id!): Use it.
* module/ice-9/psyntax.scm (gen-label): Use it to cater for unset
  module.
* module/ice-9/psyntax-pp.scm: Regenerate.
---
 module/ice-9/boot-9.scm     | 3 ++-
 module/ice-9/psyntax-pp.scm | 2 +-
 module/ice-9/psyntax.scm    | 6 ++++--
 3 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f1d684d..e18818e 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -374,12 +374,13 @@ a-cont
 (define (module-ref module sym)
   (let ((v (module-variable module sym)))
     (if v (variable-ref v) (error "badness!" (pk module) (pk sym)))))
-(define module-generate-unique-id!
+(define generate-unique-id!
   (let ((next-id 0))
     (lambda (m)
       (let ((i next-id))
         (set! next-id (+ i 1))
         i))))
+(define module-generate-unique-id! generate-unique-id!)
 (define (resolve-module . args)
   #f)
 
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 207d534..c47df7f 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -301,7 +301,7 @@
          (simple-format
            #f
            "l-~s~s"
-           (module-generate-unique-id! mod)
+           (if mod (module-generate-unique-id! mod) (generate-unique-id! #f))
            (module-name mod)))))
    (gen-labels
      (lambda (ls)
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 8fa0ff3..7e5c863 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -634,8 +634,10 @@
     (define (gen-label)
       (let ((mod (current-module)))
         (simple-format #f "l-~s~s"
-                       (module-generate-unique-id! mod)
-                       (module-name mod))))
+                        (if mod
+                            (module-generate-unique-id! mod)
+                            (generate-unique-id! #f))
+                        (module-name mod))))
 
     (define gen-labels
       (lambda (ls)
-- 
2.10.1


-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl