Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

initial variadic i/o routines

Browse source
This commit is contained in:
Alex Shinn 2009-03-08 00:55:32 +09:00
parent 09bbe9ac2e
commit 7795b773aa
3 changed files with 66 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
debug.c
View file

@ -5,13 +5,16 @@
static const char* reverse_opcode_names[] =
{"NOOP", "CALL", "APPLY1", "CALLCC", "RESUMECC", "ERROR", "FCALL0", "FCALL1",
"FCALL2", "FCALL3", "FCALL4", "FCALL5", "FCALL6", "FCALL7", "FCALLN",
"JUMP_UNLESS", "JUMP", "RET", "DONE", "PARAMETER",
"STACK_REF", "STACK_SET", "GLOBAL_REF", "GLOBAL_SET", "CLOSURE_REF",
"VECTOR_REF", "VECTOR_SET", "STRING_REF", "STRING_SET", "MAKE_PROCEDURE",
"MAKE_VECTOR", "PUSH", "DUP", "DROP", "SWAP", "PAIRP", "NULLP", "VECTORP",
"JUMP-UNLESS", "JUMP", "RET", "DONE", "PARAMETER",
"STACK-REF", "STACK-SET", "GLOBAL-REF", "GLOBAL-SET", "CLOSURE-REF",
"VECTOR-REF", "VECTOR-SET", "STRING-REF", "STRING-SET", "MAKE-PROCEDURE",
"MAKE-VECTOR", "PUSH", "DUP", "DROP", "SWAP", "PAIRP", "NULLP", "VECTORP",
"INTEGERP", "SYMBOLP", "STRINGP", "CHARP", "EOFP", "PROCEDUREP", "IPORTP",
"OPORTP", "CAR", "CDR", "SET_CAR", "SET_CDR", "CONS", "ADD", "SUB", "MUL",
"DIV", "MOD", "NEG", "INV", "LT", "LE", "GT", "GE", "EQN", "EQ",};
"OPORTP", "CAR", "CDR", "SET-CAR", "SET-CDR", "CONS", "ADD", "SUB", "MUL",
"DIV", "MOD", "NEG", "INV", "LT", "LE", "GT", "GE", "EQN", "EQ",
"DISPLAY", "WRITE", "WRITE-CHAR", "NEWLINE", "FLUSH-OUTPUT", "READ",
"READ-CHAR",
};
void disasm (bytecode bc) {
unsigned char *ip=bc->data, opcode;

49
eval.c
View file

@ -228,6 +228,19 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e,
(*d) -= sexp_length(SEXP_CDDR(obj));
}
break;
case OPC_IO:
tmp1 = sexp_length(SEXP_CDR(obj));
if (tmp1 == ((opcode)o1)->num_args && ((opcode)o1)->var_args_p) {
emit(bc, i, OP_PARAMETER);
emit_word(bc, i, (sexp_uint_t) ((opcode)o1)->data);
(*d)++;
}
for (o2 = sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2);
o2 = SEXP_CDR(o2))
analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d);
emit(bc, i, ((opcode)o1)->op_name);
(*d) -= (tmp1-1);
break;
case OPC_PARAMETER:
emit(bc, i, ((opcode)o1)->op_name);
emit_word(bc, i, (sexp_uint_t) ((opcode)o1)->data);
@ -732,6 +745,35 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
fprintf(stderr, "jumping to + %d => %d\n", ((signed char*)ip)[0], ip + ((signed char*)ip)[0]);
ip += ((signed char*)ip)[0];
break;
case OP_DISPLAY:
if (SEXP_STRINGP(stack[top-1])) {
sexp_write_string(sexp_string_data(stack[top-1]), stack[top-2]);
break;
}
case OP_WRITE:
sexp_write(stack[top-1], stack[top-2]);
stack[top-2] = SEXP_UNDEF;
top--;
break;
case OP_WRITE_CHAR:
sexp_write_char(sexp_unbox_character(stack[top-1]), stack[top-2]);
break;
case OP_NEWLINE:
sexp_write_char('\n', stack[top-1]);
stack[top-1] = SEXP_UNDEF;
break;
case OP_FLUSH_OUTPUT:
sexp_flush(stack[top-1]);
stack[top-1] = SEXP_UNDEF;
break;
case OP_READ:
stack[top-1] = sexp_read(stack[top-1]);
if (stack[top-1] == SEXP_ERROR) sexp_raise(sexp_intern("read-error"));
break;
case OP_READ_CHAR:
i = sexp_read_char(stack[top-1]);
stack[top-1] = (i == EOF) ? SEXP_EOF : sexp_make_character(i);
break;
case OP_RET:
fprintf(stderr, "returning @ %d: ", top-1);
fflush(stderr);
@ -819,6 +861,13 @@ _OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?"),
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1"),
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation"),
_OP(OPC_GENERIC, OP_ERROR, 1, SEXP_STRING, 0, 0, 0, "error"),
{SEXP_OPCODE, OPC_IO, OP_WRITE, 1, 1, 0, SEXP_OPORT, 0, "write", (sexp)&cur_output_port, NULL},
{SEXP_OPCODE, OPC_IO, OP_DISPLAY, 1, 1, 0, SEXP_OPORT, 0, "display", (sexp)&cur_output_port, NULL},
{SEXP_OPCODE, OPC_IO, OP_WRITE_CHAR, 1, 1, 0, SEXP_OPORT, 0, "write-char", (sexp)&cur_output_port, NULL},
{SEXP_OPCODE, OPC_IO, OP_NEWLINE, 0, 1, 0, SEXP_OPORT, 0, "newline", (sexp)&cur_output_port, NULL},
{SEXP_OPCODE, OPC_IO, OP_FLUSH_OUTPUT, 0, 1, 0, SEXP_OPORT, 0, "flush-output", (sexp)&cur_output_port, NULL},
{SEXP_OPCODE, OPC_IO, OP_READ, 0, 1, 0, SEXP_IPORT, 0, "read", (sexp)&cur_input_port, NULL},
{SEXP_OPCODE, OPC_IO, OP_READ_CHAR, 0, 1, 0, SEXP_IPORT, 0, "read-char", (sexp)&cur_input_port, NULL},
_FN1(SEXP_PAIR, "reverse", sexp_reverse),
_FN1(SEXP_PAIR, "list->vector", sexp_list_to_vector),
_FN2(0, SEXP_PAIR, "memq", sexp_memq),

8
eval.h
View file

@ -74,6 +74,7 @@ enum opcode_classes {
OPC_ARITHMETIC,
OPC_ARITHMETIC_INV,
OPC_ARITHMETIC_CMP,
OPC_IO,
OPC_CONSTRUCTOR,
OPC_ACCESSOR,
OPC_PARAMETER,
@ -145,6 +146,13 @@ enum opcode_names {
OP_GE,
OP_EQN,
OP_EQ,
OP_DISPLAY,
OP_WRITE,
OP_WRITE_CHAR,
OP_NEWLINE,
OP_FLUSH_OUTPUT,
OP_READ,
OP_READ_CHAR,
};
/**************************** prototypes ******************************/