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

adding support for foreign functions taking up to 16 arguments

Browse source
This commit is contained in:
Alex Shinn 2010-07-07 23:53:48 +09:00
parent c031339334
commit 766a841ca4
5 changed files with 44 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
eval.c
View file

@ -1222,20 +1222,25 @@ sexp sexp_make_opcode (sexp ctx, sexp self, sexp name, sexp op_class, sexp code,
sexp sexp_make_foreign (sexp ctx, const char *name, int num_args,
int flags, sexp_proc1 f, sexp data) {
sexp res;
if (num_args > 6) {
res = sexp_user_exception(ctx, NULL, "make-foreign: exceeded foreign arg limit",
sexp_make_fixnum(num_args));
} else {
res = sexp_alloc_type(ctx, opcode, SEXP_OPCODE);
sexp_opcode_class(res) = SEXP_OPC_FOREIGN;
#if ! SEXP_USE_EXTENDED_FCALL
if (num_args > 6)
return sexp_user_exception(ctx, NULL, "make-foreign: exceeded foreign arg limit",
sexp_make_fixnum(num_args));
#endif
res = sexp_alloc_type(ctx, opcode, SEXP_OPCODE);
sexp_opcode_class(res) = SEXP_OPC_FOREIGN;
#if SEXP_USE_EXTENDED_FCALL
if (num_args > 6)
sexp_opcode_code(res) = SEXP_OP_FCALLN;
else
#endif
sexp_opcode_code(res) = SEXP_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;
}
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;
}

1
include/chibi/eval.h
View file

@ -62,6 +62,7 @@ enum sexp_opcode_names {
SEXP_OP_FCALL4,
SEXP_OP_FCALL5,
SEXP_OP_FCALL6,
SEXP_OP_FCALLN,
SEXP_OP_JUMP_UNLESS,
SEXP_OP_JUMP,
SEXP_OP_PUSH,

7
include/chibi/features.h
View file

@ -96,6 +96,9 @@
/* heap, of course. */
/* #define SEXP_USE_GLOBAL_SYMBOLS 1 */
/* uncomment this to disable foreign function bindings with > 6 args */
/* #define SEXP_USE_EXTENDED_FCALL 0 */
/* uncomment this if you don't need flonum support */
/* This is only for EVAL - you'll still be able to read */
/* and write flonums directly through the sexp API. */
@ -310,6 +313,10 @@
#endif
#endif
#ifndef SEXP_USE_EXTENDED_FCALL
#define SEXP_USE_EXTENDED_FCALL 1
#endif
#ifndef SEXP_USE_FLONUMS
#define SEXP_USE_FLONUMS ! SEXP_USE_NO_FEATURES
#endif

4
tools/genstubs.scm
View file

@ -272,8 +272,8 @@
(s-args '()))
(cond
((null? ls)
(if (> i 6)
(error "FFI currently only supports up to 6 scheme args" func))
;;(if (> i 6)
;; (error "FFI currently only supports up to 6 scheme args" func))
(vector scheme-name c-name stub-name ret-type
(reverse results) (reverse c-args) (reverse s-args)))
(else

16
vm.c
View file

@ -455,6 +455,10 @@ static sexp_uint_t sexp_restore_stack (sexp saved, sexp *current) {
#include "opt/opcode_names.h"
#endif
#if SEXP_USE_EXTENDED_FCALL
#include "opt/fcall.c"
#endif
sexp sexp_vm (sexp ctx, sexp proc) {
sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc);
sexp *stack = sexp_stack_data(sexp_context_stack(ctx));
@ -692,6 +696,18 @@ sexp sexp_vm (sexp ctx, sexp proc) {
ip += sizeof(sexp);
sexp_check_exception();
break;
#if SEXP_USE_EXTENDED_FCALL
case SEXP_OP_FCALLN:
_ALIGN_IP();
sexp_context_top(ctx) = top;
i = sexp_opcode_num_args(_WORD0);
tmp1 = sexp_fcall(ctx, self, i, _WORD0);
top -= (i-1);
_ARG1 = tmp1;
ip += sizeof(sexp);
sexp_check_exception();
break;
#endif
case SEXP_OP_JUMP_UNLESS:
_ALIGN_IP();
if (stack[--top] == SEXP_FALSE)