>From a37033ed2aeceef85b529f49c7b79c2102ae482e Mon Sep 17 00:00:00 2001
From: Kooda <address@hidden>
Date: Sat, 21 Oct 2017 11:58:07 +0200
Subject: [PATCH 1/4] Sort the symbol table before outputing C code from the
 complier.

This helps make the compiler deterministic, as the output will not change
because of the random seeding of the symbol table.
---
 c-backend.scm | 73 ++++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 47 insertions(+), 26 deletions(-)

diff --git a/c-backend.scm b/c-backend.scm
index 3e742c9f..847f2eac 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -56,12 +56,25 @@
   (string->c-identifier
    (sprintf "C_~X_~A_" (random #x1000000) (current-seconds)) ) )
 
+;; Generate a sorted alist out of a symbol table
+(define (table->sorted-alist t)
+  (let ((alist '()))
+    (##sys#hash-table-for-each
+      (lambda (id ll)
+	(set! alist
+	  (cons (cons id ll) alist)))
+      t)
+
+    (sort! alist (lambda (p1 p2) (string<? (symbol->string (car p1))
+					   (symbol->string (car p2)))))))
+
 
 ;;; Generate target code:
 
 (define (generate-code literals lliterals lambda-table out source-file dynamic db
                        dbg-info-table)
-  (let ((non-av-proc #f))
+  (let ((lambda-table* (table->sorted-alist lambda-table))
+	(non-av-proc #f))
 
   ;; Don't truncate floating-point precision!
   (flonum-print-precision (+ flonum-maximum-decimal-exponent 1))
@@ -595,10 +608,12 @@
   
     (define (prototypes)
       (gen #t)
-      (##sys#hash-table-for-each
-       (lambda (id ll)
-	 (let* ((n (lambda-literal-argument-count ll))
-		(customizable (lambda-literal-customizable ll)) 
+      (for-each
+       (lambda (p)
+	 (let* ((id (car p))
+		(ll (cdr p))
+		(n (lambda-literal-argument-count ll))
+		(customizable (lambda-literal-customizable ll))
 		(empty-closure (and customizable (zero? (lambda-literal-closure-size ll))))
 		(varlist (intersperse (make-variable-list (if empty-closure (sub1 n) n) "t") #\,))
 		(rest (lambda-literal-rest-argument ll))
@@ -631,7 +646,7 @@
 	   ;;(when customizable (gen " C_c_regparm"))
 	   (unless direct (gen " C_noret"))
 	   (gen #\;) ))
-       lambda-table) )
+       lambda-table*) )
   
     (define (trampolines)
       (let ([ns '()]
@@ -644,9 +659,11 @@
 	      ((>= i n))
 	    (gen #t "C_word t" i "=av[" j "];")))
 
-	(##sys#hash-table-for-each
-	 (lambda (id ll)
-	   (let* ([argc (lambda-literal-argument-count ll)]
+	(for-each
+	 (lambda (p)
+	   (let* ([id (car p)]
+		  [ll (cdr p)]
+		  [argc (lambda-literal-argument-count ll)]
 		  [rest (lambda-literal-rest-argument ll)]
 		  [rest-mode (lambda-literal-rest-argument-mode ll)]
 		  [customizable (lambda-literal-customizable ll)]
@@ -661,7 +678,7 @@
 	       (let ([al (make-argument-list argc "t")])
 		 (apply gen (intersperse al #\,)) )
 	       (gen ");}") )))
-	 lambda-table)))
+	 lambda-table*)))
   
     (define (literal-frame)
       (do ([i 0 (add1 i)]
@@ -746,9 +763,11 @@
 	(else (bomb "invalid unboxed type" t))))
 
     (define (procedures)
-      (##sys#hash-table-for-each
-       (lambda (id ll)
-	 (let* ((n (lambda-literal-argument-count ll))
+      (for-each
+       (lambda (p)
+	 (let* ((id (car p))
+		(ll (cdr p))
+		(n (lambda-literal-argument-count ll))
 		(rname (real-name id db))
 		(demand (lambda-literal-allocated ll))
 		(max-av (apply max 0 (lambda-literal-callee-signatures ll)))
@@ -898,7 +917,7 @@
 		n)
 	    ll)
 	   (gen #\}) ) )
-       lambda-table) )
+       lambda-table*) )
 
     (debugging 'p "code generation phase...")
     (set! output out)
@@ -912,7 +931,7 @@
     (when emit-debug-info
       (emit-debug-table dbg-info-table))
     (procedures)
-    (emit-procedure-table lambda-table source-file)
+    (emit-procedure-table lambda-table* source-file)
     (trailer) ) )
 
 
@@ -934,18 +953,20 @@
 
 ;;; Emit procedure table:
 
-(define (emit-procedure-table lambda-table sf)
+(define (emit-procedure-table lambda-table* sf)
   (gen #t #t "#ifdef C_ENABLE_PTABLES"
-       #t "static C_PTABLE_ENTRY ptable[" (add1 (##sys#hash-table-size lambda-table)) "] = {")
-  (##sys#hash-table-for-each
-   (lambda (id ll)
-     (gen #t "{\"" id #\: (string->c-identifier sf) "\",(void*)")
-     (if (eq? 'toplevel id)
-         (if unit-name
-             (gen "C_" unit-name "_toplevel},")
-             (gen "C_toplevel},") )
-         (gen id "},") ) )
-   lambda-table)
+       #t "static C_PTABLE_ENTRY ptable[" (add1 (length lambda-table*)) "] = {")
+  (for-each
+   (lambda (p)
+     (let ((id (car p))
+	   (ll (cdr p)))
+       (gen #t "{\"" id #\: (string->c-identifier sf) "\",(void*)")
+       (if (eq? 'toplevel id)
+	   (if unit-name
+	       (gen "C_" unit-name "_toplevel},")
+	       (gen "C_toplevel},") )
+         (gen id "},") ) ) )
+   lambda-table*)
   (gen #t "{NULL,NULL}};")
   (gen #t "#endif")
   (gen #t #t "static C_PTABLE_ENTRY *create_ptable(void)")
-- 
2.15.0.rc1