Big round of changes to switch the code base to use the stream

abstraction instead of directly using C standard I/O,
to eliminate most uses of C formatted I/O,
and fix numerous bugs, such variadic argument lists which
lack a terminating ``nao'' sentinel.

Bug 28033 is addressed by this patch, since streams no longer provide
printf-compatible formatting. The native formatter is extended with
some additional capabilities to take over.

The work on literal objects is expanded and they are now used
throughout the code base.

Fixed bad realloc in string output stream: reallocating by number
of wide chars rather than bytes.

1 files changed, 71 insertions, 70 deletions

diff --git a/lib.c b/lib.c
index a04b1ee6..258d63de 100644
--- a/lib.c
+++ b/lib.c
@@ -128,14 +128,14 @@ obj_t *typeof(obj_t *obj)
 obj_t *type_check(obj_t *obj, int type)
 {
   if (!is_ptr(obj) || obj->t.type != type)
-    type_mismatch(L"~s is not of type ~s", obj, code2type(type), nao);
+    type_mismatch(lit("~s is not of type ~s"), obj, code2type(type), nao);
   return t;
 }
 
 obj_t *type_check2(obj_t *obj, int t1, int t2)
 {
   if (!is_ptr(obj) || (obj->t.type != t1 && obj->t.type != t2))
-    type_mismatch(L"~s is not of type ~s or ~s", obj,
+    type_mismatch(lit("~s is not of type ~s or ~s"), obj,
                   code2type(t1), code2type(t2), nao);
   return t;
 }
@@ -144,7 +144,7 @@ obj_t *type_check3(obj_t *obj, int t1, int t2, int t3)
 {
   if (!is_ptr(obj) || (obj->t.type != t1 && obj->t.type != t2
                        && obj->t.type != t3))
-    type_mismatch(L"~s is not of type ~s, ~s nor ~s", obj,
+    type_mismatch(lit("~s is not of type ~s, ~s nor ~s"), obj,
                   code2type(t1), code2type(t2), code2type(t3), nao);
   return t;
 }
@@ -165,7 +165,7 @@ obj_t *car(obj_t *cons)
       return cons->lc.car;
     }
   default:
-    type_mismatch(L"~s is not a cons", cons, nao);
+    type_mismatch(lit("~s is not a cons"), cons, nao);
   }
 }
 
@@ -185,7 +185,7 @@ obj_t *cdr(obj_t *cons)
       return cons->lc.cdr;
     }
   default:
-    type_mismatch(L"~s is not a cons", cons, nao);
+    type_mismatch(lit("~s is not a cons"), cons, nao);
   }
 }
 
@@ -198,7 +198,7 @@ obj_t **car_l(obj_t *cons)
     funcall1(cons->lc.func, cons);
     return &cons->lc.car;
   default:
-    type_mismatch(L"~s is not a cons", cons, nao);
+    type_mismatch(lit("~s is not a cons"), cons, nao);
   }
 }
 
@@ -211,7 +211,7 @@ obj_t **cdr_l(obj_t *cons)
     funcall1(cons->lc.func, cons);
     return &cons->lc.cdr;
   default:
-    type_mismatch(L"~s is not a cons", cons, nao);
+    type_mismatch(lit("~s is not a cons"), cons, nao);
   }
 }
 
@@ -561,7 +561,7 @@ obj_t *list(obj_t *first, ...)
     do {
       *ptr++ = next;
       if (ptr == array + 32)
-        internal_error(L"runaway arguments in list function");
+        internal_error("runaway arguments in list function");
       next = va_arg(vl, obj_t *);
     } while (next != nao);
 
@@ -624,7 +624,7 @@ obj_t *num(long val)
 long c_num(obj_t *num)
 {
   if (!is_num(num))
-    type_mismatch(L"~s is not a number", num, nao);
+    type_mismatch(lit("~s is not a number"), num, nao);
   return ((long) num) >> TAG_SHIFT;
 }
 
@@ -1012,7 +1012,7 @@ obj_t *chrp(obj_t *chr)
 wchar_t c_chr(obj_t *chr)
 {
   if (!is_chr(chr))
-    type_mismatch(L"~s is not a character", chr, nao);
+    type_mismatch(lit("~s is not a character"), chr, nao);
   return ((wchar_t) chr) >> TAG_SHIFT;
 }
 
@@ -1184,7 +1184,7 @@ obj_t *apply(obj_t *fun, obj_t *arglist)
   type_check (fun, FUN);
 
   type_assert (listp(arglist),
-               (L"apply arglist ~s is not a list", arglist, nao));
+               (lit("apply arglist ~s is not a list"), arglist, nao));
 
   *p++ = car(arglist); arglist = cdr(arglist);
   *p++ = car(arglist); arglist = cdr(arglist);
