mirror of
https://gitlab.alpinelinux.org/alpine/aports.git
synced 2025-10-29 23:42:03 +01:00
76 lines
3.3 KiB
Diff
76 lines
3.3 KiB
Diff
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)
|