adding define_foreign_opt to bind C functions with optional parameters

moving several opcodes to normal FFI functions, considering
doing the same for all I/O opcodes.

Makefile

@@ -92,7 +92,7 @@ chibi-scheme$(EXE): main.o libchibi-scheme$(SO)
 chibi-scheme-static$(EXE): main.o eval.o sexp.o
 	$(CC) $(XCFLAGS) $(STATICFLAGS) -o $@ $^ $(XLDFLAGS)
 
-lib/srfi/69/hash$(SO): lib/srfi/69/hash.c
+lib/srfi/69/hash$(SO): lib/srfi/69/hash.c $(INCLUDES)
 	$(CC) $(CLIBFLAGS) $(XCPPFLAGS) $(XCFLAGS) -o $@ $< -L. -lchibi-scheme
 
 clean:
@@ -113,10 +113,10 @@ test-basic: chibi-scheme$(EXE)
 	done
 
 test-numbers: chibi-scheme$(EXE)
-	./chibi-scheme$(EXE) tests/numeric-tests.scm
+	LD_LIBRARY_PATH=.:$LD_LIBRARY_PATH ./chibi-scheme$(EXE) tests/numeric-tests.scm
 
-test: chibi-scheme$(EXE)
+test: all
-	./chibi-scheme$(EXE) tests/r5rs-tests.scm
+	LD_LIBRARY_PATH=.:$LD_LIBRARY_PATH ./chibi-scheme$(EXE) tests/r5rs-tests.scm
 
 install: chibi-scheme$(EXE)
 	mkdir -p $(DESTDIR)$(BINDIR)

README

@@ -72,11 +72,15 @@ function takes (not counting the context argument), and a C function.
 
   /* sexp_define_foreign(context, env, name, num_args, f) */
 
-  sexp add1 (sexp context, sexp x) {
+  sexp add (sexp context, sexp x, sexp y) {
-    return sexp_fx_add(x, sexp_make_fixnum(1));
+    return sexp_fx_add(x, y);
   }
 
-  sexp_define_foreign(context, env, "add1", 1, add1)
+  sexp_define_foreign(context, env, "add", 2, add);
+
+You can also define functions with a single optional argument:
+
+  sexp_define_foreign_opt(context, env, "add", 2, add, sexp_make_fixnum(1));
 
 See the SRFI-69 implementation for more detailed examples of this.
 

TODO

@@ -27,7 +27,7 @@
 **- scheme-complete.el support
 *= ffi
 **+ libdl interface
-**= opcode generation interface
+**+ opcode generation interface
 **- stub generator
 *= cleanup
 *- user documentation

config.scm

@@ -34,7 +34,7 @@
 (define (load-module-definition name)
   (let* ((file (module-name->file name))
          (path (find-module-file name file)))
-    (if path (%load path *config-env*))))
+    (if path (load path *config-env*))))
 
 (define (find-module name)
   (cond
@@ -53,7 +53,7 @@
           (let ((mod2 (load-module (cadr x))))
             (%env-copy! env (module-env mod2) (module-exports mod2))))
          ((include)
-          (for-each (lambda (f) (%load (find-module-file name f) env)) (cdr x)))
+          (for-each (lambda (f) (load (find-module-file name f) env)) (cdr x)))
          ((body)
           (for-each (lambda (expr) (eval expr env)) (cdr x)))))
      (module-meta-data mod))

debug.c

