Merge branch 'iso-c-compliance'

blob.c

@@ -35,7 +35,7 @@ pic_blob_bytevector(pic_state *pic)
   pic_value *argv;
   size_t argc, i;
   pic_blob *blob;
-  char *data;
+  unsigned char *data;
 
   pic_get_args(pic, "*", &argc, &argv);
 
@@ -50,7 +50,7 @@ pic_blob_bytevector(pic_state *pic)
       pic_errorf(pic, "byte out of range");
     }
 
-    *data++ = pic_int(argv[i]);
+    *data++ = (unsigned char)pic_int(argv[i]);
   }
 
   return pic_obj_value(blob);
@@ -67,9 +67,12 @@ pic_blob_make_bytevector(pic_state *pic)
   if (b < 0 || b > 255)
     pic_errorf(pic, "byte out of range");
 
-  blob = pic_make_blob(pic, k);
+  if (k < 0)
+    pic_errorf(pic, "make-bytevector: cannot create a bytevector of length %d", k);
+
+  blob = pic_make_blob(pic, (size_t)k);
   for (i = 0; i < k; ++i) {
-    blob->data[i] = b;
+    blob->data[i] = (unsigned char)b;
   }
 
   return pic_obj_value(blob);
@@ -82,7 +85,7 @@ pic_blob_bytevector_length(pic_state *pic)
 
   pic_get_args(pic, "b", &bv);
 
-  return pic_int_value(bv->len);
+  return pic_int_value((int)bv->len);
 }
 
 static pic_value
@@ -107,7 +110,7 @@ pic_blob_bytevector_u8_set(pic_state *pic)
   if (v < 0 || v > 255)
     pic_errorf(pic, "byte out of range");
 
-  bv->data[k] = v;
+  bv->data[k] = (unsigned char)v;
   return pic_none_value();
 }
 
@@ -123,7 +126,7 @@ pic_blob_bytevector_copy_i(pic_state *pic)
   case 3:
     start = 0;
   case 4:
-    end = from->len;
+    end = (int)from->len;
   }
 
   if (to == from && (start <= at && at < end)) {
@@ -146,7 +149,7 @@ static pic_value
 pic_blob_bytevector_copy(pic_state *pic)
 {
   pic_blob *from, *to;
-  int n, start, end, i = 0;
+  int n, start, end, k, i = 0;
 
   n = pic_get_args(pic, "b|ii", &from, &start, &end);
 
@@ -154,10 +157,15 @@ pic_blob_bytevector_copy(pic_state *pic)
   case 1:
     start = 0;
   case 2:
-    end = from->len;
+    end = (int)from->len;
   }
 
-  to = pic_make_blob(pic, end - start);
+  k = end - start;
+
+  if (k < 0)
+    pic_errorf(pic, "make-bytevector: cannot create a bytevector of length %d", k);
+
+  to = pic_make_blob(pic, (size_t)k);
   while (start < end) {
     to->data[i++] = from->data[start++];
   }
@@ -197,12 +205,12 @@ static pic_value
 pic_blob_list_to_bytevector(pic_state *pic)
 {
   pic_blob *blob;
-  char *data;
+  unsigned char *data;
   pic_value list, e;
 
   pic_get_args(pic, "o", &list);
 
-  blob = pic_make_blob(pic, pic_length(pic, list));
+  blob = pic_make_blob(pic, (size_t)pic_length(pic, list));
 
   data = blob->data;
 
@@ -212,7 +220,7 @@ pic_blob_list_to_bytevector(pic_state *pic)
     if (pic_int(e) < 0 || pic_int(e) > 255)
       pic_errorf(pic, "byte out of range");
 
-    *data++ = pic_int(e);
+    *data++ = (unsigned char)pic_int(e);
   }
   return pic_obj_value(blob);
 }
@@ -230,7 +238,7 @@ pic_blob_bytevector_to_list(pic_state *pic)
   case 1:
     start = 0;
   case 2:
-    end = blob->len;
+    end = (int)blob->len;
   }
 
   list = pic_nil_value();

char.c