@@ -1563,9 +1563,9 @@ obj_t *cobj(void *handle, obj_t *cls_sym, struct cobj_ops *ops)
 
 void cobj_print_op(obj_t *obj, obj_t *out)
 {
-  put_cstring(out, L"#<");
+  put_string(out, lit("#<"));
   obj_print(obj->co.cls, out);
-  cformat(out, L": %p>", obj->co.handle);
+  format(out, lit(": ~p>"), obj->co.handle, nao);
 }
 
 obj_t *assoc(obj_t *list, obj_t *key)
@@ -1844,7 +1844,7 @@ static void obj_init(void)
 void obj_print(obj_t *obj, obj_t *out)
 {
   if (obj == nil) {
-    put_cstring(out, L"nil");
+    put_string(out, lit("nil"));
     return;
   }
 
@@ -1853,110 +1853,110 @@ void obj_print(obj_t *obj, obj_t *out)
   case LCONS:
     {
       obj_t *iter;
-      put_cchar(out, '(');
+      put_char(out, chr('('));
       for (iter = obj; consp(iter); iter = cdr(iter)) {
         obj_print(car(iter), out);
         if (nullp(cdr(iter))) {
-          put_cchar(out, ')');
+          put_char(out, chr(')'));
         } else if (consp(cdr(iter))) {
-          put_cchar(out, ' ');
+          put_char(out, chr(' '));
         } else {
-          put_cstring(out, L" . ");
+          put_string(out, lit(" . "));
           obj_print(cdr(iter), out);
-          put_cchar(out, ')');
+          put_char(out, chr(')'));
         }
       }
     }
     return;
-  case STR:
   case LIT:
+  case STR:
     {
       const wchar_t *ptr;
-      put_cchar(out, '"');
+      put_char(out, chr('"'));
       for (ptr = c_str(obj); *ptr; ptr++) {
         switch (*ptr) {
-        case L'\a': put_cstring(out, L"\\a"); break;
-        case L'\b': put_cstring(out, L"\\b"); break;
-        case L'\t': put_cstring(out, L"\\t"); break;
-        case L'\n': put_cstring(out, L"\\n"); break;
-        case L'\v': put_cstring(out, L"\\v"); break;
-        case L'\f': put_cstring(out, L"\\f"); break;
-        case L'\r': put_cstring(out, L"\\r"); break;
-        case L'"': put_cstring(out, L"\\\""); break;
-        case L'\\': put_cstring(out, L"\\\\"); break;
-        case 27: put_cstring(out, L"\\e"); break;
+        case '\a': put_string(out, lit("\\a")); break;
+        case '\b': put_string(out, lit("\\b")); break;
+        case '\t': put_string(out, lit("\\t")); break;
+        case '\n': put_string(out, lit("\\n")); break;
+        case '\v': put_string(out, lit("\\v")); break;
+        case '\f': put_string(out, lit("\\f")); break;
+        case '\r': put_string(out, lit("\\r")); break;
+        case '"': put_string(out, lit("\\\"")); break;
+        case '\\': put_string(out, lit("\\\\")); break;
+        case 27: put_string(out, lit("\\e")); break;
         default:
           if (iswprint(*ptr))
-            put_cchar(out, *ptr);
+            put_char(out, chr(*ptr));
           else
-            cformat(out, L"\\%03o", (int) *ptr);
+            format(out, lit("\\~03o"), num(*ptr), nao);
         }
       }
-      put_cchar(out, '"');
+      put_char(out, chr('"'));
     }
     return;
   case CHR:
     {
-      int ch = c_chr(obj);
+      wchar_t ch = c_chr(obj);
 
-      put_cchar(out, '\'');
+      put_char(out, chr('\''));
       switch (ch) {
-      case L'\a': put_cstring(out, L"\\a"); break;
-      case L'\b': put_cstring(out, L"\\b"); break;
-      case L'\t': put_cstring(out, L"\\t"); break;
-      case L'\n': put_cstring(out, L"\\n"); break;
-      case L'\v': put_cstring(out, L"\\v"); break;
-      case L'\f': put_cstring(out, L"\\f"); break;
-      case L'\r': put_cstring(out, L"\\r"); break;
-      case L'"': put_cstring(out, L"\\\""); break;
-      case L'\\': put_cstring(out, L"\\\\"); break;
-      case 27: put_cstring(out, L"\\e"); break;
+      case '\a': put_string(out, lit("\\a")); break;
+      case '\b': put_string(out, lit("\\b")); break;
+      case '\t': put_string(out, lit("\\t")); break;
+      case '\n': put_string(out, lit("\\n")); break;
+      case '\v': put_string(out, lit("\\v")); break;
+      case '\f': put_string(out, lit("\\f")); break;
+      case '\r': put_string(out, lit("\\r")); break;
+      case '"': put_string(out, lit("\\\"")); break;
+      case '\\': put_string(out, lit("\\\\")); break;
+      case 27: put_string(out, lit("\\e")); break;
       default:
         if (iswprint(ch))
-          put_cchar(out, ch);
+          put_char(out, chr(ch));
         else
-          cformat(out, L"\\%03o", ch);
+          format(out, lit("\\~03o"), num(ch), nao);
       }
-      put_cchar(out, '\'');
+      put_char(out, chr('\''));
     }
     return;
   case NUM:
-    cformat(out, L"%ld", c_num(obj));
+    format(out, lit("~s"), obj, nao);
     return;
   case SYM:
     put_string(out, symbol_name(obj));
     return;
   case FUN:
-    cformat(out, L"#<function: f%d>", (int) obj->f.functype);
+    format(out, lit("#<function: f~a>"), num(obj->f.functype), nao);
     return;
   case VEC:
     {
       long i, fill = c_num(obj->v.vec[vec_fill]);
-      put_cstring(out, L"#(");
+      put_string(out, lit("#("));
       for (i = 0; i < fill; i++) {
         obj_print(obj->v.vec[i], out);
         if (i < fill - 1)
-          put_cchar(out, ' ');
+          put_char(out, chr(' '));
       }
-      put_cchar(out, ')');
+      put_char(out, chr(')'));
     }
     return;
   case LSTR:
     obj_print(obj->ls.prefix, out);
-    put_cstring(out, L"#<... lazy string>");
+    put_string(out, lit("#<... lazy string>"));
     return;
   case COBJ:
     obj->co.ops->print(obj, out);
     return;
   }
 
