1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27 #include "libguile/_scm.h"
28 #include "libguile/gsubr.h"
29 #include "libguile/foreign.h"
30 #include "libguile/instructions.h"
31 #include "libguile/objcodes.h"
32 #include "libguile/srfi-4.h"
33 #include "libguile/programs.h"
35 #include "libguile/private-options.h"
39 * Provide `gsubrs' -- subrs taking a prescribed number of required, optional,
43 /* #define GSUBR_TEST */
47 /* OK here goes nothing: we're going to define VM assembly trampolines for
48 invoking subrs, along with their meta-information, and then wrap them into
49 statically allocated objcode values. Ready? Right!
52 /* There's a maximum of 10 args, so the number of possible combinations is:
54 for 0 args: 1 (000) (1 + 0)
55 for 1 arg: 3 (100, 010, 001) (2 + 1)
56 for 2 args: 5 (200, 110, 020, 101, 011) (3 + 2)
57 for 3 args: 7 (300, 210, 120, 030, 201, 111, 021) (4 + 3)
60 and the index at which N args starts:
69 (1 + 3 + 5 + ... + (2N+1))
70 = ((2N+1)+1)/2 * (N+1)
74 Thus the total sum is 11^2 = 121. Let's just generate all of them as
78 #ifdef WORDS_BIGENDIAN
79 #define OBJCODE_HEADER 0, 0, 0, 16, 0, 0, 0, 40
80 #define META_HEADER 0, 0, 0, 32, 0, 0, 0, 0
82 #define OBJCODE_HEADER 16, 0, 0, 0, 40, 0, 0, 0
83 #define META_HEADER 32, 0, 0, 0, 0, 0, 0, 0
86 /* A: req; B: opt; C: rest */
89 /* 0 */ scm_op_assert_nargs_ee, 0, nreq, /* assert number of args */ \
90 /* 3 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \
91 /* 5 */ scm_op_subr_call, nreq, /* and call (will return value as well) */ \
93 /* 8 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
94 /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
95 /* 16 */ META (3, 7, nreq, 0, 0)
99 /* 0 */ scm_op_bind_optionals, 0, nopt, /* bind optionals */ \
100 /* 3 */ scm_op_assert_nargs_ee, 0, nopt, /* assert number of args */ \
101 /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \
102 /* 8 */ scm_op_subr_call, nopt, /* and call (will return value as well) */ \
103 /* 10 */ scm_op_nop, scm_op_nop, \
104 /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
105 /* 16 */ META (6, 10, 0, nopt, 0)
109 /* 0 */ scm_op_push_rest, 0, 0, /* cons all args into a list */ \
110 /* 3 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \
111 /* 5 */ scm_op_subr_call, 1, /* and call (will return value as well) */ \
112 /* 7 */ scm_op_nop, \
113 /* 8 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
114 /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
115 /* 16 */ META (3, 7, 0, 0, 1)
117 #define AB(nreq, nopt) \
119 /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \
120 /* 3 */ scm_op_bind_optionals, 0, nreq+nopt, /* bind optionals */ \
121 /* 6 */ scm_op_assert_nargs_ee, 0, nreq+nopt, /* assert number of args */ \
122 /* 9 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \
123 /* 11 */ scm_op_subr_call, nreq+nopt, /* and call (will return value as well) */ \
124 /* 13 */ scm_op_nop, scm_op_nop, scm_op_nop, \
125 /* 16 */ META (9, 13, nreq, nopt, 0)
129 /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \
130 /* 3 */ scm_op_push_rest, 0, nreq, /* cons rest list */ \
131 /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \
132 /* 8 */ scm_op_subr_call, nreq+1, /* and call (will return value as well) */ \
133 /* 10 */ scm_op_nop, scm_op_nop, \
134 /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
135 /* 16 */ META (6, 10, nreq, 0, 1)
139 /* 0 */ scm_op_bind_optionals, 0, nopt, /* bind optionals */ \
140 /* 3 */ scm_op_push_rest, 0, nopt, /* cons rest list */ \
141 /* 6 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \
142 /* 8 */ scm_op_subr_call, nopt+1, /* and call (will return value as well) */ \
143 /* 10 */ scm_op_nop, scm_op_nop, \
144 /* 12 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, \
145 /* 16 */ META (6, 10, 0, nopt, 1)
147 #define ABC(nreq, nopt) \
149 /* 0 */ scm_op_assert_nargs_ge, 0, nreq, /* assert number of args */ \
150 /* 3 */ scm_op_bind_optionals, 0, nreq+nopt, /* bind optionals */ \
151 /* 6 */ scm_op_push_rest, 0, nreq+nopt, /* cons rest list */ \
152 /* 9 */ scm_op_object_ref, 0, /* push the foreign object wrapping the subr pointer */ \
153 /* 11 */ scm_op_subr_call, nreq+nopt+1, /* and call (will return value as well) */ \
154 /* 13 */ scm_op_nop, scm_op_nop, scm_op_nop, \
155 /* 16 */ META (9, 13, nreq, nopt, 1)
157 #define META(start, end, nreq, nopt, rest) \
159 /* 0 */ scm_op_make_eol, /* bindings */ \
160 /* 1 */ scm_op_make_eol, /* sources */ \
161 /* 2 */ scm_op_make_int8, start, scm_op_make_int8, end, /* arity: from ip N to ip N */ \
162 /* 6 */ scm_op_make_int8, nreq, /* the arity is N required args */ \
163 /* 8 */ scm_op_make_int8, nopt, /* N optionals */ \
164 /* 10 */ rest ? scm_op_make_true : scm_op_make_false, /* maybe a rest arg */ \
165 /* 11 */ scm_op_list, 0, 5, /* make a list of those 5 vals */ \
166 /* 14 */ scm_op_list, 0, 1, /* and the arities will be a list of that one list */ \
167 /* 17 */ scm_op_load_symbol, 0, 0, 4, 'n', 'a', 'm', 'e', /* `name' */ \
168 /* 25 */ scm_op_object_ref, 1, /* the name from the object table */ \
169 /* 27 */ scm_op_cons, /* make a pair for the properties */ \
170 /* 28 */ scm_op_list, 0, 4, /* pack bindings, sources, and arities into list */ \
171 /* 31 */ scm_op_return /* and return */ \
175 (defun generate-bytecode (n)
176 "Generate bytecode for N arguments"
178 (insert (format "/\* %d arguments *\/\n " n))
181 (let ((nopt (- n nreq)))
185 (format "AB(%d,%d), " nreq nopt)
186 (format "A(%d), " nreq))
188 (format "B(%d), " nopt)
190 (setq nreq (1- nreq))))
194 (let ((nopt (- n nreq 1)))
198 (format "ABC(%d,%d), " nreq nopt)
199 (format "AC(%d), " nreq))
201 (format "BC(%d), " nopt)
203 (setq nreq (1- nreq))))
206 (defun generate-bytecodes (n)
207 "Generate bytecodes for up to N arguments"
211 (generate-bytecode i)
216 scm_t_uint64 dummy
; /* ensure 8-byte alignment; perhaps there's a better way */
217 const scm_t_uint8 bytes
[121 * (sizeof (struct scm_objcode
) + 16
218 + sizeof (struct scm_objcode
) + 32)];
222 /* C-u 1 0 M-x generate-bytecodes RET */
235 A(3), AB(2,1), AB(1,2), B(3),
236 AC(2), ABC(1,1), BC(2),
239 A(4), AB(3,1), AB(2,2), AB(1,3), B(4),
240 AC(3), ABC(2,1), ABC(1,2), BC(3),
243 A(5), AB(4,1), AB(3,2), AB(2,3), AB(1,4), B(5),
244 AC(4), ABC(3,1), ABC(2,2), ABC(1,3), BC(4),
247 A(6), AB(5,1), AB(4,2), AB(3,3), AB(2,4), AB(1,5), B(6),
248 AC(5), ABC(4,1), ABC(3,2), ABC(2,3), ABC(1,4), BC(5),
251 A(7), AB(6,1), AB(5,2), AB(4,3), AB(3,4), AB(2,5), AB(1,6), B(7),
252 AC(6), ABC(5,1), ABC(4,2), ABC(3,3), ABC(2,4), ABC(1,5), BC(6),
255 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),
256 AC(7), ABC(6,1), ABC(5,2), ABC(4,3), ABC(3,4), ABC(2,5), ABC(1,6), BC(7),
259 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),
260 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),
263 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),
264 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)
275 #undef OBJCODE_HEADER
280 ;; (nargs * nargs) + nopt + rest * (nargs + 1)
281 (defun generate-objcode-cells-helper (n)
282 "Generate objcode cells for N arguments"
284 (insert (format " /\* %d arguments *\/\n" n))
287 (let ((nopt (- n nreq)))
289 (format " { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + %d) },\n"
292 (insert " { SCM_BOOL_F, SCM_PACK (0) },\n")
293 (setq nreq (1- nreq))))
297 (let ((nopt (- n nreq 1)))
299 (format " { STATIC_OBJCODE_TAG, SCM_PACK (raw_bytecode.bytes + %d) },\n"
301 (+ (* n n) nopt n 1))))
302 (insert " { SCM_BOOL_F, SCM_PACK (0) },\n")
303 (setq nreq (1- nreq))))
306 (defun generate-objcode-cells (n)
307 "Generate objcode cells for up to N arguments"
311 (generate-objcode-cells-helper i)
315 #define STATIC_OBJCODE_TAG \
316 SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
320 scm_t_uint64 dummy
; /* alignment */
321 scm_t_cell cells
[121 * 2]; /* 11*11 double cells */
324 /* C-u 1 0 M-x generate-objcode-cells RET */
327 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 0) },
328 { SCM_BOOL_F
, SCM_PACK (0) },
332 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 64) },
333 { SCM_BOOL_F
, SCM_PACK (0) },
334 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 128) },
335 { SCM_BOOL_F
, SCM_PACK (0) },
337 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 192) },
338 { SCM_BOOL_F
, SCM_PACK (0) },
341 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 256) },
342 { SCM_BOOL_F
, SCM_PACK (0) },
343 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 320) },
344 { SCM_BOOL_F
, SCM_PACK (0) },
345 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 384) },
346 { SCM_BOOL_F
, SCM_PACK (0) },
348 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 448) },
349 { SCM_BOOL_F
, SCM_PACK (0) },
350 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 512) },
351 { SCM_BOOL_F
, SCM_PACK (0) },
354 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 576) },
355 { SCM_BOOL_F
, SCM_PACK (0) },
356 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 640) },
357 { SCM_BOOL_F
, SCM_PACK (0) },
358 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 704) },
359 { SCM_BOOL_F
, SCM_PACK (0) },
360 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 768) },
361 { SCM_BOOL_F
, SCM_PACK (0) },
363 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 832) },
364 { SCM_BOOL_F
, SCM_PACK (0) },
365 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 896) },
366 { SCM_BOOL_F
, SCM_PACK (0) },
367 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 960) },
368 { SCM_BOOL_F
, SCM_PACK (0) },
371 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1024) },
372 { SCM_BOOL_F
, SCM_PACK (0) },
373 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1088) },
374 { SCM_BOOL_F
, SCM_PACK (0) },
375 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1152) },
376 { SCM_BOOL_F
, SCM_PACK (0) },
377 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1216) },
378 { SCM_BOOL_F
, SCM_PACK (0) },
379 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1280) },
380 { SCM_BOOL_F
, SCM_PACK (0) },
382 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1344) },
383 { SCM_BOOL_F
, SCM_PACK (0) },
384 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1408) },
385 { SCM_BOOL_F
, SCM_PACK (0) },
386 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1472) },
387 { SCM_BOOL_F
, SCM_PACK (0) },
388 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1536) },
389 { SCM_BOOL_F
, SCM_PACK (0) },
392 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1600) },
393 { SCM_BOOL_F
, SCM_PACK (0) },
394 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1664) },
395 { SCM_BOOL_F
, SCM_PACK (0) },
396 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1728) },
397 { SCM_BOOL_F
, SCM_PACK (0) },
398 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1792) },
399 { SCM_BOOL_F
, SCM_PACK (0) },
400 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1856) },
401 { SCM_BOOL_F
, SCM_PACK (0) },
402 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1920) },
403 { SCM_BOOL_F
, SCM_PACK (0) },
405 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 1984) },
406 { SCM_BOOL_F
, SCM_PACK (0) },
407 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2048) },
408 { SCM_BOOL_F
, SCM_PACK (0) },
409 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2112) },
410 { SCM_BOOL_F
, SCM_PACK (0) },
411 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2176) },
412 { SCM_BOOL_F
, SCM_PACK (0) },
413 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2240) },
414 { SCM_BOOL_F
, SCM_PACK (0) },
417 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2304) },
418 { SCM_BOOL_F
, SCM_PACK (0) },
419 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2368) },
420 { SCM_BOOL_F
, SCM_PACK (0) },
421 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2432) },
422 { SCM_BOOL_F
, SCM_PACK (0) },
423 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2496) },
424 { SCM_BOOL_F
, SCM_PACK (0) },
425 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2560) },
426 { SCM_BOOL_F
, SCM_PACK (0) },
427 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2624) },
428 { SCM_BOOL_F
, SCM_PACK (0) },
429 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2688) },
430 { SCM_BOOL_F
, SCM_PACK (0) },
432 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2752) },
433 { SCM_BOOL_F
, SCM_PACK (0) },
434 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2816) },
435 { SCM_BOOL_F
, SCM_PACK (0) },
436 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2880) },
437 { SCM_BOOL_F
, SCM_PACK (0) },
438 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 2944) },
439 { SCM_BOOL_F
, SCM_PACK (0) },
440 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3008) },
441 { SCM_BOOL_F
, SCM_PACK (0) },
442 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3072) },
443 { SCM_BOOL_F
, SCM_PACK (0) },
446 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3136) },
447 { SCM_BOOL_F
, SCM_PACK (0) },
448 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3200) },
449 { SCM_BOOL_F
, SCM_PACK (0) },
450 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3264) },
451 { SCM_BOOL_F
, SCM_PACK (0) },
452 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3328) },
453 { SCM_BOOL_F
, SCM_PACK (0) },
454 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3392) },
455 { SCM_BOOL_F
, SCM_PACK (0) },
456 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3456) },
457 { SCM_BOOL_F
, SCM_PACK (0) },
458 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3520) },
459 { SCM_BOOL_F
, SCM_PACK (0) },
460 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3584) },
461 { SCM_BOOL_F
, SCM_PACK (0) },
463 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3648) },
464 { SCM_BOOL_F
, SCM_PACK (0) },
465 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3712) },
466 { SCM_BOOL_F
, SCM_PACK (0) },
467 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3776) },
468 { SCM_BOOL_F
, SCM_PACK (0) },
469 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3840) },
470 { SCM_BOOL_F
, SCM_PACK (0) },
471 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3904) },
472 { SCM_BOOL_F
, SCM_PACK (0) },
473 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 3968) },
474 { SCM_BOOL_F
, SCM_PACK (0) },
475 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4032) },
476 { SCM_BOOL_F
, SCM_PACK (0) },
479 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4096) },
480 { SCM_BOOL_F
, SCM_PACK (0) },
481 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4160) },
482 { SCM_BOOL_F
, SCM_PACK (0) },
483 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4224) },
484 { SCM_BOOL_F
, SCM_PACK (0) },
485 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4288) },
486 { SCM_BOOL_F
, SCM_PACK (0) },
487 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4352) },
488 { SCM_BOOL_F
, SCM_PACK (0) },
489 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4416) },
490 { SCM_BOOL_F
, SCM_PACK (0) },
491 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4480) },
492 { SCM_BOOL_F
, SCM_PACK (0) },
493 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4544) },
494 { SCM_BOOL_F
, SCM_PACK (0) },
495 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4608) },
496 { SCM_BOOL_F
, SCM_PACK (0) },
498 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4672) },
499 { SCM_BOOL_F
, SCM_PACK (0) },
500 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4736) },
501 { SCM_BOOL_F
, SCM_PACK (0) },
502 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4800) },
503 { SCM_BOOL_F
, SCM_PACK (0) },
504 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4864) },
505 { SCM_BOOL_F
, SCM_PACK (0) },
506 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4928) },
507 { SCM_BOOL_F
, SCM_PACK (0) },
508 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 4992) },
509 { SCM_BOOL_F
, SCM_PACK (0) },
510 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5056) },
511 { SCM_BOOL_F
, SCM_PACK (0) },
512 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5120) },
513 { SCM_BOOL_F
, SCM_PACK (0) },
516 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5184) },
517 { SCM_BOOL_F
, SCM_PACK (0) },
518 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5248) },
519 { SCM_BOOL_F
, SCM_PACK (0) },
520 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5312) },
521 { SCM_BOOL_F
, SCM_PACK (0) },
522 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5376) },
523 { SCM_BOOL_F
, SCM_PACK (0) },
524 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5440) },
525 { SCM_BOOL_F
, SCM_PACK (0) },
526 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5504) },
527 { SCM_BOOL_F
, SCM_PACK (0) },
528 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5568) },
529 { SCM_BOOL_F
, SCM_PACK (0) },
530 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5632) },
531 { SCM_BOOL_F
, SCM_PACK (0) },
532 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5696) },
533 { SCM_BOOL_F
, SCM_PACK (0) },
534 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5760) },
535 { SCM_BOOL_F
, SCM_PACK (0) },
537 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5824) },
538 { SCM_BOOL_F
, SCM_PACK (0) },
539 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5888) },
540 { SCM_BOOL_F
, SCM_PACK (0) },
541 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 5952) },
542 { SCM_BOOL_F
, SCM_PACK (0) },
543 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6016) },
544 { SCM_BOOL_F
, SCM_PACK (0) },
545 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6080) },
546 { SCM_BOOL_F
, SCM_PACK (0) },
547 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6144) },
548 { SCM_BOOL_F
, SCM_PACK (0) },
549 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6208) },
550 { SCM_BOOL_F
, SCM_PACK (0) },
551 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6272) },
552 { SCM_BOOL_F
, SCM_PACK (0) },
553 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6336) },
554 { SCM_BOOL_F
, SCM_PACK (0) },
557 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6400) },
558 { SCM_BOOL_F
, SCM_PACK (0) },
559 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6464) },
560 { SCM_BOOL_F
, SCM_PACK (0) },
561 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6528) },
562 { SCM_BOOL_F
, SCM_PACK (0) },
563 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6592) },
564 { SCM_BOOL_F
, SCM_PACK (0) },
565 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6656) },
566 { SCM_BOOL_F
, SCM_PACK (0) },
567 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6720) },
568 { SCM_BOOL_F
, SCM_PACK (0) },
569 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6784) },
570 { SCM_BOOL_F
, SCM_PACK (0) },
571 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6848) },
572 { SCM_BOOL_F
, SCM_PACK (0) },
573 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6912) },
574 { SCM_BOOL_F
, SCM_PACK (0) },
575 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 6976) },
576 { SCM_BOOL_F
, SCM_PACK (0) },
577 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7040) },
578 { SCM_BOOL_F
, SCM_PACK (0) },
580 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7104) },
581 { SCM_BOOL_F
, SCM_PACK (0) },
582 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7168) },
583 { SCM_BOOL_F
, SCM_PACK (0) },
584 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7232) },
585 { SCM_BOOL_F
, SCM_PACK (0) },
586 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7296) },
587 { SCM_BOOL_F
, SCM_PACK (0) },
588 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7360) },
589 { SCM_BOOL_F
, SCM_PACK (0) },
590 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7424) },
591 { SCM_BOOL_F
, SCM_PACK (0) },
592 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7488) },
593 { SCM_BOOL_F
, SCM_PACK (0) },
594 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7552) },
595 { SCM_BOOL_F
, SCM_PACK (0) },
596 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7616) },
597 { SCM_BOOL_F
, SCM_PACK (0) },
598 { STATIC_OBJCODE_TAG
, SCM_PACK (raw_bytecode
.bytes
+ 7680) },
599 { SCM_BOOL_F
, SCM_PACK (0) }
604 (defun generate-objcode (n)
605 "Generate objcode for N arguments"
607 (insert (format " /\* %d arguments *\/\n" n))
609 (while (< i (* (1+ n) (1+ n)))
610 (insert (format " SCM_PACK (objcode_cells.cells+%d),\n" (* i 2)))
614 (defun generate-objcodes (n)
615 "Generate objcodes for up to N arguments"
622 static const SCM scm_subr_objcode_trampolines
[121] = {
623 /* C-u 1 0 M-x generate-objcodes RET */
625 SCM_PACK (objcode_cells
.cells
+0),
628 SCM_PACK (objcode_cells
.cells
+2),
629 SCM_PACK (objcode_cells
.cells
+4),
630 SCM_PACK (objcode_cells
.cells
+6),
633 SCM_PACK (objcode_cells
.cells
+8),
634 SCM_PACK (objcode_cells
.cells
+10),
635 SCM_PACK (objcode_cells
.cells
+12),
636 SCM_PACK (objcode_cells
.cells
+14),
637 SCM_PACK (objcode_cells
.cells
+16),
640 SCM_PACK (objcode_cells
.cells
+18),
641 SCM_PACK (objcode_cells
.cells
+20),
642 SCM_PACK (objcode_cells
.cells
+22),
643 SCM_PACK (objcode_cells
.cells
+24),
644 SCM_PACK (objcode_cells
.cells
+26),
645 SCM_PACK (objcode_cells
.cells
+28),
646 SCM_PACK (objcode_cells
.cells
+30),
649 SCM_PACK (objcode_cells
.cells
+32),
650 SCM_PACK (objcode_cells
.cells
+34),
651 SCM_PACK (objcode_cells
.cells
+36),
652 SCM_PACK (objcode_cells
.cells
+38),
653 SCM_PACK (objcode_cells
.cells
+40),
654 SCM_PACK (objcode_cells
.cells
+42),
655 SCM_PACK (objcode_cells
.cells
+44),
656 SCM_PACK (objcode_cells
.cells
+46),
657 SCM_PACK (objcode_cells
.cells
+48),
660 SCM_PACK (objcode_cells
.cells
+50),
661 SCM_PACK (objcode_cells
.cells
+52),
662 SCM_PACK (objcode_cells
.cells
+54),
663 SCM_PACK (objcode_cells
.cells
+56),
664 SCM_PACK (objcode_cells
.cells
+58),
665 SCM_PACK (objcode_cells
.cells
+60),
666 SCM_PACK (objcode_cells
.cells
+62),
667 SCM_PACK (objcode_cells
.cells
+64),
668 SCM_PACK (objcode_cells
.cells
+66),
669 SCM_PACK (objcode_cells
.cells
+68),
670 SCM_PACK (objcode_cells
.cells
+70),
673 SCM_PACK (objcode_cells
.cells
+72),
674 SCM_PACK (objcode_cells
.cells
+74),
675 SCM_PACK (objcode_cells
.cells
+76),
676 SCM_PACK (objcode_cells
.cells
+78),
677 SCM_PACK (objcode_cells
.cells
+80),
678 SCM_PACK (objcode_cells
.cells
+82),
679 SCM_PACK (objcode_cells
.cells
+84),
680 SCM_PACK (objcode_cells
.cells
+86),
681 SCM_PACK (objcode_cells
.cells
+88),
682 SCM_PACK (objcode_cells
.cells
+90),
683 SCM_PACK (objcode_cells
.cells
+92),
684 SCM_PACK (objcode_cells
.cells
+94),
685 SCM_PACK (objcode_cells
.cells
+96),
688 SCM_PACK (objcode_cells
.cells
+98),
689 SCM_PACK (objcode_cells
.cells
+100),
690 SCM_PACK (objcode_cells
.cells
+102),
691 SCM_PACK (objcode_cells
.cells
+104),
692 SCM_PACK (objcode_cells
.cells
+106),
693 SCM_PACK (objcode_cells
.cells
+108),
694 SCM_PACK (objcode_cells
.cells
+110),
695 SCM_PACK (objcode_cells
.cells
+112),
696 SCM_PACK (objcode_cells
.cells
+114),
697 SCM_PACK (objcode_cells
.cells
+116),
698 SCM_PACK (objcode_cells
.cells
+118),
699 SCM_PACK (objcode_cells
.cells
+120),
700 SCM_PACK (objcode_cells
.cells
+122),
701 SCM_PACK (objcode_cells
.cells
+124),
702 SCM_PACK (objcode_cells
.cells
+126),
705 SCM_PACK (objcode_cells
.cells
+128),
706 SCM_PACK (objcode_cells
.cells
+130),
707 SCM_PACK (objcode_cells
.cells
+132),
708 SCM_PACK (objcode_cells
.cells
+134),
709 SCM_PACK (objcode_cells
.cells
+136),
710 SCM_PACK (objcode_cells
.cells
+138),
711 SCM_PACK (objcode_cells
.cells
+140),
712 SCM_PACK (objcode_cells
.cells
+142),
713 SCM_PACK (objcode_cells
.cells
+144),
714 SCM_PACK (objcode_cells
.cells
+146),
715 SCM_PACK (objcode_cells
.cells
+148),
716 SCM_PACK (objcode_cells
.cells
+150),
717 SCM_PACK (objcode_cells
.cells
+152),
718 SCM_PACK (objcode_cells
.cells
+154),
719 SCM_PACK (objcode_cells
.cells
+156),
720 SCM_PACK (objcode_cells
.cells
+158),
721 SCM_PACK (objcode_cells
.cells
+160),
724 SCM_PACK (objcode_cells
.cells
+162),
725 SCM_PACK (objcode_cells
.cells
+164),
726 SCM_PACK (objcode_cells
.cells
+166),
727 SCM_PACK (objcode_cells
.cells
+168),
728 SCM_PACK (objcode_cells
.cells
+170),
729 SCM_PACK (objcode_cells
.cells
+172),
730 SCM_PACK (objcode_cells
.cells
+174),
731 SCM_PACK (objcode_cells
.cells
+176),
732 SCM_PACK (objcode_cells
.cells
+178),
733 SCM_PACK (objcode_cells
.cells
+180),
734 SCM_PACK (objcode_cells
.cells
+182),
735 SCM_PACK (objcode_cells
.cells
+184),
736 SCM_PACK (objcode_cells
.cells
+186),
737 SCM_PACK (objcode_cells
.cells
+188),
738 SCM_PACK (objcode_cells
.cells
+190),
739 SCM_PACK (objcode_cells
.cells
+192),
740 SCM_PACK (objcode_cells
.cells
+194),
741 SCM_PACK (objcode_cells
.cells
+196),
742 SCM_PACK (objcode_cells
.cells
+198),
745 SCM_PACK (objcode_cells
.cells
+200),
746 SCM_PACK (objcode_cells
.cells
+202),
747 SCM_PACK (objcode_cells
.cells
+204),
748 SCM_PACK (objcode_cells
.cells
+206),
749 SCM_PACK (objcode_cells
.cells
+208),
750 SCM_PACK (objcode_cells
.cells
+210),
751 SCM_PACK (objcode_cells
.cells
+212),
752 SCM_PACK (objcode_cells
.cells
+214),
753 SCM_PACK (objcode_cells
.cells
+216),
754 SCM_PACK (objcode_cells
.cells
+218),
755 SCM_PACK (objcode_cells
.cells
+220),
756 SCM_PACK (objcode_cells
.cells
+222),
757 SCM_PACK (objcode_cells
.cells
+224),
758 SCM_PACK (objcode_cells
.cells
+226),
759 SCM_PACK (objcode_cells
.cells
+228),
760 SCM_PACK (objcode_cells
.cells
+230),
761 SCM_PACK (objcode_cells
.cells
+232),
762 SCM_PACK (objcode_cells
.cells
+234),
763 SCM_PACK (objcode_cells
.cells
+236),
764 SCM_PACK (objcode_cells
.cells
+238),
765 SCM_PACK (objcode_cells
.cells
+240)
768 /* (nargs * nargs) + nopt + rest * (nargs + 1) */
769 #define SCM_SUBR_OBJCODE_TRAMPOLINE(nreq,nopt,rest) \
770 scm_subr_objcode_trampolines[(nreq + nopt + rest) * (nreq + nopt + rest) \
771 + nopt + rest * (nreq + nopt + rest + 1)]
774 scm_subr_objcode_trampoline (unsigned int nreq
, unsigned int nopt
,
777 if (SCM_UNLIKELY (rest
> 1 || nreq
+ nopt
+ rest
> 10))
778 scm_out_of_range ("make-subr", scm_from_uint (nreq
+ nopt
+ rest
));
780 return SCM_SUBR_OBJCODE_TRAMPOLINE (nreq
, nopt
, rest
);
784 create_gsubr (int define
, const char *name
,
785 unsigned int nreq
, unsigned int nopt
, unsigned int rest
,
786 SCM (*fcn
) (), SCM
*generic_loc
)
794 sname
= scm_from_utf8_symbol (name
);
795 table
= scm_c_make_vector (generic_loc
? 3 : 2, SCM_UNDEFINED
);
796 SCM_SIMPLE_VECTOR_SET (table
, 0, scm_from_pointer (fcn
, NULL
));
797 SCM_SIMPLE_VECTOR_SET (table
, 1, sname
);
799 SCM_SIMPLE_VECTOR_SET (table
, 2,
800 scm_from_pointer (generic_loc
, NULL
));
803 ret
= scm_make_program (scm_subr_objcode_trampoline (nreq
, nopt
, rest
),
807 flags
= SCM_F_PROGRAM_IS_PRIMITIVE
;
808 flags
|= generic_loc
? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC
: 0;
809 SCM_SET_CELL_WORD_0 (ret
, SCM_CELL_WORD_0 (ret
) | flags
);
811 /* define, if needed */
813 scm_define (sname
, ret
);
820 scm_c_make_gsubr (const char *name
, int req
, int opt
, int rst
, SCM (*fcn
)())
822 return create_gsubr (0, name
, req
, opt
, rst
, fcn
, NULL
);
826 scm_c_define_gsubr (const char *name
, int req
, int opt
, int rst
, SCM (*fcn
)())
828 return create_gsubr (1, name
, req
, opt
, rst
, fcn
, NULL
);
832 scm_c_make_gsubr_with_generic (const char *name
,
839 return create_gsubr (0, name
, req
, opt
, rst
, fcn
, gf
);
843 scm_c_define_gsubr_with_generic (const char *name
,
850 return create_gsubr (1, name
, req
, opt
, rst
, fcn
, gf
);
855 /* A silly example, taking 2 required args, 1 optional, and
856 a scm_list of rest args
859 gsubr_21l(SCM req1
, SCM req2
, SCM opt
, SCM rst
)
861 scm_puts_unlocked ("gsubr-2-1-l:\n req1: ", scm_cur_outp
);
862 scm_display(req1
, scm_cur_outp
);
863 scm_puts_unlocked ("\n req2: ", scm_cur_outp
);
864 scm_display(req2
, scm_cur_outp
);
865 scm_puts_unlocked ("\n opt: ", scm_cur_outp
);
866 scm_display(opt
, scm_cur_outp
);
867 scm_puts_unlocked ("\n rest: ", scm_cur_outp
);
868 scm_display(rst
, scm_cur_outp
);
869 scm_newline(scm_cur_outp
);
870 return SCM_UNSPECIFIED
;
879 scm_c_define_gsubr ("gsubr-2-1-l", 2, 1, 1, gsubr_21l
); /* example */
882 #include "libguile/gsubr.x"