@@ -31,7 +31,11 @@ pic_char_integer_to_char(pic_state *pic)
 
   pic_get_args(pic, "i", &i);
 
-  return pic_char_value(i);
+  if (i < 0 || i > 127) {
+    pic_errorf(pic, "integer->char: integer out of char range: %d", i);
+  }
+
+  return pic_char_value((char)i);
 }
 
 #define DEFINE_CHAR_CMP(op, name)			\

dict.c

@@ -35,7 +35,7 @@ xh_value_hash(const void *key, void *data)
     break;
   }
 
-  return hash + pic_vtype(val);
+  return hash + (int)pic_vtype(val);
 }
 
 static int
@@ -213,7 +213,7 @@ pic_dict_dictionary_size(pic_state *pic)
 
   pic_get_args(pic, "d", &dict);
 
-  return pic_int_value(pic_dict_size(pic, dict));
+  return pic_int_value((int)pic_dict_size(pic, dict));
 }
 
 static pic_value

gc.c

@@ -706,7 +706,7 @@ gc_sweep_page(pic_state *pic, struct heap_page *page)
 #else
   static union header *NIL = NULL;
 #endif
-  union header *bp, *p, *s = NIL, *t;
+  union header *bp, *p, *s = NIL, *t = NIL;
 
 #if GC_DEBUG
   int c = 0;

include/picrin/blob.h

