core: Use casting functions.

Silence all casting errors by using casting functions.

* src/cc.c (cast_charp_to_scmp, cast_charp_to_scmpp,
cast_voidp_to_charp, cast_scmp_to_long, cast_scmp_to_charp): New function.
* src/m2.c (cast_charp_to_scmp, cast_charp_to_scmpp,
cast_voidp_to_charp, cast_scmp_to_long, cast_scmp_to_charp): New function.
* include/mes/mes.h: Declare them.
(struct scm): Add car_value, cdr_value, function.
(g_continuations): Change to long.
* src/mes.c: Silence all casting errors by using casting functions.

build-aux/GNUmakefile.in

@@ -135,7 +135,7 @@ maintainer-clean: distclean
 	rm -f doc/version.texi
 
 TAGS:
-	etags ${srcdest}lib/*.c ${srcdest}lib/*/*.c ${srcdest}src/*.c ${srcdest}include/*.h ${srcdest}include/sys/*.h
+	etags ${srcdest}lib/*.c ${srcdest}lib/*/*.c ${srcdest}src/*.c ${srcdest}include/*.h ${srcdest}include/*/*.h ${srcdest}include/sys/*.h
 
 all-go:
 	${srcdest}build-aux/build-guile.sh

include/mes/lib.h

@@ -23,18 +23,12 @@
 
 #include <mes/lib-mini.h>
 
-char* cast_intp_to_charp (int const *i);
+char *cast_intp_to_charp (int const *i);
-char* cast_long_to_charp (long i);
+char *cast_long_to_charp (long i);
 long cast_charp_to_long (char const *);
 long cast_int_to_long (int i);
 long cast_voidp_to_long (void const *);
 
-// #define cast_intp_to_charp(x) ((char*) x)
-// #define cast_long_to_charp(x) ((char*) x)
-// #define cast_charp_to_long(x) ((long) x)
-// #define cast_int_to_long(x) ((long) x)
-// #define cast_voidp_to_long(x) ((long) x)
-
 int __mes_debug ();
 void __ungetc_init ();
 void __ungetc_clear (int filedes);

include/mes/mes.h

@@ -30,6 +30,7 @@ struct scm
   union
   {
     struct scm *car;
+    long car_value;
     char *bytes;
     long length;
     struct scm *ref;
@@ -40,12 +41,14 @@ struct scm
   union
   {
     struct scm *cdr;
+    long cdr_value;
     struct scm *closure;
     struct scm *continuation;
     char *name;
     struct scm *string;
     struct scm *structure;
     long value;
+    FUNCTION function;
     struct scm *vector;
   };
 };
@@ -54,7 +57,7 @@ struct scm
 char *g_datadir;
 int g_debug;
 char *g_buf;
-struct scm *g_continuations;
+int g_continuations;
 struct scm *g_symbols;
 struct scm *g_symbol_max;
 int g_mini;
@@ -102,6 +105,12 @@ struct timespec *g_start_time;
 struct timeval *__gettimeofday_time;
 struct timespec *__get_internal_run_time_ts;
 
+struct scm *cast_charp_to_scmp (char const *i);
+struct scm **cast_charp_to_scmpp (char const *i);
+char *cast_voidp_to_charp (void const *i);
+long cast_scmp_to_long (struct scm *i);
+char *cast_scmp_to_charp (struct scm *i);
+
 struct scm *alloc (long n);
 struct scm *apply (struct scm *f, struct scm *x, struct scm *a);
 struct scm *apply_builtin (struct scm *fn, struct scm *x);
@@ -119,6 +128,8 @@ struct scm *init_time (struct scm *a);
 struct scm *make_builtin_type ();
 struct scm *make_bytes (char const *s, size_t length);
 struct scm *make_cell (long type, struct scm *car, struct scm *cdr);
+struct scm *make_pointer_cell (long type, long car, void *cdr);
+struct scm *make_value_cell (long type, long car, long cdr);
 struct scm *make_char (int n);
 struct scm *make_continuation (long n);
 struct scm *make_hash_table_ (long size);
@@ -146,7 +157,7 @@ int unreadchar ();
 long gc_free ();
 long length__ (struct scm *x);
 size_t bytes_cells (size_t length);
-void assert_max_string (size_t i, char const *msg, char *string);
+void assert_max_string (size_t i, char const *msg, char const *string);
 void assert_msg (int check, char *msg);
 void assert_number (char const *name, struct scm *x);
 void copy_cell (struct scm *to, struct scm *from);

lib/m2/cast.c

@@ -20,12 +20,6 @@
 
 #include <mes/lib.h>
 
-#undef cast_intp_to_charp
-#undef cast_long_to_charp
-#undef cast_charp_to_long
-#undef cast_int_to_long
-#undef cast_voidp_to_long
-
 char*
 cast_intp_to_charp (int const *i)
 {

src/builtins.c

@@ -61,7 +61,7 @@ FUNCTION
 builtin_function (struct scm *builtin)
 {
   struct scm *x = struct_ref_ (builtin, 5);
-  return x->value;
+  return x->function;
 }
 
 struct scm *
@@ -98,12 +98,13 @@ builtin_printer (struct scm *builtin)
 }
 
 struct scm *
-init_builtin (struct scm *builtin_type, char const *name, int arity, FUNCTION function, struct scm *a)
+init_builtin (struct scm *builtin_type, char const *name, int arity, void* function, struct scm *a)
 {
   struct scm *s = cstring_to_symbol (name);
+  long n = cast_voidp_to_long (function);
   return acons (s,
                 make_builtin (builtin_type, symbol_to_string (s), make_number (arity),
-                              make_number (function)), a);
+                              make_number (n)), a);
 }
 
 struct scm *

src/cc.c

@@ -48,3 +48,39 @@ apply_builtin3 (struct scm *fn, struct scm *x, struct scm *y, struct scm *z)
   struct scm *(*fp) (struct scm *, struct scm *, struct scm *) = (function3_t) builtin_function (fn);
   return fp (x, y, z);
 }
+
+#undef cast_charp_to_scmp
+#undef cast_charp_to_scmpp
+#undef cast_voidp_to_charp
+#undef cast_scmp_to_long
+#undef cast_scmp_to_charp
+
+struct scm *
+cast_charp_to_scmp (char const *i)
+{
+  return (struct scm *)i;
+}
+
+struct scm **
+cast_charp_to_scmpp (char const *i)
+{
+  return (struct scm **)i;
+}
+
+char*
+cast_voidp_to_charp (void const *i)
+{
+  return (char*)i;
+}
+
+long
+cast_scmp_to_long (struct scm *i)
+{
+  return (long)i;
+}
+
+char*
+cast_scmp_to_charp (struct scm *i)
+{
+  return (char*)i;
+}

src/display.c

@@ -251,7 +251,7 @@ display_helper (struct scm *x, int cont, char *sep, int fd, int write_p)
       fdputs ("<", fd);
       fdputs (itoa (t), fd);
       fdputs (":", fd);
-      fdputs (itoa (x), fd);
+      fdputs (ltoa (cast_voidp_to_long (x)), fd);
       fdputs (">", fd);
     }
   return cell_unspecified;

src/gc.c

@@ -34,14 +34,14 @@ int g_dump_filedes;
 char *
 cell_bytes (struct scm *x)
 {
-  char *p = x;
+  char *p = cast_voidp_to_charp (x);
   return p + (2 * sizeof (long));
 }
 
 char *
 news_bytes (struct scm *x)
 {
-  char *p = x;
+  char *p = cast_voidp_to_charp (x);
   return p + (2 * sizeof (long));
 }
 
@@ -88,8 +88,8 @@ gc_init ()
   long alloc_bytes = arena_bytes + (STACK_SIZE * sizeof (struct scm));
 
   g_arena = malloc (alloc_bytes);
-  g_cells = g_arena;
+  g_cells = cast_charp_to_scmp (g_arena);
-  g_stack_array = g_arena + arena_bytes;
+  g_stack_array = cast_charp_to_scmpp (g_arena + arena_bytes);
 
   /* The vector that holds the arenea. */
   cell_arena = g_cells;
