From 09bbe9ac2ebb9797b363030c9ab6dc2257bac89c Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 8 Mar 2009 00:24:46 +0900 Subject: [PATCH] adding i/o port parameters --- config.h | 21 ++++++++++++++++----- debug.c | 3 ++- eval.c | 41 ++++++++++++++++++----------------------- eval.h | 2 ++ sexp.c | 8 ++++---- sexp.h | 14 ++++++++------ 6 files changed, 50 insertions(+), 39 deletions(-) diff --git a/config.h b/config.h index 1c739fae..625d3117 100644 --- a/config.h +++ b/config.h @@ -1,9 +1,20 @@ -/* config.h -- general configuration */ +/* config.h -- general configuration */ /* Copyright (c) 2009 Alex Shinn. All rights reserved. */ -/* BSD-style license: http://synthcode.com/license.txt */ +/* BSD-style license: http://synthcode.com/license.txt */ +#ifndef USE_BOEHM #define USE_BOEHM 1 -#define USE_HUFF_SYMS 1 -#define USE_DEBUG 1 -#define USE_STRING_STREAMS 1 +#endif + +#ifndef USE_HUFF_SYMS +#define USE_HUFF_SYMS 1 +#endif + +#ifndef USE_DEBUG +#define USE_DEBUG 1 +#endif + +#ifndef USE_STRING_STREAMS +#define USE_STRING_STREAMS 1 +#endif diff --git a/debug.c b/debug.c index a9486f2f..09c5f718 100644 --- a/debug.c +++ b/debug.c @@ -5,7 +5,7 @@ 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", + "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", @@ -26,6 +26,7 @@ void disasm (bytecode bc) { case OP_STACK_REF: case OP_STACK_SET: case OP_CLOSURE_REF: + case OP_PARAMETER: fprintf(stderr, "%d", (long) ((sexp*)ip)[0]); ip += sizeof(sexp); break; diff --git a/eval.c b/eval.c index 201aeb3a..1f4e20f1 100644 --- a/eval.c +++ b/eval.c @@ -12,7 +12,7 @@ static sexp cur_input_port, cur_output_port, cur_error_port; static sexp exception_handler_cell; static sexp continuation_resumer; -#ifdef USE_DEBUG +#if USE_DEBUG #include "debug.c" #else #define print_stack(...) @@ -228,6 +228,10 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, (*d) -= sexp_length(SEXP_CDDR(obj)); } break; + case OPC_PARAMETER: + emit(bc, i, ((opcode)o1)->op_name); + emit_word(bc, i, (sexp_uint_t) ((opcode)o1)->data); + break; case OPC_FOREIGN: for (o2 = sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2 = SEXP_CDR(o2)) { @@ -454,35 +458,20 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) { int i; loop: - /* fprintf(stderr, "opcode: %s (%d), ip: %d\n", reverse_opcode_names[*ip], *ip, ip); */ - /* print_bytecode(bc); */ switch (*ip++) { case OP_NOOP: fprintf(stderr, "noop\n"); break; case OP_GLOBAL_REF: -/* fprintf(stderr, "global ref: ip: %p => %p: ", ip, ((sexp*)ip)[0]); */ -/* fflush(stderr); */ -/* sexp_write(stderr, ((sexp*)ip)[0]); */ -/* fprintf(stderr, "\n"); */ tmp1 = env_cell(e, ((sexp*)ip)[0]); stack[top++]=SEXP_CDR(tmp1); ip += sizeof(sexp); break; case OP_GLOBAL_SET: -/* fprintf(stderr, "global set: %p: ", ((sexp*)ip)[0]); */ -/* fflush(stderr); */ -/* sexp_write(stderr, ((sexp*)ip)[0]); */ -/* fprintf(stderr, "\n"); */ env_define(e, ((sexp*)ip)[0], stack[--top]); ip += sizeof(sexp); break; case OP_STACK_REF: -/* fprintf(stderr, "stack ref: ip=%p, %d - %d => ", */ -/* ip, top, (sexp_uint_t) ((sexp*)ip)[0]); */ -/* fflush(stderr); */ -/* sexp_write(stderr, stack[top - (unsigned int) ((sexp*)ip)[0]]); */ -/* fprintf(stderr, "\n"); */ stack[top] = stack[top - (unsigned int) ((sexp*)ip)[0]]; ip += sizeof(sexp); top++; @@ -493,10 +482,6 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) { ip += sizeof(sexp); break; case OP_CLOSURE_REF: -/* fprintf(stderr, "closure-ref %d => ", ((sexp*)ip)[0]); */ -/* fflush(stderr); */ -/* sexp_write(stderr, vector_ref(cp,((sexp*)ip)[0])); */ -/* fprintf(stderr, "\n"); */ stack[top++]=sexp_vector_ref(cp,((sexp*)ip)[0]); ip += sizeof(sexp); break; @@ -542,6 +527,11 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) { stack[top-2]=stack[top-1]; stack[top-1]=tmp1; break; + case OP_PARAMETER: + stack[top] = *(sexp*)((sexp*)ip)[0]; + top++; + ip += sizeof(sexp); + break; case OP_PAIRP: stack[top-1]=SEXP_PAIRP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break; case OP_NULLP: @@ -748,8 +738,6 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) { sexp_write(stack[top-1], cur_error_port); fprintf(stderr, "...\n"); /* print_stack(stack, top); */ - /* top-1 */ - /* stack: args ... n ip result */ cp = stack[top-2]; ip = (unsigned char*) sexp_unbox_integer(stack[top-3]); i = sexp_unbox_integer(stack[top-4]); @@ -795,6 +783,7 @@ static const struct opcode opcodes[] = { #define _FN0(s, f) _FN(OP_FCALL0, 0, 0, 0, s, f) #define _FN1(t, s, f) _FN(OP_FCALL1, 1, t, 0, s, f) #define _FN2(t, u, s, f) _FN(OP_FCALL2, 2, t, u, s, f) +#define _PARAM(n,a,t) {SEXP_OPCODE, OPC_PARAMETER, OP_PARAMETER, 0, 1, t, 0, 0, n, a, NULL} _OP(OPC_ACCESSOR, OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car"), _OP(OPC_ACCESSOR, OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!"), _OP(OPC_ACCESSOR, OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr"), @@ -827,7 +816,7 @@ _OP(OPC_TYPE_PREDICATE, OP_PROCEDUREP, 1, 0, 0, 0, 0, "procedure?"), _OP(OPC_TYPE_PREDICATE, OP_IPORTP, 1, 0, 0, 0, 0, "input-port?"), _OP(OPC_TYPE_PREDICATE, OP_OPORTP, 1, 0, 0, 0, 0, "output-port?"), _OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?"), -_OP(OPC_GENERIC, OP_APPLY1, 2, SEXP_PROCEDURE, SEXP_PAIR, 0, 0, "apply1"), +_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"), _FN1(SEXP_PAIR, "reverse", sexp_reverse), @@ -835,11 +824,15 @@ _FN1(SEXP_PAIR, "list->vector", sexp_list_to_vector), _FN2(0, SEXP_PAIR, "memq", sexp_memq), _FN2(0, SEXP_PAIR, "assq", sexp_assq), _FN2(SEXP_PAIR, SEXP_PAIR, "diffq", sexp_lset_diff), +_PARAM("current-input-port", (sexp)&cur_input_port, SEXP_IPORT), +_PARAM("current-output-port", (sexp)&cur_output_port, SEXP_OPORT), +_PARAM("current-error-port", (sexp)&cur_error_port, SEXP_OPORT), #undef _OP #undef _FN #undef _FN0 #undef _FN1 #undef _FN2 +#undef _PARAM }; env make_standard_env() { @@ -925,6 +918,8 @@ int main (int argc, char **argv) { env_define(e, err_handler_sym, err_handler); exception_handler_cell = env_cell(e, err_handler_sym); + fprintf(stderr, "current-input-port: %d => %d\n", &cur_input_port, cur_input_port); + /* parse options */ for (i=1; i < argc && argv[i][0] == '-'; i++) { switch (argv[i][1]) { diff --git a/eval.h b/eval.h index 045e3af0..e8b9b2e3 100644 --- a/eval.h +++ b/eval.h @@ -76,6 +76,7 @@ enum opcode_classes { OPC_ARITHMETIC_CMP, OPC_CONSTRUCTOR, OPC_ACCESSOR, + OPC_PARAMETER, OPC_FOREIGN, }; @@ -99,6 +100,7 @@ enum opcode_names { OP_JUMP, OP_RET, OP_DONE, + OP_PARAMETER, OP_STACK_REF, OP_STACK_SET, OP_GLOBAL_REF, diff --git a/sexp.c b/sexp.c index 32e61c3c..2101681d 100644 --- a/sexp.c +++ b/sexp.c @@ -215,7 +215,7 @@ sexp sexp_intern(char *str) { char c, *mystr, *p=str; sexp sym, *newtable; -#ifdef USE_HUFF_SYMS +#if USE_HUFF_SYMS res = 0; for (p=str; c=*p; p++) { he = huff_table[c]; @@ -312,7 +312,7 @@ sexp sexp_vector(int count, ...) { /************************ reading and writing *************************/ -#ifdef USE_STRING_STREAMS +#if USE_STRING_STREAMS int sstream_read(void *vec, char *dst, int n) { int len = (int) sexp_vector_ref((sexp) vec, sexp_make_integer(1)); @@ -455,7 +455,7 @@ void sexp_write (sexp obj, sexp out) { } } else if (SEXP_SYMBOLP(obj)) { -#ifdef USE_HUFF_SYMS +#if USE_HUFF_SYMS if (((sexp_uint_t)obj&7)==7) { c = ((sexp_uint_t)obj)>>3; while (c) { @@ -764,7 +764,7 @@ sexp sexp_read_from_string(char *str) { void sexp_init() { if (! sexp_initialized_p) { sexp_initialized_p = 1; -#ifdef USE_BOEHM +#if USE_BOEHM GC_init(); #endif symbol_table = SEXP_ALLOC(symbol_table_primes[0]*sizeof(sexp)); diff --git a/sexp.h b/sexp.h index 719c91a5..8d15dbe3 100644 --- a/sexp.h +++ b/sexp.h @@ -13,7 +13,7 @@ #include "config.h" -#ifdef HAVE_ERR_H +#if HAVE_ERR_H #include #else /* requires that msg be a string literal */ @@ -21,10 +21,12 @@ #endif #if defined(__APPLE__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__DragonFly__) || defined(__OpenBSD__) -#define SEXP_BSD +#define SEXP_BSD 1 +#else +#define SEXP_BSD 0 #endif -#ifdef USE_BOEHM +#if USE_BOEHM #include "gc/include/gc.h" #define SEXP_ALLOC GC_malloc #define SEXP_ALLOC_ATOMIC GC_malloc_atomic @@ -125,7 +127,7 @@ typedef long sexp_sint_t; #define SEXP_SYMBOLP(x) (SEXP_ISYMBOLP(x) || SEXP_LSYMBOLP(x)) -#ifdef USE_HUFF_SYMS +#if USE_HUFF_SYMS #define SEXP_DOTP(x) (((sexp_uint_t)(x))==((0x5D00<data1) -#ifdef USE_STRING_STREAMS -#ifdef SEXP_BSD +#if USE_STRING_STREAMS +#if SEXP_BSD #define fmemopen(str, len, m) funopen(sexp_vector(3, (sexp)str, (sexp)len, (sexp)0), sstream_read, sstream_write, sstream_seek, sstream_close) int sstream_read(void *vec, char *dst, int n); int sstream_write(void *vec, const char *src, int n);