@@ -11,7 +11,7 @@ extern "C" {
 
 struct pic_blob {
   PIC_OBJECT_HEADER
-  char *data;
+  unsigned char *data;
   size_t len;
 };
 

include/picrin/cont.h

@@ -19,7 +19,7 @@ struct pic_escape {
   ptrdiff_t sp_offset;
   ptrdiff_t ci_offset;
   ptrdiff_t xp_offset;
-  int arena_idx;
+  size_t arena_idx;
 
   pic_code *ip;
 

include/picrin/data.h

@@ -16,7 +16,7 @@ typedef struct {
 } pic_data_type;
 
 struct pic_data {
-  PIC_OBJECT_HEADER;
+  PIC_OBJECT_HEADER
   const pic_data_type *type;
   xhash storage;                /* const char * to pic_value table */
   void *data;

include/picrin/value.h

@@ -10,10 +10,10 @@ extern "C" {
 #endif
 
 /**
- * pic_sym is just an alias of uint32_t.
+ * pic_sym is just an alias of int.
  */
 
-typedef uint32_t pic_sym;
+typedef int pic_sym;
 
 /**
  * `undef` values never seen from user-end: that is,
@@ -71,7 +71,14 @@ pic_int(pic_value v)
   return u.i;
 }
 
-#define pic_sym(v) ((v) & 0xfffffffful)
+static inline int
+pic_sym(pic_value v)
+{
+  union { int i; unsigned u; } u;
+  u.u = v & 0xfffffffful;
+  return u.i;
+}
+
 #define pic_char(v) ((v) & 0xfffffffful)
 
 #else
@@ -215,9 +222,9 @@ pic_type(pic_value v)
     return PIC_TT_EOF;
   case PIC_VTYPE_HEAP:
     return ((struct pic_object *)pic_ptr(v))->tt;
-  default:
-    return -1;                  /* logic flaw */
   }
+
+  UNREACHABLE();
 }
 
 static inline const char *
@@ -357,10 +364,13 @@ pic_int_value(int i)
 static inline pic_value
 pic_symbol_value(pic_sym sym)
 {
+  union { int i; unsigned u; } u;
   pic_value v;
 
+  u.i = sym;
+
   pic_init_value(v, PIC_VTYPE_SYMBOL);
-  v |= sym;
+  v |= u.u;
   return v;
 }
 

include/picrin/xfile.h

@@ -111,7 +111,7 @@ xf_file_read(void *cookie, char *ptr, int size)
   FILE *file = cookie;
   int r;
 
-  r = fread(ptr, 1, size, file);
+  r = (int)fread(ptr, 1, (size_t)size, file);
   if (r < size && ferror(file)) {
     return -1;
   }
@@ -127,7 +127,7 @@ xf_file_write(void *cookie, const char *ptr, int size)
   FILE *file = cookie;
   int r;
 
-  r = fwrite(ptr, 1, size, file);
+  r = (int)fwrite(ptr, 1, (size_t)size, file);
   if (r < size) {
     return -1;
   }
@@ -212,8 +212,8 @@ xf_mem_read(void *cookie, char *ptr, int size)
 
   mem = (struct xf_membuf *)cookie;
 
-  if (size > mem->end - mem->pos)
+  if (size > (int)(mem->end - mem->pos))
-    size = mem->end - mem->pos;
+    size = (int)(mem->end - mem->pos);
   memcpy(ptr, mem->buf + mem->pos, size);
   mem->pos += size;
   return size;
@@ -228,7 +228,7 @@ xf_mem_write(void *cookie, const char *ptr, int size)
 
   if (mem->pos + size >= mem->capa) {
     mem->capa = (mem->pos + size) * 2;
-    mem->buf = realloc(mem->buf, mem->capa);
+    mem->buf = realloc(mem->buf, (size_t)mem->capa);
   }
   memcpy(mem->buf + mem->pos, ptr, size);
   mem->pos += size;
@@ -344,12 +344,12 @@ xfread(void *ptr, size_t block, size_t nitems, xFILE *file)
   for (i = 0; i < nitems; ++i) {
     offset = 0;
     if (file->ungot != -1 && block > 0) {
-      buf[0] = file->ungot;
+      buf[0] = (char)file->ungot;
       offset += 1;
       file->ungot = -1;
     }
     while (offset < block) {
-      n = file->vtable.read(file->vtable.cookie, buf + offset, block - offset);
+      n = file->vtable.read(file->vtable.cookie, buf + offset, (int)(block - offset));
       if (n < 0) {
         file->flags |= XF_ERR;
         goto exit;
@@ -358,7 +358,7 @@ xfread(void *ptr, size_t block, size_t nitems, xFILE *file)
         file->flags |= XF_EOF;
         goto exit;
       }
-      offset += n;
+      offset += (unsigned)n;
     }
     memcpy(dst, buf, block);
     dst += block;
@@ -378,12 +378,12 @@ xfwrite(const void *ptr, size_t block, size_t nitems, xFILE *file)
   for (i = 0; i < nitems; ++i) {
     offset = 0;
     while (offset < block) {
-      n = file->vtable.write(file->vtable.cookie, dst + offset, block - offset);
+      n = file->vtable.write(file->vtable.cookie, dst + offset, (int)(block - offset));
       if (n < 0) {
         file->flags |= XF_ERR;
         goto exit;
       }
-      offset += n;
+      offset += (unsigned)n;
     }
     dst += block;
   }
@@ -458,7 +458,7 @@ xfgets(char *str, int size, xFILE *file)
     if ((c = xfgetc(file)) == EOF) {
       break;
     }
-    str[i] = c;
+    str[i] = (char)c;
   }
   if (i == 0 && c == EOF) {
     return NULL;
@@ -492,7 +492,7 @@ xfputc(int c, xFILE *file)
 {
   char buf[1];
 
-  buf[0] = c;
+  buf[0] = (char)c;
   xfwrite(buf, 1, 1, file);
 
   if (xferror(file)) {
@@ -516,7 +516,7 @@ xputchar(int c)
 static inline int
 xfputs(const char *str, xFILE *file)
 {
-  int len;
+  size_t len;
 
   len = strlen(str);
   xfwrite(str, len, 1, file);
@@ -573,7 +573,7 @@ xvfprintf(xFILE *stream, const char *fmt, va_list ap)
     }
 
     va_end(ap2);
-    return sizeof buf;
+    return (int)(sizeof buf);
   }
 }
 

include/picrin/xhash.h

@@ -21,7 +21,7 @@ extern "C" {
 #define XHASH_RESIZE_RATIO 0.75
 
 #define XHASH_ALIGNMENT 3       /* quad word alignment */
-#define XHASH_MASK (~((1 << XHASH_ALIGNMENT) - 1))
+#define XHASH_MASK (~(size_t)((1 << XHASH_ALIGNMENT) - 1))
 #define XHASH_ALIGN(i) ((((i) - 1) & XHASH_MASK) + (1 << XHASH_ALIGNMENT))
 
 typedef struct xh_entry {
@@ -325,7 +325,7 @@ xh_ptr_hash(const void *key, void *data)
 {
   (void)data;
 
-  return (size_t)*(const void **)key;
+  return (int)(size_t)*(const void **)key;
 }
 
 static inline int

include/picrin/xvect.h

@@ -45,7 +45,7 @@ xv_init(xvect *x, size_t width)
   x->data = NULL;
   x->width = width;
   x->size = 0;
-  x->mask = -1;
+  x->mask = (size_t)-1;
   x->head = 0;
   x->tail = 0;
 }

number.c

@@ -271,7 +271,7 @@ pic_number_abs(pic_state *pic)
   pic_get_args(pic, "F", &f, &e);
 
   if (e) {
-    return pic_int_value(fabs(f));
+    return pic_int_value(abs((int)f));
   }
   else {
     return pic_float_value(fabs(f));
@@ -283,17 +283,23 @@ pic_number_floor2(pic_state *pic)
 {
   int i, j;
   bool e1, e2;
-  double q, r;
 
   pic_get_args(pic, "II", &i, &e1, &j, &e2);
 
-  q = floor((double)i/j);
-  r = i - j * q;
-
   if (e1 && e2) {
-    return pic_values2(pic, pic_int_value(q), pic_int_value(r));
+    int k;
+
+    k = (i < 0 && j < 0) || (0 <= i && 0 <= j)
+      ? i / j
+      : (i / j) - 1;
+
+    return pic_values2(pic, pic_int_value(k), pic_int_value(i - k * j));
   }
   else {
+    double q, r;
+
+    q = floor((double)i/j);
+    r = i - j * q;
     return pic_values2(pic, pic_float_value(q), pic_float_value(r));
   }
 }
@@ -303,17 +309,18 @@ pic_number_trunc2(pic_state *pic)
 {
   int i, j;
   bool e1, e2;
-  double q, r;
 
   pic_get_args(pic, "II", &i, &e1, &j, &e2);
 
+  if (e1 && e2) {
+    return pic_values2(pic, pic_int_value(i/j), pic_int_value(i - (i/j) * j));
+  }
+  else {
+    double q, r;
+
     q = trunc((double)i/j);
     r = i - j * q;
 
-  if (e1 && e2) {
-    return pic_values2(pic, pic_int_value(q), pic_int_value(r));
-  }
-  else {
     return pic_values2(pic, pic_float_value(q), pic_float_value(r));
   }
 }
@@ -516,7 +523,7 @@ pic_number_exact(pic_state *pic)
 
   pic_get_args(pic, "f", &f);
 
-  return pic_int_value((int)round(f));
+  return pic_int_value((int)(round(f)));
 }
 
 static pic_value
@@ -564,7 +571,7 @@ pic_number_string_to_number(pic_state *pic)
   num = strtol(str, &eptr, radix);
   if (*eptr == '\0') {
     return pic_valid_int(num)
-      ? pic_int_value(num)
+      ? pic_int_value((int)num)
       : pic_float_value(num);
   }
 

port.c

@@ -87,12 +87,12 @@ pic_open_output_string(pic_state *pic)
 struct pic_string *
 pic_get_output_string(pic_state *pic, struct pic_port *port)
 {
-  long size;
+  size_t size;
   char *buf;
 
   /* get endpos */
   xfflush(port->file);
-  size = xftell(port->file);
+  size = (size_t)xftell(port->file);
   xrewind(port->file);
 
   /* copy to buf */
@@ -347,7 +347,7 @@ pic_port_get_output_bytevector(pic_state *pic)
 {
   struct pic_port *port = pic_stdout(pic);
   pic_blob *blob;
-  long endpos;
+  size_t size;
 
   pic_get_args(pic, "|p", &port);
 
@@ -355,12 +355,12 @@ pic_port_get_output_bytevector(pic_state *pic)
 
   /* get endpos */
   xfflush(port->file);
-  endpos = xftell(port->file);
+  size = (size_t)xftell(port->file);
   xrewind(port->file);
 
   /* copy to buf */
-  blob = pic_make_blob(pic, endpos);
+  blob = pic_make_blob(pic, size);
-  xfread(blob->data, 1, endpos, port->file);
+  xfread(blob->data, 1, size, port->file);
 
   return pic_obj_value(blob);
 }
@@ -521,15 +521,20 @@ pic_port_read_blob(pic_state *pic)
 {
   struct pic_port *port = pic_stdin(pic);
   pic_blob *blob;
-  int k, i;
+  int k;
+  size_t i;
 
   pic_get_args(pic, "i|p", &k, &port);
 
   assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector");
 
-  blob = pic_make_blob(pic, k);
+  if (k < 0) {
+    pic_errorf(pic, "read-bytevector: index must be non-negative %d", k);
+  }
 
-  i = xfread(blob->data, sizeof(char), k, port->file);
+  blob = pic_make_blob(pic, (size_t)k);
+
+  i = xfread(blob->data, sizeof(char), (size_t)k, port->file);
   if (i == 0) {
     return pic_eof_object();
   }
@@ -545,8 +550,9 @@ pic_port_read_blob_ip(pic_state *pic)
 {
   struct pic_port *port;
   struct pic_blob *bv;
-  int i, n, start, end, len;
+  int n, start, end;
   char *buf;
+  size_t i, len;
 
   n = pic_get_args(pic, "b|pii", &bv, &port, &start, &end);
   switch (n) {
@@ -555,11 +561,16 @@ pic_port_read_blob_ip(pic_state *pic)
   case 2:
     start = 0;
   case 3:
-    end = bv->len;
+    end = (int)bv->len;
   }
 
   assert_port_profile(port, PIC_PORT_IN | PIC_PORT_BINARY, PIC_PORT_OPEN, "read-bytevector!");
-  len = end - start;
+
+  if (end - start < 0) {
+    pic_errorf(pic, "read-bytevector!: end index must be greater than or equal to start index");
+  }
+
+  len = (size_t)(end - start);
 
   buf = pic_calloc(pic, len, sizeof(char));
   i = xfread(buf, sizeof(char), len, port->file);
@@ -570,7 +581,7 @@ pic_port_read_blob_ip(pic_state *pic)
     return pic_eof_object();
   }
   else {
-    return pic_int_value(i);
+    return pic_int_value((int)i);
   }
 }
 
@@ -654,7 +665,7 @@ pic_port_write_blob(pic_state *pic)
   case 2:
     start = 0;
   case 3:
-    end = blob->len;
+    end = (int)blob->len;
   }
 
   assert_port_profile(port, PIC_PORT_OUT | PIC_PORT_BINARY, PIC_PORT_OPEN, "write-bytevector");

symbol.c

@@ -57,7 +57,7 @@ pic_gensym(pic_state *pic, pic_sym base)
   }
 
   len = snprintf(NULL, 0, "%s%c%d", pic_symbol_name(pic, base), mark, uid);
-  str = pic_alloc(pic, len + 1);
+  str = pic_alloc(pic, (size_t)len + 1);
   sprintf(str, "%s%c%d", pic_symbol_name(pic, base), mark, uid);
 
   /* don't put the symbol to pic->syms to keep it uninterned */

time.c

@@ -27,7 +27,7 @@ pic_current_jiffy(pic_state *pic)
   pic_get_args(pic, "");
 
   c = clock();
-  return pic_int_value(c);
+  return pic_int_value((int)c);
 }
 
 static pic_value

var.c

@@ -37,7 +37,7 @@ var_call(pic_state *pic)
 {
   struct pic_proc *self = pic_get_proc(pic);
   pic_value val, tmp, box, conv;
-  size_t n;
+  int n;
 
   n = pic_get_args(pic, "|oo", &val, &tmp);
 

write.c

@@ -211,7 +211,7 @@ write_core(struct writer_control *p, pic_value obj)
   size_t i;
   xh_entry *e, *it;
   int c;
-  float f;
+  double f;
 
   /* shared objects */
   if (pic_vtype(obj) == PIC_VTYPE_HEAP