1 // eval4.cpp Copyright (C) 1991-2021, Codemist
2
3 //
4 // Bytecode interpreter/main interpreter interfaces
5 //
6
7 /**************************************************************************
8 * Copyright (C) 2021, Codemist. A C Norman *
9 * *
10 * Redistribution and use in source and binary forms, with or without *
11 * modification, are permitted provided that the following conditions are *
12 * met: *
13 * *
14 * * Redistributions of source code must retain the relevant *
15 * copyright notice, this list of conditions and the following *
16 * disclaimer. *
17 * * Redistributions in binary form must reproduce the above *
18 * copyright notice, this list of conditions and the following *
19 * disclaimer in the documentation and/or other materials provided *
20 * with the distribution. *
21 * *
22 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *
23 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *
24 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS *
25 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE *
26 * COPYRIGHT OWNERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, *
27 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, *
28 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS *
29 * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *
30 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR *
31 * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF *
32 * THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH *
33 * DAMAGE. *
34 *************************************************************************/
35
36 // $Id: eval4.cpp 5620 2021-01-26 16:16:36Z arthurcnorman $
37
38
39 #include "headers.h"
40
41 //
42 // Here is a bit of a commentary about calling arrangements.
43 //
44 // When a Lisp function is called in the C code it will have 0, 1, 2, 3
45 // or 4 arguments (never more). If present the 4th argument will be a list
46 // of lisp-level arguments 4, 5, 6 ...
47 // The entrypoints such as bytecoded3() etc here are C code and will thus
48 // be invoked in this way. They end up transferring control to the
49 // bytecode interpreter. The bytecode interpreter is entered with arguments
50 // on the (Lisp) stack, and there can be as many as the function wants.
51 // If there is a &REST argument that corresponds to one argument that will
52 // receive a list value. Thus that amount of stack used is related to the
53 // number of arguments written in the function definition. Thus a case such
54 // as (DE foo (a1 a2 ... a1000) ...) could lead to huge stack usage, but I
55 // expect that not to arise.
56 // So in a case where the function definition has been (DE foo (a b &REST c)
57 // ...) and the call was (as it were) (foo A1 A2 ... A1000), the C code
58 // would see four arguments A1, A2, A3 and (A4 .. A1000) and would re-package
59 // them to put three items on the stack for the bytecode system: A1, A2 and
60 // (A3 A4 ... A1000).
61 // This means that the interface code here needs to know just how many values
62 // a bytecoded function expects to find on its stack. If the function
63 // concerned is a simple one taking 0, 1, 2 or 3 arguments that is trivial.
64 // If a fixed numner of arguments is involved but that is at least 4 then
65 // the interface code will scan its list input to count values, and the byte
66 // stream has an initial prefix byte indicating the desired argument
67 // count. This imposes a limit at 255 arguments.
68 // If &OPTIONAL or &REST arguments are involved then the bytestream will
69 // have a pair of initial bytes giving the smallest and largest number of
70 // direct arguments (ie ones to be used before any remaining ones get
71 // collected by &REST). If all the &OPTIONAL values just default to NIL then
72 // that conversion is done here. In more complicated cases any optional
73 // arguments not provided with proper values are passed using a marker
74 // value SPID_NOARG that the bytecode can inspect and deal with as it sees
75 // fit.
76 // &KEY arguments (to the extent that they are supported!) are merely handled
77 // via the &REST machanism.
78 //
79
80 // I will expect most calls to be to functions with rigidly fixed known
81 // numbers of arguments, and the other more complicated cases may well
82 // be handled in ways intended to make the code easy to write even if doing
83 // so impacts performance.
84
85
86
87 // Each of these entrypoints to the bytecode interpreter preserves litvec
88 // and codevec. Just about the only place these variable are set is within
89 // the bytecode interpreter.
90
bytecoded_0(LispObject def)91 LispObject bytecoded_0(LispObject def)
92 {
93 // Note that when I have a conservative garbage collector the mess
94 // of SAVE_CODEVEC can be removed, and that should at least slightly
95 // speed things up.
96 SAVE_CODEVEC;
97 RealSave save(def);
98 LispObject r;
99 TRY
100 r = bytestream_interpret(CELL-TAG_VECTOR, def, stack);
101 CATCH(LispException)
102 // No args to print as part of a backtrace here!
103 RETHROW;
104 END_CATCH;
105 return r;
106 }
107
bytecoded_1(LispObject def,LispObject a)108 LispObject bytecoded_1(LispObject def, LispObject a)
109 { SAVE_CODEVEC;
110 #ifdef DEBUG
111 // In the NO_THROW case I arrange that (most) functions that exit via
112 // a simulated throw return a value that denotes an exception value. This
113 // ought to be intercepted promptly! But if it is not and it gets passed on
114 // as an argument here that indicated that some interception tests had been
115 // omitted. If I abort() here then exceptionFile and exceptionLine can be
116 // checked using a debugger and they will show where the exception originated.
117 if (is_exception(a)) my_abort("exception value not trapped");
118 #endif
119 RealSave save(def, a);
120 LispObject &a1 = save.val(2);
121 LispObject r;
122 TRY
123 r = bytestream_interpret(CELL-TAG_VECTOR, def, stack-1);
124 CATCH(LispError)
125 int _reason = exit_reason;
126 if (SHOW_ARGS)
127 { err_printf("Arg1: ");
128 loop_print_error(a1);
129 err_printf("\n");
130 }
131 exit_reason = _reason;
132 RETHROW;
133 END_CATCH;
134 // Note that a destructor set up by SAVE_CODEVEC gets activated here and
135 // that restores the stack pointer and also values of codevec and litvec.
136 return r;
137 }
138
bytecoded_2(LispObject def,LispObject a,LispObject b)139 LispObject bytecoded_2(LispObject def, LispObject a, LispObject b)
140 { SAVE_CODEVEC;
141 #ifdef DEBUG
142 if (is_exception(a)) my_abort("exception value not trapped");
143 if (is_exception(b)) my_abort("exception value not trapped");
144 #endif
145 RealSave save(def, a, b);
146 LispObject &a1 = save.val(2);
147 LispObject &a2 = save.val(3);
148 LispObject r;
149 TRY
150 r = bytestream_interpret(CELL-TAG_VECTOR, def, stack-2);
151 CATCH(LispError)
152 int _reason = exit_reason;
153 if (SHOW_ARGS)
154 { err_printf("Arg 1: ");
155 loop_print_error(a1); err_printf("\n");
156 err_printf("Arg 2: ");
157 loop_print_error(a2); err_printf("\n");
158 }
159 exit_reason = _reason;
160 RETHROW;
161 END_CATCH
162 return r;
163 }
164
bytecoded_3(LispObject def,LispObject a,LispObject b,LispObject c)165 LispObject bytecoded_3(LispObject def, LispObject a, LispObject b,
166 LispObject c)
167 { SAVE_CODEVEC;
168 #ifdef DEBUG
169 if (is_exception(a)) my_abort("exception value not trapped");
170 if (is_exception(b)) my_abort("exception value not trapped");
171 if (is_exception(c)) my_abort("exception value not trapped");
172 #endif
173 RealSave save(def, a, b, c);
174 LispObject &a1 = save.val(2);
175 LispObject &a2 = save.val(3);
176 LispObject &a3 = save.val(4);
177 LispObject r;
178 TRY
179 r = bytestream_interpret(CELL-TAG_VECTOR, def, stack-3);
180 CATCH(LispError)
181 int _reason = exit_reason;
182 if (SHOW_ARGS)
183 { err_printf("Arg1: ");
184 loop_print_error(a1); err_printf("\n");
185 err_printf("Arg2: ");
186 loop_print_error(a2); err_printf("\n");
187 err_printf("Arg3: ");
188 loop_print_error(a3); err_printf("\n");
189 }
190 exit_reason = _reason;
191 RETHROW;
192 END_CATCH;
193 return r;
194 }
195
countargs(LispObject a4up)196 inline int countargs(LispObject a4up)
197 { int r = 3;
198 while (a4up != nil)
199 { r++;
200 a4up = cdr(a4up);
201 }
202 return r;
203 }
204
bytecoded_4up(LispObject def,LispObject a1,LispObject a2,LispObject a3,LispObject a4up)205 LispObject bytecoded_4up(LispObject def, LispObject a1, LispObject a2,
206 LispObject a3, LispObject a4up)
207 { SAVE_CODEVEC;
208 #ifdef DEBUG
209 if (is_exception(a1)) my_abort("exception value not trapped");
210 if (is_exception(a2)) my_abort("exception value not trapped");
211 if (is_exception(a3)) my_abort("exception value not trapped");
212 if (is_exception(a4up)) my_abort("exception value not trapped");
213 #endif
214 int nargs = countargs(a4up);
215 LispObject r = car(qenv(def)); // the vector of bytecodes
216 if (nargs != (reinterpret_cast<unsigned char *>(data_of_bps(r)))[0])
217 return error(2, err_wrong_no_args, def, fixnum_of_int(nargs));
218 // I now know that there will be the right number of arguments.
219 RealSave save(def, a1, a2, a3);
220 for (int i=4; i<=nargs; i++)
221 { *++stack = car(a4up);
222 a4up = cdr(a4up);
223 }
224 TRY
225 r = bytestream_interpret(CELL-TAG_VECTOR+1, def, stack-nargs);
226 CATCH(LispError)
227 int _reason = exit_reason;
228 if (SHOW_ARGS)
229 { for (int i=1; i<=nargs; i++)
230 { err_printf("Arg%d: ", i);
231 loop_print_error(save.val(i+1)); err_printf("\n");
232 }
233 }
234 exit_reason = _reason;
235 RETHROW;
236 END_CATCH;
237 return r;
238 }
239
nreverse2(LispObject a,LispObject b)240 LispObject nreverse2(LispObject a, LispObject b)
241 { while (consp(a))
242 { LispObject c = a;
243 a = cdr(a);
244 write_barrier(cdraddr(c), b);
245 b = c;
246 }
247 return b;
248 }
249
250 // The code that follows is just used to support compiled code that
251 // has &optional or &rest arguments.
252
byteopt(LispObject def,LispObject a1,LispObject a2,LispObject a3,LispObject a4up,LispObject defaultval,bool restp)253 static LispObject byteopt(LispObject def, LispObject a1,
254 LispObject a2, LispObject a3,
255 LispObject a4up, LispObject defaultval, bool restp)
256 { LispObject r;
257 #ifdef DEBUG
258 if (is_exception(a1)) my_abort("exception value not trapped");
259 if (is_exception(a2)) my_abort("exception value not trapped");
260 if (is_exception(a3)) my_abort("exception value not trapped");
261 if (is_exception(a4up)) my_abort("exception value not trapped");
262 if (is_exception(defaultval)) my_abort("exception value not trapped");
263 #endif
264 int i, wantargs, wantopts;
265 SAVE_CODEVEC;
266 // From calls that passed a small number of arguments I will invoke this as
267 // 0: byteopt(SPID_NOARG, SPID_NOARG, SPID_NOARG, nil, ...)
268 // 1: byteopt(arg1, SPID_NOARG, SPID_NOARG, nil, ...)
269 // 2: byteopt(arg1, arg2, SPID_NOARG, nil, ...)
270 // 3: byteopt(arg1, arg2, arg3, nil, ...)
271 // 4: byteopt(arg1, arg2, arg3, list(arg4), ...)
272 // On that basis I can work out how many arguments have actually been provided.
273 int nargs;
274 if (a1 == SPID_NOARG) nargs = 0;
275 else if (a2 == SPID_NOARG) nargs = 1;
276 else if (a3 == SPID_NOARG) nargs = 2;
277 else nargs = countargs(a4up);
278 // In this case the first 2 bytes of the bytecode stream give and upper and
279 // lower bound for arguments ahead of any &REST ones.
280 r = car(qenv(def));
281 wantargs = (reinterpret_cast<unsigned char *>(data_of_bps(r)))[0];
282 wantopts = (reinterpret_cast<unsigned char *>(data_of_bps(r)))[1];
283 if (nargs < wantargs || (!restp && nargs > wantargs+wantopts))
284 return error(2, err_wrong_no_args, def,
285 fixnum_of_int((int32_t)nargs));
286 // Now to make life easier for myself I will collect ALL the arguments as
287 // a list. I will keep that in a4up, which in some sense now becomes "a1up".
288 switch (nargs)
289 { case 0:
290 a4up = nil;
291 break;
292 case 1:
293 a4up = ncons(a1);
294 break;
295 case 2:
296 a4up = list2(a1, a2);
297 break;
298 default:
299 a4up = list3star(a1, a2, a3, a4up);
300 break;
301 }
302 errexit();
303 // I know there are enough arguments for the ones that are mandatory. I will
304 // now pad the list of arguments so that there is something for every
305 // &OPTIONAL one too. In the easy case I will just default to NIL and the
306 // bytecodes will not do anything more. In the complicated case I will pass
307 // SPID_NOARG to mark missing arguments, and the bytecode stuff must check
308 // for that and fill in the non-nil default.
309 if (nargs < wantargs+wantopts)
310 { a4up = nreverse(a4up);
311 while (nargs < wantargs+wantopts)
312 { Save save(def);
313 // Note that defaultval will be either nil or SPID_NOARG and neither
314 // of those change address during garbage collection, so I do not need to
315 // take special action to save the value.
316 a4up = cons(defaultval, a4up);
317 save.restore(def);
318 errexit();
319 nargs++;
320 }
321 if (restp)
322 { Save save(def, a4up);
323 // On this path the number of actual arguments could not even supply all
324 // &OPTIONAL args, and so the &RESR value will definitely be nil. So stick
325 // a NIL on the end.
326 a1 = ncons(nil);
327 save.restore(def, a4up);
328 errexit();
329 a4up = nreverse2(a4up, a1);
330 nargs++; // allow for the &REST arg.
331 }
332 else a4up = nreverse(a4up);
333 }
334 // Now I have at least the number of arguments that I need to satisfy all
335 // required and &OPTIONAL ones. I may still need to think about &REST.
336 else if (restp) // There is an extra &REST argument
337 { LispObject ra = nil;
338 a4up = nreverse(a4up);
339 // a4up is at present (a<n> a<n-1> ... a4 a3 a3 a1), nargs is its
340 // length. So I can pick off nargs-(wantargs+optargs) items to make
341 // a &REST argument...
342 while (nargs > wantargs+wantopts)
343 { Save save(def, a4up);
344 ra = cons(car(a4up), ra);
345 save.restore(def, a4up);
346 a4up = cdr(a4up);
347 errexit();
348 }
349 // Here I have (eg) a4up = (a3 a2 a1) and ra = (a4 a5 ...).
350 { Save save(def, a4up);
351 a4up = ncons(ra);
352 save.restore(def, ra);
353 errexit();
354 }
355 // Make a final extra argument out of the list, and then reverse the rest
356 // of the arguments back, to get (eg again) (a1 a2 a3 (a4 a5 ...)).
357 a4up = nreverse2(a4up, ra);
358 nargs = wantargs + wantopts + 1;
359 }
360 // I have now handled &OPTIONAL and &REST issues, and a4up is now a list of
361 // length nargs.
362 for (int i=0; i<nargs; i++)
363 { *++stack = car(a4up);
364 a4up = cdr(a4up);
365 }
366 TRY
367 r = bytestream_interpret(CELL-TAG_VECTOR+2, def, stack-nargs);
368 CATCH(LispError)
369 int _reason = exit_reason;
370 if (SHOW_ARGS)
371 { for (i=1; i<=nargs; i++)
372 { err_printf("Arg%d: ", i);
373 loop_print_error(stack[i-nargs]);
374 err_printf("\n");
375 }
376 }
377 exit_reason = _reason;
378 RETHROW;
379 END_CATCH;
380 return r;
381 }
382
byteopt_0(LispObject def)383 LispObject byteopt_0(LispObject def)
384 { return byteopt(def, SPID_NOARG, SPID_NOARG, SPID_NOARG, nil, nil,
385 false);
386 }
387
byteopt_1(LispObject def,LispObject a)388 LispObject byteopt_1(LispObject def, LispObject a)
389 { return byteopt(def, a, SPID_NOARG, SPID_NOARG, nil, nil, false);
390 }
391
byteopt_2(LispObject def,LispObject a,LispObject b)392 LispObject byteopt_2(LispObject def, LispObject a, LispObject b)
393 { return byteopt(def, a, b, SPID_NOARG, nil, nil, false);
394 }
395
byteopt_3(LispObject def,LispObject a,LispObject b,LispObject c)396 LispObject byteopt_3(LispObject def, LispObject a, LispObject b,
397 LispObject c)
398 { return byteopt(def, a, b, c, nil, nil, false);
399 }
400
byteopt_4up(LispObject def,LispObject a1,LispObject a2,LispObject a3,LispObject a4up)401 LispObject byteopt_4up(LispObject def, LispObject a1, LispObject a2,
402 LispObject a3, LispObject a4up)
403 { return byteopt(def, a1, a2, a3, a4up, nil, false);
404 }
405
hardopt_0(LispObject def)406 LispObject hardopt_0(LispObject def)
407 { return byteopt(def, SPID_NOARG, SPID_NOARG, SPID_NOARG, nil,
408 SPID_NOARG, false);
409 }
410
hardopt_1(LispObject def,LispObject a)411 LispObject hardopt_1(LispObject def, LispObject a)
412 { return byteopt(def, a, SPID_NOARG, SPID_NOARG, nil, SPID_NOARG,
413 false);
414 }
415
hardopt_2(LispObject def,LispObject a,LispObject b)416 LispObject hardopt_2(LispObject def, LispObject a, LispObject b)
417 { return byteopt(def, a, b, SPID_NOARG, nil, SPID_NOARG, false);
418 }
419
hardopt_3(LispObject def,LispObject a,LispObject b,LispObject c)420 LispObject hardopt_3(LispObject def, LispObject a, LispObject b,
421 LispObject c)
422 { return byteopt(def, a, b, c, nil, SPID_NOARG, false);
423 }
424
hardopt_4up(LispObject def,LispObject a1,LispObject a2,LispObject a3,LispObject a4up)425 LispObject hardopt_4up(LispObject def, LispObject a1, LispObject a2,
426 LispObject a3, LispObject a4up)
427 { return byteopt(def, a1, a3, a3, a4up, SPID_NOARG, false);
428 }
429
430
byteoptrest_0(LispObject def)431 LispObject byteoptrest_0(LispObject def)
432 { return byteopt(def, SPID_NOARG, SPID_NOARG, SPID_NOARG, nil, nil,
433 true);
434 }
435
byteoptrest_1(LispObject def,LispObject a)436 LispObject byteoptrest_1(LispObject def, LispObject a)
437 { return byteopt(def, a, SPID_NOARG, SPID_NOARG, nil, nil, true);
438 }
439
byteoptrest_2(LispObject def,LispObject a,LispObject b)440 LispObject byteoptrest_2(LispObject def, LispObject a, LispObject b)
441 { return byteopt(def, a, b, SPID_NOARG, nil, nil, true);
442 }
443
byteoptrest_3(LispObject def,LispObject a,LispObject b,LispObject c)444 LispObject byteoptrest_3(LispObject def, LispObject a, LispObject b,
445 LispObject c)
446 { return byteopt(def, a, b, c, nil, nil, true);
447 }
448
byteoptrest_4up(LispObject def,LispObject a1,LispObject a2,LispObject a3,LispObject a4up)449 LispObject byteoptrest_4up(LispObject def, LispObject a1,
450 LispObject a2,
451 LispObject a3, LispObject a4up)
452 { return byteopt(def, a1, a2, a3, a4up, nil, true);
453 }
454
hardoptrest_0(LispObject def)455 LispObject hardoptrest_0(LispObject def)
456 { return byteopt(def, SPID_NOARG, SPID_NOARG, SPID_NOARG, nil,
457 SPID_NOARG, true);
458 }
459
hardoptrest_1(LispObject def,LispObject a)460 LispObject hardoptrest_1(LispObject def, LispObject a)
461 { return byteopt(def, a, SPID_NOARG, SPID_NOARG, nil, SPID_NOARG,
462 true);
463 }
464
hardoptrest_2(LispObject def,LispObject a,LispObject b)465 LispObject hardoptrest_2(LispObject def, LispObject a, LispObject b)
466 { return byteopt(def, a, b, SPID_NOARG, nil, SPID_NOARG, true);
467 }
468
hardoptrest_3(LispObject def,LispObject a,LispObject b,LispObject c)469 LispObject hardoptrest_3(LispObject def, LispObject a, LispObject b,
470 LispObject c)
471 { return byteopt(def, a, b, c, nil, SPID_NOARG, true);
472 }
473
hardoptrest_4up(LispObject def,LispObject a1,LispObject a2,LispObject a3,LispObject a4up)474 LispObject hardoptrest_4up(LispObject def, LispObject a1,
475 LispObject a2,
476 LispObject a3, LispObject a4up)
477 { return byteopt(def, a1, a2, a3, a4up, SPID_NOARG, true);
478 }
479
Lis_spid(LispObject env,LispObject a)480 LispObject Lis_spid(LispObject env, LispObject a)
481 { // Used in compilation for optional args
482 return onevalue(Lispify_predicate(is_spid(a)));
483 }
484
Lspid_to_nil(LispObject env,LispObject a)485 LispObject Lspid_to_nil(LispObject env, LispObject a)
486 { // Used in compilation for optional args
487 if (is_spid(a)) a = nil;
488 return onevalue(a);
489 }
490
Lload_spid(LispObject)491 LispObject Lload_spid(LispObject)
492 { // Used in compilation of UNWIND-PROTECT
493 return onevalue(SPID_PROTECT);
494 }
495
Lmv_list(LispObject env,LispObject a)496 LispObject Lmv_list(LispObject env, LispObject a)
497 //
498 // This does a (multiple-value-list A) on just one form. It must be used
499 // carefully so that the value-count information does not get lost between
500 // the evaluation of A and calling this code. For this to work the variable
501 // exit_count must have been set to 1 before the call that evaluated the
502 // argument! Ensuring that all the time may be tough and may mean that
503 // non-compiled code has to set exit_count rather often "just to be sure".
504 // It also makes the case of (apply #'mv!-list ...) seem slightly scary,
505 // because normally arguments only generate one value each. Hmmm maybe this
506 // would be best implemented as a special form.
507 // Haha (multiple-value-list V) may be implemented as
508 // (multiple-value-call #'list V) and multiple-value-call is a special form.
509 // so what I have here is in fact unsupportable!
510 //
511 { LispObject r;
512 #ifdef DEBUG
513 if (is_exception(a)) my_abort("exception value not trapped");
514 #endif
515 SaveStack saver;
516 int i, x = exit_count;
517 if (x > 0) *++stack = a;
518 for (i=2; i<=x; i++)
519 {
520 #ifdef DEBUG
521 if (is_exception((&work_0)[i])) my_abort("exception value not trapped");
522 #endif
523 *++stack = (&work_0)[i];
524 }
525 r = nil;
526 for (i=0; i<x; i++)
527 { LispObject w= *stack--;
528 r = cons(w, r);
529 errexit();
530 }
531 return onevalue(r);
532 }
533
534 //
535 // In these tables there are some functions that would need adjusting
536 // for a Common Lisp compiler, since they take different numbers of
537 // args in Common and Standard Lisp.
538 // This means, to be specific:
539 //
540 // Lgensym Lread Latan Ltruncate Lfloat
541 // Lintern Lmacroexpand Lmacroexpand_1
542 // Lrandom Lunintern Lappend Leqn Lgcd
543 // Lgeq Lgreaterp Llcm Lleq Llessp
544 // Lquotient
545 //
546 // In these cases (at least!) the Common Lisp version of the compiler will
547 // need to avoid generating the call that uses this table.
548 //
549 // Some functions are missing from the list here because they seemed
550 // critical enough to be awarded single-byte opcodes or because the
551 // compiler always expands them away - car through cddddr are the main
552 // cases, together with eq and equal.
553 //
554
555
556 #define NO_ARGS \
557 BI(Lbatchp, "batchp", 0), \
558 BI(Ldate, "date", 1), \
559 BI(Leject, "eject", 2), \
560 BI((no_args *)Lerror_0, "error0", 3), \
561 BI(Lgctime, "gctime", 4), \
562 BI(Lgensym, "gensym", 5), \
563 BI(Llposn, "lposn", 6), \
564 BI(Lnext_random, "next-random-number", 7), \
565 BI(Lposn, "posn", 8), \
566 BI(Lread, "read", 9), \
567 BI(Lreadch, "readch", 10), \
568 BI(Lterpri, "terpri", 11), \
569 BI(Ltime, "time", 12), \
570 BI(Ltyi, "tyi", 13), \
571 BI(Lload_spid, "load-spid", 14), \
572 BI(nullptr, nullptr, 0)
573
574 #undef BI
575 #define BI(a, b, c) a
576 no_args *no_arg_functions[] =
577 { NO_ARGS
578 };
579
580 #undef BI
581 #define BI(a, b, c) b
582 const char *no_arg_names[] =
583 { NO_ARGS
584 };
585
586 bool no_arg_traceflags[sizeof(no_arg_functions)/sizeof(
587 no_arg_functions[0])];
588
589 #define ONE_ARGS \
590 BI(Labsval, "absval", 0), \
591 BI(Ladd1, "add1", 1), \
592 BI(Latan, "atan", 2), \
593 BI(Lapply_1, "apply0", 3), \
594 BI(Latom, "atom", 4), \
595 BI(Lboundp, "boundp", 5), \
596 BI(Lchar_code, "char-code", 6), \
597 BI(Lclose, "close", 7), \
598 BI(Lcodep, "codep", 8), \
599 BI(Lcompress, "compress", 9), \
600 BI(Lconstantp, "constantp", 10), \
601 BI(Ldigitp, "digitp", 11), \
602 BI(Lendp, "endp", 12), \
603 BI(Leval, "eval", 13), \
604 BI(Levenp, "evenp", 14), \
605 BI(Levlis, "evlis", 15), \
606 BI(Lexplode, "explode", 16), \
607 BI(Lexplode2lc, "explode2lc", 17), \
608 BI(Lexplodec, "explodec", 18), \
609 BI(Lfixp, "fixp", 19), \
610 BI(Lfloat, "float", 20), \
611 BI(Lfloatp, "floatp", 21), \
612 BI(Lsymbol_specialp, "fluidp", 22), \
613 BI(Lgc, "reclaim", 23), \
614 BI(Lgensym1, "gensym1", 24), \
615 BI(Lgetenv, "getenv", 25), \
616 BI(Lsymbol_globalp, "globalp", 26), \
617 BI(Liadd1, "iadd1", 27), \
618 BI(Lsymbolp, "symbolp", 28), \
619 BI(Liminus, "iminus", 29), \
620 BI(Liminusp, "iminusp", 30), \
621 BI(Lindirect, "indirect", 31), \
622 BI(Lintegerp, "integerp", 32), \
623 BI(Lintern, "intern", 33), \
624 BI(Lisub1, "isub1", 34), \
625 BI(Llength, "length", 35), \
626 BI(Llengthc, "lengthc", 36), \
627 BI(Llinelength, "linelength", 37), \
628 BI(Lalpha_char_p, "liter", 38), \
629 BI(Lload_module, "load-module", 39), \
630 BI(Llognot, "lognot", 40), \
631 BI(Lmacroexpand, "macroexpand", 41), \
632 BI(Lmacroexpand_1, "macroexpand-1", 42), \
633 BI(Lmacro_function, "macro-function", 43), \
634 BI(Lget_bps, "get_bps", 44), \
635 BI(Lmake_global, "make-global", 45), \
636 BI(Lsmkvect, "smkvect", 46), \
637 BI(Lmake_special, "make-special", 47), \
638 BI(Lminus, "minus", 48), \
639 BI(Lminusp, "minusp", 49), \
640 BI(Lmkvect, "mkvect", 50), \
641 BI(Lmodular_minus, "modular-minus", 51), \
642 BI(Lmodular_number, "modular-number", 52), \
643 BI(Lmodular_reciprocal,"modular-reciprocal", 53), \
644 BI(Lnull, "null", 54), \
645 BI(Loddp, "oddp", 55), \
646 BI(Lonep, "onep", 56), \
647 BI(Lpagelength, "pagelength", 57), \
648 BI(Lconsp, "consp", 58), \
649 BI(Lplist, "plist", 59), \
650 BI(Lplusp, "plusp", 60), \
651 BI(Lprin, "prin", 61), \
652 BI(Lprinc, "princ", 62), \
653 BI(Lprint, "print", 63), \
654 BI(Lprintc, "printc", 64), \
655 BI(Lrandom_1, "random", 65), \
656 BI(Lrational, "rational", 66), \
657 BI(Lrdf1, "rdf1", 67), \
658 BI(Lrds, "rds", 68), \
659 BI(Lremd, "remd", 69), \
660 BI(Lreverse, "reverse", 70), \
661 BI(Lnreverse, "nreverse", 71), \
662 BI(Lwhitespace_char_p, "whitespace-char-p", 72), \
663 BI(Lset_small_modulus, "set-small-modulus", 73), \
664 BI(Lxtab, "xtab", 74), \
665 BI(Lspecial_char, "special-char", 75), \
666 BI(Lspecial_form_p, "special-form-p", 76), \
667 BI(Lspool, "spool", 77), \
668 BI((one_arg *)Lstop1, "stop", 78), \
669 BI(Lstringp, "stringp", 79), \
670 BI(Lsub1, "sub1", 80), \
671 BI(Lsymbol_env, "symbol-env", 81), \
672 BI(Lsymbol_function, "symbol-function", 82), \
673 BI(Lsymbol_name, "symbol-name", 83), \
674 BI(Lsymbol_value, "symbol-value", 84), \
675 BI(Lsystem, "system", 85), \
676 BI(Ltruncate, "truncate", 86), \
677 BI(Lttab, "ttab", 87), \
678 BI(Ltyo, "tyo", 88), \
679 BI(Lunintern, "unintern", 89), \
680 BI(Lunmake_global, "unmake-global", 90), \
681 BI(Lunmake_special, "unmake-special", 91), \
682 BI(Lupbv, "upbv", 92), \
683 BI(Lsimple_vectorp, "simple-vectorp", 93), \
684 BI(Lverbos, "verbos", 94), \
685 BI(Lwrs, "wrs", 95), \
686 BI(Lzerop, "zerop", 96), \
687 BI(Lcar, "car", 97), \
688 BI(Lcdr, "cdr", 98), \
689 BI(Lcaar, "caar", 99), \
690 BI(Lcadr, "cadr", 100), \
691 BI(Lcdar, "cdar", 101), \
692 BI(Lcddr, "cddr", 102), \
693 BI(Lcar, "car", 103), \
694 BI(Lcdr, "cdr", 104), \
695 BI(Lcaar, "caar", 105), \
696 BI(Lcadr, "cadr", 106), \
697 BI(Lcdar, "cdar", 107), \
698 BI(Lcddr, "cddr", 108), \
699 BI(Lncons, "ncons", 109), \
700 BI(Lnumberp, "numberp", 110), \
701 BI(Lis_spid, "is-spid", 111), \
702 BI(Lspid_to_nil, "spid-to-nil", 112), \
703 BI(Lmv_list, "mv-list", 113), \
704 BI(Lload_source, "load-source", 114), \
705 BI(quote_fn, "quote", 115), \
706 BI(progn_fn, "progn", 116), \
707 BI(progn_fn, "progn", 117), \
708 BI(declare_fn, "declare", 118), \
709 BI(function_fn, "function", 119), \
710 BI(nullptr, nullptr, 0)
711
712 #undef BI
713 #define BI(a, b, c) a
714 one_arg *one_arg_functions[] =
715 { ONE_ARGS
716 };
717
718 #undef BI
719 #define BI(a, b, c) b
720 const char *one_arg_names[] =
721 { ONE_ARGS
722 };
723
724 bool one_arg_traceflags[sizeof(one_arg_functions)/sizeof(
725 one_arg_functions[0])];
726
727 #define TWO_ARGS \
728 BI(Lappend_2, "append", 0), \
729 BI(Lash, "ash", 1), \
730 BI(Lassoc, "assoc", 2), \
731 BI(Latsoc, "atsoc", 3), \
732 BI(Ldeleq, "deleq", 4), \
733 BI(Ldelete, "delete", 5), \
734 BI(Ldivide_2, "divide", 6), \
735 BI(Leqcar, "eqcar", 7), \
736 BI(Leql, "eql", 8), \
737 BI(Leqn_2, "eqn", 9), \
738 BI(Lexpt, "expt", 10), \
739 BI(Lflag, "flag", 11), \
740 BI(Lflagpcar, "flagpcar", 12), \
741 BI(Lgcd_2, "gcd", 13), \
742 BI(Lgeq_2, "geq", 14), \
743 BI(Lgetv, "getv", 15), \
744 BI(Lgreaterp_2, "greaterp", 16), \
745 BI(Lidifference_2, "idifference", 17), \
746 BI(Ligreaterp_2, "igreaterp", 18), \
747 BI(Lilessp_2, "ilessp", 19), \
748 BI(Limax_2, "imax", 20), \
749 BI(Limin_2, "imin", 21), \
750 BI(Liplus_2, "iplus2", 22), \
751 BI(Liquotient_2, "iquotient", 23), \
752 BI(Liremainder_2, "iremainder", 24), \
753 BI(Lirightshift, "irightshift", 25), \
754 BI(Litimes_2, "itimes2", 26), \
755 BI(Llcm_2, "lcm", 27), \
756 BI(Lleq_2, "leq", 28), \
757 BI(Llessp_2, "lessp", 29), \
758 BI(Lmake_random_state, "make-random-state", 30), \
759 BI(Lmax_2, "max2", 31), \
760 BI(Lmember, "member", 32), \
761 BI(Lmemq, "memq", 33), \
762 BI(Lmin_2, "min2", 34), \
763 BI(Lmod_2, "mod", 35), \
764 BI(Lmodular_difference, "modular-difference", 36), \
765 BI(Lmodular_expt, "modular-expt", 37), \
766 BI(Lmodular_plus, "modular-plus", 38), \
767 BI(Lmodular_quotient, "modular-quotient", 39), \
768 BI(Lmodular_times, "modular-times", 40), \
769 BI(Lnconc, "nconc", 41), \
770 BI(Lneq_2, "neq", 42), \
771 BI(Lorderp, "orderp", 43), \
772 BI(Lquotient_2, "quotient", 44), \
773 BI(Lrem_2, "rem", 45), \
774 BI(Lremflag, "remflag", 46), \
775 BI(Lremprop, "remprop", 47), \
776 BI(Lrplaca, "rplaca", 48), \
777 BI(Lrplacd, "rplacd", 49), \
778 BI(Lsgetv, "sgetv", 50), \
779 BI(Lset, "set", 51), \
780 BI(Lsmemq, "smemq", 52), \
781 BI(Lsubla, "subla", 53), \
782 BI(Lsublis, "sublis", 54), \
783 BI(Lsymbol_set_definition, "symbol-set-definition", 55), \
784 BI(Lsymbol_set_env, "symbol-set-env", 56), \
785 BI(Ltimes_2, "times2", 57), \
786 BI(Lxcons, "xcons", 58), \
787 BI(Lequal, "equal", 59), \
788 BI(Leq, "eq", 60), \
789 BI(Lcons, "cons", 61), \
790 BI(Llist_2, "list2", 62), \
791 BI(Lget, "get", 63), \
792 BI(Lgetv, "getv", 64), \
793 BI(Lflagp, "flagp", 65), \
794 BI(Lapply_2, "apply1", 66), \
795 BI(Ldifference_2, "difference2", 67), \
796 BI(Lplus_2, "plus2", 68), \
797 BI(Ltimes_2, "times2", 69), \
798 BI(Lequalcar, "equalcar", 70), \
799 BI(Leq, "eq", 71), \
800 BI(Lnreverse2, "nreverse2", 72), \
801 BI(nullptr, nullptr, 0)
802
803 #undef BI
804 #define BI(a, b, c) a
805 two_args *two_arg_functions[] =
806 { TWO_ARGS
807 };
808
809 #undef BI
810 #define BI(a, b, c) b
811 const char *two_arg_names[] =
812 { TWO_ARGS
813 };
814
815 bool two_arg_traceflags[sizeof(two_arg_functions)/sizeof(
816 two_arg_functions[0])];
817
818 #define THREE_ARGS \
819 BI(Lbpsputv, "bpsputv", 0), \
820 BI(Lerrorset_3, "errorset", 1), \
821 BI(Llist_2star, "list2*", 2), \
822 BI(Llist_3, "list3", 3), \
823 BI(Lputprop, "putprop", 4), \
824 BI(Lputv, "putv", 5), \
825 BI(Lsputv, "sputv", 6), \
826 BI(Lsubst, "subst", 7), \
827 BI(Lapply_3, "apply2", 8), \
828 BI(Lacons, "acons", 9), \
829 BI(nullptr, nullptr, 0)
830
831 #undef BI
832 #define BI(a, b, c) a
833 three_args *three_arg_functions[] =
834 { THREE_ARGS
835 };
836
837 #undef BI
838 #define BI(a, b, c) b
839 const char *three_arg_names[] =
840 { THREE_ARGS
841 };
842
843 bool three_arg_traceflags[sizeof(three_arg_functions)/sizeof(
844 three_arg_functions[0])];
845
846 #define FOURUP_ARGS \
847 BI(nullptr, nullptr, 0)
848
849 #undef BI
850 #define BI(a, b, c) a
851 fourup_args *fourup_arg_functions[] =
852 { FOURUP_ARGS
853 };
854
855 #undef BI
856 #define BI(a, b, c) b
857 const char *fourup_arg_names[] =
858 { FOURUP_ARGS
859 };
860
861 bool fourup_arg_traceflags[sizeof(fourup_arg_functions)/sizeof(
862 fourup_arg_functions[0])];
863
864 // end of eval4.cpp
865