From 47f408ca8480937ac946db8455b7c3d3e0b353bb Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 18 Sep 2012 22:01:12 +0100 Subject: [PATCH] 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. --- src/code/early-extensions.lisp | 25 ++++++++++-------- src/code/primordial-extensions.lisp | 6 ++--- src/compiler/generic/early-objdef.lisp | 2 +- src/compiler/ir1tran-lambda.lisp | 28 ++++++++++---------- src/compiler/x86-64/macros.lisp | 2 +- src/compiler/x86-64/pred.lisp | 45 +++++++++++++------------------- src/compiler/x86-64/static-fn.lisp | 21 ++++++--------- 7 files changed, 59 insertions(+), 70 deletions(-) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 3ceae71..9ed8d28 100644 --- 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)))))))) @@ -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 --- 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)))) ;;;; miscellany diff --git a/src/compiler/generic/early-objdef.lisp b/src/compiler/generic/early-objdef.lisp index bafa05d..5543acf 100644 --- 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 --- 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 --- 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 --- 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)) ;;;; conditional VOPs diff --git a/src/compiler/x86-64/static-fn.lisp b/src/compiler/x86-64/static-fn.lisp index 8760e33..bf3c6ea 100644 --- 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: -- 1.7.10.4