@@ -5,20 +5,17 @@
 static const char* reverse_opcode_names[] =
   {"NOOP", "RAISE", "RESUMECC", "CALLCC", "APPLY1", "TAIL-CALL", "CALL",
    "FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "FCALL5", "FCALL6",
-   "EVAL", "JUMP-UNLESS",
+   "JUMP-UNLESS", "JUMP", "PUSH", "DROP", "GLOBAL-REF", "GLOBAL-KNOWN-REF",
-   "JUMP", "PUSH", "DROP", "GLOBAL-REF", "GLOBAL-KNOWN-REF", "STACK-REF",
+   "STACK-REF", "LOCAL-REF", "LOCAL-SET",
-   "LOCAL-REF", "LOCAL-SET",
    "CLOSURE-REF", "VECTOR-REF", "VECTOR-SET", "VECTOR-LENGTH", "STRING-REF",
    "STRING-SET", "STRING-LENGTH", "MAKE-PROCEDURE", "MAKE-VECTOR", "AND",
    "NULL?", "FIXNUM?", "SYMBOL?", "CHAR?",
    "EOF?", "TYPEP", "MAKE", "SLOT-REF", "SLOT-SET", "CAR", "CDR",
    "SET-CAR", "SET-CDR", "CONS", "ADD", "SUB",
    "MUL", "DIV", "QUOTIENT", "REMAINDER", "NEGATIVE", "INVERSE",
-   "LT", "LE", "EQN", "EQ",
+   "LT", "LE", "EQN", "EQ", "EXACT->INEXACT", "INEXACT->EXACT",
-   "EXACT->INEXACT", "INEXACT->EXACT",
    "CHAR->INTEGER", "INTEGER->CHAR", "CHAR-UPCASE", "CHAR-DOWNCASE",
-   "DISPLAY", "WRITE", "WRITE-CHAR",
+   "WRITE-CHAR", "NEWLINE", "READ-CHAR", "PEEK-CHAR", "RET", "DONE",
-   "NEWLINE", "FLUSH-OUTPUT", "READ", "READ-CHAR", "PEEK-CHAR", "RET", "DONE",
   };
 
 static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) {

eval.c

@@ -871,7 +871,7 @@ static void generate_opcode_app (sexp ctx, sexp app) {
     num_args++;
   }
 
-  /* push the arguments onto the stack */
+  /* push the arguments onto the stack in reverse order */
   ls = ((sexp_opcode_inverse(op)
          && (sexp_opcode_class(op) != OPC_ARITHMETIC_INV))
         ? sexp_cdr(app) : sexp_reverse(ctx, sexp_cdr(app)));
@@ -1401,12 +1401,6 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     ip += sizeof(sexp);
     sexp_check_exception();
     break;
-  case OP_EVAL:
-    sexp_context_top(ctx) = top;
-    _ARG2 = sexp_eval(ctx, _ARG1, _ARG2);
-    top--;
-    sexp_check_exception();
-    break;
   case OP_JUMP_UNLESS:
     if (stack[--top] == SEXP_FALSE)
       ip += _SWORD0;
@@ -1886,24 +1880,6 @@ sexp sexp_vm (sexp ctx, sexp proc) {
       sexp_raise("char-downcase: not a character", sexp_list1(ctx, _ARG1));
     _ARG1 = sexp_make_character(tolower(sexp_unbox_character(_ARG1)));
     break;
-  case OP_DISPLAY:
-    if (sexp_stringp(_ARG1)) {
-      sexp_write_string(ctx, sexp_string_data(_ARG1), _ARG2);
-      _ARG2 = SEXP_VOID;
-      top--;
-      break;
-    } else if (sexp_charp(_ARG1)) {
-      sexp_write_char(ctx, sexp_unbox_character(_ARG1), _ARG2);
-      _ARG2 = SEXP_VOID;
-      top--;
-      break;
-    }
-    /* ... FALLTHROUGH ... */
-  case OP_WRITE:
-    sexp_write(ctx, _ARG1, _ARG2);
-    _ARG2 = SEXP_VOID;
-    top--;
-    break;
   case OP_WRITE_CHAR:
     if (! sexp_charp(_ARG1))
       sexp_raise("write-char: not a character", sexp_list1(ctx, _ARG1));
@@ -1915,15 +1891,6 @@ sexp sexp_vm (sexp ctx, sexp proc) {
     sexp_newline(ctx, _ARG1);
     _ARG1 = SEXP_VOID;
     break;
-  case OP_FLUSH_OUTPUT:
-    sexp_flush(ctx, _ARG1);
-    _ARG1 = SEXP_VOID;
-    break;
-  case OP_READ:
-    sexp_context_top(ctx) = top;
-    _ARG1 = sexp_read(ctx, _ARG1);
-    sexp_check_exception();
-    break;
   case OP_READ_CHAR:
     i = sexp_read_char(ctx, _ARG1);
     _ARG1 = (i == EOF) ? SEXP_EOF : sexp_make_character(i);
@@ -2251,7 +2218,8 @@ sexp sexp_make_opcode (sexp ctx, sexp name, sexp op_class, sexp code,
   return res;
 }
 
-sexp sexp_make_foreign (sexp ctx, char *name, int num_args, sexp_proc1 f) {
+sexp sexp_make_foreign (sexp ctx, char *name, int num_args,
+                        int flags, sexp_proc1 f, sexp data) {
   sexp res;
   if (num_args > 6) {
     res = sexp_type_exception(ctx, "make-foreign: exceeded foreign arg limit",
@@ -2260,19 +2228,22 @@ sexp sexp_make_foreign (sexp ctx, char *name, int num_args, sexp_proc1 f) {
     res = sexp_alloc_type(ctx, opcode, SEXP_OPCODE);
     sexp_opcode_class(res) = OPC_FOREIGN;
     sexp_opcode_code(res) = OP_FCALL1+num_args-1;
+    if (flags & 1) num_args--;
     sexp_opcode_num_args(res) = num_args;
+    sexp_opcode_flags(res) = flags;
     sexp_opcode_name(res) = name;
+    sexp_opcode_data(res) = data;
     sexp_opcode_func(res) = f;
   }
   return res;
 }
 
-sexp sexp_define_foreign_aux (sexp ctx, sexp env, char *name,
+sexp sexp_define_foreign_aux (sexp ctx, sexp env, char *name, int num_args,
-                              int num_args, sexp_proc1 f) {
+                              int flags, sexp_proc1 f, sexp data) {
   sexp_gc_var1(op);
   sexp_gc_preserve1(ctx, op);
   sexp res = SEXP_VOID;
-  op = sexp_make_foreign(ctx, name, num_args, (sexp_proc1)f);
+  op = sexp_make_foreign(ctx, name, num_args, flags, f, data);
   if (sexp_exceptionp(op))
     res = op;
   else

include/chibi/eval.h

@@ -57,7 +57,6 @@ enum opcode_names {
   OP_FCALL4,
   OP_FCALL5,
   OP_FCALL6,
-  OP_EVAL,
   OP_JUMP_UNLESS,
   OP_JUMP,
   OP_PUSH,
@@ -109,12 +108,8 @@ enum opcode_names {
   OP_INT2CHAR,
   OP_CHAR_UPCASE,
   OP_CHAR_DOWNCASE,
-  OP_DISPLAY,
-  OP_WRITE,
   OP_WRITE_CHAR,
   OP_NEWLINE,
-  OP_FLUSH_OUTPUT,
-  OP_READ,
   OP_READ_CHAR,
   OP_PEEK_CHAR,
   OP_RET,
@@ -135,9 +130,11 @@ SEXP_API void sexp_env_define (sexp context, sexp env, sexp sym, sexp val);
 SEXP_API sexp sexp_make_context (sexp context, sexp stack, sexp env);
 SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out);
 SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1);
-SEXP_API sexp sexp_make_foreign (sexp ctx, char *name, int num_args, sexp_proc1 f);
+SEXP_API sexp sexp_make_foreign (sexp ctx, char *name, int num_args, int flags, sexp_proc1 f, sexp data);
-SEXP_API sexp sexp_define_foreign_aux (sexp ctx, sexp env, char *name, int num_args, sexp_proc1 f);
+SEXP_API sexp sexp_define_foreign_aux (sexp ctx, sexp env, char *name, int num_args, int flags, sexp_proc1 f, sexp data);
-#define sexp_define_foreign(c,e,s,n,f) sexp_define_foreign_aux(c,e,s,n,(sexp_proc1)f)
+
+#define sexp_define_foreign(c,e,s,n,f) sexp_define_foreign_aux(c,e,s,n,0,(sexp_proc1)f,NULL)
+#define sexp_define_foreign_opt(c,e,s,n,f,d) sexp_define_foreign_aux(c,e,s,n,1,(sexp_proc1)f,d)
 
 #if USE_TYPE_DEFS
 SEXP_API sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type);

include/chibi/sexp.h

@@ -688,7 +688,9 @@ SEXP_API sexp sexp_string_to_symbol(sexp ctx, sexp str);
 SEXP_API sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt);
 SEXP_API sexp sexp_list_to_vector(sexp ctx, sexp ls);
 SEXP_API sexp sexp_make_cpointer(sexp ctx, void* value);
-SEXP_API void sexp_write(sexp ctx, sexp obj, sexp out);
+SEXP_API sexp sexp_write(sexp ctx, sexp obj, sexp out);
+SEXP_API sexp sexp_display(sexp ctx, sexp obj, sexp out);
+SEXP_API sexp sexp_flush_output(sexp ctx, sexp out);
 SEXP_API sexp sexp_read_string(sexp ctx, sexp in);
 SEXP_API sexp sexp_read_symbol(sexp ctx, sexp in, int init, int internp);
 SEXP_API sexp sexp_read_number(sexp ctx, sexp in, int base);

init.scm

@@ -487,8 +487,6 @@
 (define (char-ready? . o)
   (not (eof-object? (peek-char (if (pair? o) (car o) (current-input-port))))))
 
-(define (load file) (%load file (interaction-environment)))
-
 (define (call-with-input-string str proc)
   (let* ((in (open-input-string str))
          (res (proc in)))

lib/srfi/69/hash.c

@@ -2,6 +2,7 @@
 #include <chibi/eval.h>
 
 #define HASH_DEPTH 5
+#define HASH_BOUND sexp_make_fixnum(SEXP_MAX_FIXNUM)
 
 #define FNV_PRIME 16777619
 #define FNV_OFFSET_BASIS 2166136261uL
@@ -11,6 +12,8 @@
 #define sexp_hash_table_hash_fn(x)  sexp_slot_ref(x, 2)
 #define sexp_hash_table_eq_fn(x)    sexp_slot_ref(x, 3)
 
+#define sexp_hash_resize_check(n, len) (((n)*3) > ((len)>>2))
+
 static sexp_uint_t string_hash (char *str, sexp_uint_t bound) {
   sexp_uint_t acc = FNV_OFFSET_BASIS;
   while (*str) {acc *= FNV_PRIME; acc ^= *str++;}
@@ -147,6 +150,9 @@ static sexp sexp_scan_bucket (sexp ctx, sexp ls, sexp obj, sexp eq_fn) {
   return res;
 }
 
+/* static sexp sexp_regrow_hash_table (sexp ctx, sexp ht) { */
+/* } */
+
 static sexp sexp_hash_table_cell (sexp ctx, sexp ht, sexp obj, sexp createp) {
   sexp_gc_var1(res);
   sexp_uint_t size;
@@ -158,6 +164,11 @@ static sexp sexp_hash_table_cell (sexp ctx, sexp ht, sexp obj, sexp createp) {
   } else if (sexp_truep(createp)) {
     sexp_gc_preserve1(ctx, res);
     size = sexp_unbox_fixnum(sexp_hash_table_size(ht));
+    /* if (sexp_hash_resize_check(size, sexp_vector_length(buckets))) { */
+    /*   sexp_regrow_hash_table(ctx, ht); */
+    /*   buckets = sexp_hash_table_buckets(ht); */
+    /*   i = sexp_get_bucket(ctx, ht, obj); */
+    /* } */
     res = sexp_cons(ctx, obj, createp);
     sexp_vector_set(buckets, i, sexp_cons(ctx, res, sexp_vector_ref(buckets, i)));
     sexp_hash_table_size(ht) = sexp_make_fixnum(size+1);
@@ -171,6 +182,8 @@ static sexp sexp_hash_table_delete (sexp ctx, sexp ht, sexp obj) {
     i=sexp_get_bucket(ctx, ht, obj), p, res;
   res = sexp_scan_bucket(ctx, sexp_vector_ref(buckets, i), obj, eq_fn);
   if (sexp_pairp(res)) {
+    sexp_hash_table_size(ht)
+      = sexp_fx_sub(sexp_hash_table_size(ht), sexp_make_fixnum(1));
     if (res == sexp_vector_ref(buckets, i)) {
       sexp_vector_set(buckets, i, sexp_cdr(res));
     } else {
@@ -184,10 +197,10 @@ static sexp sexp_hash_table_delete (sexp ctx, sexp ht, sexp obj) {
 
 sexp sexp_init_library (sexp ctx, sexp env) {
 
-  sexp_define_foreign(ctx, env, "string-hash", 2, sexp_string_hash);
+  sexp_define_foreign_opt(ctx, env, "string-hash", 2, sexp_string_hash, HASH_BOUND);
-  sexp_define_foreign(ctx, env, "string-ci-hash", 2, sexp_string_ci_hash);
+  sexp_define_foreign_opt(ctx, env, "string-ci-hash", 2, sexp_string_ci_hash, HASH_BOUND);
-  sexp_define_foreign(ctx, env, "hash", 2, sexp_hash);
+  sexp_define_foreign_opt(ctx, env, "hash", 2, sexp_hash, HASH_BOUND);
-  sexp_define_foreign(ctx, env, "hash-by-identity", 2, sexp_hash_by_identity);
+  sexp_define_foreign_opt(ctx, env, "hash-by-identity", 2, sexp_hash_by_identity, HASH_BOUND);
   sexp_define_foreign(ctx, env, "hash-table-cell", 3, sexp_hash_table_cell);
   sexp_define_foreign(ctx, env, "hash-table-delete!", 2, sexp_hash_table_delete);
 

opcodes.c

@@ -2,15 +2,18 @@
 #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, NULL, f}}}
-#define _FN(o,n,m,t,u,s,f,p) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, f, (sexp_proc1)p)
+#define _FN(o,n,m,t,u,s,d,f) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, d, (sexp_proc1)f)
-#define _FN0(s, f, d) _FN(OP_FCALL0, 0, 0, 0, 0, s, f, d)
+#define _FN0(s, d, f) _FN(OP_FCALL0, 0, 0, 0, 0, s, d, f)
-#define _FN1(t, s, f, d) _FN(OP_FCALL1, 1, 0, t, 0, s, f, d)
+#define _FN1(t, s, d, f) _FN(OP_FCALL1, 1, 0, t, 0, s, d, f)
-#define _FN2(t, u, s, f, d) _FN(OP_FCALL2, 2, 0, t, u, s, f, d)
+#define _FN1OPT(t, s, d, f) _FN(OP_FCALL1, 0, 1, t, u, s, d, f)
-#define _FN2OPT(t, u, s, f, d) _FN(OP_FCALL2, 1, 1, t, u, s, f, d)
+#define _FN1OPTP(t, s, d, f) _FN(OP_FCALL1, 0, 3, t, 0, s, d, f)
-#define _FN3(t, u, s, f, d) _FN(OP_FCALL3, 3, 0, t, u, s, f, d)
+#define _FN2(t, u, s, d, f) _FN(OP_FCALL2, 2, 0, t, u, s, d, f)
-#define _FN4(t, u, s, f, d) _FN(OP_FCALL4, 4, 0, t, u, s, f, d)
+#define _FN2OPT(t, u, s, d, f) _FN(OP_FCALL2, 1, 1, t, u, s, d, f)
-#define _FN5(t, u, s, f, d) _FN(OP_FCALL5, 5, 0, t, u, s, f, d)
+#define _FN2OPTP(t, u, s, d, f) _FN(OP_FCALL2, 1, 3, t, u, s, d, f)
-#define _FN6(t, u, s, f, d) _FN(OP_FCALL6, 6, 0, t, u, s, f, d)
+#define _FN3(t, u, s, d, f) _FN(OP_FCALL3, 3, 0, t, u, s, d, f)
+#define _FN4(t, u, s, d, f) _FN(OP_FCALL4, 4, 0, t, u, s, d, f)
+#define _FN5(t, u, s, d, f) _FN(OP_FCALL5, 5, 0, t, u, s, d, f)
+#define _FN6(t, u, s, d, f) _FN(OP_FCALL6, 6, 0, t, u, s, d, f)
 #define _PARAM(n, a, t) _OP(OPC_PARAMETER, OP_NOOP, 0, 3, t, 0, 0, n, a, 0)
 
 static struct sexp_struct opcodes[] = {
@@ -61,15 +64,14 @@ _OP(OPC_TYPE_PREDICATE, OP_TYPEP,  1, 0, 0, 0, 0, "output-port?", sexp_make_fixn
 _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),
-_OP(OPC_IO, OP_WRITE, 1, 3, 0, SEXP_OPORT, 0, "write", (sexp)"*current-output-port*", NULL),
-_OP(OPC_IO, OP_DISPLAY, 1, 3, 0, SEXP_OPORT, 0, "display", (sexp)"*current-output-port*", NULL),
 _OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL),
 _OP(OPC_IO, OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL),
-_OP(OPC_IO, OP_FLUSH_OUTPUT, 0, 3, 0, SEXP_OPORT, 0, "flush-output", (sexp)"*current-output-port*", NULL),
-_OP(OPC_IO, OP_READ, 0, 3, 0, SEXP_IPORT, 0, "read", (sexp)"*current-input-port*", NULL),
 _OP(OPC_IO, OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL),
 _OP(OPC_IO, OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL),
-_OP(OPC_GENERIC, OP_EVAL, 1, 3, 0, 0, 0, "eval", (sexp)"*interaction-environment*", NULL),
+_FN1OPTP(SEXP_IPORT, "read", (sexp)"*current-input-port*", sexp_read),
+_FN2OPTP(0, SEXP_OPORT, "write", (sexp)"*current-output-port*", sexp_write),
+_FN2OPTP(0, SEXP_OPORT, "display", (sexp)"*current-output-port*", sexp_display),
+_FN1OPTP(SEXP_OPORT, "flush-output", (sexp)"*current-output-port*", sexp_flush_output),
 _FN2(0, 0, "equal?", 0, sexp_equalp),
 _FN1(0, "list?", 0, sexp_listp),
 _FN1(0, "identifier?", 0, sexp_identifierp),
@@ -88,7 +90,8 @@ _FN1(SEXP_STRING, "file-exists?", 0, sexp_file_exists_p),
 _FN0("make-environment", 0, sexp_make_env),
 _FN1(SEXP_FIXNUM, "null-environment", 0, sexp_make_null_env),
 _FN1(SEXP_FIXNUM, "scheme-report-environment", 0, sexp_make_standard_env),
-_FN2(SEXP_STRING, SEXP_ENV, "%load", 0, sexp_load),
+_FN2OPTP(0, SEXP_ENV, "eval", (sexp)"*interaction-environment*", sexp_eval),
+_FN2OPTP(SEXP_STRING, SEXP_ENV, "load", (sexp)"*interaction-environment*", sexp_load),
 _FN3(SEXP_ENV, SEXP_ENV, "%env-copy!", 0, sexp_env_copy),
 _FN2(SEXP_EXCEPTION, SEXP_OPORT, "print-exception", 0, sexp_print_exception),
 _FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_func),

sexp.c

@@ -863,7 +863,7 @@ sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name) {
   return p;
 }
 
-void sexp_write (sexp ctx, sexp obj, sexp out) {
+sexp sexp_write (sexp ctx, sexp obj, sexp out) {
   unsigned long len, c, res;
   long i=0;
   double f;
@@ -1026,6 +1026,22 @@ void sexp_write (sexp ctx, sexp obj, sexp out) {
       sexp_write_string(ctx, "#<invalid immediate>", out);
     }
   }
+  return SEXP_VOID;
+}
+
+sexp sexp_display (sexp ctx, sexp obj, sexp out) {
+  if (sexp_stringp(obj))
+    sexp_write_string(ctx, sexp_string_data(obj), out);
+  else if (sexp_charp(obj))
+    sexp_write_char(ctx, sexp_unbox_character(obj), out);
+  else
+    sexp_write(ctx, obj, out);
+  return SEXP_VOID;
+}
+
+sexp sexp_flush_output (sexp ctx, sexp out) {
+  sexp_flush(ctx, out);
+  return SEXP_VOID;
 }
 
 #define INIT_STRING_BUFFER_SIZE 128