-  cformat(out, L"#<garbage: %p>", (void *) obj);
+  format(out, lit("#<garbage: ~p>"), (void *) obj, nao);
 }
 
 void obj_pprint(obj_t *obj, obj_t *out)
 {
   if (obj == nil) {
-    put_cstring(out, L"nil");
+    put_string(out, lit("nil"));
     return;
   }
 
@@ -1965,21 +1965,22 @@ void obj_pprint(obj_t *obj, obj_t *out)
   case LCONS:
     {
       obj_t *iter;
-      put_cchar(out, '(');
+      put_char(out, chr('('));
       for (iter = obj; consp(iter); iter = cdr(iter)) {
         obj_pprint(car(iter), out);
         if (nullp(cdr(iter))) {
-          put_cchar(out, ')');
+          put_char(out, chr(')'));
         } else if (consp(cdr(iter))) {
-          put_cchar(out, ' ');
+          put_char(out, chr(' '));
         } else {
-          put_cstring(out, L" . ");
+          put_string(out, lit(" . "));
           obj_pprint(cdr(iter), out);
-          put_cchar(out, ')');
+          put_char(out, chr(')'));
         }
       }
     }
     return;
+  case LIT:
   case STR:
     put_string(out, obj);
     return;
@@ -1987,36 +1988,36 @@ void obj_pprint(obj_t *obj, obj_t *out)
     put_char(out, obj);
     return;
   case NUM:
-    cformat(out, L"%ld", c_num(obj));
+    format(out, lit("~s"), obj, nao);
     return;
   case SYM:
     put_string(out, symbol_name(obj));
     return;
   case FUN:
-    cformat(out, L"#<function: f%d>", (int) obj->f.functype);
+    format(out, lit("#<function: f~a>"), num(obj->f.functype), nao);
     return;
   case VEC:
     {
       long i, fill = c_num(obj->v.vec[vec_fill]);
-      put_cstring(out, L"#(");
+      put_string(out, lit("#("));
       for (i = 0; i < fill; i++) {
         obj_pprint(obj->v.vec[i], out);
         if (i < fill - 1)
-          put_cchar(out, ' ');
+          put_char(out, chr(' '));
       }
-      put_cchar(out, ')');
+      put_char(out, chr(')'));
     }
     return;
   case LSTR:
     obj_pprint(obj->ls.prefix, out);
-    put_cstring(out, L"...");
+    put_string(out, lit("..."));
     return;
   case COBJ:
     obj->co.ops->print(obj, out);
     return;
   }
 
-  cformat(out, L"#<garbage: %p>", (void *) obj);
+  format(out, lit("#<garbage: ~p>"), (void *) obj, nao);
 }
 
 void init(const wchar_t *pn, void *(*oom)(void *, size_t),
@@ -2037,7 +2038,7 @@ void init(const wchar_t *pn, void *(*oom)(void *, size_t),
 void dump(obj_t *obj, obj_t *out)
 {
   obj_print(obj, out);
-  put_cchar(out, '\n');
+  put_char(out, chr('\n'));
 }
 
 /*