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