mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 14:19:18 +02:00
Cleanup for more pedantic C.
Notably no longer converting from function pointers <-> void*. Remaining --pedantic warnings: * ISO C90 does not support 'long long' * ISO C90 does not support the 'z' printf length modifier * ISO C90 does not support flexible array members * ISO C90 forbids mixed declarations and code * ISO C90 forbids specifying subobject to initialize * anonymous variadic macros were introduced in C99 * invalid use of structure with flexible array member The first one is only used when optional bignums are enabled, and I have no intention of supporting bignums on systems w/o long long (although it's not guaranteed two words fit in a long long - I need to fix this). The 'z' modifier is necessary for long types (you'd get warnings the other way without it). The next 4 are intentional - they make the code cleaner, and all of these extensions are supported by Plan 9. The last one is tricky. I think it refers to the fact that not only am I using flexible array members, but I'm using them as non-final alternates in a union. I'll have to double check the semantics of this.
This commit is contained in:
Alex Shinn
parent
ba187ed4ae
commit
6d709264bd
7 changed files with 57 additions and 54 deletions
37
eval.c
37
eval.c
|
|
@ -899,9 +899,9 @@ static void generate_opcode_app (sexp ctx, sexp app) {
|
|||
/* maybe push the default for an optional argument */
|
||||
if ((num_args == sexp_opcode_num_args(op))
|
||||
&& sexp_opcode_variadic_p(op)
|
||||
&& sexp_opcode_default(op)
|
||||
&& sexp_opcode_data(op)
|
||||
&& (sexp_opcode_class(op) != OPC_PARAMETER)) {
|
||||
emit_push(ctx, sexp_opcode_default(op));
|
||||
emit_push(ctx, sexp_opcode_data(op));
|
||||
if (sexp_opcode_opt_param_p(op))
|
||||
emit(ctx, OP_CDR);
|
||||
sexp_context_depth(ctx)++;
|
||||
|
|
@ -945,14 +945,16 @@ static void generate_opcode_app (sexp ctx, sexp app) {
|
|||
emit(ctx, sexp_opcode_code(op));
|
||||
break;
|
||||
case OPC_FOREIGN:
|
||||
emit(ctx, sexp_opcode_code(op));
|
||||
emit_word(ctx, (sexp_uint_t)op);
|
||||
break;
|
||||
case OPC_TYPE_PREDICATE:
|
||||
/* push the funtion pointer for foreign calls */
|
||||
emit(ctx, sexp_opcode_code(op));
|
||||
if (sexp_opcode_data(op))
|
||||
emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op));
|
||||
break;
|
||||
case OPC_PARAMETER:
|
||||
emit_push(ctx, sexp_opcode_default(op));
|
||||
emit_push(ctx, sexp_opcode_data(op));
|
||||
emit(ctx, ((num_args == 0) ? OP_CDR : OP_SET_CDR));
|
||||
break;
|
||||
default:
|
||||
|
|
@ -1396,47 +1398,47 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
break;
|
||||
case OP_FCALL0:
|
||||
sexp_context_top(ctx) = top;
|
||||
_PUSH(((sexp_proc1)_UWORD0)(ctx));
|
||||
_PUSH(((sexp_proc1)sexp_opcode_func(_WORD0))(ctx));
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL1:
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG1 = ((sexp_proc2)_UWORD0)(ctx, _ARG1);
|
||||
_ARG1 = ((sexp_proc2)sexp_opcode_func(_WORD0))(ctx, _ARG1);
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL2:
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG2 = ((sexp_proc3)_UWORD0)(ctx, _ARG1, _ARG2);
|
||||
_ARG2 = ((sexp_proc3)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2);
|
||||
top--;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL3:
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG3 =((sexp_proc4)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3);
|
||||
_ARG3 = ((sexp_proc4)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3);
|
||||
top -= 2;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL4:
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG4 =((sexp_proc5)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4);
|
||||
_ARG4 = ((sexp_proc5)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4);
|
||||
top -= 3;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL5:
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG5 =((sexp_proc6)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5);
|
||||
_ARG5 = ((sexp_proc6)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5);
|
||||
top -= 4;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL6:
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG6 =((sexp_proc7)_UWORD0)(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6);
|
||||
_ARG6 = ((sexp_proc7)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6);
|
||||
top -= 5;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
|
|
@ -1516,7 +1518,6 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
sexp_raise("string-set!: not a string", sexp_list1(ctx, _ARG1));
|
||||
else if (sexp_immutablep(_ARG1))
|
||||
sexp_raise("string-set!: immutable string", sexp_list1(ctx, _ARG1));
|
||||
fprintf(stderr, "string-set! %p (immutable: %d)\n", _ARG1, sexp_immutablep(_ARG1));
|
||||
sexp_string_set(_ARG1, _ARG2, _ARG3);
|
||||
_ARG3 = SEXP_VOID;
|
||||
top-=2;
|
||||
|
|
@ -1560,8 +1561,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
_ARG1 = sexp_make_boolean(sexp_charp(_ARG1)); break;
|
||||
case OP_TYPEP:
|
||||
_ARG1 = sexp_make_boolean(sexp_pointerp(_ARG1)
|
||||
&& (sexp_pointer_tag(_ARG1)
|
||||
== _UWORD0));
|
||||
&& (sexp_make_integer(sexp_pointer_tag(_ARG1))
|
||||
== _WORD0));
|
||||
ip += sizeof(sexp);
|
||||
break;
|
||||
case OP_CAR:
|
||||
|
|
@ -2185,10 +2186,10 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
|||
e = sexp_make_null_env(ctx, version);
|
||||
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
|
||||
op = sexp_copy_opcode(ctx, &opcodes[i]);
|
||||
if (sexp_opcode_opt_param_p(op) && sexp_opcode_default(op)) {
|
||||
sym = sexp_intern(ctx, (char*)sexp_opcode_default(op));
|
||||
if (sexp_opcode_opt_param_p(op) && sexp_opcode_data(op)) {
|
||||
sym = sexp_intern(ctx, (char*)sexp_opcode_data(op));
|
||||
cell = env_cell_create(ctx, e, sym, SEXP_VOID);
|
||||
sexp_opcode_default(op) = cell;
|
||||
sexp_opcode_data(op) = cell;
|
||||
}
|
||||
env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op);
|
||||
}
|
||||
|
|
@ -2211,7 +2212,7 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
|||
emit(ctx2, OP_LOCAL_REF);
|
||||
emit_word(ctx2, 0);
|
||||
emit(ctx2, OP_FCALL2);
|
||||
emit_word(ctx2, (sexp_uint_t)sexp_opcode_data(sexp_cdr(perr_cell)));
|
||||
emit_word(ctx2, (sexp_uint_t)sexp_cdr(perr_cell));
|
||||
}
|
||||
emit_push(ctx2, SEXP_VOID);
|
||||
emit(ctx2, OP_DONE);
|
||||
|
|
|
|||
1
gc.c
1
gc.c
|
|
@ -151,6 +151,7 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
|
|||
sexp sexp_gc (sexp ctx, size_t *sum_freed) {
|
||||
sexp res;
|
||||
int i;
|
||||
fprintf(stderr, "*********************** gc **********************\n");
|
||||
sexp_mark(continuation_resumer);
|
||||
sexp_mark(final_resumer);
|
||||
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
|
||||
|
|
|
|||
|
|
@ -14,16 +14,6 @@
|
|||
|
||||
#define sexp_init_file "init.scm"
|
||||
|
||||
/* procedure types */
|
||||
typedef sexp (*sexp_proc0) ();
|
||||
typedef sexp (*sexp_proc1) (sexp);
|
||||
typedef sexp (*sexp_proc2) (sexp, sexp);
|
||||
typedef sexp (*sexp_proc3) (sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc4) (sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc5) (sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc6) (sexp, sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc7) (sexp, sexp, sexp, sexp, sexp, sexp, sexp);
|
||||
|
||||
enum core_form_names {
|
||||
CORE_DEFINE = 1,
|
||||
CORE_SET,
|
||||
|
|
@ -33,7 +23,7 @@ enum core_form_names {
|
|||
CORE_QUOTE,
|
||||
CORE_DEFINE_SYNTAX,
|
||||
CORE_LET_SYNTAX,
|
||||
CORE_LETREC_SYNTAX,
|
||||
CORE_LETREC_SYNTAX
|
||||
};
|
||||
|
||||
enum opcode_classes {
|
||||
|
|
@ -47,7 +37,7 @@ enum opcode_classes {
|
|||
OPC_CONSTRUCTOR,
|
||||
OPC_ACCESSOR,
|
||||
OPC_PARAMETER,
|
||||
OPC_FOREIGN,
|
||||
OPC_FOREIGN
|
||||
};
|
||||
|
||||
enum opcode_names {
|
||||
|
|
@ -123,7 +113,7 @@ enum opcode_names {
|
|||
OP_READ_CHAR,
|
||||
OP_PEEK_CHAR,
|
||||
OP_RET,
|
||||
OP_DONE,
|
||||
OP_DONE
|
||||
};
|
||||
|
||||
/**************************** prototypes ******************************/
|
||||
|
|
|
|||
|
|
@ -82,7 +82,7 @@ enum sexp_types {
|
|||
SEXP_LIT,
|
||||
SEXP_STACK,
|
||||
SEXP_CONTEXT,
|
||||
SEXP_NUM_TYPES,
|
||||
SEXP_NUM_TYPES
|
||||
};
|
||||
|
||||
typedef unsigned long sexp_uint_t;
|
||||
|
|
@ -102,6 +102,16 @@ typedef struct sexp_struct *sexp;
|
|||
#define SEXP_MAX_FIXNUM ((((sexp_sint_t)1)<<(sizeof(sexp_sint_t)*8-SEXP_FIXNUM_BITS-1))-1)
|
||||
#define SEXP_MIN_FIXNUM (-SEXP_MAX_FIXNUM-1)
|
||||
|
||||
/* procedure types */
|
||||
typedef sexp (*sexp_proc0) ();
|
||||
typedef sexp (*sexp_proc1) (sexp);
|
||||
typedef sexp (*sexp_proc2) (sexp, sexp);
|
||||
typedef sexp (*sexp_proc3) (sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc4) (sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc5) (sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc6) (sexp, sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc7) (sexp, sexp, sexp, sexp, sexp, sexp, sexp);
|
||||
|
||||
struct sexp_gc_var_t {
|
||||
sexp *var;
|
||||
char *name;
|
||||
|
|
@ -176,7 +186,8 @@ struct sexp_struct {
|
|||
unsigned char op_class, code, num_args, flags,
|
||||
arg1_type, arg2_type, inverse;
|
||||
char *name;
|
||||
sexp data, dflt, proc;
|
||||
sexp data, proc;
|
||||
sexp_proc0 func;
|
||||
} opcode;
|
||||
struct {
|
||||
char code;
|
||||
|
|
@ -437,9 +448,9 @@ sexp sexp_make_flonum(sexp ctx, double f);
|
|||
#define sexp_opcode_arg2_type(x) ((x)->value.opcode.arg2_type)
|
||||
#define sexp_opcode_inverse(x) ((x)->value.opcode.inverse)
|
||||
#define sexp_opcode_name(x) ((x)->value.opcode.name)
|
||||
#define sexp_opcode_default(x) ((x)->value.opcode.dflt)
|
||||
#define sexp_opcode_data(x) ((x)->value.opcode.data)
|
||||
#define sexp_opcode_proc(x) ((x)->value.opcode.proc)
|
||||
#define sexp_opcode_func(x) ((x)->value.opcode.func)
|
||||
|
||||
#define sexp_opcode_variadic_p(x) (sexp_opcode_flags(x) & 1)
|
||||
#define sexp_opcode_opt_param_p(x) (sexp_opcode_flags(x) & 2)
|
||||
|
|
|
|||
34
opcodes.c
34
opcodes.c
|
|
@ -1,8 +1,8 @@
|
|||
|
||||
#define _OP(c,o,n,m,t,u,i,s,f,d) \
|
||||
{.tag=SEXP_OPCODE, \
|
||||
.value={.opcode={c, o, n, m, t, u, i, s, d, f, NULL}}}
|
||||
#define _FN(o,n,m,t,u,s,f,d) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, f, (sexp)d)
|
||||
#define _OP(c,o,n,m,t,u,i,s,d,f) \
|
||||
{.tag=SEXP_OPCODE, \
|
||||
.value={.opcode={c, o, n, m, t, u, i, s, d, NULL, f}}}
|
||||
#define _FN(o,n,m,t,u,s,f,p) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, f, (sexp_proc0)p)
|
||||
#define _FN0(s, f, d) _FN(OP_FCALL0, 0, 0, 0, 0, s, f, d)
|
||||
#define _FN1(t, s, f, d) _FN(OP_FCALL1, 1, 0, t, 0, s, f, d)
|
||||
#define _FN2(t, u, s, f, d) _FN(OP_FCALL2, 2, 0, t, u, s, f, d)
|
||||
|
|
@ -45,19 +45,19 @@ _OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL),
|
|||
_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL),
|
||||
_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL),
|
||||
_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", 0, NULL),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", 0, NULL),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", 0, NULL),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", 0, NULL),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", 0, NULL),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", 0, (sexp)SEXP_PAIR),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", 0, (sexp)SEXP_STRING),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", 0, (sexp)SEXP_VECTOR),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", 0, (sexp)SEXP_FLONUM),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", 0, (sexp)SEXP_PROCEDURE),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", 0, (sexp)SEXP_OPCODE),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", 0, (sexp)SEXP_IPORT),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", 0, (sexp)SEXP_OPORT),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_integer(SEXP_PAIR), 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_integer(SEXP_STRING), 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_integer(SEXP_VECTOR), 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_integer(SEXP_FLONUM), 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_integer(SEXP_PROCEDURE), 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_integer(SEXP_OPCODE), 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_integer(SEXP_IPORT), 0),
|
||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_integer(SEXP_OPORT), 0),
|
||||
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL),
|
||||
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL),
|
||||
_OP(OPC_GENERIC, OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL),
|
||||
|
|
|
|||
|
|
@ -418,7 +418,7 @@ enum sexp_number_types {
|
|||
SEXP_NUM_NOT = 0,
|
||||
SEXP_NUM_FIX,
|
||||
SEXP_NUM_FLO,
|
||||
SEXP_NUM_BIG,
|
||||
SEXP_NUM_BIG
|
||||
};
|
||||
|
||||
enum sexp_number_combs {
|
||||
|
|
@ -437,7 +437,7 @@ enum sexp_number_combs {
|
|||
SEXP_NUM_BIG_NOT,
|
||||
SEXP_NUM_BIG_FIX,
|
||||
SEXP_NUM_BIG_FLO,
|
||||
SEXP_NUM_BIG_BIG,
|
||||
SEXP_NUM_BIG_BIG
|
||||
};
|
||||
|
||||
int sexp_number_type_lookup[SEXP_NUM_TYPES] =
|
||||
|
|
|
|||
2
sexp.c
2
sexp.c
|
|
@ -84,7 +84,7 @@ static struct sexp_struct sexp_type_specs[] = {
|
|||
_DEF_TYPE(SEXP_ENV, sexp_offsetof(env, parent), 3, 0, 0, sexp_sizeof(env), 0, 0, "environment"),
|
||||
_DEF_TYPE(SEXP_BYTECODE, sexp_offsetof(bytecode, name), 2, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, "bytecode"),
|
||||
_DEF_TYPE(SEXP_CORE, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, "core-form"),
|
||||
_DEF_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, dflt), 2, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode"),
|
||||
_DEF_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, data), 2, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode"),
|
||||
_DEF_TYPE(SEXP_LAMBDA, sexp_offsetof(lambda, name), 8, 0, 0, sexp_sizeof(lambda), 0, 0, "lambda"),
|
||||
_DEF_TYPE(SEXP_CND, sexp_offsetof(cnd, test), 3, 0, 0, sexp_sizeof(cnd), 0, 0, "conditoinal"),
|
||||
_DEF_TYPE(SEXP_REF, sexp_offsetof(ref, name), 2, 0, 0, sexp_sizeof(ref), 0, 0, "reference"),
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue