/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License * as published by the Free Software Foundation; either version 3 of * the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA * 02110-1301 USA */ #ifdef HAVE_CONFIG_H # include #endif #include #include #include #include "libguile/_scm.h" #include "libguile/gsubr.h" #include "libguile/foreign.h" #include "libguile/instructions.h" #include "libguile/objcodes.h" #include "libguile/srfi-4.h" #include "libguile/programs.h" #include "libguile/private-options.h" /* * gsubr.c * Provide `gsubrs' -- subrs taking a prescribed number of required, optional, * and rest arguments. */ /* #define GSUBR_TEST */ /* OK here goes nothing: we're going to define VM assembly trampolines for invoking subrs, along with their meta-information, and then wrap them into statically allocated objcode values. Ready? Right! */ /* There's a maximum of 10 args, so the number of possible combinations is: (REQ-OPT-REST) for 0 args: 1 (000) (1 + 0) for 1 arg: 3 (100, 010, 001) (2 + 1) for 2 args: 5 (200, 110, 020, 101, 011) (3 + 2) for 3 args: 7 (300, 210, 120, 030, 201, 111, 021) (4 + 3) for N args: 2N+1 and the index at which N args starts: for 0 args: 0 for 1 args: 1 for 2 args: 4 for 3 args: 9 for N args: N^2 One can prove this: (1 + 3 + 5 + ... + (2N+1)) = ((2N+1)+1)/2 * (N+1) = 2(N+1)/2 * (N+1) = (N+1)^2 Thus the total sum is 11^2 = 121. Let's just generate all of them as read-only data. */ #ifdef WORDS_BIGENDIAN #define OBJCODE_HEADER 0, 0, 0, 16, 0, 0, 0, 40 #define META_HEADER 0, 0, 0, 32, 0, 0, 0, 0 #else #define OBJCODE_HEADER 16, 0, 0, 0, 40, 0, 0, 0 #define META_HEADER 32, 0, 0, 0, 0, 0, 0, 0 #endif /* A: req; B: opt; C: rest */ #define A(nreq) \ OBJCODE_HEADER, \ /* 0 */ scm_op_assert_nargs_ee, 0, nreq, /* assert number of args */ \ /* 3 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \ /* 5 */ scm_op_subr_call, nreq, /* and call (will return value as well) */ \ /* 7 */ scm_op_nop, \ /* 8 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \ /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \ /* 16 */ META (3, 7, nreq, 0, 0) #define B(nopt) \ OBJCODE_HEADER, \ /* 0 */ scm_op_bind_optionals, 0, nopt, /* bind optionals */ \ /* 3 */ scm_op_assert_nargs_ee, 0, nopt, /* assert number of args */ \ /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \ /* 8 */ scm_op_subr_call, nopt, /* and call (will return value as well) */ \ /* 10 */ scm_op_nop, scm_op_nop, \ /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \ /* 16 */ META (6, 10, 0, nopt, 0) #define C() \ OBJCODE_HEADER, \ /* 0 */ scm_op_push_rest, 0, 0, /* cons all args into a list */ \ /* 3 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \ /* 5 */ scm_op_subr_call, 1, /* and call (will return value as well) */ \ /* 7 */ scm_op_nop, \ /* 8 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \ /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \ /* 16 */ META (3, 7, 0, 0, 1) #define AB(nreq, nopt) \ OBJCODE_HEADER, \ /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \ /* 3 */ scm_op_bind_optionals, 0, nreq+nopt, /* bind optionals */ \ /* 6 */ scm_op_assert_nargs_ee, 0, nreq+nopt, /* assert number of args */ \ /* 9 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \ /* 11 */ scm_op_subr_call, nreq+nopt, /* and call (will return value as well) */ \ /* 13 */ scm_op_nop, scm_op_nop, scm_op_nop, \ /* 16 */ META (9, 13, nreq, nopt, 0) #define AC(nreq) \ OBJCODE_HEADER, \ /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \ /* 3 */ scm_op_push_rest, 0, nreq, /* cons rest list */ \ /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \ /* 8 */ scm_op_subr_call, nreq+1, /* and call (will return value as well) */ \ /* 10 */ scm_op_nop, scm_op_nop, \ /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \ /* 16 */ META (6, 10, nreq, 0, 1) #define BC(nopt) \ OBJCODE_HEADER, \ /* 0 */ scm_op_bind_optionals, 0, nopt, /* bind optionals */ \ /* 3 */ scm_op_push_rest, 0, nopt, /* cons rest list */ \ /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \ /* 8 */ scm_op_subr_call, nopt+1, /* and call (will return value as well) */ \ /* 10 */ scm_op_nop, scm_op_nop, \ /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \ /* 16 */ META (6, 10, 0, nopt, 1) #define ABC(nreq, nopt) \ OBJCODE_HEADER, \ /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \ /* 3 */ scm_op_bind_optionals, 0, nreq+nopt, /* bind optionals */ \ /* 6 */ scm_op_push_rest, 0, nreq+nopt, /* cons rest list */ \ /* 9 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \ /* 11 */ scm_op_subr_call, nreq+nopt+1, /* and call (will return value as well) */ \ /* 13 */ scm_op_nop, scm_op_nop, scm_op_nop, \ /* 16 */ META (9, 13, nreq, nopt, 1) #define META(start, end, nreq, nopt, rest) \ META_HEADER, \ /* 0 */ scm_op_make_eol, /* bindings */ \ /* 1 */ scm_op_make_eol, /* sources */ \ /* 2 */ scm_op_make_int8, start, scm_op_make_int8, end, /* arity: from ip N to ip N */ \ /* 6 */ scm_op_make_int8, nreq, /* the arity is N required args */ \ /* 8 */ scm_op_make_int8, nopt, /* N optionals */ \ /* 10 */ rest ? scm_op_make_true : scm_op_make_false, /* maybe a rest arg */ \ /* 11 */ scm_op_list, 0, 5, /* make a list of those 5 vals */ \ /* 14 */ scm_op_list, 0, 1, /* and the arities will be a list of that one list */ \ /* 17 */ scm_op_load_symbol, 0, 0, 4, 'n', 'a', 'm', 'e', /* `name' */ \ /* 25 */ scm_op_object_ref, 1, /* the name from the object table */ \ /* 27 */ scm_op_cons, /* make a pair for the properties */ \ /* 28 */ scm_op_list, 0, 4, /* pack bindings, sources, and arities into list */ \ /* 31 */ scm_op_return /* and return */ \ /* 32 */ /* (defun generate-bytecode (n) "Generate bytecode for N arguments" (interactive "p") (insert (format "/\* %d arguments *\/\n " n)) (let ((nreq n)) (while (<= 0 nreq) (let ((nopt (- n nreq))) (insert (if (< 0 nreq) (if (< 0 nopt) (format "AB(%d,%d), " nreq nopt) (format "A(%d), " nreq)) (if (< 0 nopt) (format "B(%d), " nopt) (format "A(0), ")))) (setq nreq (1- nreq)))) (insert "\n ") (setq nreq (1- n)) (while (<= 0 nreq) (let ((nopt (- n nreq 1))) (insert (if (< 0 nreq) (if (< 0 nopt) (format "ABC(%d,%d), " nreq nopt) (format "AC(%d), " nreq)) (if (< 0 nopt) (format "BC(%d), " nopt) (format "C(), ")))) (setq nreq (1- nreq)))) (insert "\n\n "))) (defun generate-bytecodes (n) "Generate bytecodes for up to N arguments" (interactive "p") (let ((i 0)) (while (<= i n) (generate-bytecode i) (setq i (1+ i))))) */ static const struct { scm_t_uint64 dummy; /* ensure 8-byte alignment; perhaps there's a better way */ const scm_t_uint8 bytes[121 * (sizeof (struct scm_objcode) + 16 + sizeof (struct scm_objcode) + 32)]; } raw_bytecode = { 0, { /* C-u 1 0 M-x generate-bytecodes RET */ /* 0 arguments */ A(0), /* 1 arguments */ A(1), B(1), C(), /* 2 arguments */ A(2), AB(1,1), B(2), AC(1), BC(1), /* 3 arguments */ A(3), AB(2,1), AB(1,2), B(3), AC(2), ABC(1,1), BC(2), /* 4 arguments */ A(4), AB(3,1), AB(2,2), AB(1,3), B(4), AC(3), ABC(2,1), ABC(1,2), BC(3), /* 5 arguments */ A(5), AB(4,1), AB(3,2), AB(2,3), AB(1,4), B(5), AC(4), ABC(3,1), ABC(2,2), ABC(1,3), BC(4), /* 6 arguments */ A(6), AB(5,1), AB(4,2), AB(3,3), AB(2,4), AB(1,5), B(6), AC(5), ABC(4,1), ABC(3,2), ABC(2,3), ABC(1,4), BC(5), /* 7 arguments */ A(7), AB(6,1), AB(5,2), AB(4,3), AB(3,4), AB(2,5), AB(1,6), B(7), AC(6), ABC(5,1), ABC(4,2), ABC(3,3), ABC(2,4), ABC(1,5), BC(6), /* 8 arguments */ A(8), AB(7,1), AB(6,2), AB(5,3), AB(4,4), AB(3,5), AB(2,6), AB(1,7), B(8), AC(7), ABC(6,1), ABC(5,2), ABC(4,3), ABC(3,4), ABC(2,5), ABC(1,6), BC(7), /* 9 arguments */ A(9), AB(8,1), AB(7,2), AB(6,3), AB(5,4), AB(4,5), AB(3,6), AB(2,7), AB(1,8), B(9), AC(8), ABC(7,1), ABC(6,2), ABC(5,3), ABC(4,4), ABC(3,5), ABC(2,6), ABC(1,7), BC(8), /* 10 arguments */ A(10), AB(9,1), AB(8,2), AB(7,3), AB(6,4), AB(5,5), AB(4,6), AB(3,7), AB(2,8), AB(1,9), B(10), AC(9), ABC(8,1), ABC(7,2), ABC(6,3), ABC(5,4), ABC(4,5), ABC(3,6), ABC(2,7), ABC(1,8), BC(9) } }; #undef A #undef B #undef C #undef AB #undef AC #undef BC #undef ABC #undef OBJCODE_HEADER #undef META_HEADER #undef META /* ;; (nargs * nargs) + nopt + rest * (nargs + 1) (defun generate-objcode-cells-helper (n) "Generate objcode cells for N arguments" (interactive "p") (insert (format " /\* %d arguments *\/\n" n)) (let ((nreq n)) (while (<= 0 nreq) (let ((nopt (- n nreq))) (insert (format " { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + %d) },\n" (* (+ 4 4 16 4 4 32) (+ (* n n) nopt)))) (insert " { SCM_BOOL_F, SCM_PACK (0) },\n") (setq nreq (1- nreq)))) (insert "\n") (setq nreq (1- n)) (while (<= 0 nreq) (let ((nopt (- n nreq 1))) (insert (format " { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + %d) },\n" (* (+ 4 4 16 4 4 32) (+ (* n n) nopt n 1)))) (insert " { SCM_BOOL_F, SCM_PACK (0) },\n") (setq nreq (1- nreq)))) (insert "\n"))) (defun generate-objcode-cells (n) "Generate objcode cells for up to N arguments" (interactive "p") (let ((i 0)) (while (<= i n) (generate-objcode-cells-helper i) (setq i (1+ i))))) */ #define STATIC_OBJCODE_TAG \ SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8)) static const struct { scm_t_uint64 dummy; /* alignment */ scm_t_cell cells[121 * 2]; /* 11*11 double cells */ } objcode_cells = { 0, /* C-u 1 0 M-x generate-objcode-cells RET */ { /* 0 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 0) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 1 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 64) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 128) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 192) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 2 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 256) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 320) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 384) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 448) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 512) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 3 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 576) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 640) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 704) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 768) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 832) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 896) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 960) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 4 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1024) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1088) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1152) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1216) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1280) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1344) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1408) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1472) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1536) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 5 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1600) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1664) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1728) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1792) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1856) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1920) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 1984) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2048) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2112) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2176) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2240) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 6 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2304) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2368) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2432) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2496) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2560) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2624) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2688) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2752) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2816) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2880) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 2944) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3008) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3072) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 7 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3136) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3200) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3264) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3328) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3392) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3456) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3520) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3584) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3648) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3712) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3776) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3840) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3904) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 3968) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4032) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 8 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4096) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4160) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4224) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4288) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4352) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4416) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4480) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4544) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4608) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4672) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4736) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4800) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4864) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4928) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 4992) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5056) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5120) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 9 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5184) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5248) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5312) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5376) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5440) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5504) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5568) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5632) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5696) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5760) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5824) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5888) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 5952) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6016) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6080) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6144) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6208) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6272) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6336) }, { SCM_BOOL_F, SCM_PACK (0) }, /* 10 arguments */ { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6400) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6464) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6528) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6592) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6656) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6720) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6784) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6848) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6912) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 6976) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7040) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7104) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7168) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7232) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7296) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7360) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7424) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7488) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7552) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7616) }, { SCM_BOOL_F, SCM_PACK (0) }, { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + 7680) }, { SCM_BOOL_F, SCM_PACK (0) } } }; /* (defun generate-objcode (n) "Generate objcode for N arguments" (interactive "p") (insert (format " /\* %d arguments *\/\n" n)) (let ((i (* n n))) (while (< i (* (1+ n) (1+ n))) (insert (format " SCM_PACK (objcode_cells.cells+%d),\n" (* i 2))) (setq i (1+ i))) (insert "\n"))) (defun generate-objcodes (n) "Generate objcodes for up to N arguments" (interactive "p") (let ((i 0)) (while (<= i n) (generate-objcode i) (setq i (1+ i))))) */ static const SCM scm_subr_objcode_trampolines[121] = { /* C-u 1 0 M-x generate-objcodes RET */ /* 0 arguments */ SCM_PACK (objcode_cells.cells+0), /* 1 arguments */ SCM_PACK (objcode_cells.cells+2), SCM_PACK (objcode_cells.cells+4), SCM_PACK (objcode_cells.cells+6), /* 2 arguments */ SCM_PACK (objcode_cells.cells+8), SCM_PACK (objcode_cells.cells+10), SCM_PACK (objcode_cells.cells+12), SCM_PACK (objcode_cells.cells+14), SCM_PACK (objcode_cells.cells+16), /* 3 arguments */ SCM_PACK (objcode_cells.cells+18), SCM_PACK (objcode_cells.cells+20), SCM_PACK (objcode_cells.cells+22), SCM_PACK (objcode_cells.cells+24), SCM_PACK (objcode_cells.cells+26), SCM_PACK (objcode_cells.cells+28), SCM_PACK (objcode_cells.cells+30), /* 4 arguments */ SCM_PACK (objcode_cells.cells+32), SCM_PACK (objcode_cells.cells+34), SCM_PACK (objcode_cells.cells+36), SCM_PACK (objcode_cells.cells+38), SCM_PACK (objcode_cells.cells+40), SCM_PACK (objcode_cells.cells+42), SCM_PACK (objcode_cells.cells+44), SCM_PACK (objcode_cells.cells+46), SCM_PACK (objcode_cells.cells+48), /* 5 arguments */ SCM_PACK (objcode_cells.cells+50), SCM_PACK (objcode_cells.cells+52), SCM_PACK (objcode_cells.cells+54), SCM_PACK (objcode_cells.cells+56), SCM_PACK (objcode_cells.cells+58), SCM_PACK (objcode_cells.cells+60), SCM_PACK (objcode_cells.cells+62), SCM_PACK (objcode_cells.cells+64), SCM_PACK (objcode_cells.cells+66), SCM_PACK (objcode_cells.cells+68), SCM_PACK (objcode_cells.cells+70), /* 6 arguments */ SCM_PACK (objcode_cells.cells+72), SCM_PACK (objcode_cells.cells+74), SCM_PACK (objcode_cells.cells+76), SCM_PACK (objcode_cells.cells+78), SCM_PACK (objcode_cells.cells+80), SCM_PACK (objcode_cells.cells+82), SCM_PACK (objcode_cells.cells+84), SCM_PACK (objcode_cells.cells+86), SCM_PACK (objcode_cells.cells+88), SCM_PACK (objcode_cells.cells+90), SCM_PACK (objcode_cells.cells+92), SCM_PACK (objcode_cells.cells+94), SCM_PACK (objcode_cells.cells+96), /* 7 arguments */ SCM_PACK (objcode_cells.cells+98), SCM_PACK (objcode_cells.cells+100), SCM_PACK (objcode_cells.cells+102), SCM_PACK (objcode_cells.cells+104), SCM_PACK (objcode_cells.cells+106), SCM_PACK (objcode_cells.cells+108), SCM_PACK (objcode_cells.cells+110), SCM_PACK (objcode_cells.cells+112), SCM_PACK (objcode_cells.cells+114), SCM_PACK (objcode_cells.cells+116), SCM_PACK (objcode_cells.cells+118), SCM_PACK (objcode_cells.cells+120), SCM_PACK (objcode_cells.cells+122), SCM_PACK (objcode_cells.cells+124), SCM_PACK (objcode_cells.cells+126), /* 8 arguments */ SCM_PACK (objcode_cells.cells+128), SCM_PACK (objcode_cells.cells+130), SCM_PACK (objcode_cells.cells+132), SCM_PACK (objcode_cells.cells+134), SCM_PACK (objcode_cells.cells+136), SCM_PACK (objcode_cells.cells+138), SCM_PACK (objcode_cells.cells+140), SCM_PACK (objcode_cells.cells+142), SCM_PACK (objcode_cells.cells+144), SCM_PACK (objcode_cells.cells+146), SCM_PACK (objcode_cells.cells+148), SCM_PACK (objcode_cells.cells+150), SCM_PACK (objcode_cells.cells+152), SCM_PACK (objcode_cells.cells+154), SCM_PACK (objcode_cells.cells+156), SCM_PACK (objcode_cells.cells+158), SCM_PACK (objcode_cells.cells+160), /* 9 arguments */ SCM_PACK (objcode_cells.cells+162), SCM_PACK (objcode_cells.cells+164), SCM_PACK (objcode_cells.cells+166), SCM_PACK (objcode_cells.cells+168), SCM_PACK (objcode_cells.cells+170), SCM_PACK (objcode_cells.cells+172), SCM_PACK (objcode_cells.cells+174), SCM_PACK (objcode_cells.cells+176), SCM_PACK (objcode_cells.cells+178), SCM_PACK (objcode_cells.cells+180), SCM_PACK (objcode_cells.cells+182), SCM_PACK (objcode_cells.cells+184), SCM_PACK (objcode_cells.cells+186), SCM_PACK (objcode_cells.cells+188), SCM_PACK (objcode_cells.cells+190), SCM_PACK (objcode_cells.cells+192), SCM_PACK (objcode_cells.cells+194), SCM_PACK (objcode_cells.cells+196), SCM_PACK (objcode_cells.cells+198), /* 10 arguments */ SCM_PACK (objcode_cells.cells+200), SCM_PACK (objcode_cells.cells+202), SCM_PACK (objcode_cells.cells+204), SCM_PACK (objcode_cells.cells+206), SCM_PACK (objcode_cells.cells+208), SCM_PACK (objcode_cells.cells+210), SCM_PACK (objcode_cells.cells+212), SCM_PACK (objcode_cells.cells+214), SCM_PACK (objcode_cells.cells+216), SCM_PACK (objcode_cells.cells+218), SCM_PACK (objcode_cells.cells+220), SCM_PACK (objcode_cells.cells+222), SCM_PACK (objcode_cells.cells+224), SCM_PACK (objcode_cells.cells+226), SCM_PACK (objcode_cells.cells+228), SCM_PACK (objcode_cells.cells+230), SCM_PACK (objcode_cells.cells+232), SCM_PACK (objcode_cells.cells+234), SCM_PACK (objcode_cells.cells+236), SCM_PACK (objcode_cells.cells+238), SCM_PACK (objcode_cells.cells+240) }; /* (nargs * nargs) + nopt + rest * (nargs + 1) */ #define SCM_SUBR_OBJCODE_TRAMPOLINE(nreq,nopt,rest) \ scm_subr_objcode_trampolines[(nreq + nopt + rest) * (nreq + nopt + rest) \ + nopt + rest * (nreq + nopt + rest + 1)] SCM scm_subr_objcode_trampoline (unsigned int nreq, unsigned int nopt, unsigned int rest) { if (SCM_UNLIKELY (rest > 1 || nreq + nopt + rest > 10)) scm_out_of_range ("make-subr", scm_from_uint (nreq + nopt + rest)); return SCM_SUBR_OBJCODE_TRAMPOLINE (nreq, nopt, rest); } static SCM create_gsubr (int define, const char *name, unsigned int nreq, unsigned int nopt, unsigned int rest, SCM (*fcn) (), SCM *generic_loc) { SCM ret; SCM sname; SCM table; scm_t_bits flags; /* make objtable */ sname = scm_from_locale_symbol (name); table = scm_c_make_vector (generic_loc ? 3 : 2, SCM_UNDEFINED); SCM_SIMPLE_VECTOR_SET (table, 0, scm_c_from_foreign (SCM_FOREIGN_TYPE_POINTER, &fcn, 0, NULL)); SCM_SIMPLE_VECTOR_SET (table, 1, sname); if (generic_loc) SCM_SIMPLE_VECTOR_SET (table, 2, scm_c_from_foreign (SCM_FOREIGN_TYPE_POINTER, &generic_loc, 0, NULL)); /* make program */ ret = scm_make_program (scm_subr_objcode_trampoline (nreq, nopt, rest), table, SCM_BOOL_F); /* set flags */ flags = generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0; SCM_SET_CELL_WORD_0 (ret, SCM_CELL_WORD_0 (ret) | flags); /* define, if needed */ if (define) scm_define (sname, ret); /* et voila. */ return ret; } SCM scm_c_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)()) { return create_gsubr (0, name, req, opt, rst, fcn, NULL); } SCM scm_c_define_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)()) { return create_gsubr (1, name, req, opt, rst, fcn, NULL); } SCM scm_c_make_gsubr_with_generic (const char *name, int req, int opt, int rst, SCM (*fcn)(), SCM *gf) { return create_gsubr (0, name, req, opt, rst, fcn, gf); } SCM scm_c_define_gsubr_with_generic (const char *name, int req, int opt, int rst, SCM (*fcn)(), SCM *gf) { return create_gsubr (1, name, req, opt, rst, fcn, gf); } /* Apply PROC, a gsubr, to the ARGC arguments in ARGV. ARGC is expected to match the number of arguments of the underlying C function. */ static SCM gsubr_apply_raw (SCM proc, unsigned int argc, const SCM *argv) { SCM (*fcn) (); unsigned int type, argc_max; type = SCM_GSUBR_TYPE (proc); argc_max = SCM_GSUBR_REQ (type) + SCM_GSUBR_OPT (type) + SCM_GSUBR_REST (type); if (SCM_UNLIKELY (argc != argc_max)) /* We expect the exact argument count. */ scm_wrong_num_args (SCM_SUBR_NAME (proc)); fcn = SCM_SUBRF (proc); switch (argc) { case 0: return (*fcn) (); case 1: return (*fcn) (argv[0]); case 2: return (*fcn) (argv[0], argv[1]); case 3: return (*fcn) (argv[0], argv[1], argv[2]); case 4: return (*fcn) (argv[0], argv[1], argv[2], argv[3]); case 5: return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4]); case 6: return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); case 7: return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); case 8: return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7]); case 9: return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8]); case 10: return (*fcn) (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8], argv[9]); default: scm_misc_error ((char *) SCM_SUBR_NAME (proc), "gsubr invocation with more than 10 arguments not implemented", SCM_EOL); } return SCM_BOOL_F; /* Never reached. */ } /* Apply PROC, a gsubr, to the given arguments. Missing optional arguments are added, and rest arguments are turned into a list. */ SCM scm_i_gsubr_apply (SCM proc, SCM arg, ...) { unsigned int type, argc, argc_max; SCM *argv; va_list arg_list; type = SCM_GSUBR_TYPE (proc); argc_max = SCM_GSUBR_REQ (type) + SCM_GSUBR_OPT (type); argv = alloca ((argc_max + SCM_GSUBR_REST (type)) * sizeof (*argv)); va_start (arg_list, arg); for (argc = 0; !SCM_UNBNDP (arg) && argc < argc_max; argc++, arg = va_arg (arg_list, SCM)) argv[argc] = arg; if (SCM_UNLIKELY (argc < SCM_GSUBR_REQ (type))) /* too few args */ scm_wrong_num_args (SCM_SUBR_NAME (proc)); if (SCM_UNLIKELY (!SCM_UNBNDP (arg) && !SCM_GSUBR_REST (type))) /* too many args */ scm_wrong_num_args (SCM_SUBR_NAME (proc)); /* Fill in optional arguments that were not passed. */ while (argc < argc_max) argv[argc++] = SCM_UNDEFINED; if (SCM_GSUBR_REST (type)) { /* Accumulate rest arguments in a list. */ SCM *rest_loc; argv[argc_max] = SCM_EOL; for (rest_loc = &argv[argc_max]; !SCM_UNBNDP (arg); rest_loc = SCM_CDRLOC (*rest_loc), arg = va_arg (arg_list, SCM)) *rest_loc = scm_cons (arg, SCM_EOL); argc = argc_max + 1; } va_end (arg_list); return gsubr_apply_raw (proc, argc, argv); } /* Apply SELF, a gsubr, to the arguments listed in ARGS. Missing optional arguments are added, and rest arguments are kept into a list. */ SCM scm_i_gsubr_apply_list (SCM self, SCM args) #define FUNC_NAME "scm_i_gsubr_apply" { SCM v[SCM_GSUBR_MAX]; unsigned int typ = SCM_GSUBR_TYPE (self); long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ); for (i = 0; i < SCM_GSUBR_REQ (typ); i++) { if (scm_is_null (args)) scm_wrong_num_args (SCM_SUBR_NAME (self)); v[i] = SCM_CAR(args); args = SCM_CDR(args); } for (; i < SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ); i++) { if (SCM_NIMP (args)) { v[i] = SCM_CAR (args); args = SCM_CDR(args); } else v[i] = SCM_UNDEFINED; } if (SCM_GSUBR_REST(typ)) v[i] = args; else if (!scm_is_null (args)) scm_wrong_num_args (SCM_SUBR_NAME (self)); return gsubr_apply_raw (self, n, v); } #undef FUNC_NAME /* Apply SELF, a gsubr, to the arguments in ARGS. Missing optional arguments are added, and rest arguments are consed into a list. */ SCM scm_i_gsubr_apply_array (SCM self, SCM *args, int nargs, int headroom) #define FUNC_NAME "scm_i_gsubr_apply" { unsigned int typ = SCM_GSUBR_TYPE (self); long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ); if (SCM_UNLIKELY (nargs < SCM_GSUBR_REQ (typ))) scm_wrong_num_args (SCM_SUBR_NAME (self)); if (SCM_UNLIKELY (headroom < n - nargs)) { /* fallback on apply-list */ SCM arglist = SCM_EOL; while (nargs--) arglist = scm_cons (args[nargs], arglist); return scm_i_gsubr_apply_list (self, arglist); } for (i = nargs; i < SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ); i++) args[i] = SCM_UNDEFINED; if (SCM_GSUBR_REST(typ)) { SCM rest = SCM_EOL; /* fallback on apply-list */ while (nargs-- >= n) rest = scm_cons (args[nargs], rest); args[n - 1] = rest; } else if (nargs > n) scm_wrong_num_args (SCM_SUBR_NAME (self)); return gsubr_apply_raw (self, n, args); } #undef FUNC_NAME #ifdef GSUBR_TEST /* A silly example, taking 2 required args, 1 optional, and a scm_list of rest args */ SCM gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst) { scm_puts ("gsubr-2-1-l:\n req1: ", scm_cur_outp); scm_display(req1, scm_cur_outp); scm_puts ("\n req2: ", scm_cur_outp); scm_display(req2, scm_cur_outp); scm_puts ("\n opt: ", scm_cur_outp); scm_display(opt, scm_cur_outp); scm_puts ("\n rest: ", scm_cur_outp); scm_display(rst, scm_cur_outp); scm_newline(scm_cur_outp); return SCM_UNSPECIFIED; } #endif void scm_init_gsubr() { #ifdef GSUBR_TEST scm_c_define_gsubr ("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */ #endif #include "libguile/gsubr.x" } /* Local Variables: c-file-style: "gnu" End: */