Taken from https://gitlab.com/embeddable-common-lisp/ecl/-/commit/f3d4cf4b66ab6c3cd8629ab6d0c7f7c50d7fd8a4 with "src/cmp/cmppass2-loc.lsp" changed to its old name "src/cmp/cmploc.lsp" diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp index 2f5f4063ca7050975d8468a322165dcd098f713e..1a681455c5e3888fffdc59637900a0123e339758 100644 --- a/src/cmp/cmpc-wt.lsp +++ b/src/cmp/cmpc-wt.lsp @@ -19,18 +19,7 @@ (defun wt1 (form) (cond ((not (floatp form)) (typecase form - (INTEGER - (princ form *compiler-output1*) - (princ - (cond ((typep form (rep-type->lisp-type :int)) "") - ((typep form (rep-type->lisp-type :unsigned-int)) "U") - ((typep form (rep-type->lisp-type :long)) "L") - ((typep form (rep-type->lisp-type :unsigned-long)) "UL") - ((typep form (rep-type->lisp-type :long-long)) "LL") - ((typep form (rep-type->lisp-type :unsigned-long-long)) "ULL") - (t (baboon :format-control "wt1: The number ~A doesn't fit any integer type." form))) - *compiler-output1*)) - ((or STRING CHARACTER) + ((or INTEGER STRING CHARACTER) (princ form *compiler-output1*)) (VAR (wt-var form)) (t (wt-loc form)))) diff --git a/src/cmp/cmppass2-loc.lsp b/src/cmp/cmppass2-loc.lsp index c6ec0a6637e399268cfaf8fd1021ca0ef08f7432..a1fa9fd8704e1eaba0561e1df23bba254451c30b 100644 --- a/src/cmp/cmploc.lsp +++ b/src/cmp/cmploc.lsp @@ -181,10 +181,30 @@ (defun wt-temp (temp) (wt "T" temp)) +(defun wt-fixnum (value &optional vv) + (declare (ignore vv)) + (princ value *compiler-output1*) + ;; Specify explicit type suffix as a workaround for MSVC. C99 + ;; standard compliant compilers don't need type suffixes and choose + ;; the correct type themselves. Note that we cannot savely use + ;; anything smaller than a long long here, because we might perform + ;; some other computation on the integer constant which could + ;; overflow if we use a smaller integer type (overflows in long long + ;; computations are taken care of by the compiler before we get to + ;; this point). + #+msvc (princ (cond ((typep value (rep-type->lisp-type :long-long)) "LL") + ((typep value (rep-type->lisp-type :unsigned-long-long)) "ULL") + (t (baboon :format-control + "wt-fixnum: The number ~A doesn't fit any integer type." + value))) + *compiler-output1*)) + (defun wt-number (value &optional vv) + (declare (ignore vv)) (wt value)) (defun wt-character (value &optional vv) + (declare (ignore vv)) ;; We do not use the '...' format because this creates objects of type ;; 'char' which have sign problems (wt value)) diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index 814f5f8410ce50b3a9b00d626bb9c641ecd526a9..e649bf8834fb355b188de4123c38d3b0a4b7ae5b 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -182,7 +182,7 @@ (temp . wt-temp) (lcl . wt-lcl-loc) - (fixnum-value . wt-number) + (fixnum-value . wt-fixnum) (long-float-value . wt-number) (double-float-value . wt-number) (single-float-value . wt-number)