mostly make the build deterministic

From clisp, about 10 files still differ in xc fasls after these changes.
At least one remaining issue is obvious (floats, where our float constants
aren't representable on clisp) but there are other mysteries.

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 3ceae71..9ed8d28 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -826,7 +826,7 @@
           (let* ((name (first spec))
                  (exp-temp (gensym "ONCE-ONLY")))
             `(let ((,exp-temp ,(second spec))
-                   (,name (gensym ,(symbol-name name))))
+                   (,name (sb!xc:gensym ,(symbol-name name))))
                `(let ((,,name ,,exp-temp))
                   ,,(frob (rest specs) body))))))))
 \f
@@ -1166,19 +1166,22 @@
 
 (defmacro define-deprecated-function (state since name replacements lambda-list &body body)
   (let* ((replacements (normalize-deprecation-replacements replacements))
-         (doc (let ((*package* (find-package :keyword)))
-                (apply #'format nil
-                       "~@<~S has been deprecated as of SBCL ~A.~
-                        ~#[~; Use ~S instead.~; ~
-                              Use ~S or ~S instead.~:; ~
-                              Use~@{~#[~; or~] ~S~^,~} instead.~]~@:>"
-                       name since replacements))))
+         (doc
+          (let ((*package* (find-package :keyword))
+                (*print-pretty* nil))
+            (apply #'format nil
+                   "~S has been deprecated as of SBCL ~A.~
+                    ~#[~;~2%Use ~S instead.~;~2%~
+                            Use ~S or ~S instead.~:;~2%~
+                            Use~@{~#[~; or~] ~S~^,~} instead.~]"
+                    name since replacements))))
     `(progn
        ,(ecase state
           ((:early :late)
-           `(defun ,name ,lambda-list
-              ,doc
-              ,@body))
+           `(progn
+              (defun ,name ,lambda-list
+                ,doc
+                ,@body)))
           ((:final)
            `(progn
               (declaim (ftype (function * nil) ,name))

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 0ca98ac..3a5350f 100644 (file)
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -154,7 +154,7 @@
                           (stem (if (every #'alpha-char-p symbol-name)
                                     symbol-name
                                     (concatenate 'string symbol-name "-"))))
-                     `(,symbol (gensym ,stem))))
+                     `(,symbol (sb!xc:gensym ,stem))))
                  symbols)
      ,@body))
 
@@ -166,8 +166,8 @@
   (when (eq t name)
     (break))
   (if name
-      (loop repeat n collect (gensym (string name)))
-      (loop repeat n collect (gensym))))
+      (loop repeat n collect (sb!xc:gensym (string name)))
+      (loop repeat n collect (sb!xc:gensym))))
 \f
 ;;;; miscellany
 

diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp
index bafa05d..5543acf 100644 (file)
--- a/src/compiler/generic/early-objdef.lisp
+++ b/src/compiler/generic/early-objdef.lisp
@@ -99,7 +99,7 @@
                        (string= name "-LOWTAG" :start1 (- len 7))
                        (zerop (logand (symbol-value sym) fixnum-tag-mask)))
               (push sym fixtags))))
