diff --git a/build-aux/GNUmakefile.in b/build-aux/GNUmakefile.in index b6c9e49c..a4c39601 100644 --- a/build-aux/GNUmakefile.in +++ b/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 diff --git a/include/mes/lib.h b/include/mes/lib.h index a78d5bb6..6074d0c9 100644 --- a/include/mes/lib.h +++ b/include/mes/lib.h @@ -23,18 +23,12 @@ #include -char* cast_intp_to_charp (int const *i); -char* cast_long_to_charp (long i); +char *cast_intp_to_charp (int const *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); diff --git a/include/mes/mes.h b/include/mes/mes.h index dc8dab55..a0fed07f 100644 --- a/include/mes/mes.h +++ b/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); diff --git a/lib/m2/cast.c b/lib/m2/cast.c index 6c6fe969..60aba048 100644 --- a/lib/m2/cast.c +++ b/lib/m2/cast.c @@ -20,12 +20,6 @@ #include -#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) { diff --git a/src/builtins.c b/src/builtins.c index e02beff4..0cc9ec46 100644 --- a/src/builtins.c +++ b/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 * diff --git a/src/cc.c b/src/cc.c index 1ab604df..98f93afb 100644 --- a/src/cc.c +++ b/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; +} diff --git a/src/display.c b/src/display.c index adf230ac..0d6db3a0 100644 --- a/src/display.c +++ b/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; diff --git a/src/gc.c b/src/gc.c index 47b47539..57b7359d 100644 --- a/src/gc.c +++ b/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_stack_array = g_arena + arena_bytes; + g_cells = cast_charp_to_scmp (g_arena); + 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 d = src->cdr; + long a = src->car_value; + 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 a = g_arena; + long i = cast_scmp_to_long (r); + 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 d = cells->cdr; + long a = cells->car_value; + long d = cells->cdr_value; if (size == 0) dumps ("0 0 0"); else diff --git a/src/lib.c b/src/lib.c index 2560e0db..c0f2ad87 100644 --- a/src/lib.c +++ b/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 * diff --git a/src/m2.c b/src/m2.c index 93db9757..4c8500b3 100644 --- a/src/m2.c +++ b/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; +} diff --git a/src/mes.c b/src/mes.c index 53b11adf..ae4f4ac1 100644 --- a/src/mes.c +++ b/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; - if (p = getenv ("MES_DEBUG")) + char *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 (); } diff --git a/src/reader.c b/src/reader.c index 8fbb9436..087fae24 100644 --- a/src/reader.c +++ b/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 ()); } diff --git a/src/string.c b/src/string.c index 68a14b39..6b3b3bbb 100644 --- a/src/string.c +++ b/src/string.c @@ -25,7 +25,7 @@ #include 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; - eputs (string); + char *p = cast_voidp_to_charp (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; } diff --git a/src/symbol.c b/src/symbol.c index c54ac424..c9598ff6 100644 --- a/src/symbol.c +++ b/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); }