From f3d4cf4b66ab6c3cd8629ab6d0c7f7c50d7fd8a4 Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Sat, 15 Jan 2022 17:38:05 +0100
Subject: [PATCH] cmp: fix specification of integer suffixes for the C compiler

Fixes #667.
---
 src/cmp/cmpc-wt.lsp      | 13 +------------
 src/cmp/cmploc.lsp | 20 ++++++++++++++++++++
 src/cmp/cmptables.lsp    |  2 +-
 3 files changed, 22 insertions(+), 13 deletions(-)

diff --git src.orig/cmp/cmpc-wt.lsp src/cmp/cmpc-wt.lsp
index 2f5f4063c..1a681455c 100644
--- src.orig/cmp/cmpc-wt.lsp
+++ 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 src.orig/cmp/cmploc.lsp src/cmp/cmploc.lsp
index c6ec0a663..a1fa9fd87 100644
--- src.orig/cmp/cmploc.lsp
+++ 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 src.orig/cmp/cmptables.lsp src/cmp/cmptables.lsp
index 814f5f841..e649bf883 100644
--- src.orig/cmp/cmptables.lsp
+++ 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)
-- 
GitLab