Remove os-provides-putwc and backtrace's use of putwc

It took me half a day to find out why stderr could stop working entirely
while fd 2 itself was fine. Thanks to rongut @ google the answer is hidden
within https://man7.org/linux/man-pages/man3/fwide.3.html -
"Once a stream has an orientation, it cannot be changed and persists
until the stream is closed." ("orientation" means "element width")
Using the wrong function can bork the stream so it appears inoperative.

Since I don't think the right thing is to change *all* fprintf calls to
fwprintf etc etc to accomodate widechar, the solution is to completely
avoid using the widechar-oriented functions.

.gitignore

@@ -45,8 +45,6 @@ tools-for-build/determine-endianness.exe
 tools-for-build/grovel-headers
 tools-for-build/grovel-headers.exe
 tools-for-build/mmap-rwx
-tools-for-build/os-provides-putwc-test
-tools-for-build/os-provides-putwc-test.exe
 tools-for-build/where-is-mcontext
 contrib/*/test-passed
 contrib/*/test-output

make-target-2-load.lisp

@@ -24,8 +24,7 @@
           ;; "LISP_FEATURE_" on the corresponding #define is unfortunate.
           :GCC-TLS
           :RESTORE-FS-SEGMENT-REGISTER-FROM-TLS ; only for 'src/runtime/thread.h'
-          :OS-PROVIDES-BLKSIZE-T ; only for 'src/runtime/wrap.h'
-          :OS-PROVIDES-PUTWC)) ; only for 'src/runtime/backtrace.c'
+          :OS-PROVIDES-BLKSIZE-T)) ; only for 'src/runtime/wrap.h'
        (public-features
         (cons
          sb-impl::!sbcl-architecture

src/runtime/backtrace.c

@@ -36,25 +36,12 @@
 #include "code.h"
 #include "var-io.h"
 #include "forwarding-ptr.h"
+#include "lispstring.h"
 
 #ifdef LISP_FEATURE_OS_PROVIDES_DLADDR
 # include <dlfcn.h>
 #endif
 
-static void
-sbcl_putwc(wchar_t c, FILE *file)
-{
-#ifdef LISP_FEATURE_OS_PROVIDES_PUTWC
-    putwc(c, file);
-#else
-    if (c < 256) {
-        fputc(c, file);
-    } else {
-        fputc('?', file);
-    }
-#endif
-}
-
 static int decode_locs(lispobj packed_integer, int *offset, int *elsewhere)
 {
     struct varint_unpacker unpacker;
@@ -106,34 +93,24 @@ debug_function_from_pc (struct code* code, void *pc)
 static void
 print_string (struct vector *vector, FILE *f)
 {
-  int tag = widetag_of(&vector->header);
-
-#define doit(TYPE)                              \
-  do {                                          \
-    int i;                                      \
-    int n = fixnum_value(vector->length);       \
-    TYPE *data = (TYPE *) vector->data;         \
-    for (i = 0; i < n; i++) {                   \
-      wchar_t c = (wchar_t) data[i];            \
-      if (c == '\\' || c == '"')                \
-        putc('\\', f);                          \
-      sbcl_putwc(c, f);                         \
-    }                                           \
-  } while (0)
-
-  switch (tag) {
-  case SIMPLE_BASE_STRING_WIDETAG:
-    doit(unsigned char);
-    break;
-#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
-  case SIMPLE_CHARACTER_STRING_WIDETAG:
-    doit(unsigned int);
-    break;
-#endif
-  default:
-    fprintf(f, "<??? type %d>", tag);
+    if (!string_widetag_p(widetag_of(&vector->header))) {
+        fprintf(f, "<??? type %d>", widetag_of(&vector->header));
+        return;
+    }
+    int i;
+    int n = fixnum_value(vector->length);
+    for (i = 0; i < n; i++) {
+        unsigned int c = schar(vector, i);
+        if (c > 0xFFFF) fprintf(f,"\\U%08x", c);
+        // without knowing whether the terminal can accept
+        // character codes 128 through 255, it's conservative
+        // to just output unicode escapes.
+        else if (c > 0x7F) fprintf(f,"\\u%04x", c);
+        else {
+            if (c == '\\' || c == '"') putc('\\', f);
+            putc(c, f);
+        }
     }
-#undef doit
 }
 
 static int string_equal (struct vector *vector, char *string)

src/runtime/immobile-space.c

@@ -58,6 +58,7 @@
 #include "immobile-space.h"
 #include "unaligned.h"
 #include "code.h"
+#include "lispstring.h"
 
 #include <stdlib.h>
 #include <stdio.h>
@@ -1727,17 +1728,6 @@ static lispobj* get_load_address(lispobj* old)
 }
 
 #if DEFRAGMENT_FIXEDOBJ_SUBSPACE
-// This does not accept (SIMPLE-ARRAY NIL (*))
-// (You'd have a pretty bad time trying making a symbol like that)
-static int schar(struct vector* string, int index)
-{
-#ifdef LISP_FEATURE_SB_UNICODE
-    if (widetag_of(&string->header) == SIMPLE_CHARACTER_STRING_WIDETAG)
-        return ((int*)string->data)[index];
-#endif
-    return ((char*)string->data)[index];
-}
-
 #include "genesis/package.h"
 #define N_SYMBOL_KINDS 5
 

src/runtime/lispstring.h

@@ -0,0 +1,35 @@
+/*
+ * This software is part of the SBCL system. See the README file for
+ * more information.
+ *
+ * This software is derived from the CMU CL system, which was
+ * written at Carnegie Mellon University and released into the
+ * public domain. The software is in the public domain and is
+ * provided with absolutely no warranty. See the COPYING and CREDITS
+ * files for more information.
+ */
+
+#ifndef _LISPSTRING_H_
+#define _LISPSTRING_H_
+
+static inline boolean string_widetag_p(int widetag)
+{
+    // element type of NIL can just go to hell
+    return widetag == SIMPLE_BASE_STRING_WIDETAG
+#ifdef SIMPLE_CHARACTER_STRING_WIDETAG
+        || widetag == SIMPLE_CHARACTER_STRING_WIDETAG
+#endif
+        ;
+}
+
+// This does not accept (SIMPLE-ARRAY NIL (*))
+// (You'd have a pretty bad time trying making a symbol like that)
+static inline unsigned int schar(struct vector* string, int index)
+{
+    if (widetag_of(&string->header) == SIMPLE_BASE_STRING_WIDETAG)
+        return ((char*)string->data)[index];
+    else
+        return ((unsigned int*)string->data)[index];
+}
+
+#endif

tools-for-build/grovel-features.sh

@@ -23,8 +23,6 @@ featurep os-provides-dlopen
 
 featurep os-provides-dladdr
 
-featurep os-provides-putwc
-
 featurep os-provides-blksize-t
 
 featurep os-provides-suseconds-t

tools-for-build/os-provides-putwc-test.c

@@ -1,11 +0,0 @@
-/* test to build and run so that we know if we have putwc */
-
-#include <stdio.h>
-#include <wchar.h>
-
-int main ()
-{
-    wchar_t a = 'a';
-    putwc(a, stdout);
-    return 104;
-}