@@ -149,13 +149,43 @@ make_cell (long type, struct scm *car, struct scm *cdr)
   long i = g_free - g_cells;
   i = i / M2_CELL_SIZE;
   if (i > ARENA_SIZE)
-    assert_msg (0, "alloc: out of memory");
+    assert_msg (0, "make_cell: out of memory");
   x->type = type;
   x->car = car;
   x->cdr = cdr;
   return x;
 }
 
+struct scm *
+make_pointer_cell (long type, long car, void *cdr)
+{
+  struct scm *x = g_free;
+  g_free = g_free + M2_CELL_SIZE;
+  long i = g_free - g_cells;
+  i = i / M2_CELL_SIZE;
+  if (i > ARENA_SIZE)
+    assert_msg (0, "make_pointer_cell: out of memory");
+  x->type = type;
+  x->length = car;
+  x->cdr = cdr;
+  return x;
+}
+
+struct scm *
+make_value_cell (long type, long car, long cdr)
+{
+  struct scm *x = g_free;
+  g_free = g_free + M2_CELL_SIZE;
+  long i = g_free - g_cells;
+  i = i / M2_CELL_SIZE;
+  if (i > ARENA_SIZE)
+    assert_msg (0, "make_value_cell: out of memory");
+  x->type = type;
+  x->length = car;
+  x->value = cdr;
+  return x;
+}
+
 void
 copy_cell (struct scm *to, struct scm *from)
 {
@@ -215,13 +245,13 @@ make_bytes (char const *s, size_t length)
 struct scm *
 make_char (int n)
 {
-  return make_cell (TCHAR, 0, n);
+  return make_value_cell (TCHAR, 0, n);
 }
 
 struct scm *
 make_continuation (long n)
 {
-  return make_cell (TCONTINUATION, n, g_stack);
+  return make_value_cell (TCONTINUATION, n, g_stack);
 }
 
 struct scm *
@@ -233,7 +263,7 @@ make_macro (struct scm *name, struct scm *x)    /*:((internal)) */
 struct scm *
 make_number (long n)
 {
-  return make_cell (TNUMBER, 0, n);
+  return make_value_cell (TNUMBER, 0, n);
 }
 
 struct scm *
@@ -247,7 +277,7 @@ make_string (char const *s, size_t length)
 {
   if (length > MAX_STRING)
     assert_max_string (length, "make_string", s);
-  struct scm *x = make_cell (TSTRING, length, 0);
+  struct scm *x = make_pointer_cell (TSTRING, length, 0);
   struct scm *v = make_bytes (s, length + 1);
   x->cdr = v;
   return x;
@@ -262,7 +292,7 @@ make_string0 (char const *s)
 struct scm *
 make_string_port (struct scm *x)        /*:((internal)) */
 {
-  return make_cell (TPORT, -length__ (g_ports) - 2, x);
+  return make_pointer_cell (TPORT, -length__ (g_ports) - 2, x);
 }
 
 void
@@ -301,7 +331,7 @@ gc_up_arena ()
   if (p == 0)
     {
       eputs ("realloc failed, g_free=");
-      eputs (ltoa (g_free));
+      eputs (ltoa (cast_voidp_to_long (g_free)));
       eputs (":");
       long i = g_free - g_cells;
       i = i / M2_CELL_SIZE;
@@ -334,8 +364,8 @@ gc_cellcpy (struct scm *dest, struct scm *src, size_t n)
   while (n != 0)
     {
       long t = src->type;
-      long a = src->car;
+      long a = src->car_value;
-      long d = src->cdr;
+      long d = src->cdr_value;
       dest->type = t;
       if (t == TBROKEN_HEART)
         assert_msg (0, "gc_cellcpy: broken heart");
@@ -343,9 +373,9 @@ gc_cellcpy (struct scm *dest, struct scm *src, size_t n)
           || t == TPAIR
           || t == TREF
           || t == TVARIABLE)
-        dest->car = a - dist;
+        dest->car_value = a - dist;
       else
-        dest->car = a;
+        dest->car_value = a;
       if (t == TBYTES
           || t == TCLOSURE
           || t == TCONTINUATION
@@ -359,21 +389,21 @@ gc_cellcpy (struct scm *dest, struct scm *src, size_t n)
           || t == TSYMBOL
           || t == TVALUES
           || t == TVECTOR)
-        dest->cdr = d - dist;
+        dest->cdr_value = d - dist;
       else
-        dest->cdr = d;
+        dest->cdr_value = d;
       if (t == TBYTES)
         {
           if (g_debug > 5)
             {
               eputs ("copying bytes[");
-              eputs (ntoab (cell_bytes (src), 16, 0));
+              eputs (ntoab (cast_voidp_to_long (cell_bytes (src)), 16, 0));
               eputs (", ");
               eputs (ntoab (a, 10, 0));
               eputs ("]: ");
               eputs (cell_bytes (src));
               eputs ("\n to [");
-              eputs (ntoab (cell_bytes (dest), 16, 0));
+              eputs (ntoab (cast_voidp_to_long (cell_bytes (dest)), 16, 0));
             }
           memcpy (cell_bytes (dest), cell_bytes (src), a);
           if (g_debug > 5)
@@ -555,16 +585,17 @@ gc_ ()
     }
   g_free = g_news + M2_CELL_SIZE;
 
-  if (ARENA_SIZE < MAX_ARENA_SIZE && g_cells == g_arena + M2_CELL_SIZE)
+  if (ARENA_SIZE < MAX_ARENA_SIZE
+      && cast_voidp_to_charp (g_cells) == g_arena + M2_CELL_SIZE)
     {
       if (g_debug == 2)
         eputs ("+");
       if (g_debug > 2)
         {
           eputs (" up[");
-          eputs (ltoa (g_cells));
+          eputs (ltoa (cast_voidp_to_long (g_cells)));
           eputs (",");
-          eputs (ltoa (g_news));
+          eputs (ltoa (cast_voidp_to_long (g_news)));
           eputs (":");
           eputs (ltoa (ARENA_SIZE));
           eputs (",");
@@ -668,8 +699,8 @@ void
 gc_dump_register (char const* n, struct scm *r)
 {
   dumps (n); dumps (": ");
-  long i = r;
+  long i = cast_scmp_to_long (r);
-  long a = g_arena;
+  long a = cast_charp_to_long (g_arena);
   i = i - a;
   i = i / M2_CELL_SIZE;
   dumps (ltoa (i));
@@ -725,8 +756,8 @@ gc_dump_arena (struct scm *cells, long size)
       for (i=0; i < 16; i = i + 1)
         {
           long t = cells->type;
-          long a = cells->car;
+          long a = cells->car_value;
-          long d = cells->cdr;
+          long d = cells->cdr_value;
           if (size == 0)
             dumps ("0 0 0");
           else

src/lib.c

@@ -41,7 +41,7 @@ car_ (struct scm *x)
   struct scm *a = x->car;
   if (x->type == TPAIR)
     return a;
-  return make_number (a);
+  return make_number (cast_scmp_to_long (a));
 }
 
 struct scm *
@@ -50,7 +50,7 @@ cdr_ (struct scm *x)
   struct scm *d = x->cdr;
   if (x->type == TPAIR || x->type == TCLOSURE)
     return d;
-  return make_number (d);
+  return make_number (cast_scmp_to_long (d));
 }
 
 struct scm *

src/m2.c

@@ -48,3 +48,39 @@ apply_builtin3 (struct scm *fn, struct scm *x, struct scm *y, struct scm *z)
   FUNCTION fp = builtin_function (fn);
   return fp (x, y, z);
 }
+
+#undef cast_charp_to_scmp
+#undef cast_charp_to_scmpp
+#undef cast_voidp_to_charp
+#undef cast_scmp_to_long
+#undef cast_scmp_to_charp
+
+struct scm *
+cast_charp_to_scmp (char const *i)
+{
+  return i;
+}
+
+struct scm **
+cast_charp_to_scmpp (char const *i)
+{
+  return i;
+}
+
+char*
+cast_voidp_to_charp (void const *i)
+{
+  return i;
+}
+
+long
+cast_scmp_to_long (struct scm *i)
+{
+  return i;
+}
+
+char*
+cast_scmp_to_charp (struct scm *i)
+{
+  return i;
+}

src/mes.c

@@ -172,10 +172,10 @@ init (char **envp)
   g_start_time = malloc (sizeof (struct timespec));
   memset (g_start_time, 0, sizeof (struct timespec));
 
-  char *p;
+  char *p = getenv ("MES_DEBUG");
-  if (p = getenv ("MES_DEBUG"))
+  if (p != 0)
     g_debug = atoi (p);
-  g_mini = getenv ("MES_MINI");
+  g_mini = cast_charp_to_long (getenv ("MES_MINI"));
   open_boot ();
   gc_init ();
 }

src/reader.c

@@ -201,7 +201,10 @@ reader_read_block_comment (int s, int c)
 {
   if (c == s)
     if (peekchar () == '#')
-      return readchar ();
+      {
+        readchar ();
+        return cell_unspecified;
+      }
   return reader_read_block_comment (s, readchar ());
 }
 

src/string.c

@@ -25,7 +25,7 @@
 #include <string.h>
 
 void
-assert_max_string (size_t i, char const *msg, char *string)
+assert_max_string (size_t i, char const *msg, char const *string)
 {
   if (i > MAX_STRING)
     {
@@ -33,8 +33,9 @@ assert_max_string (size_t i, char const *msg, char *string)
       eputs (":string too long[");
       eputs (itoa (i));
       eputs ("]:");
-      string[MAX_STRING - 1] = 0;
+      char *p = cast_voidp_to_charp (string);
-      eputs (string);
+      p[MAX_STRING - 1] = 0;
+      eputs (p);
       error (cell_symbol_system_error, cell_f);
     }
 }
@@ -121,7 +122,7 @@ string_to_symbol (struct scm *string)
 struct scm *
 make_symbol (struct scm *string)
 {
-  struct scm *x = make_cell (TSYMBOL, string->length, string->string);
+  struct scm *x = make_pointer_cell (TSYMBOL, string->length, string->string);
   hash_set_x (g_symbols, string, x);
   return x;
 }

src/symbol.c

@@ -45,7 +45,7 @@ init_symbol (struct scm *x, long type, char const *name)
     {
       int length = strlen (name);
       struct scm *string = make_string (name, length);
-      x->car = length;
+      x->car_value = length;
       x->cdr = string->string;
       hash_set_x (g_symbols, string, x);
     }