-        `',fixtags)
+        `',(sort fixtags #'string< :key #'symbol-name))
   #'equal)
 
 ;;; the heap types, stored in 8 bits of the header of an object on the

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 5501a62..ffd254c 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -406,7 +406,7 @@
                 (dolist (default defaults)
                   (if (sb!xc:constantp default)
                       (default-vals default)
-                      (let ((var (gensym)))
+                      (let ((var (sb!xc:gensym)))
                         (default-bindings `(,var ,default))
                         (default-vals var))))
                 (let ((bindings (default-bindings))
@@ -535,9 +535,9 @@
                                  :type (leaf-type var)
                                  :where-from (leaf-where-from var))))
 
-    (let* ((n-context (gensym "N-CONTEXT-"))
+    (let* ((n-context (sb!xc:gensym "N-CONTEXT-"))
            (context-temp (make-lambda-var :%source-name n-context))
-           (n-count (gensym "N-COUNT-"))
+           (n-count (sb!xc:gensym "N-COUNT-"))
            (count-temp (make-lambda-var :%source-name n-count
                                         :type (specifier-type 'index))))
 
@@ -556,12 +556,12 @@
       ;; and take advantage of the base+index+displacement addressing
       ;; mode on x86oids.)
       (when (optional-dispatch-keyp res)
-        (let ((n-index (gensym "N-INDEX-"))
-              (n-key (gensym "N-KEY-"))
-              (n-value-temp (gensym "N-VALUE-TEMP-"))
-              (n-allowp (gensym "N-ALLOWP-"))
-              (n-lose (gensym "N-LOSE-"))
-              (n-losep (gensym "N-LOSEP-"))
+        (let ((n-index (sb!xc:gensym "N-INDEX-"))
+              (n-key (sb!xc:gensym "N-KEY-"))
+              (n-value-temp (sb!xc:gensym "N-VALUE-TEMP-"))
+              (n-allowp (sb!xc:gensym "N-ALLOWP-"))
+              (n-lose (sb!xc:gensym "N-LOSE-"))
+              (n-losep (sb!xc:gensym "N-LOSEP-"))
               (allowp (or (optional-dispatch-allowp res)
                           (policy *lexenv* (zerop safety))))
               (found-allow-p nil))
@@ -582,9 +582,9 @@
                      (default (arg-info-default info))
                      (keyword (arg-info-key info))
                      (supplied-p (arg-info-supplied-p info))
-                     (n-value (gensym "N-VALUE-"))
+                     (n-value (sb!xc:gensym "N-VALUE-"))
                      (clause (cond (supplied-p
-                                    (let ((n-supplied (gensym "N-SUPPLIED-")))
+                                    (let ((n-supplied (sb!xc:gensym "N-SUPPLIED-")))
                                       (temps n-supplied)
                                       (arg-vals n-value n-supplied)
                                       `((eq ,n-key ',keyword)
@@ -689,10 +689,10 @@
         ;; Make up two extra variables, and squirrel them away in
         ;; ARG-INFO-DEFAULT for transforming (VALUES-LIST REST) into
         ;; (%MORE-ARG-VALUES CONTEXT 0 COUNT) when possible.
-        (let* ((context-name (gensym "REST-CONTEXT"))
+        (let* ((context-name (sb!xc:gensym "REST-CONTEXT-"))
                (context (make-lambda-var :%source-name context-name
                                          :arg-info (make-arg-info :kind :more-context)))
-               (count-name (gensym "REST-COUNT"))
+               (count-name (sb!xc:gensym "REST-COUNT-"))
                (count (make-lambda-var :%source-name count-name
                                        :arg-info (make-arg-info :kind :more-count)
                                        :type (specifier-type 'index))))
@@ -719,7 +719,7 @@
         (main-vars val-temp)
         (bind-vars key)
         (cond ((or hairy-default supplied-p)
-               (let* ((n-supplied (gensym "N-SUPPLIED-"))
+               (let* ((n-supplied (sb!xc:gensym "N-SUPPLIED-"))
                       (supplied-temp (make-lambda-var
                                       :%source-name n-supplied)))
                  (unless supplied-p

diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index 0df9cf4..41d91f0 100644 (file)
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -540,7 +540,7 @@ Useful for e.g. foreign calls where another thread may trigger
 collection."
   (if objects
       (let ((pins (make-gensym-list (length objects)))
-            (wpo (gensym "WITH-PINNED-OBJECTS-THUNK")))
+            (wpo (sb!xc:gensym "WITH-PINNED-OBJECTS-THUNK")))
         ;; BODY is stuffed in a function to preserve the lexical
         ;; environment.
         `(flet ((,wpo () (progn ,@body)))

diff --git a/src/compiler/x86-64/pred.lisp b/src/compiler/x86-64/pred.lisp
index 8c9b2fd..428c2c1 100644 (file)
--- a/src/compiler/x86-64/pred.lisp
+++ b/src/compiler/x86-64/pred.lisp
@@ -180,35 +180,26 @@
                 (dolist (flag flags)
                   (inst cmov flag res then))))))))
 
-(macrolet ((def-move-if (name type reg &optional stack)
-               (when stack (setf stack (list stack)))
-
-               `(define-vop (,name move-if)
-                  (:args (then :scs (immediate ,reg ,@stack) :to :eval
-                               :load-if (not (or (sc-is then immediate)
-                                                 (and (sc-is then ,@stack)
-                                                      (not (location= else res))))))
-                         (else :scs (immediate ,reg ,@stack) :target res
-                               :load-if (not (sc-is else immediate ,@stack))))
-                  (:arg-types ,type ,type)
-                  (:results (res :scs (,reg)
-                                 :from (:argument 1)))
-                  (:result-types ,type))))
-  (def-move-if move-if/t
-      t descriptor-reg control-stack)
-  (def-move-if move-if/fx
-      tagged-num any-reg control-stack)
-  (def-move-if move-if/unsigned
-      unsigned-num unsigned-reg unsigned-stack)
-  (def-move-if move-if/signed
-      signed-num signed-reg signed-stack)
+(macrolet ((def-move-if (name type reg stack)
+             `(define-vop (,name move-if)
+                (:args (then :scs (immediate ,reg ,stack) :to :eval
+                             :load-if (not (or (sc-is then immediate)
+                                               (and (sc-is then ,stack)
+                                                    (not (location= else res))))))
+                       (else :scs (immediate ,reg ,stack) :target res
+                             :load-if (not (sc-is else immediate ,stack))))
+                (:arg-types ,type ,type)
+                (:results (res :scs (,reg)
+                               :from (:argument 1)))
+                (:result-types ,type))))
+  (def-move-if move-if/t t descriptor-reg control-stack)
+  (def-move-if move-if/fx tagged-num any-reg control-stack)
+  (def-move-if move-if/unsigned unsigned-num unsigned-reg unsigned-stack)
+  (def-move-if move-if/signed signed-num signed-reg signed-stack)
   ;; FIXME: See *CMOV-PTYPE-REPRESENTATION-VOP* above.
   #!+sb-unicode
-  (def-move-if move-if/char
-      character character-reg character-stack)
-  (def-move-if move-if/sap
-      system-area-pointer sap-reg sap-stack))
-
+  (def-move-if move-if/char character character-reg character-stack)
+  (def-move-if move-if/sap system-area-pointer sap-reg sap-stack))
 \f
 ;;;; conditional VOPs
 

diff --git a/src/compiler/x86-64/static-fn.lisp b/src/compiler/x86-64/static-fn.lisp
index 8760e33..bf3c6ea 100644 (file)
--- a/src/compiler/x86-64/static-fn.lisp
+++ b/src/compiler/x86-64/static-fn.lisp
@@ -39,7 +39,11 @@
     (error "either too many args (~W) or too many results (~W); max = ~W"
            num-args num-results register-arg-count))
   (let ((num-temps (max num-args num-results))
-        (node (gensym "NODE-")))
+        (node (sb!xc:gensym "NODE-"))
+        (new-rbp-ea
+         '(make-ea :qword
+           :disp (frame-byte-offset (+ sp->fp-offset -3 ocfp-save-offset))
+           :base rsp-tn)))
     (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
       (dotimes (i num-results)
         (let ((result-name (intern (format nil "RESULT-~D" i))))
@@ -80,17 +84,8 @@
          ;; 3+4+4=11 bytes as opposed to 1+4=5 bytes.
          (cond ((policy ,node (>= speed space))
                 (inst sub rsp-tn (* 3 n-word-bytes))
-                (inst mov (make-ea :qword :base rsp-tn
-                                   :disp (frame-byte-offset
-                                          (+ sp->fp-offset
-                                             -3
-                                             ocfp-save-offset)))
-                      rbp-tn)
-                (inst lea rbp-tn (make-ea :qword :base rsp-tn
-                                          :disp (frame-byte-offset
-                                                 (+ sp->fp-offset
-                                                    -3
-                                                    ocfp-save-offset)))))
+                (inst mov ,new-rbp-ea rbp-tn)
+                (inst lea rbp-tn ,new-rbp-ea))
                (t
                 ;; Dummy for return address.
                 (inst push rbp-tn)
@@ -98,7 +93,7 @@
 
          ,(if (zerop num-args)
               '(inst xor ecx ecx)
-              `(inst mov ecx (fixnumize ,num-args)))
+              `(inst mov ecx ,(fixnumize num-args)))
 
          (note-this-location vop :call-site)
          ;; Old CMU CL comment: