/src/eval.d

/*
 * EVAL, APPLY and bytecode interpreter for CLISP
 * Bruno Haible 1990-2005
 * Sam Steingold 1998-2008
 * German comments translated into English: Stefan Kain 2001-08-13
 */
#include "lispbibl.c"

/* function-table:
 In this table only SUBRS are listed, which may be inlined by the compiler.
 In FUNTAB1 and FUNTAB2 SUBRs without Rest-Parameter (i.e. with
 fixed number of arguments known at compile-time) are listed.
 In FUNTABR SUBRs with Rest-Parameter are listed. */
#define _(name)  &subr_tab.D_##name  /* address of SUBR name, like L(name) */
/* FUNTAB1 and FUNTAB2, first: */
local const Subr FUNTAB[] = {
  /* SPVW : 0 SUBRs */
  /* EVAL : 3 SUBRs */
  _(funtabref), _(subr_info), _(special_variable_p),
  /* ARRAY : 30-2 SUBRs */
  _(copy_simple_vector), /* _(svref), _(psvstore), */ _(row_major_aref),
  _(row_major_store), _(array_element_type), _(array_rank),
  _(array_dimension), _(array_dimensions), _(array_total_size),
  _(adjustable_array_p), _(bit_and), _(bit_ior), _(bit_xor), _(bit_eqv),
  _(bit_nand), _(bit_nor), _(bit_andc1), _(bit_andc2), _(bit_orc1),
  _(bit_orc2), _(bit_not), _(array_has_fill_pointer_p), _(fill_pointer),
  _(set_fill_pointer), _(vector_push), _(vector_pop), _(vector_push_extend),
  _(make_array), _(adjust_array),
  /* CHARSTRG : 54 SUBRs */
  _(standard_char_p), _(graphic_char_p), _(string_char_p), _(alpha_char_p),
  _(upper_case_p), _(lower_case_p), _(both_case_p), _(digit_char_p),
  _(alphanumericp), _(char_code), _(code_char), _(character), _(char_upcase),
  _(char_downcase), _(digit_char), _(char_int), _(int_char), _(char_name),
  _(char), _(schar), _(store_char), _(store_schar),
  _(string_eq), _(cs_string_eq), _(string_noteq), _(cs_string_noteq),
  _(string_less), _(cs_string_less), _(string_greater), _(cs_string_greater),
  _(string_ltequal), _(cs_string_ltequal),
  _(string_gtequal), _(cs_string_gtequal), _(string_equal),
  _(string_not_equal), _(string_lessp), _(string_greaterp),
  _(string_not_greaterp), _(string_not_lessp), _(search_string_eq),
  _(search_string_equal), _(make_string), _(string_both_trim),
  _(nstring_upcase), _(string_upcase), _(nstring_downcase),
  _(string_downcase), _(nstring_capitalize), _(string_capitalize),
  _(string), _(cs_string), _(name_char), _(substring),
  /* CONTROL : 25-2 SUBRs */
  _(symbol_value), /* _(symbol_function), */ _(fdefinition), _(boundp),
  _(fboundp), _(special_operator_p), _(set), _(makunbound), _(fmakunbound),
  /* _(values_list), */ _(driver), _(unwind_to_driver), _(macro_function),
  _(macroexpand), _(macroexpand_1), _(proclaim), _(eval),
  _(evalhook), _(applyhook), _(constantp), _(function_side_effect),
  _(function_name_p),_(parse_body), _(keyword_test), _(check_function_name),
  /* DEBUG : 0 SUBRs */
  /* ERROR : 1 SUBR */
  _(invoke_debugger),
  /* HASHTABL : 11 SUBRs */
  _(make_hash_table), _(gethash), _(puthash), _(remhash), _(maphash),
  _(clrhash), _(hash_table_count), _(hash_table_iterator),
  _(hash_table_iterate), _(class_gethash), _(sxhash),
  /* IO : 38 SUBRs */
  _(copy_readtable), _(set_syntax_from_char), _(set_macro_character),
  _(get_macro_character), _(make_dispatch_macro_character),
  _(set_dispatch_macro_character), _(get_dispatch_macro_character),
  _(read), _(read_preserving_whitespace), _(read_delimited_list),
  _(read_line), _(read_char), _(unread_char), _(peek_char), _(listen),
  _(read_char_no_hang), _(clear_input), _(read_from_string), _(parse_integer),
  _(whitespacep), _(write), _(prin1), _(print), _(pprint), _(princ),
  _(write_to_string), _(prin1_to_string), _(princ_to_string), _(write_char),
  _(write_string), _(write_line), _(terpri), _(fresh_line), _(elastic_newline),
  _(finish_output), _(force_output), _(clear_output), _(line_position),
  /* LIST : 84-36=48 SUBRs */
  /* _(car), _(cdr), _(caar), _(cadr), _(cdar), _(cddr), _(caaar), _(caadr),
     _(cadar), _(caddr), _(cdaar), _(cdadr), _(cddar), _(cdddr), _(caaaar),
     _(caaadr), _(caadar), _(caaddr), _(cadaar), _(cadadr), _(caddar),
     _(cadddr), _(cdaaar), _(cdaadr), _(cdadar), _(cdaddr), _(cddaar),
     _(cddadr), _(cdddar), _(cddddr), _(cons), */ _(tree_equal), _(endp),
  _(list_length), _(nth), /* _(first), _(second), _(third), _(fourth), */
  _(fifth), _(sixth), _(seventh), _(eighth), _(ninth), _(tenth), /* _(rest), */
  _(nthcdr), _(last), _(make_list), _(copy_list), _(copy_alist), _(memq),
  _(copy_tree), _(revappend), _(nreconc), _(list_nreverse), _(butlast),
  _(nbutlast), _(ldiff), _(rplaca), _(prplaca), _(rplacd), _(prplacd),
  _(subst), _(subst_if), _(subst_if_not), _(nsubst), _(nsubst_if),
  _(nsubst_if_not), _(sublis), _(nsublis), _(member), _(member_if),
  _(member_if_not), _(tailp), _(adjoin), _(acons), _(pairlis), _(assoc),
  _(assoc_if), _(assoc_if_not), _(rassoc), _(rassoc_if), _(rassoc_if_not),
  /* MISC : 10 SUBRs */
  _(lisp_implementation_type), _(lisp_implementation_version),
  _(software_type), _(software_version), _(identity), _(get_universal_time),
  _(get_internal_run_time), _(get_internal_real_time), _(sleep), _(time),
  /* PACKAGE : 32 SUBRs */
  _(make_symbol), _(find_package), _(package_name), _(package_nicknames),
  _(rename_package), _(package_use_list), _(package_used_by_list),
  _(package_shadowing_symbols), _(list_all_packages), _(intern), _(cs_intern),
  _(find_symbol), _(cs_find_symbol), _(unintern), _(export), _(unexport),
  _(import), _(shadowing_import), _(shadow), _(cs_shadow),
  _(use_package), _(unuse_package),
  _(make_package), _(cs_make_package), _(pin_package),
  _(find_all_symbols), _(cs_find_all_symbols),
  _(map_symbols), _(map_external_symbols), _(map_all_symbols),
  _(pfind_package), _(re_export),
  /* PATHNAME : 27 SUBRs */
  _(parse_namestring), _(pathname), _(pathnamehost), _(pathnamedevice),
  _(pathnamedirectory), _(pathnamename), _(pathnametype),
  _(pathnameversion), _(file_namestring), _(directory_namestring),
  _(host_namestring), _(merge_pathnames), _(enough_namestring),
  _(make_pathname), _(namestring), _(truename), _(probe_file),
  _(delete_file), _(rename_file), _(open), _(directory), _(cd),
  _(make_directory), _(delete_directory), _(file_write_date), _(file_author),
  _(savemem),
  /* PREDTYPE : 48-3 SUBRs */
  /* _(eq), */ _(eql), _(equal), _(equalp), _(consp), _(atom), _(symbolp),
  _(stringp), _(numberp), _(compiled_function_p), /* _(null), _(not), */
  _(closurep), _(listp), _(integerp), _(fixnump), _(rationalp), _(floatp),
  _(short_float_p), _(single_float_p), _(double_float_p), _(long_float_p),
  _(realp), _(complexp), _(streamp), _(random_state_p), _(readtablep),
  _(hash_table_p), _(pathnamep), _(logical_pathname_p), _(characterp),
  _(functionp), _(packagep), _(arrayp), _(simple_array_p), _(bit_vector_p),
  _(vectorp), _(simple_vector_p), _(simple_string_p), _(simple_bit_vector_p),
  _(type_of), _(class_of), _(find_class), _(coerce), _(typep_class),
  _(defined_class_p), _(proper_list_p), _(pcompiled_function_p),
  /* RECORD : 29 SUBRs */
  _(record_ref), _(record_store), _(record_length), _(structure_ref),
  _(structure_store), _(make_structure), _(copy_structure),
  _(structure_type_p), _(closure_name), _(closure_codevec),
  _(closure_consts), _(make_closure), _(make_macro),
  _(copy_generic_function), _(make_load_time_eval),
  _(function_macro_function), _(structure_object_p), _(std_instance_p),
  _(slot_value), _(set_slot_value), _(slot_boundp), _(slot_makunbound),
  _(slot_exists_p), _(macrop), _(macro_expander), _(symbol_macro_p),
  _(symbol_macro_expand),
  _(standard_instance_access), _(set_standard_instance_access),
  /* SEQUENCE : 40-1 SUBRs */
  _(sequencep), _(elt), _(setelt), _(subseq), _(copy_seq), _(length),
  _(reverse), _(nreverse), _(make_sequence), _(reduce), _(fill),
  _(replace), _(remove), _(remove_if), _(remove_if_not), _(delete),
  _(delete_if), _(delete_if_not), _(remove_duplicates),
  _(delete_duplicates), _(substitute), _(substitute_if),
  _(substitute_if_not), _(nsubstitute), _(nsubstitute_if),
  _(nsubstitute_if_not), _(find), _(find_if), _(find_if_not), _(position),
  _(position_if), _(position_if_not), _(count), _(count_if),
  _(count_if_not), _(mismatch), _(search), _(sort), /* _(stable_sort), */
  _(merge),
  /* STREAM : 24 SUBRs */
  _(file_stream_p), _(make_synonym_stream), _(synonym_stream_p),
  _(broadcast_stream_p), _(concatenated_stream_p), _(make_two_way_stream),
  _(two_way_stream_p), _(make_echo_stream), _(echo_stream_p),
  _(make_string_input_stream), _(string_input_stream_index),
  _(make_string_output_stream), _(get_output_stream_string),
  _(make_string_push_stream), _(string_stream_p), _(input_stream_p),
  _(output_stream_p), _(built_in_stream_element_type),
  _(stream_external_format), _(built_in_stream_close), _(read_byte),
  _(write_byte), _(file_position), _(file_length),
  /* SYMBOL : 15 SUBRs */
  _(putd), _(proclaim_constant), _(get), _(getf), _(get_properties),
  _(putplist), _(put), _(remprop), _(symbol_package), _(symbol_plist),
  _(symbol_name), _(cs_symbol_name), _(keywordp), _(gensym), _(gensym),
  /* LISPARIT : 84 SUBRs */
  _(decimal_string), _(zerop), _(plusp), _(minusp), _(oddp), _(evenp),
  _(plus_one), _(minus_one), _(conjugate), _(exp), _(expt), _(log),
  _(sqrt), _(isqrt), _(abs), _(phase), _(signum), _(sin), _(cos), _(tan),
  _(cis), _(asin), _(acos), _(atan), _(sinh), _(cosh), _(tanh), _(asinh),
  _(acosh), _(atanh), _(float), _(rational), _(rationalize), _(numerator),
  _(denominator), _(floor), _(ceiling), _(truncate), _(round), _(mod),
  _(rem), _(ffloor), _(fceiling), _(ftruncate), _(fround), _(decode_float),
  _(scale_float), _(float_radix), _(float_sign), _(float_digits),
  _(float_precision), _(integer_decode_float), _(complex), _(realpart),
  _(imagpart), _(lognand), _(lognor), _(logandc1), _(logandc2), _(logorc1),
  _(logorc2), _(boole), _(lognot), _(logtest), _(logbitp), _(ash),
  _(logcount), _(integer_length), _(byte), _(bytesize), _(byteposition),
  _(ldb), _(ldb_test), _(mask_field), _(dpb), _(deposit_field), _(random),
  _(make_random_state), _(factorial), _(exquo), _(long_float_digits),
  _(set_long_float_digits), _(log2), _(log10),
  /* ENCODING: 1 SUBRs */
  _(encodingp),
}; /* that were 512 = 556 - 44 SUBRs.
     (- (+ 0 3 30 54 25 0 1 11 38 84 10 32 27 48 29 40 24 15 84 1)
        (+ 0 0  2  0  2 0 0  0  0 36  0  0  0  3  0  1  0  0  0 0)) */
/* Now FUNTABR : */
local const Subr FUNTABR[] = {
  /* SPVW : 0 SUBRs */
  /* EVAL : 0 SUBRs */
  /* ARRAY : 7 SUBRs */
  _(vector), _(aref), _(store), _(array_in_bounds_p),
  _(array_row_major_index), _(bit), _(sbit),
  /* CHARSTRG : 13 SUBRs */
  _(char_eq), _(char_noteq), _(char_less), _(char_greater),
  _(char_ltequal), _(char_gtequal), _(char_equal), _(char_not_equal),
  _(char_lessp), _(char_greaterp), _(char_not_greaterp), _(char_not_lessp),
  _(string_concat),
  /* CONTROL : 10 SUBRs */
  _(apply), _(funcall), _(mapcar), _(maplist), _(mapc),
  _(mapl), _(mapcan), _(mapcap), _(mapcon), _(values),
  /* DEBUG : 0 SUBRs */
  /* ERROR : 2 SUBRs */
  _(error), _(error_of_type),
  /* HASHTABL : 1 SUBR */
  _(class_tuple_gethash),
  /* IO : 0 SUBRs */
  /* LIST : 4 SUBRs */
  _(list), _(liststar), _(append), _(nconc),
  /* MISC : 0 SUBRs */
  /* PACKAGE : 0 SUBRs */
  /* PATHNAME : 0 SUBRs */
  /* PREDTYPE : 0 SUBRs */
  /* RECORD : 1 SUBR */
  _(pallocate_instance),
  /* SEQUENCE : 7 SUBRs */
  _(concatenate), _(map), _(map_into), _(some), _(every), _(notany),
  _(notevery),
  /* STREAM : 2 SUBRs */
  _(make_broadcast_stream), _(make_concatenated_stream),
  /* SYMBOL : 0 SUBRs */
  /* LISPARIT : 19 SUBRs */
  _(numequal), _(numunequal), _(smaller), _(greater), _(ltequal),
  _(gtequal), _(max), _(min), _(plus), _(minus), _(star), _(slash), _(gcd),
  _(xgcd), _(lcm), _(logior), _(logxor), _(logand), _(logeqv)
}; /* That were (+ 0 0 7 13 10 0 2 1 0 4 0 0 0 0 1 7 2 0 19) = 66 SUBRs. */
#undef _
#define FUNTAB1  (&FUNTAB[0])
#define FUNTAB2  (&FUNTAB[256])
#define FUNTAB_length  (sizeof(FUNTAB)/sizeof(Subr))
#define FUNTABR_length  (sizeof(FUNTABR)/sizeof(Subr))

#if defined(DEBUG_SPVW)
local void check_funtab (void) {
  uintL i;
  for (i=0; i < FUNTAB_length; i++)
    if (FUNTAB[i]->rest_flag != subr_norest) {
      nobject_out(stdout,FUNTAB[i]->name);
      printf("=FUNTAB[%d] accepts &rest\n",i);
    }
  for (i=0; i < FUNTABR_length; i++)
    if (FUNTABR[i]->rest_flag != subr_rest) {
      nobject_out(stdout,FUNTABR[i]->name);
      printf("=FUNTABR[%d] does NOT accept &rest\n",i);
    }
  printf("FUNTAB_length=%d\n",FUNTAB_length);
  if (FUNTAB_length > 512) printf(" *** - > 512!\n");
  printf("FUNTABR_length=%d\n",FUNTABR_length);
  if (FUNTABR_length > 256) printf(" *** - > 256!\n");
}
#endif

/* argument-type-tokens for compiled closures: */
typedef enum {
  cclos_argtype_default,
  cclos_argtype_0_0,
  cclos_argtype_1_0,
  cclos_argtype_2_0,
  cclos_argtype_3_0,
  cclos_argtype_4_0,
  cclos_argtype_5_0,
  cclos_argtype_0_1,
  cclos_argtype_1_1,
  cclos_argtype_2_1,
  cclos_argtype_3_1,
  cclos_argtype_4_1,
  cclos_argtype_0_2,
  cclos_argtype_1_2,
  cclos_argtype_2_2,
  cclos_argtype_3_2,
  cclos_argtype_0_3,
  cclos_argtype_1_3,
  cclos_argtype_2_3,
  cclos_argtype_0_4,
  cclos_argtype_1_4,
  cclos_argtype_0_5,
  cclos_argtype_0_0_rest,
  cclos_argtype_1_0_rest,
  cclos_argtype_2_0_rest,
  cclos_argtype_3_0_rest,
  cclos_argtype_4_0_rest,
  cclos_argtype_0_0_key,
  cclos_argtype_1_0_key,
  cclos_argtype_2_0_key,
  cclos_argtype_3_0_key,
  cclos_argtype_4_0_key,
  cclos_argtype_0_1_key,
  cclos_argtype_1_1_key,
  cclos_argtype_2_1_key,
  cclos_argtype_3_1_key,
  cclos_argtype_0_2_key,
  cclos_argtype_1_2_key,
  cclos_argtype_2_2_key,
  cclos_argtype_0_3_key,
  cclos_argtype_1_3_key,
  cclos_argtype_0_4_key,
  cclos_argtype_for_broken_compilers_that_dont_like_trailing_commas
} cclos_argtype_t;

/* Call of the bytecode-interpreter:
 interpretes the bytecode of a compiled closure.
 interpret_bytecode(closure,codevec,index);
 > closure: compiled closure
 > codevec: its codevector, a Simple-Bit-Vector
 > index: Start-Index
 < mv_count/mv_space: values
 changes STACK, can trigger GC
 local Values interpret_bytecode (object closure, object codevec, uintL index);
*/
local /*maygc*/ Values interpret_bytecode_ (object closure, Sbvector codeptr,
                                            const uintB* byteptr);

/* GCC2 can jump directly to labels.
   This results in faster code than switch(). */
#if defined(GNU) && !(__APPLE_CC__ > 1)
  #if (__GNUC__ >= 2) && !defined(UNIX_HPUX) && !defined(NO_FAST_DISPATCH) /* work around HP-UX Linker Bug */
    #define FAST_DISPATCH
    #if (__GNUC__ >= 3) || (__GNUC_MINOR__ >= 7) /* work around gcc-2.6.3 Bug (-fno-defer-pop ginge auch) */
      #define FAST_DISPATCH_THREADED
    #endif
  #endif
#endif

#if defined(USE_JITC)
/* replacement for interpret_bytecode_ */
local /*maygc*/ Values jitc_run (object closure_in, Sbvector codeptr,
                                 const uintB* byteptr_in);
local inline /*maygc*/ Values cclosure_run (object closure_in, Sbvector codevec,
                                            const uintB* byteptr_in) {
  if (cclosure_jitc_p(closure_in)) jitc_run(closure_in,codevec,byteptr_in);
  else interpret_bytecode_(closure_in,codevec,byteptr_in);
}
#define interpret_bytecode(closure,codevec,index)                       \
  with_saved_back_trace_cclosure(closure,                               \
    cclosure_run(closure,TheSbvector(codevec),&TheSbvector(codevec)->data[index]); )
#else
#define interpret_bytecode(closure,codevec,index)                       \
  with_saved_back_trace_cclosure(closure,                               \
    interpret_bytecode_(closure,TheSbvector(codevec),&TheSbvector(codevec)->data[index]); )
#endif

/* Values of the bytecodes (256 totally): */
typedef enum {
 #define BYTECODE(code)  code,
  #include "bytecode.c"
 #undef BYTECODE
  cod_for_broken_compilers_that_dont_like_trailing_commas
} bytecode_enum_t;


/* ---------------------- LISP-FUNCTIONS ----------------------- */

/* (SYS::%FUNTABREF i) returns the name of function Nr. i from the function-
 table (a symbol), resp. NIL if i is not in the right range. */
LISPFUNNF(funtabref,1)
{
  var object arg = popSTACK(); /* argument */
  var uintV i;
  if (posfixnump(arg) /* should be Fixnum >=0 */
      && (i = posfixnum_to_V(arg),
          i < FUNTAB_length+FUNTABR_length)) { /* and < table-length */
    /* Name of the indexed element of the table: */
    value1 = (i < FUNTAB_length
              ? FUNTAB[i]                /* from FUNTAB1/2 */
              : FUNTABR[i-FUNTAB_length] /* resp. from FUNTABR */
              )->name;
  } else {
    value1 = NIL; /* or NIL */
  }
  mv_count=1; /* as value */
}

/* (SYS::SUBR-INFO obj) returns information for this SUBR, if obj is a SUBR
   (or a Symbol with a SUBR as global function definition),
 6 values:
   name              Name,
   req-count         number of required parameters,
   opt-count         number of optional parameters,
   rest-p            flag, if &rest is specified,
   keywords          list of admissible keywords (empty: no &key specified),
   allow-other-keys  flag, if additional keywords are allowed,
 otherwise NIL. */
LISPFUNNR(subr_info,1)
{
  var object obj = popSTACK();
  if (!subrp(obj)) {
    if (!(symbolp(obj) && subrp(Symbol_function(obj)))) {
      VALUES0; return; /* no SUBR -> no value */
    }
    obj = Symbol_function(obj);
  }
  /* obj is a SUBR */
  pushSTACK(TheSubr(obj)->name); /* Name */
  pushSTACK(fixnum(TheSubr(obj)->req_count)); /* req-count (req-nr) */
  pushSTACK(fixnum(TheSubr(obj)->opt_count)); /* opt-count (opt-nr) */
  pushSTACK(TheSubr(obj)->rest_flag == subr_norest ? NIL : T); /* rest-p */
  /* during bootstrap, before defseq.lisp is loaded, this may fail: */
  coerce_sequence(TheSubr(obj)->keywords,S(list),false);
  /* keyword-vector as list (during bootstrap: vector) */
  pushSTACK(eq(value1,nullobj) ? (object)TheSubr(obj)->keywords : value1);
  pushSTACK(TheSubr(obj)->key_flag == subr_key_allow ? T : NIL); /* allow-other-keys */
  funcall(L(values),6); /* 6 values */
}


/* ----------------------- SUBROUTINES ----------------------- */

/* UP: unwinds a frame, which is pointed at by STACK.
 unwind();
 The values mv_count/mv_space remain unmodified.
 If it is no Unwind-Protect-Frame: return normally.
 If it is a  Unwind-Protect-Frame:
   save the values, climbs(?) up STACK and SP
   and then calls unwind_protect_to_save.fun .
 changes STACK
 can trigger GC */
global /*maygc*/ void unwind (void)
{
  var fcint frame_info = framecode(STACK_0);
  GCTRIGGER_IF(frame_info == APPLY_frame_info || frame_info == TRAPPED_APPLY_frame_info
               || frame_info == EVAL_frame_info || frame_info == TRAPPED_EVAL_frame_info,
               GCTRIGGER1(mv_space));
 #ifdef unwind_bit_t
  if (frame_info & bit(unwind_bit_t)) /* anything to do? */
 #else
  if (frame_info >= unwind_limit_t) /* anything to do? */
 #endif
    { /* (not at APPLY, EVAL untrapped, CATCH, HANDLER,
         IBLOCK or ITAGBODY unnested) */
      if ((frame_info & bit(skip2_bit_t)) == 0) { /* ENV- or DYNBIND-Frame? */
       #ifdef entrypoint_bit_t
        if (frame_info & bit(entrypoint_bit_t)) /* BLOCK, TAGBODY, CATCH etc. ? */
       #else
        if (frame_info < entrypoint_limit_t) /* BLOCK, TAGBODY, CATCH etc. ? */
       #endif
          /* Frame with Exitpoint */
          if (frame_info & bit(blockgo_bit_t)) { /* BLOCK or TAGBODY? */
            /* BLOCK_FRAME or TAGBODY_FRAME */
            if (frame_info & bit(cframe_bit_t)) { /* compiled? */
              /* CBLOCK_FRAME or CTAGBODY_FRAME
                 In Cons (NAME/Tags . <Framepointer>) */
              Cdr(STACK_(frame_ctag)) = disabled; /* disable Exit/Tags */
            } else {
              /* IBLOCK_FRAME or ITAGBODY_FRAME, nested
                 In Cons (NAME/Tags . <Framepointer>)
                 (first pair of alist next_env) */
              Cdr(Car(STACK_(frame_next_env))) = disabled; /* disable Exit/Tags */
            }
          } else {
            /* UNWIND_PROTECT_FRAME DRIVER_FRAME or trapped APPLY/EVAL_FRAME */
            if (frame_info & bit(dynjump_bit_t)) {
              /* UNWIND_PROTECT_FRAME or DRIVER_FRAME */
              if (frame_info & bit(driver_bit_t)) {
                /* DRIVER_FRAME */
              } else {
                /* UNWIND_PROTECT_FRAME */
                enter_frame_at_STACK();
              }
            } else {
              /* trapped APPLY/EVAL_FRAME
                 like in the tracer: */
              var object values;
              mv_to_list(); values = popSTACK(); /* pack values into list */
              dynamic_bind(S(trace_values),values); /* bind *TRACE-VALUES* */
              break_driver(true); /* call break-driver */
              list_to_mv(Symbol_value(S(trace_values)), /* build values again */
                         error_mv_toomany(framecode(STACK_(0+3))==
                                          TRAPPED_EVAL_frame_info
                                          ? S(eval)
                                          : S(apply)););
              dynamic_unbind(S(trace_values)); /* unbind */
            }
          }
        else {
         #ifdef HAVE_SAVED_REGISTERS
          if ((frame_info & bit(callback_bit_t)) == 0) {
            /* CALLBACK_FRAME */
            var gcv_object_t* new_STACK = topofframe(STACK_0); /* Pointer to Frame */
            /* set callback_saved_registers: */
            callback_saved_registers = (struct registers *)(aint)as_oint(STACK_1);
            /* set STACK, thus unwind frame: */
            setSTACK(STACK = new_STACK);
            goto done;
          } else
         #endif
          {
            /* VAR_FRAME or FUN_FRAME */
            var gcv_object_t* new_STACK = topofframe(STACK_0); /* Pointer to Frame */
            if (frame_info & bit(fun_bit_t)) {
              /* for functions: do nothing */
            } else {
              /* VAR_FRAME, bindingptr iterates over the bindungs */
              var gcv_object_t* frame_end = STACKpointable(new_STACK);
              var gcv_object_t* bindingptr = &STACK_(frame_bindings); /* start of the variable-/functionbindings */
              while (bindingptr != frame_end) {
                if (as_oint(*(bindingptr STACKop 0)) & wbit(dynam_bit_o))
                  if (as_oint(*(bindingptr STACKop 0)) & wbit(active_bit_o)) {
                    /* binding static or inactive -> nothing to do
                       binding dynamic and active -> write back value: */
                    TheSymbolflagged(*(bindingptr STACKop varframe_binding_sym))->symvalue =
                      *(bindingptr STACKop varframe_binding_value);
                  }
                bindingptr skipSTACKop varframe_binding_size; /* next binding */
              }
            }
            /* set STACK, thus unwind frame: */
            setSTACK(STACK = new_STACK);
            goto done;
          }
        }
      } else {
        /* DYNBIND_FRAME or CALLBACK_FRAME or ENV_FRAME */
        if (frame_info & bit(envbind_bit_t)) {
          /* ENV_FRAME */
          var gcv_object_t* ptr = &STACK_1;
          switch (frame_info & envbind_case_mask_t) {
            case (ENV1V_frame_info & envbind_case_mask_t): /* 1 VAR_ENV */
              aktenv.var_env = *ptr; ptr skipSTACKop 1; break;
            case (ENV1F_frame_info & envbind_case_mask_t): /* 1 FUN_ENV */
              aktenv.fun_env = *ptr; ptr skipSTACKop 1; break;
            case (ENV1B_frame_info & envbind_case_mask_t): /* 1 BLOCK_ENV */
              aktenv.block_env = *ptr; ptr skipSTACKop 1; break;
            case (ENV1G_frame_info & envbind_case_mask_t): /* 1 GO_ENV */
              aktenv.go_env = *ptr; ptr skipSTACKop 1; break;
            case (ENV1D_frame_info & envbind_case_mask_t): /* 1 DECL_ENV */
              aktenv.decl_env = *ptr; ptr skipSTACKop 1; break;
            case (ENV2VD_frame_info & envbind_case_mask_t): /* 1 VAR_ENV and 1 DECL_ENV */
              aktenv.var_env = *ptr; ptr skipSTACKop 1;
                  aktenv.decl_env = *ptr; ptr skipSTACKop 1;
                  break;
            case (ENV5_frame_info & envbind_case_mask_t): /* all 5 Environments */
              aktenv.var_env = *ptr; ptr skipSTACKop 1;
              aktenv.fun_env = *ptr; ptr skipSTACKop 1;
              aktenv.block_env = *ptr; ptr skipSTACKop 1;
              aktenv.go_env = *ptr; ptr skipSTACKop 1;
              aktenv.decl_env = *ptr; ptr skipSTACKop 1;
              break;
            default: NOTREACHED;
          }
        } else {
          /* DYNBIND_FRAME */
          var gcv_object_t* new_STACK = topofframe(STACK_0); /* Pointer to Frame */
          var gcv_object_t* frame_end = STACKpointable(new_STACK);
          var gcv_object_t* bindingptr = &STACK_1; /* start of the bindings */
          /* bindingptr iterates through the bindings */
          while (bindingptr != frame_end) {
            Symbol_value(*(bindingptr STACKop 0)) = *(bindingptr STACKop 1);
            bindingptr skipSTACKop 2; /* next binding */
          }
          /* set STACK, thus unwind frame: */
          setSTACK(STACK = new_STACK);
          goto done;
        }
      }
    }
  /* set STACK, thus unwind frame: */
  setSTACK(STACK = topofframe(STACK_0));
 done: ;
}

/* UP: "unwinds" the STACK up to the next DRIVER_FRAME and
 jumps into the corresponding top-level-loop.
 if count=0, unwind to TOP; otherwise reset that many times */
nonreturning_function(global, reset, (uintL count)) {
  /* when unwinding UNWIND-PROTECT-frames, don't save values: */
  bool top_p = (count==0);
  gcv_object_t *last_driver_frame = NULL;
  VALUES0;
  unwind_protect_to_save.fun = (restartf_t)&reset;
  unwind_protect_to_save.upto_frame = NULL;
  while (1) {
    /* does STACK end here? */
    if (eq(STACK_0,nullobj) && eq(STACK_1,nullobj)) { /* check STACK_start? */
      if (last_driver_frame) {  /* restart at last driver frame */
        setSTACK(STACK = last_driver_frame);
        break;
      }
      /* we used to start a new driver() here, but this is wrong because it
         does not clean up SP & back_trace, just STACK, see
         https://sourceforge.net/tracker/?func=detail&atid=101355&aid=1448744&group_id=1355
         we probably cannot even do NOTREACHED - the STACK is bad. */
      fprintf(stderr,"\n[%s:%d] reset() found no driver frame (sp=0x%x-0x%x)\n",
              __FILE__,__LINE__,(aint)SP_anchor,(aint)SP());
      abort();
    }
    if (framecode(STACK_0) & bit(frame_bit_t)) {
      /* at STACK_0: beginning of a frame */
      if (framecode(STACK_0) == DRIVER_frame_info) { /* DRIVER_FRAME ? */
        last_driver_frame = STACK; /* save the frame */
        if (!top_p && --count==0) /* done count resets */
          break; /* yes -> found */
      }
      unwind(); /* unwind frame */
    } else { /* STACK_0 contains a normal LISP-object */
      skipSTACK(1);
    }
  }
  /* At STACK_0 a new Driver-Frame starts. */
  enter_frame_at_STACK();
}

/* UP: dynamically binds the symbols of list symlist
 to the the values of list vallist.
 progv(symlist,vallist);
 > symlist, vallist: two lists
 Exactly one variable binding frame is constructed.
 changes STACK
 can trigger GC */
global maygc void progv (object symlist, object vallist) {
  /* check symlist */
  var uintL llen = 0;
  var bool need_new_symlist = true;
  pushSTACK(symlist); pushSTACK(vallist);
  for (pushSTACK(symlist); consp(STACK_0); STACK_0 = Cdr(STACK_0), llen++) {
    var object sym = check_symbol_non_constant(Car(STACK_0),S(progv));
    if (!eq(sym,Car(STACK_0))) { /* changed symbol ==> must copy symlist */
      if (need_new_symlist) {    /* have not copied symlist yet */
        pushSTACK(sym);          /* save sym */
        STACK_1 = STACK_3 = copy_list(STACK_3); /* copy symlist */
        var uintL pos = llen;                 /* skip copy ... */
        while (pos--) STACK_1 = Cdr(STACK_1); /* ... to the right position */
        need_new_symlist = false; /* do not copy symlist twice */
        sym = popSTACK();         /* restore sym */
      }
      Car(STACK_0) = sym;
    }
  }
  skipSTACK(1); vallist = popSTACK(); symlist = popSTACK();
  /* demand room on STACK: */
  get_space_on_STACK(llen * 2 * sizeof(gcv_object_t));
  /* build frame: */
  var gcv_object_t* top_of_frame = STACK; /* Pointer to Frame */
  var object symlistr = symlist;
  while (consp(symlistr)) { /* loop over symbol list */
    var object sym = Car(symlistr);
    pushSTACK(Symbol_value(sym)); /* old value of the variables */
    pushSTACK(sym); /* variable */
    symlistr = Cdr(symlistr);
  }
  finish_frame(DYNBIND);
  /* building of frame completed, now change the values of the variables: */
  while (consp(symlist)) {
    if (atomp(vallist)) {
      /* value list shorter than symbol list
         -> all further "values" are #<UNBOUND> */
      do {
        Symbol_value(Car(symlist)) = unbound;
        symlist = Cdr(symlist);
      } while (consp(symlist));
      break;
    }
    /* symbol obtains new value: */
    Symbol_value(Car(symlist)) = Car(vallist);
    symlist = Cdr(symlist); vallist = Cdr(vallist);
  }
}

/* UP: unwinds the dynamic nesting in STACK up to the frame
 (exclusively), which is pointed to by upto, and then jumps to it.
 unwind_upto(upto);
 > upto: pointer to a frame (into the stack, without typinfo).
 saves the values mv_count/mv_space.
 changes STACK,SP
 can trigger GC
 then jumps to the frame, which was found. */
nonreturning_function(global /*maygc*/, unwind_upto, (gcv_object_t* upto_frame)) {
  GCTRIGGER1(mv_space);
  unwind_protect_to_save.fun        = &unwind_upto;
  unwind_protect_to_save.upto_frame = upto_frame;
  while (STACK != upto_frame) { /* arrived at target-frame? */
    if (framecode(STACK_0) & bit(frame_bit_t)) { /* is it a frame? */
      unwind(); /* yes -> unwind */
      /* (if this is a Unwind-Protect-Frame, then
         unwind_upto(upto_frame) is called again, and we are again here.) */
    } else {
      skipSTACK(1); /* no -> simply go ahead */
    }
  }
  /* now STACK points to the FRAME found. */
  enter_frame_at_STACK();
}

/* UP: throws to the Tag tag and passes the values mv_count/mv_space.
 returns only, if there is no CATCH-Frame for this tag.
 throw_to(tag); */
global void throw_to (object tag) {
  /* search for Catch-Frame with Tag = tag: */
  var gcv_object_t* FRAME = STACK;
  while (1) { /* search in the Stack starting at FRAME
                 for a CATCH-Frame with the same Tag: */
    if (eq(FRAME_(0),nullobj)) /* end of Stack? */
      return; /* yes -> no suitable Catch there -> jump back */
    if (framecode(FRAME_(0)) & bit(frame_bit_t)) {
      /* found frame */
      if ((framecode(FRAME_(0)) == CATCH_frame_info) /* Catch-Frame? */
          && eq(FRAME_(frame_tag),tag)) /* with the same tag? */
        break; /* yes -> search-loop finished */
      /* skip Frame: */
      FRAME = topofframe(FRAME_(0));
    } else {
      FRAME skipSTACKop 1;
    }
  }
  /* FRAME points to the lowest CATCH-Frame with the same Tag */
  unwind_upto(FRAME); /* unwind upto there, then jump */
}

/* UP: Invokes all handlers for condition cond. Returns only, if none
 of these handlers feels responsible (i.e. if each handler returns).
 invoke_handlers(cond);
 can trigger GC
 This deactivates the handler, that is called right now,
 and all newer handlers. */
global maygc void invoke_handlers (object cond) {
  /* Also deactivates the handler being called, and all newer handlers.
     the handler-ranges, which are screened off: */
  var stack_range_t* other_ranges = inactive_handlers;
  var stack_range_t new_range;
  /* Search for Handler-Frame, that handles a Type with (TYPEP cond type): */
  var gcv_object_t* FRAME = STACK;
  while (1) {
    /* search in Stack starting at FRAME for a suitable HANDLER-Frame: */
    if (!(other_ranges == NULL) && (FRAME == other_ranges->low_limit)) {
      FRAME = other_ranges->high_limit;
      other_ranges = other_ranges->next;
    } else if (eq(FRAME_(0),nullobj)) { /* End of Stack? */
      break; /* yes -> finised, jump back */
    } else if (framecode(FRAME_(0)) & bit(frame_bit_t)) {
      /* found frame */
      if (framecode(FRAME_(0)) == HANDLER_frame_info) { /* Handler-Frame? */
        /* loop over types of the vectors #(type1 label1 ... typem labelm): */
        var uintL m2 = Svector_length(Car(FRAME_(frame_handlers))); /* 2*m */
        var uintL i = 0;
        do {
          pushSTACK(cond); /* save cond */
          pushSTACK(cond);
          pushSTACK(TheSvector(Car(FRAME_(frame_handlers)))->data[i]); /* typei */
          funcall(S(safe_typep),2); /* execute (SYS::SAFE-TYPEP cond typei) */
          if (!nullp(value1)) { /* found a suitable handler */
            /* CLtL2 S. 873, 884:
               "A handler is executed in the dynamic context
               of the signaler, except that the set of available condition
               handlers will have been rebound to the value that was active
               at the time the condition handler was made active."
               we make the whole thing bullet-proof by an
               Unwind-Protect-Frame: */
            var stack_range_t* saved_inactive_handlers = inactive_handlers;
            new_range.low_limit = STACK;
            new_range.high_limit = topofframe(FRAME_(0));
            new_range.next = other_ranges;
            var gcv_object_t* top_of_frame = STACK;
            var sp_jmp_buf returner; /* return point */
            finish_entry_frame(UNWIND_PROTECT,returner,, {
              var restartf_t fun = unwind_protect_to_save.fun;
              var gcv_object_t* arg = unwind_protect_to_save.upto_frame;
              skipSTACK(2); /* unwind Unwind-Protect-Frame */
              /* Cleanup: reactivate Handler: */
              inactive_handlers = saved_inactive_handlers;
              /* and jump ahead: */
              fun(arg);
              NOTREACHED;
            });
            /* deactivate Handler: */
            inactive_handlers = &new_range;
            if (!nullp(Cdr(FRAME_(frame_handlers)))) {
              /* make information available for Handler: */
              handler_args.condition = STACK_(0+2);
              handler_args.stack = FRAME STACKop 4;
              handler_args.sp = (SPint*)(aint)as_oint(FRAME_(frame_SP));
              handler_args.spdepth = Cdr(FRAME_(frame_handlers));
              /* call Handler: */
              var object closure = FRAME_(frame_closure);
              var object codevec = TheCclosure(closure)->clos_codevec;
              var uintL index = (TheCodevec(codevec)->ccv_flags & bit(7) ? CCV_START_KEY : CCV_START_NONKEY)
                + (uintL)posfixnum_to_V(TheSvector(Car(FRAME_(frame_handlers)))->data[i+1]);
              interpret_bytecode(closure,codevec,index);
            } else {
              /* call C-Handler: */
              void* handler_fn = TheMachineCode(FRAME_(frame_closure));
              ((void (*) (void*, gcv_object_t*, object, object)) handler_fn)
                ((void*)(aint)as_oint(FRAME_(frame_SP)),FRAME,
                 TheSvector(Car(FRAME_(frame_handlers)))->data[i+1],
                 STACK_(0+2));
            }
            skipSTACK(2); /* unwind Unwind-Protect-Frame */
            /* reactivate Handler: */
            inactive_handlers = saved_inactive_handlers;
          }
          cond = popSTACK(); /* cond back */
          i += 2;
        } while (i < m2);
      }
      /* skip Frame: */
      FRAME = topofframe(FRAME_(0));
    } else {
      FRAME skipSTACKop 1;
    }
  }
  var object handler = Symbol_function(S(global_handler));
  if (boundp(handler)) {                 /* unbound during bootstrap */
    pushSTACK(cond); funcall(handler,1); /* (GLOBAL-HANDLER cond) */
  }
}

/* UP: finds out, if an object is a function name, i.e. a Symbol or
 a list of the form (SETF symbol).
 funnamep(obj)
 > obj: Object
 < result: true if function name */
global bool funnamep (object obj) {
  if (symbolp(obj))
    return true;
  if (consp(obj) && eq(Car(obj),S(setf))) {
    obj = Cdr(obj);
    if (consp(obj) && nullp(Cdr(obj)) && symbolp(Car(obj)))
      return true;
  }
  return false;
}

/* UP: find whether the symbol is bound in the environment */
local inline gcv_object_t* symbol_env_search (object sym, object venv)
{
  /* Does the binding at bindptr bind the symbol sym? */
#ifdef NO_symbolflags
  #define binds_sym_p(bindingptr)  \
    (eq(*(bindingptr STACKop 1),sym) /* the right symbol? */ \
     && eq(*(bindingptr STACKop 0),fixnum(bit(active_bit)))) /* active & static? */
#else
  var object cmp = SET_BIT(sym,active_bit_o); /* for comparison: binding must be active */
  #define binds_sym_p(bindingptr)  \
    (eq(*(bindingptr STACKop 0),cmp)) /* right symbol & active & static? */
#endif
 next_env:
  if (framepointerp(venv)) {
    /* Environment is a Pointer to a variable-binding-frame */
    var gcv_object_t* FRAME = TheFramepointer(venv);
    var uintL count = as_oint(FRAME_(frame_count)); /* number of bindings */
    if (count > 0) {
      var gcv_object_t* bindingsptr = &FRAME_(frame_bindings); /* 1st binding */
      do {
        if (binds_sym_p(bindingsptr)) /* right symbol & active & static? */
          return bindingsptr STACKop varframe_binding_value;
        bindingsptr skipSTACKop varframe_binding_size; /* no: next binding */
      } while (--count);
    }
    venv = FRAME_(frame_next_env);
    goto next_env;
  }
  var bool from_inside_macrolet = false;
  for (;;) {
    if (simple_vector_p(venv)) {
      /* environment is a simple-vector */
      var uintL count = floor(Svector_length(venv),2); /* number of bindings */
      var gcv_object_t* ptr = &TheSvector(venv)->data[0];
      dotimesL(count,count, {
        if (eq(*ptr,sym)) { /* right symbol? */
          if (from_inside_macrolet && !eq(*(ptr+1),specdecl)
              && !symbolmacrop(*(ptr+1)))
            goto macrolet_error;
          return ptr+1;
        }
        ptr += 2; /* next binding */
      });
      venv = *ptr; /* next environment */
      continue;
    } else if (consp(venv)) {
      /* environment is a MACROLET capsule */
      ASSERT(eq(Car(venv),S(macrolet)));
      from_inside_macrolet = true;
      venv = Cdr(venv);
      continue;
    } else
      break;
  }
  /* Environment is NIL */
  return NULL;
#undef binds_sym_p
 macrolet_error:
  pushSTACK(sym); /* SOURCE-PROGRAM-ERROR slot DETAIL */
  pushSTACK(S(macrolet)); pushSTACK(sym);
  error(program_error,
         GETTEXT("Invalid access to the value of the lexical variable ~S from within a ~S definition"));
}

/* (SYS::SPECIAL-VARIABLE-P symbol &optional environment)
   tests whether the symbol is a special variable or a constant.
   A missing or NIL environment means the global environment. */
LISPFUN(special_variable_p,seclass_read,1,1,norest,nokey,0,NIL)
{
  var object symbol = check_symbol(STACK_1);
  var object env = STACK_0; skipSTACK(2);
  if (special_var_p(TheSymbol(symbol))) {
    value1 = T;
  } else if (missingp(env)) {
    value1 = NIL;
  } else {
    if (simple_vector_p(env)) {
      var uintL len = Svector_length(env);
      if (len == 2 || len == 5)
        env = TheSvector(env)->data[0]; /* venv */
      else
        error_environment(env);
    }
    var gcv_object_t *binding = symbol_env_search(symbol,env);
    if ((binding != NULL) && eq(*binding,specdecl))
      value1 = T;
    else
      value1 = NIL;
  }
  mv_count = 1;
}

/* UP: returns the value of a symbol in an environment.
 sym_value(symbol,venv,&symbolmacro)
 > symbol: Symbol
 > venv: a Variable- and Symbolmacro-Environment
 < symbolmacro: symbol-macro definition, or nullobj if not a symbol-macro
 < result: value of the symbol in this environment, or
           nullobj if a symbol-macro */
local gcv_object_t sym_value (object sym, object env, object* symbolmacro_)
{
  if (special_var_p(TheSymbol(sym))) {
    /* Constants and symbols declared special have only global values. */
    goto global_value;
  } else {
    var gcv_object_t* binding = symbol_env_search(sym,env);
    if (binding != NULL) {
      var object val = *binding;
      if (eq(val,specdecl))
        goto global_value;
      if (symbolmacrop(val)) {
        *symbolmacro_ = val;
        return nullobj;
      }
      *symbolmacro_ = nullobj;
      return val;
    }
    if (symmacro_var_p(TheSymbol(sym))) {
      /* Fetch the symbol-macro definition from the property list: */
      var object symbolmacro = get(sym,S(symbolmacro));
      if (!eq(symbolmacro,unbound)) {
        ASSERT(globalsymbolmacrop(symbolmacro));
        *symbolmacro_ = TheGlobalSymbolmacro(symbolmacro)->globalsymbolmacro_definition;
        return nullobj;
      }
      /* Huh? The symbol-macro definition got lost. */
      clear_symmacro_flag(TheSymbol(sym));
    }
  }
 global_value: /* the global (dynamic) value of the Symbol */
  *symbolmacro_ = nullobj;
  return Symbol_value(sym);
}

/* UP: determines, if a Symbol is a Macro in the current environment.
 sym_macrop(symbol)
 > symbol: Symbol
 < result: true if sym is a Symbol-Macro */
global bool sym_macrop (object sym) {
  var object symbolmacro;
  sym_value(sym,aktenv.var_env,&symbolmacro);
  return !eq(symbolmacro,nullobj);
}

/* UP: Sets the value of a Symbol in the current Environment.
 setq(symbol,value);
 > symbol: Symbol, no constant, not a symbol-macro in the current Environment
 > value: desired value of the Symbols in the current Environment
 < result: value
 can trigger GC */
global maygc object setq (object sym, object value)
{
  if (special_var_p(TheSymbol(sym))) {
    /* Constants and symbols declared special have only global values. */
    goto global_value;
  } else {
    var gcv_object_t* binding = symbol_env_search(sym,aktenv.var_env);
    if (binding != NULL) {
      var object val = *binding;
      if (eq(val,specdecl))
        goto global_value;
      ASSERT(!symbolmacrop(val));
      return *binding = value;
    }
    ASSERT(!symmacro_var_p(TheSymbol(sym)));
  }
 global_value: /* the global (dynamic) value of the Symbol */
  pushSTACK(value); pushSTACK(sym);
  symbol_value_check_lock(S(setq),sym);
  Symbol_value(STACK_0) = STACK_1;
  skipSTACK(1);
  return popSTACK();
}

/* UP: returns for a Symbol its function definition in an Environment
 sym_function(sym,fenv)
 > sym: function name (e.g. Symbol)
 > fenv: a function- and macro-bindung-environment
 < result: function definition, either unbound (if undefined function)
             or Closure/SUBR/FSUBR/Macro/FunctionMacro. */
global object sym_function (object sym, object env)
{
  var object value;
  { next_env:
    if (framepointerp(env)) {
      /* Environment is a Pointer to a function-binding-frame */
      var gcv_object_t* FRAME = TheFramepointer(env);
      var uintL count = as_oint(FRAME_(frame_count)); /* number of bindings */
      if (count > 0) {
        var gcv_object_t* bindingsptr = &FRAME_(frame_bindings); /* pointer to the first binding */
        dotimespL(count,count, {
          if (equal(*(bindingsptr STACKop 0),sym)) { /* right Symbol? */
            value = *(bindingsptr STACKop 1); goto done;
          }
          bindingsptr skipSTACKop 2; /* no: next binding */
        });
      }
      env = FRAME_(frame_next_env);
      goto next_env;
    }
    var bool from_inside_macrolet = false;
    for (;;) {
      if (simple_vector_p(env)) {
        /* Environment is a Simple-Vector */
        var uintL count = floor(Svector_length(env),2); /* number of bindings */
        var gcv_object_t* ptr = &TheSvector(env)->data[0];
        dotimesL(count,count, {
          if (equal(*ptr,sym)) { /* right Symbol? */
            value = *(ptr+1);
            if (from_inside_macrolet && !macrop(value))
              goto macrolet_error;
            goto done;
          }
          ptr += 2;             /* next binding */
        });
        env = *ptr;             /* next Environment */
        continue;
      } else if (consp(env)) {
        /* environment is a MACROLET capsule */
        ASSERT(eq(Car(env),S(macrolet)));
        from_inside_macrolet = true;
        env = Cdr(env);
        continue;
      } else                    /* Environment is NIL */
        goto global_value;
    }
  }
 global_value:                  /* global function-definition */
  if (!symbolp(sym)) {
    sym = get(Car(Cdr(sym)),S(setf_function)); /* (get s 'SYS::SETF-FUNCTION) */
    if (!symbolp(sym))          /* should be (uninterned) Symbol */
      return unbound;           /* else undefined */
  }
  return Symbol_function(sym);
 done:
  /* Symbol found active in Environment, "Value" value (a Closure or Macro
     or FunctionMacro or NIL) if Definition = NIL (during LABELS),
     the function is passed for as undefined: */
  if (nullp(value))
    value = unbound;
  return value;
 macrolet_error:
  pushSTACK(sym); /* SOURCE-PROGRAM-ERROR slot DETAIL */
  pushSTACK(S(macrolet)); pushSTACK(sym);
  error(source_program_error,
        GETTEXT("Invalid access to the local function definition of ~S from within a ~S definition"));
}

/* UP: evaluates a Form in a given Environment.
 eval_5env(form,var,fun,block,go,decl);
 > var_env: value for VAR_ENV
 > fun_env: value for FUN_ENV
 > block_env: value for BLOCK_ENV
 > go_env: value for GO_ENV
 > decl_env: value for DECL_ENV
 > form: Form
 < mv_count/mv_space: values
 can trigger GC */
global maygc Values eval_5env (object form, object var_env, object fun_env,
                               object block_env, object go_env, object decl_env)
{
  /* bind Environments: */
  make_ENV5_frame();
  /* set current Environments: */
  aktenv.var_env = var_env;
  aktenv.fun_env = fun_env;
  aktenv.block_env = block_env;
  aktenv.go_env = go_env;
  aktenv.decl_env = decl_env;
  /* evaluate Form: */
  eval(form);
  /* unwind Environment-Frame: */
  unwind();
  return;                       /* finished */
}

/* UP: evaluates a form in an empty environment.
 eval_noenv(form);
 > form: Form
 < mv_count/mv_space: values
 can trigger GC */
global maygc Values eval_noenv (object form) {
  return_Values eval_5env(form,NIL,NIL,NIL,NIL,O(top_decl_env));
}

/* UP: "nests" a FUN-Environment, i.e. writes all active bindings
 from the Stack into freshly allocated vectors.
 nest_fun(env)
 > env: FUN-Env
 < result: same environment, no Pointer into the Stack
 can trigger GC */
global maygc object nest_fun (object env)
{
  var uintL depth = 0;     /* recursion counter := 0 */
  /* Pseudorecursion with Input env, Output env. */
 nest_start:                    /* start of recursion */
  if (framepointerp(env)) {
    /* env is a pointer to a STACK-Frame. */
    check_STACK();
    pushSTACK(env);             /* save env */
    /* execute nest_fun(NEXT_ENV(env)) "disrecursified" :-) : */
    {
      var gcv_object_t* FRAME = TheFramepointer(env);
      env = FRAME_(frame_next_env); depth++; goto nest_start;
    }
   nest_reentry: depth--;
    {                           /* NEXT_ENV is now nested. */
      var gcv_object_t* FRAME = TheFramepointer(STACK_0); /* next STACK-Frame to be nested */
      STACK_0 = env;            /* bisher genestetes Environment */
      var uintL bcount = as_oint(FRAME_(frame_count)); /* number of not yet netsted bindings */
      if (bcount == 0) {
        /* no bindings -> unnecessary, to create a vector. */
        env = popSTACK();
      } else {
        /* create vector for bcount bindings: */
        env = allocate_vector(2*bcount+1);
        /* and fill: */
        {
          var gcv_object_t* ptr = &TheSvector(env)->data[0];
          var gcv_object_t* bindingsptr = &FRAME_(frame_bindings); /* Pointer to the first binding */
          /* put bcount bindings starting at bindingsptr into the vector at ptr: */
          dotimespL(bcount,bcount, {
            *ptr++ = *(bindingsptr STACKop 0); /* copy binding into the vector */
            *ptr++ = *(bindingsptr STACKop 1);
            bindingsptr skipSTACKop 2;
          });
          *ptr++ = popSTACK();  /* put nested NEXT_ENV into vector */
        }
        FRAME_(frame_next_env) = env; /* Vector as NEXT_ENV into the Frame */
        FRAME_(frame_count) = as_object(0); /* new number of not yet nested bindings */
      }
    }
  }
  /* finished with this Nest-substep. */
  if (depth>0)                  /* end of recursion */
    goto nest_reentry;
  return env;
}

/* UP: "nests" a VAR-Environment, i.e. writes all active bindings
 from the Stack in freshly allocated vectors.
 nest_var(env)
 > env: VAR-Env
 < result: same Environment, no Pointer in the Stack
 can trigger GC */
local maygc object nest_var (object env)
{
  var uintL depth = 0;     /* Recursion counter := 0 */
  /* Pseudorecursion with Input env, Output env. */
 nest_start:                    /* start of Recursion */
  if (framepointerp(env)) {
    /* env is a Pointer to a STACK-Frame. */
    check_STACK();
    pushSTACK(env);             /* save env */
    /* execute nest_var(NEXT_ENV(env)) "disrecursified" :-) : */
    {
      var gcv_object_t* FRAME = TheFramepointer(env);
      env = FRAME_(frame_next_env); depth++; goto nest_start;
    }
   nest_reentry: depth--;
    /* NEXT_ENV is now nested. */
    {
      var gcv_object_t* FRAME = TheFramepointer(STACK_0); /* next STACK-Frame to be nested */
      STACK_0 = env;            /* formerly nested Environment */
      /* Search (from bottom) the first active among the not yet
       nested bindings: */
      var uintL bcount = as_oint(FRAME_(frame_count)); /* number of not yet nested bindings */
      var uintL count = 0;
      var gcv_object_t* bindingsptr = &FRAME_(frame_bindings); /* Pointer to the first binding */
      while (!((count>=bcount)  /* all unnested bindings through? */
               || (as_oint(*(bindingsptr STACKop 0)) & wbit(active_bit_o)))) { /* discovered active binding? */
        /* no -> continue search: */
        bindingsptr skipSTACKop varframe_binding_size;
        count++;
      }
      /* Below bindingsptr are count inactive bindings.
       From bindingsptr on there are bcount-count active, to be nested bindings. */
      bcount = bcount-count;    /* number of bindings to be nested */
      if (bcount == 0) {
        /* no bindings -> creating a vector is unnecessary. */
        env = popSTACK();
      } else {
        /* create vector for bcount bindings: */
        env = allocate_vector(2*bcount+1);
        /* and fill: */
        {
          var gcv_object_t* ptr = &TheSvector(env)->data[0];
          /* put bindungs starting at bindingsptr in the vector at ptr: */
          dotimespL(bcount,bcount, {
            if (as_oint(*(bindingsptr STACKop varframe_binding_mark)) & wbit(dynam_bit_o)) { /* binding dynamic? */
              /* dynamic binding, lexical scope */
              *ptr++ = symbol_without_flags(*(bindingsptr STACKop varframe_binding_sym)); /* put Symbol without Flag-Bits in the Vector */
              *ptr++ = specdecl; /* mark as special reference */
              /* binding stays active in the Frame */
            } else {
              /* static binding, lexical scope */
              *(bindingsptr STACKop varframe_binding_mark) =
                CLR_BIT(*(bindingsptr STACKop varframe_binding_mark),active_bit_o); /* deactivate binding */
              *ptr++ = *(bindingsptr STACKop varframe_binding_sym); /* copy binding in the vector */
              *ptr++ = *(bindingsptr STACKop varframe_binding_value);
            }
            bindingsptr skipSTACKop varframe_binding_size;
          });
          *ptr++ = popSTACK();  /* put nested NEXT_ENV in the vector */
        }
        FRAME_(frame_next_env) = env; /* vector as NEXT_ENV in the Frame */
        FRAME_(frame_count) = fake_gcv_object(count); /* new number of not yet nested bindings */
      }
    }
  }
  /* finished with this Nest-substep. */
  if (depth>0)                  /* end of recursion */
    goto nest_reentry;
  return env;
}

/* UP: Nests the Environments in *env (i.e. writes all information in
 Stack-independent structures) and pushes them onto the STACK.
 (The values VAR_ENV, FUN_ENV, BLOCK_ENV, GO_ENV, DECL_ENV will not
 be changed, because inactive bindings might poss. still sit in the frames.
 It has to be feasible, to activate these bindings without change of VAR_ENV.)
 nest_env(env)
 > gcv_environment_t* env: Pointer to five Environments
 < gcv_environment_t* result: Pointer to the Environments in the STACK
 changes STACK, can trigger GC */
global maygc gcv_environment_t* nest_env (gcv_environment_t* env5)
{
  /* First copy all Environments in the STACK: */
  make_STACK_env(env5->var_env,env5->fun_env,env5->block_env,env5->go_env,
                 env5->decl_env,env5 = );
  /* DECL_ENV: Not to be changed. */
  { /* GO_ENV: */
    var object env = env5->go_env;
    var uintL depth = 0; /* recursion depth := 0 */
    /* pseudo-recursion: nests a GO_ENV. */
    /* Input: env, a GO_ENV. Output: env, with Alist. */
   nest_go_start: { /* start of recursion */
      var gcv_object_t* FRAME;
      if (framepointerp(env)) {
        /* env is a pointer into the STACK to a ITAGBODY-frame. */
        check_STACK();
        FRAME = TheFramepointer(env);
        if (framecode(FRAME_(0)) & bit(nested_bit_t)) { /* frame already nested? */
          env = FRAME_(frame_next_env); /* yes -> fetch former Alist */
        } else {
          pushSTACK(env); /* save env */
          /* execute nest_go(NEXT_ENV(env)) "disrecursivied": */
          env = FRAME_(frame_next_env); depth++; goto nest_go_start;
         nest_go_reentry: depth--;
          { /* NEXT_ENV is now nested. */
            var object frame = STACK_0; /* next to be nested STACK-Frame */
            FRAME = uTheFramepointer(frame);
            STACK_0 = env; /* so far nested Environment */
            var gcv_object_t* tagsptr = &FRAME_(frame_bindings); /* Pointer to the bottom Tag */
            var gcv_object_t* frame_end = STACKpointable(topofframe(FRAME_(0))); /* Pointer to Frame */
            var uintL count = /* number of tags */
              /* subtract the pointers tagsptr and frame_end (both without Typinfo!): */
              STACK_item_count(tagsptr,frame_end) / 2;
              { /* create vector for count tags: */
                var object tagvec = allocate_vector(count);
                /* and fill: */
                if (count > 0) {
                  var gcv_object_t* ptr = &TheSvector(tagvec)->data[0];
                  /* put tags starting at tagsptr in the vector at ptr: */
                  dotimespL(count,count, {
                    *ptr++ = *(tagsptr STACKop 0);
                    tagsptr skipSTACKop 2;
                  });
                }
                pushSTACK(tagvec); /* and save */
              }
            { /* create next Alist Cons (cons tag-vector frame-pointer) : */
              var object new_cons = allocate_cons();
              Car(new_cons) = STACK_0; /* tagvec */
              Cdr(new_cons) = frame;
              STACK_0 = new_cons;
            }
            /* and prepend to Alist: */
            env = allocate_cons();
            Car(env) = popSTACK(); /* new_cons */
            Cdr(env) = popSTACK(); /* previous Alist */
            FRAME_(frame_next_env) = env; /* store new NEXT_ENV */
            *(oint*)(&FRAME_(0)) |= wbit(nested_bit_o); /* this frame is now nested. */
          }
        }
      }
      /* finished with this Nest-Substep. */
      if (depth>0) /* end of Recursion */
        goto nest_go_reentry;
      env5->go_env = env; /* file nested GO_ENV */
    }
  }
  { /* BLOCK_ENV: */
    var object env = env5->block_env;
    var uintL depth = 0; /* recursion depth := 0 */
    /* Pseudo-Recursion: nests a BLOCK_ENV. */
    /* Input: env, a BLOCK_ENV. Output: env, with Aliste. */
   nest_block_start: { /* start of recursion */
      var gcv_object_t* FRAME;
      if (framepointerp(env)) {
        /* env is a pointer into the STACK to a IBLOCK-Frame. */
        check_STACK();
        FRAME = TheFramepointer(env);
        if (framecode(FRAME_(0)) & bit(nested_bit_t)) { /* Frame already nested? */
          env = FRAME_(frame_next_env); /* yes -> fetch previous Alist */
        } else {
          pushSTACK(env); /* save env */
          /* execute nest_block(NEXT_ENV(env)) "disrecursified": */
          env = FRAME_(frame_next_env); depth++; goto nest_block_start;
         nest_block_reentry: depth--;
          { /* NEXT_ENV is now nested. */
            var object frame = STACK_0; /* next to be nested STACK-Frame */
            FRAME = TheFramepointer(frame);
            STACK_0 = env; /* so far nested Environment */
            { /* create next Alist Cons (cons Block-Name Frame-Pointer) : */
              var object new_cons = allocate_cons();
              Car(new_cons) = FRAME_(frame_name);
              Cdr(new_cons) = frame;
              pushSTACK(new_cons);
            }
            /* and prepend to the Aliste: */
            env = allocate_cons();
            Car(env) = popSTACK(); /* new_cons */
            Cdr(env) = popSTACK(); /* previous Alist */
            FRAME_(frame_next_env) = env; /* store new NEXT_ENV */
            *(oint*)(&FRAME_(0)) |= wbit(nested_bit_o); /* this frame is now nested. */
          }
        }
      }
    }
    /* finished with this Nest-Substep. */
    if (depth>0) /* end of recursion */
      goto nest_block_reentry;
    env5->block_env = env; /* file nested BLOCK_ENV */
  }
  /* FUN_ENV: */
  env5->fun_env = nest_fun(env5->fun_env);
  /* VAR_ENV: */
  env5->var_env = nest_var(env5->var_env);
  /* done */
  return env5;
}

/* UP: Nests the current environments (i.e. writes all Information in
 Stack-independent Structures) and pushes them onto the STACK.
 (The values VAR_ENV, FUN_ENV, BLOCK_ENV, GO_ENV, DECL_ENV are not
 modified, because inactive bindings might poss. still sit in the Frames.
 It has to be feasible, to activate these bindings without change of VAR_ENV.)
 nest_aktenv()
 < gcv_environment* result: Pointer to the Environments in the STACK
 changes STACK, can trigger GC */
#define nest_aktenv()  nest_env(&aktenv)

/* UP: augments a Declaration-Environment with a decl-spec.
 augment_decl_env(declspec,env)
 > declspec: Declaration-Specifier, a Cons
 > env: Declaration-Environment
 < result: new (poss. augmented) Declaration-Environment
 can trigger GC */
global maygc object augment_decl_env (object new_declspec, object env)
{
  var object decltype = Car(new_declspec); /* Declaration-Type */
  /* Is this a declaration type to be payed attention to?
   Is there a Decl-Spec of the form (DECLARATION ... decltype ...) in env?
   Aside: The List O(declaration_types) is the last Decl-Spec in env. */
  if (symbolp(decltype)) {
    /* loop over all local to be respected Declaration-Types: */
    var object declspecs = env;
    while (consp(declspecs)) {  /* loop over all declspecs from env */
      var object declspec = Car(declspecs);
      if (eq(Car(declspec),S(declaration)) /* (DECLARATION ...) ? */
          && !nullp(memq(decltype,Cdr(declspec))))
        goto beachten;
      declspecs = Cdr(declspecs);
    }
  }
  /* not to be respected Declaration. */
  return env;                   /* leave env unchanged */
 beachten:
  /* a to be respected Declaration -> env := (cons new_declspec env) */
  pushSTACK(env); pushSTACK(new_declspec);
  env = allocate_cons();
  Car(env) = popSTACK(); Cdr(env) = popSTACK();
  return env;
}

/* UP: expands a form, if possible, (however it doesn't, if FSUBR-Call
 or Symbol or FunctionMacro-Call) in an Environment
 macroexp(form,venv,fenv);
 > form: Form
 > venv: a Variable- and Symbolmacro-Environment
 > fenv: a Function- and Macrobinding-Environment
 < value1: the expansion
 < value2: NIL, if not expanded,
           T, if expansion has taken place
 can trigger GC */
global maygc void macroexp (object form, object venv, object fenv)
{
  if (consp(form)) {                /* only lists can be a macro-call */
    var object funname = Car(form); /* function name */
    if (symbolp(funname)) {
      var object fdef = sym_function(funname,fenv); /* fetch function definition */
      /* is it a #<MACRO expander> ? */
      if (macrop(fdef)) {
        /* yes -> expand:
         execute (FUNCALL *MACROEXPAND-HOOK* expander form env) : */
        pushSTACK(TheMacro(fdef)->macro_expander); /* expander as first argument */
        pushSTACK(form);        /* form as second argument */
        pushSTACK(fenv);
        pushSTACK(nest_var(venv)); /* nested Variable- and Symbolmacro-Environment */
        STACK_1 = nest_fun(STACK_1); /* nested Functions- and Macrobinding-Environment */
        var object env = allocate_vector(2); /* Environment for both */
        TheSvector(env)->data[0] = popSTACK(); /* venv as 1st component */
        TheSvector(env)->data[1] = STACK_0; /* fenv as 2nd component */
        STACK_0 = env;          /* Environment as third Argument */
        funcall(Symbol_value(S(macroexpand_hook)),3);
        value2 = T;       /* expanded Form as 1st value, T as 2nd value */
        return;
      }
    }
  }
  /* else, don't expand: */
  value1 = form; value2 = NIL;
}

/* UP: expands a form, if possible, (also, when FSUBR-Call or
 Symbol, however not, when FunctionMacro-Call) in an Environment
 macroexp0(form,env);
 > form: Form
 > env: a Macroexpansion-Environment
 < value1: the Expansion
 < value2: NIL, if not expanded,
           T, if expansion has taken place
 can trigger GC */
global maygc void macroexp0 (object form, object env)
{
  if (consp(form)) {                /* only lists can be a macro-call */
    var object funname = Car(form); /* function name */
    if (symbolp(funname)) {
      var object fdef = sym_function(funname,TheSvector(env)->data[1]); /* fetch function definition */
      if (fsubrp(fdef)) {
        /* fdef is a FSUBR, so the global function definition was valid.
         loop up, if the property list contains a macro definition: */
        var object expander = get(funname,S(macro)); /* search for Property SYS::MACRO */
        if (boundp(expander)) {
          /* found. Expand with th Expander from the property list:
           execute (FUNCALL *MACROEXPAND-HOOK* expander form env) : */
          pushSTACK(expander);  /* expander as first argument */
          pushSTACK(form);      /* form as second Argument */
          pushSTACK(env);       /* environment as third argument */
          funcall(Symbol_value(S(macroexpand_hook)),3);
          value2 = T;     /* expanded form as 1st value, t as 2nd value */
          return;
        }
      } else {
        /* 4 possibilities:
         #UNBOUND/SUBR/Closure (global or lexical function def.)
           -> don't expand
         #<MACRO expander> (lexical macro definition)
           -> expand (call expander)
         #<FUNCTION-MACRO function expander> (lexical FunctionMacro-
           Definition) -> don't expand, because
           (MACRO-FUNCTION funname) => NIL
         Symbol (lexical function definition during SYS::%EXPAND)
         expand: (list* 'FUNCALL Symbol (cdr form)) */
        if (macrop(fdef)) {
          /* #<MACRO expander> -> expand:
           execute (FUNCALL *MACROEXPAND-HOOK* expander form env) : */
          pushSTACK(TheMacro(fdef)->macro_expander); /* Expander as first Argument */
          pushSTACK(form);      /* Form as second Argument */
          pushSTACK(env);       /* Environment as third Argument */
          funcall(Symbol_value(S(macroexpand_hook)),3);
          value2 = T;     /* expanded Form as 1st value, T as 2nd value */
          return;
        } else if (symbolp(fdef)) {
          /* fdef a Symbol
           Must be expanded to (FUNCALL fdef ...) : */
          pushSTACK(Cdr(form));                      /* (cdr form) */
          pushSTACK(fdef);                           /* Symbol */
          {
            var object new_cons = allocate_cons();
            Car(new_cons) = popSTACK(); Cdr(new_cons) = STACK_0;
            STACK_0 = new_cons; /* (cons Symbol (cdr form)) */
          }
          {
            var object new_cons = allocate_cons();
            Car(new_cons) = S(funcall); Cdr(new_cons) = popSTACK();
            value1 = new_cons; /* (cons 'FUNCALL (cons Symbol (cdr form))) */
          }
          value2 = T; return;   /* expansion has taken place. */
        }
      }
    }
  } else if (symbolp(form)) {
    var object symbolmacro;
    var object val = sym_value(form,TheSvector(env)->data[0],&symbolmacro);
    if (!eq(symbolmacro,nullobj)) { /* found Symbol-Macro? */
      /* yes -> expand */
      value1 = TheSymbolmacro(symbolmacro)->symbolmacro_expansion; value2 = T;
      return;
    }
  }
  /* else, don't expand: */
  value1 = form; value2 = NIL;
}

/* UP: Parse-Declarations-Docstring. Detaches those from a list of forms,
 that have to be viewed as declarations resp. documentation string.
 parse_dd(formlist)
 > formlist: ( {decl|doc-string} . body )
 < value1: body
 < value2: List of decl-specs
 < value3: Doc-String or NIL
 < result: true if one (COMPILE)-declaration occurred, else false
 can trigger GC */
global maygc bool parse_dd (object formlist)
{
  pushSTACK(formlist); /* store formlist for error message */
  pushSTACK(NIL); /* preliminary Doc-String */
  pushSTACK(NIL); /* start of decl-spec-Liste */
  /* stack layout: formlist, docstring, declspecs. */
  var bool compile_decl = false; /* flag: (COMPILE)-declaration occurred */
  var object body = formlist; /* rest of the form-list */
  while (consp(body)) {
    var object form = Car(body); /* next form */
    var object body_rest = Cdr(body); /* shorten body */
    if (stringp(form)) { /* found Doc-String? */
      if (atomp(body_rest)) /* at the last position of the form list? */
        break; /* yes -> last form can't be a Doc-String! */
      if (!nullp(STACK_1)) { /* preceding Doc-String? */
        /* yes -> more than one Doc-String is too much: */
        pushSTACK(STACK_2);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
        pushSTACK(STACK_0);
        error(source_program_error,
              GETTEXT("Too many documentation strings in ~S"));
      }
      STACK_1 = form; /* new Doc-String */
      body = body_rest;
    } else if (consp(form) && eq(Car(form),S(declare))) {/* (DECLARE ...) */
      /* cons decl-specs one by one onto STACK_0: */
      pushSTACK(body_rest); /* save body_rest */
      pushSTACK(Cdr(form)); /* list of the new decl-specs */
      while (mconsp(STACK_0)) {
        var object declspec = Car(STACK_0); /* next decl-spec */
        /* check for (COMPILE)
           Test: (EQUAL d '(COMPILE)) =
                 (and (consp d) (eq (car d) 'COMPILE) (null (cdr d))) */
        if (consp(declspec)
            && eq(Car(declspec),S(compile))
            && nullp(Cdr(declspec)))
          compile_decl = true;
        { /* push this declaration onto STACK_(0+2) : */
          pushSTACK(declspec);
          var object new_cons = allocate_cons();
          Car(new_cons) = popSTACK(); /* declspec */
          Cdr(new_cons) = STACK_(0+2);
          STACK_(0+2) = new_cons;
        }
        /* go to next decl-spec: */
        STACK_0 = Cdr(STACK_0);
      }
      skipSTACK(1);
      body = popSTACK(); /* body := old body_rest */
    } else { /* finished with loop over the form list */
      break;
    }
  }
  value1 = body;
  value2 = nreverse(popSTACK()); /* decl-spec-Liste */
  value3 = popSTACK(); /* Doc-String */
  skipSTACK(1);
  return compile_decl;
}

/* UP: binds *EVALHOOK* and *APPLYHOOK* dynamically to the specified values.
 bindhooks(evalhook_value,applyhook_value);
 > evalhook_value: value for *EVALHOOK*
 > applyhook_value: value for *APPLYHOOK*
 changes STACK */
global void bindhooks (object evalhook_value, object applyhook_value) {
  /* build frame: */
  {
    var gcv_object_t* top_of_frame = STACK;    /* Pointer to Frame */
    pushSTACK(Symbol_value(S(evalhookstern))); /* old value of *EVALHOOK* */
    pushSTACK(S(evalhookstern));               /* *EVALHOOK* */
    pushSTACK(Symbol_value(S(applyhookstern))); /* old value of *APPLYHOOK* */
    pushSTACK(S(applyhookstern));               /* *APPLYHOOK* */
    finish_frame(DYNBIND);
  }
  /* Frame got ready, now change the values of the variables: */
  Symbol_value(S(evalhookstern)) = evalhook_value; /* (SETQ *EVALHOOK* evalhook_value) */
  Symbol_value(S(applyhookstern)) = applyhook_value; /* (SETQ *APPLYHOOK* applyhook_value) */
}

/* UP: binds *EVALHOOK* and *APPLYHOOK* dynamically to NIL.
 bindhooks_NIL();
 changes STACK */
#define bindhooks_NIL()  bindhooks(NIL,NIL)

/* UP: Determines the source-lambdabody of a lambda body.
 lambdabody_source(lambdabody)
 > lambdabody: Lambdabody (a Cons)
 < result: Source-Lambdabody (unbound if no source specified) */
local object lambdabody_source (object lambdabody) {
  var object body = Cdr(lambdabody);
  /* body = ((DECLARE (SOURCE ...) ...) ...) ? */
  if (consp(body)) {
    var object form = Car(body); /* first Form */
    /* form = (DECLARE (SOURCE ...) ...) ? */
    if (consp(form) && eq(Car(form),S(declare))) {
      var object declspecs = Cdr(form);
      /* declspecs = ((SOURCE ...) ...) ? */
      if (consp(declspecs)) {
        var object declspec = Car(declspecs);
        /* declspec = (SOURCE ...) ? */
        if (consp(declspec) && eq(Car(declspec),S(source))) {
          var object declspecr = Cdr(declspec);
          if (consp(declspecr))
            /* found Source */
            return Car(declspecr);
        }
      }
    }
  }
  return unbound;
}

/* UP: Inserts an implicit BLOCK in a lambda body.
 add_implicit_block();
 > STACK_1: function name
 > STACK_0: lambda body
 > value1: body
 > value2: list of decl-specs
 > value3: Doc-String or NIL
 < STACK_0: new lambda body
 can trigger GC */
local /*maygc*/ void add_implicit_block (void)
{
  GCTRIGGER3(value1,value2,value3);
  /* Replace lambdabody with
 (cons (car lambdabody) ; lambda list
       (multiple-value-bind (body-rest declarations docstring)
           (sys::parse-body (cdr lambdabody) t) ; body
         (append (if declarations (list (cons 'DECLARE declarations)))
                 (if docstring (list docstring))
                 (list (list* 'BLOCK (function-block-name name)
                       body-rest))))) */
  var object new_body;
  pushSTACK(value2);            /* declarations */
  pushSTACK(value3);            /* docstring */
  pushSTACK(funname_blockname(STACK_(1+2))); /* blockname */
  pushSTACK(value1);                         /* body-rest */
  { /* stack layout: name, lambdabody, declarations, docstring,
                     blockname, body-rest. */
    var object tmp = allocate_cons();
    Cdr(tmp) = popSTACK(); Car(tmp) = STACK_0;
    STACK_0 = tmp;
  }
  {
    var object tmp = allocate_cons();
    Car(tmp) = S(block); Cdr(tmp) = STACK_0;
    STACK_0 = tmp;
  }
  { /* stack layout: name, lambdabody, declarations, docstring, block-form. */
    var object tmp = allocate_cons();
    Car(tmp) = popSTACK();
    new_body = tmp;
  }
  /* stack layout: name, lambdabody, declarations, docstring. */
  if (nullp(STACK_0)) {
    skipSTACK(1);
  } else {
    pushSTACK(new_body);
    var object tmp = allocate_cons();
    Cdr(tmp) = popSTACK(); Car(tmp) = popSTACK();
    new_body = tmp;
  }
  /* stack layout: name, lambdabody, declarations. */
  if (nullp(STACK_0)) {
    STACK_0 = new_body;
  } else {
    pushSTACK(new_body);
    {
      var object tmp = allocate_cons();
      Car(tmp) = S(declare); Cdr(tmp) = STACK_1;
      STACK_1 = tmp;
    }
    {
      var object tmp = allocate_cons();
      Cdr(tmp) = popSTACK(); Car(tmp) = STACK_0;
      STACK_0 = tmp;
    }
  }
  { /* stack layout: name, lambdabody, new-body. */
    var object tmp = allocate_cons();
    Cdr(tmp) = popSTACK(); Car(tmp) = Car(STACK_0);
    STACK_0 = tmp;
  }
}

LISPFUNNR(add_implicit_block,2)
{ /* (ADD-IMPLICIT-BLOCK name (lambda-list . lambda-body))
     inserts an implicit BLOCK in the BODY */
  parse_dd(Cdr(STACK_0));       /* just the lambda-body */
  add_implicit_block();
  VALUES1(STACK_0);
  skipSTACK(2);
}

LISPFUNNR(function_block_name,1)
{ /* returns the name of the implicit block for a function-name */
  var object funname =
    check_funname(type_error,S(function_block_name),popSTACK());
  VALUES1(funname_blockname(funname));
}

/* UP: Creates the corresponding Closure for a Lambdabody by decomposition
 of the lambda list and poss. macro-expansion of all forms.
 get_closure(lambdabody,name,blockp,env)
 > lambdabody: (lambda-list {decl|doc} {form})
 > name: Name, a Symbol or (SETF symbol)
 > blockp: if an implicit BLOCK has to be inserted
 > env: Pointer to the five distinct environments:
        env->var_env = VENV, env->fun_env = FENV,
        env->block_env = BENV, env->go_env = GENV,
        env->decl_env = DENV.
 < result: Closure
 can trigger GC */
global maygc object get_closure (object lambdabody, object name, bool blockp,
                                 gcv_environment_t* env)
{
  /* Lambdabody must be a Cons: */
  if (atomp(lambdabody)) {
    pushSTACK(lambdabody);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(name);
    error(source_program_error,GETTEXT("~S: lambda-list for ~S is missing"));
  }
  { /* and the CAR must be a List: */
    var object lambdalist = Car(lambdabody);
    if (!listp(lambdalist)) {
      pushSTACK(lambdalist);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
      pushSTACK(lambdalist); pushSTACK(name); pushSTACK(S(function));
      error(source_program_error,
             GETTEXT("~S: lambda-list for ~S should be a list, not ~S"));
    }
  }
  pushSTACK(name);
  pushSTACK(lambdabody);
  /* stack layout: name, lambdabody.
     decompose ({decl|doc} {form}) */
  if (parse_dd(Cdr(lambdabody))) {
    /* A (COMPILE)-Declaration occurred.
       replace Lambdabody by its source (because some Macros
       can be compiled more efficiently than their Macro-Expansion): */
    { var object source = lambdabody_source(STACK_0);
      if (!boundp(source)) {
        if (blockp)
          add_implicit_block();
      } else {
        STACK_0 = source;
      }
    }
    { /* nest environments: */
      var gcv_environment_t* stack_env = nest_env(env); /* push on STACK */
     #if !defined(STACK_UP)
      /* and transfer over here */
      var object my_var_env = stack_env->var_env;
      var object my_fun_env = stack_env->fun_env;
      var object my_block_env = stack_env->block_env;
      var object my_go_env = stack_env->go_env;
      var object my_decl_env = stack_env->decl_env;
      skipSTACK(5); /* and pop from STACK again */
      pushSTACK(my_var_env);
      pushSTACK(my_fun_env);
      pushSTACK(my_block_env);
      pushSTACK(my_go_env);
      pushSTACK(my_decl_env);
     #endif
      /* stack layout: name, lambdabody, venv, fenv, benv, genv, denv. */
    }
    /* (SYS::COMPILE-LAMBDA name lambdabody venv fenv benv genv denv t) : */
    pushSTACK(T); funcall(S(compile_lambda),8);
    return value1; /* compiled Closure as value */
  }
  { /* build Interpreted Closure: */
    var object source = lambdabody_source(STACK_0);
    if (!boundp(source)) { /* no source specified -> expand Lambdabody: */
      if (blockp)
        add_implicit_block();
      /* call (SYS::%EXPAND-LAMBDABODY-MAIN lambdabody venv fenv) : */
      pushSTACK(STACK_0); /* Lambdabody */
      pushSTACK(nest_var(env->var_env)); /* nested Variable Environment */
      pushSTACK(nest_fun(env->fun_env)); /* nested Function Environment */
      funcall(S(expand_lambdabody_main),3);
      lambdabody = value1; /* expanded Lambdabody */
    } else { /* Source specified -> it replaces the old Lambdabody: */
      lambdabody = STACK_0; /* Lambdabody */
      STACK_0 = source; /* Source-Lambdabody */
    }
  }
  /* Now  STACK_0      is the Source-Lambdabody,
          lambdabody   is the Lambdabody to be used. */
  pushSTACK(Car(lambdabody)); /* Lambdalist */
  /* decompose ({decl|doc} {form}) : */
  parse_dd(Cdr(lambdabody));
  pushSTACK(value1); /* Body */
  pushSTACK(value2); /* Declarations */
  pushSTACK(value3); /* Doc-String or NIL */
  var gcv_object_t* closure_; /* Pointer to the Closure in the STACK */
  { /* create Closure (filled with NIL): */
    var object closure = allocate_closure(iclos_length,seclass_default<<4);
    /* and fill partially: */
    TheIclosure(closure)->clos_docstring = popSTACK(); /* Doc-String */
    var object declarations              = popSTACK(); /* Declarations */
    TheIclosure(closure)->clos_body      = popSTACK(); /* Body */
    var object lambdalist                = popSTACK(); /* Lambda-List */
    TheIclosure(closure)->clos_form      = popSTACK(); /* Source-Lambdabody */
    TheIclosure(closure)->clos_name      = STACK_0;    /* Name */
    /* and save: */
    STACK_0 = closure;
    /* stack layout: closure. */
    closure_ = &STACK_0; /* Pointer to the Closure in the STACK */
    if (!nullpSv(defun_accept_specialized_lambda_list)
        && functionp(Symbol_function(S(specialized_lambda_list_to_ordinary)))) {
      /* convert lambda list to ordinary */
      pushSTACK(declarations); /* save */
      pushSTACK(lambdalist); pushSTACK(S(function));
      funcall(S(specialized_lambda_list_to_ordinary),2);
      lambdalist = value1;       /* new ordinary lambda list */
      declarations = popSTACK(); /* restore */
      if (!nullp(value2))        /* merge in declarations */
        declarations = nreconc(value2,declarations);
    }
    pushSTACK(lambdalist); pushSTACK(lambdalist); pushSTACK(lambdalist);
    pushSTACK(declarations);
  }
  { /* nest Environments and put them nested in the closure: */
    var gcv_environment_t* stack_env = nest_env(env);
    var object closure = *closure_;
    TheIclosure(closure)->clos_var_env   = stack_env->var_env  ;
    TheIclosure(closure)->clos_fun_env   = stack_env->fun_env  ;
    TheIclosure(closure)->clos_block_env = stack_env->block_env;
    TheIclosure(closure)->clos_go_env    = stack_env->go_env   ;
    TheIclosure(closure)->clos_decl_env  = stack_env->decl_env ;
    skipSTACK(5);
    /* keywords:=0, as long as &KEY is missing: */
    TheIclosure(closure)->clos_keywords = Fixnum_0;
  }
  /* stack layout:
     closure, lambdalist, lalist-save, lalist-rest, declarations */
  var uintL spec_count = 0; /* number of dynamic references */
  var uintL req_count  = 0; /* number of required-parameters */
  var uintL opt_count  = 0; /* number of optional-parameters */
  var uintL key_count  = 0; /* number of keyword-parameters */
  var uintL aux_count  = 0; /* number of &AUX-variables */
  var uintL var_count  = 0; /* total number of the variables on the STACK */
  { /* process declarations:
       read dynamically referenced variables from the decl-spec-list
       declarations and push them on STACK. Other to be respected
       declarations change the declarations-environment of the Closure. */
    var object declarations = popSTACK();
    while (consp(declarations)) { /* all decl-specs processed? */
      var object declspec = Car(declarations);
      /* declspec must be a List: */
      if (atomp(declspec)) {
        pushSTACK(declspec);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
        pushSTACK(declspec); pushSTACK(S(function));
        error(source_program_error,
               GETTEXT("~S: illegal declaration ~S"));
      }
      /* process SPECIAL-declaration: */
      if (eq(Car(declspec),S(special))) { /* SPECIAL-declaration ? */
        var object declspecrest = Cdr(declspec);
        while (consp(declspecrest)) {
          var object sym = Car(declspecrest);
          if (!symbolp(sym)) {
            pushSTACK(declarations); pushSTACK(declspec); /* save */
            pushSTACK(declspecrest);
            sym = check_symbol_special(sym,S(function));
            declspecrest = popSTACK(); Car(declspecrest) = sym;
            declspec = popSTACK(); declarations = popSTACK(); /* restore */
          }
          /* push Symbol on STACK: */
          check_STACK(); pushSTACK(sym); spec_count++; var_count++;
          declspecrest = Cdr(declspecrest);
        }
      }
      /* process other declaration: */
      pushSTACK(Cdr(declarations)); /* shorten and save declarations */
      {
        var object denv = TheIclosure(*closure_)->clos_decl_env;
        denv = augment_decl_env(declspec,denv);
        TheIclosure(*closure_)->clos_decl_env = denv;
      }
      declarations = popSTACK();
    }
  }
  /* stack layout:
     closure, lambdalist, lalist-save, lalist-rest [special symbols]* */
  var gcv_object_t *lalist_ = closure_ STACKop -2; /* remaining lambda list */
  var gcv_object_t *lalist_save_ = closure_ STACKop -3; /* save fixed items */
  var object item; /* element of the lambda list */
  /* Macro:
     NEXT_ITEM(&OPTIONAL_label,&REST_label,&KEY_label,
               &ALLOW-OTHER-KEYS_label,&AUX_label,Ende_label)
     shortens the rest of the lambda list, moves the next Element to "item"
     and in case of one of the 6 specified lambda-list-markers, it jumps to
     the respective locations. */
  #define NEXT_ITEM(opt_label,rest_label,key_label,allow_label,aux_label,end_label) \
    { if (atomp(*lalist_)) goto end_label; /* Lambda-List finished? */  \
      item = Car(*lalist_); *lalist_save_ = *lalist_; /* next element */ \
      *lalist_ = Cdr(*lalist_); /* shorten List */                      \
      if (eq(item,S(LLoptional)))         goto opt_label;   /* &OPTIONAL ? */ \
      if (eq(item,S(LLrest)))             goto rest_label;  /* &REST ? */ \
      if (eq(item,S(LLkey)))              goto key_label;   /* &KEY ? */ \
      if (eq(item,S(LLallow_other_keys))) goto allow_label; /* &ALLOW-OTHER-KEYS ? */ \
      if (eq(item,S(LLaux)))              goto aux_label;   /* &AUX ? */ \
      if (eq(item,S(LLbody)))             goto badLLkey;    /* &BODY ? */ \
    }
 req: /* process required-parameter push on STACK: */
  while (1) {
    NEXT_ITEM(opt,rest,key,badLLkey,aux,ende);
    item = check_symbol_non_constant(item,S(function));
    Car(*lalist_save_) = item;
    /* push Variable on STACK: */
    check_STACK();
    pushSTACK(item); pushSTACK(Fixnum_0); req_count++; var_count++;
  }
 opt: /* process &OPTIONAL-parameter, push on STACK and
         put Init-Forms into the Closure: */
  while(1) {
    NEXT_ITEM(badLLkey,rest,key,badLLkey,aux,ende);
    var object init_form;
    /* Parse variable spezification in item:
         var  or  (var [init [svar]])
       push var and poss. svar on STACK, set in var poss.
       the svar_bit. Returns also init (or NIL) in init_form. */
    check_STACK();
    if (atomp(item)) {
      item = check_symbol_non_constant(item,S(function));
      Car(*lalist_save_) = item;
      /* push variable on STACK: */
      pushSTACK(item); pushSTACK(Fixnum_0); opt_count++; var_count++;
      init_form = NIL; /* Default-Init */
    } else {
      var object item_rest = item;
      /* first list-element: var */
      pushSTACK(item_rest);
      item = check_symbol_non_constant(Car(item),S(function));
      item_rest = popSTACK(); Car(item_rest) = item;
      item_rest = Cdr(item_rest);
      /* push variable on STACK: */
      pushSTACK(item); pushSTACK(Fixnum_0); opt_count++; var_count++;
      if (consp(item_rest)) {
        init_form = Car(item_rest); /* second list-element: init */
        item_rest = Cdr(item_rest);
        if (consp(item_rest)) {
          if (mconsp(Cdr(item_rest))) { /* varspec is too lang */
            pushSTACK(item_rest);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
            pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
            pushSTACK(S(LLoptional)); pushSTACK(S(function));
            error(source_program_error,
                   GETTEXT("~S: variable specification after ~S too long: ~S"));
          }
          /* third list-element: svar */
          pushSTACK(init_form); pushSTACK(item_rest);
          item = check_symbol_non_constant(Car(item_rest),S(function));
          item_rest = popSTACK(); Car(item_rest) = item;
          init_form = popSTACK();
          /* set svar-bit for var: */
          STACK_0 = fixnum_inc(STACK_0,bit(svar_bit));
          /* push variable on STACK: */
          pushSTACK(item); pushSTACK(Fixnum_0); var_count++;
        }
      } else
        init_form = NIL; /* Default-Init */
    }
    /* push init_form in front of (clos_opt_inits closure) : */
    pushSTACK(init_form);
    {
      var object new_cons = allocate_cons();
      Car(new_cons) = popSTACK();
      var object closure = *closure_;
      Cdr(new_cons) = TheIclosure(closure)->clos_opt_inits;
      TheIclosure(closure)->clos_opt_inits = new_cons;
    }
  }
 rest: { /* process &REST-parameter and push on Stack: */
    NEXT_ITEM(badrest,badrest,badrest,badrest,badrest,badrest);
    item = check_symbol_non_constant(item,S(function));
    Car(*lalist_save_) = item;
    /* push variable on STACK: */
    pushSTACK(item); pushSTACK(Fixnum_0); var_count++;
    /* set Rest-Flag to T: */
    TheIclosure(*closure_)->clos_rest_flag = T;
    NEXT_ITEM(badLLkey,badLLkey,key,badLLkey,aux,ende);
    pushSTACK(item);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
    pushSTACK(S(LLaux)); pushSTACK(S(LLkey));
    pushSTACK(S(LLrest)); pushSTACK(S(function));
    error(source_program_error,GETTEXT("~S: ~S var must be followed by ~S or ~S or end of list: ~S"));
  }
 badrest: {
    pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
    pushSTACK(STACK_0);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(S(LLrest)); pushSTACK(S(function));
    error(source_program_error,
          GETTEXT("~S: ~S must be followed by a variable: ~S"));
  }
 key: /* process &KEY-Parameter, push on STACK
         and put Init-Forms in the Closure: */
  { TheIclosure(*closure_)->clos_keywords = NIL; } /* keywords:=NIL */
  while(1) {
    NEXT_ITEM(badLLkey,badLLkey,badLLkey,allow,aux,ende);
    var object keyword;
    var object init_form;
    /* Parse variable-spezification in item:
         var  or  (var [init [svar]])  or ((key var) [init [svar]])
       push var and poss. svar on STACK, set in var poss.
       the svar_bit. Returns also the Keyword in keyword and
       init (or NIL) in init_form. */
    check_STACK();
    if (atomp(item)) {
      item = check_symbol_non_constant(item,S(function));
      Car(*lalist_save_) = item;
      /* push variable on STACK: */
      pushSTACK(item); pushSTACK(Fixnum_0); key_count++; var_count++;
      /* fetch Keyword: */
      keyword = intern_keyword(Symbol_name(item));
      /* Default-Init: */
      init_form = NIL;
    } else {
      var object item_rest = item; /* (item [init [svar]]) */
      item = Car(item); /* first list-element: var or (key var) */
      pushSTACK(item_rest); /* save */
      if (atomp(item)) {
        item = check_symbol_non_constant(item,S(function)); /* item = var */
        /* push variable on STACK: */
        item_rest = popSTACK(); /* restore */
        Car(item_rest) = item; item_rest = Cdr(item_rest); /*([init [svar]])*/
        pushSTACK(item); pushSTACK(Fixnum_0); key_count++; var_count++;
        /* fetch Keyword: */
        pushSTACK(item_rest); /* save */
        keyword = intern_keyword(Symbol_name(item));
        item_rest = popSTACK(); /* restore */
      } else {
        pushSTACK(item);
        /* item = (key var) */
        keyword = check_symbol(Car(item)); /* key */
        item = popSTACK(); Car(item) = keyword;
        item = Cdr(item); /* (var) */
        if (!(consp(item) && matomp(Cdr(item))))
          goto error_keyspec;
        pushSTACK(keyword); pushSTACK(item); /* save */
        item = check_symbol_non_constant(Car(item),S(function)); /* var */
        Car(popSTACK()) = item; keyword = popSTACK(); /* restore */
        item_rest = popSTACK(); item_rest = Cdr(item_rest); /*([init [svar]])*/
        /* push variable on STACK: */
        pushSTACK(item); pushSTACK(Fixnum_0); key_count++; var_count++;
      }
      if (consp(item_rest)) {
        init_form = Car(item_rest); /* second list-element: init */
        item_rest = Cdr(item_rest); /* ([svar]) */
        if (consp(item_rest)) {
          if (mconsp(Cdr(item_rest)))
            goto error_keyspec;
          /* third list-element: svar */
          pushSTACK(init_form); pushSTACK(keyword); pushSTACK(item_rest);
          item = check_symbol_non_constant(Car(item_rest),S(function));
          item_rest = popSTACK(); Car(item_rest) = item;
          keyword = popSTACK(); init_form = popSTACK(); /* restore */
          /* set svar-Bit in var: */
          STACK_0 = fixnum_inc(STACK_0,bit(svar_bit));
          /* push variable on STACK: */
          pushSTACK(item); pushSTACK(Fixnum_0); var_count++;
        }
      } else
        init_form = NIL; /* Default-Init */
    }
    /* push keyword in front of (clos_keywords closure) and
       push init_form in front of (clos_key_inits closure) : */
    pushSTACK(init_form); pushSTACK(keyword);
    {
      var object new_cons = allocate_cons();
      Car(new_cons) = popSTACK();
      var object closure = *closure_;
      Cdr(new_cons) = TheIclosure(closure)->clos_keywords;
      TheIclosure(closure)->clos_keywords = new_cons;
    }
    {
      var object new_cons = allocate_cons();
      Car(new_cons) = popSTACK();
      var object closure = *closure_;
      Cdr(new_cons) = TheIclosure(closure)->clos_key_inits;
      TheIclosure(closure)->clos_key_inits = new_cons;
    }
  }
 error_keyspec: {
    pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
    pushSTACK(STACK_0);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(S(LLkey)); pushSTACK(S(function));
    error(source_program_error,
          GETTEXT("~S: incorrect variable specification after ~S: ~S"));
  }
 allow: { /* process &ALLOW-OTHER-KEYS: */
    TheIclosure(*closure_)->clos_allow_flag = T; /* set Flag to T */
    NEXT_ITEM(badLLkey,badLLkey,badLLkey,badLLkey,aux,ende);
    pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
    pushSTACK(STACK_0);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(S(LLaux)); pushSTACK(S(LLallow_other_keys));
    pushSTACK(S(function));
    error(source_program_error,
          GETTEXT("~S: ~S must be followed by ~S or end of list: ~S"));
  }
 aux: /* process &AUX-Parameter, push on STACK and
         put Init-Forms in the Closure: */
  while(1) {
    NEXT_ITEM(badLLkey,badLLkey,badLLkey,badLLkey,badLLkey,ende);
    var object init_form;
    /* Parse variable-spezification in item:
         var  or  (var [init])
       push var on STACK.
       Returns also init (or NIL) in init_form. */
    check_STACK();
    if (atomp(item)) {
      item = check_symbol_non_constant(item,S(function));
      Car(*lalist_save_) = item;
      /* push variable on STACK: */
      pushSTACK(item); pushSTACK(Fixnum_0); aux_count++; var_count++;
      init_form = NIL; /* Default-Init */
    } else {
      var object item_rest = item; pushSTACK(item_rest);
      /* first list-element: var */
      item = check_symbol_non_constant(Car(item),S(function));
      item_rest = popSTACK(); Car(item_rest) = item; item_rest = Cdr(item_rest);
      /* push variable on STACK: */
      pushSTACK(item); pushSTACK(Fixnum_0); aux_count++; var_count++;
      if (consp(item_rest)) {
        init_form = Car(item_rest); /* second list-element: init */
        if (mconsp(Cdr(item_rest))) { /* varspec too long */
          pushSTACK(item_rest);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
          pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
          pushSTACK(S(LLaux)); pushSTACK(S(function));
          error(source_program_error,
                 GETTEXT("~S: variable specification after ~S too long: ~S"));
        }
      } else
        init_form = NIL; /* Default-Init */
    }
    /* push init_form in front of (clos_aux_inits closure) : */
    pushSTACK(init_form);
    {
      var object new_cons = allocate_cons();
      Car(new_cons) = popSTACK();
      var object closure = *closure_;
      Cdr(new_cons) = TheIclosure(closure)->clos_aux_inits;
      TheIclosure(closure)->clos_aux_inits = new_cons;
    }
  }
  /* Collected error messages: */
 badLLkey: {
    pushSTACK(item);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
    pushSTACK(item); pushSTACK(S(function));
    error(source_program_error,
          GETTEXT("~S: badly placed lambda-list keyword ~S: ~S"));
  }
 ende: /* reached list-end */
#undef NEXT_ITEM
  if (((uintL)~(uintL)0 > lp_limit_1) && (var_count > lp_limit_1)) {
    /* too many parameters? */
    pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
    pushSTACK(STACK_0);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(S(function));
    error(source_program_error,
           GETTEXT("~S: too many parameters in the lambda-list ~S"));
  }
  /* var_count <= lp_limit_1, therefore all counts fit in an uintC. */
  if (!nullp(*lalist_)) { /* is Lambda-List a Dotted List? */
    pushSTACK(*lalist_);  /* SOURCE-PROGRAM-ERROR slot DETAIL */
    pushSTACK(*(closure_ STACKop -1)); /* entire Lambda-List */
    pushSTACK(S(function));
    error(source_program_error,
           GETTEXT("~S: a dot in a lambda-list is allowed only for macros, not here: ~S"));
  }
  /* Collect variables into a vector and put it into the Closure,
     Collect variable-flags into a Byte-Vector and put it into the Closure: */
  pushSTACK(allocate_bit_vector(Atype_8Bit,var_count-spec_count)); /* create Byte-Vector */
  var object vars = allocate_vector(var_count); /* create Vector */
  var object varflags = popSTACK();
  { /* write variables in the Vector (last one to the back,
       leading ones in front): */
    var gcv_object_t* ptr = &TheSvector(vars)->data[var_count];
    var uintB* ptrflags = &TheSbvector(varflags)->data[var_count-spec_count];
    var uintC count = var_count-spec_count;
    while (count--) {
      *--ptrflags = (uintB)posfixnum_to_V(popSTACK());
      *--ptr = popSTACK();
    }
    for (count = spec_count; count--;)
      *--ptr = popSTACK();
  }
  var object closure = *closure_;
  TheIclosure(closure)->clos_vars     = vars;
  TheIclosure(closure)->clos_varflags = varflags;
  /* write counts in the Closure: */
  TheIclosure(closure)->clos_spec_count = fixnum(spec_count);
  TheIclosure(closure)->clos_req_count  = fixnum(req_count);
  TheIclosure(closure)->clos_opt_count  = fixnum(opt_count);
  TheIclosure(closure)->clos_key_count  = fixnum(key_count);
  TheIclosure(closure)->clos_aux_count  = fixnum(aux_count);
  /* In the Variable-Vector the first spec_count variables are the
     SPECIAL-declared ones. In each remaining variable the DYNAM_BIT is
     set, if it occurs among the SPECIAL-declared one. */
  if (spec_count) { /* loop over the remaining variables: */
    if (var_count-spec_count > 0) {
      var gcv_object_t* othervarptr = &TheSvector(vars)->data[spec_count];
      var uintB* othervarflagsptr = &TheSbvector(varflags)->data[0];
      var uintC count1 = var_count-spec_count;
      do {
        var object othervar = *othervarptr++; /* next variable */
        { /* Search for it among the SPECIAL-declared variables: */
          var gcv_object_t* specvarptr = &TheSvector(vars)->data[0];
          var uintC count2 = spec_count;
          do {
            if (eq(*specvarptr++,othervar)) { /* found? */
              /* yes -> so the variable othervar is to be bound dynamically. */
              *othervarflagsptr |= bit(dynam_bit); break;
            }
          } while (--count2);
        }
        othervarflagsptr++;
      } while (--count1);
    }
  }
  /* Finally reverse the accumulated lists in the Closure: */
  nreverse(TheIclosure(closure)->clos_opt_inits);
  nreverse(TheIclosure(closure)->clos_keywords);
  nreverse(TheIclosure(closure)->clos_key_inits);
  nreverse(TheIclosure(closure)->clos_aux_inits);
  /* stack layout: closure, lambdalist, lalist-save, lalist-rest */
  skipSTACK(4);
  return closure;
}

/* error, if symbol to be called is a special form.
 error_specialform(caller,funname);
 > caller: caller (a symbol)
 > funname: a symbol */
nonreturning_function(local, error_specialform, (object caller, object funname)) {
  pushSTACK(funname);           /* CELL-ERROR slot NAME */
  pushSTACK(funname);
  pushSTACK(caller);
  error(undefined_function,
         GETTEXT("~S: ~S is a special operator, not a function"));
}

/* error, if symbol to be called is a macro.
 error_macro(caller,funname);
 > caller: caller (a symbol)
 > funname: a symbol */
nonreturning_function(local, error_macro, (object caller, object funname)) {
  pushSTACK(funname);           /* CELL-ERROR slot NAME */
  pushSTACK(funname);
  pushSTACK(caller);
  error(undefined_function,GETTEXT("~S: ~S is a macro, not a function"));
}

/* UP: Alters argument to a function.
 coerce_function(obj)
 > obj: object
 < result: object as function (SUBR or Closure)
 can trigger GC */
global maygc object coerce_function (object obj)
{
  /* obj should be a symbol, a SUBR or a Closure. */
  if (functionp(obj)) {
    return obj; /* function is OK */
  } else if (symbolp(obj)) {
    var object fdef = Symbol_function(obj);
    if (functionp(fdef))
      return fdef;
    else if (orecordp(fdef)) {
      switch (Record_type(fdef)) {
        case Rectype_Fsubr:
          error_specialform(TheSubr(subr_self)->name,obj);
        case Rectype_Macro:
          error_macro(TheSubr(subr_self)->name,obj);
        default: NOTREACHED;
      }
    } else
      return check_fdefinition(obj,TheSubr(subr_self)->name);
  } else if (funnamep(obj)) {
    /* this could have be done easier but we inline the checks -
       symbolp and functionp for performance reasons */
    var object symbol = get(Car(Cdr(obj)),S(setf_function)); /* (get ... 'SYS::SETF-FUNCTION) */
    if (!symbolp(symbol)) { /* should be symbol */
      pushSTACK(obj); symbol = check_symbol(symbol); obj = popSTACK();
    }
    var object fdef = Symbol_function(symbol);
    if (functionp(fdef))
      return fdef;
    else
      return check_fdefinition(obj,TheSubr(subr_self)->name);
  } else if (consp(obj) && eq(Car(obj),S(lambda))) { /* (LAMBDA . ...) ? */
    error_lambda_expression(TheSubr(subr_self)->name,obj);
  } else
    return check_function(obj);
}

#ifdef DEBUG_EVAL
/* Emit some trace output for a function call, to *funcall-trace-output*.
 trace_call(fun,type_of_call,caller_type);
 > object fun: function being called, a SUBR/FSUBR/Closure
 > uintB type_of_call: 'A' for apply, 'F' for funcall, 'B' for bytecode
 > uintB caller_type: 'F' for fsubr, 'S' for subr,
                      'C' for cclosure, 'I' for iclosure
 can trigger GC */
local maygc void trace_call (object fun, uintB type_of_call, uintB caller_type)
{
  var object stream = Symbol_value(S(funcall_trace_output)); /* SYS::*FUNCALL-TRACE-OUTPUT* */
  /* No output until *funcall-trace-output* has been initialized: */
  if (!streamp(stream))
    return;
  pushSTACK(stream);
  if (cclosurep(fun)) {
    pushSTACK(Closure_name(fun));
    write_ascii_char(&STACK_1,'c');
  } else if (closurep(fun)) {
    pushSTACK(TheIclosure(fun)->clos_name);
    write_ascii_char(&STACK_1,'C');
  } else if (subrp(fun)) {
    pushSTACK(TheSubr(fun)->name);
    write_ascii_char(&STACK_1,'S');
  } else if (fsubrp(fun)) {
    pushSTACK(TheFsubr(fun)->name);
    write_ascii_char(&STACK_1,'F');
  } else {
    pushSTACK(NIL);
    write_ascii_char(&STACK_1,'?');
  }
  write_ascii_char(&STACK_1,type_of_call); /* output type of call */
  write_ascii_char(&STACK_1,caller_type);  /* output caller */
  write_ascii_char(&STACK_1,'[');
  prin1(&STACK_1,STACK_0);    /* output function name */
  write_ascii_char(&STACK_1,']');
  terpri(&STACK_1);
  skipSTACK(2);
}
#define TRACE_CALL(fu,tc,ct)                                            \
  if (streamp(Symbol_value(S(funcall_trace_output)))) {                 \
    pushSTACK(fu); trace_call(fu,tc,ct); fu = popSTACK();               \
  }
#else
#define TRACE_CALL(fu,tc,ct)
#endif

/* Test for illegal keywords
 check_for_illegal_keywords(allow_flag,error_statement);
 > uintC argcount: Number of Keyword/Value-pairs
 > gcv_object_t* rest_args_pointer: Pointer to the 2*argcount remaining arguments
 > bool allow_flag: Flag, if &ALLOW-OTHER-KEYS was specified
 > for_every_keyword: Macro, which loops over all Keywords and assigns
                      them to 'keyword'.
 > error_statement: Statement, that reports, that bad_keyword is illegal. */
#define check_for_illegal_keywords(allow_flag_expr,caller,error_statement) \
  { var gcv_object_t* argptr = rest_args_pointer; /* Pointer to the arguments */ \
    var object bad_keyword = nullobj; /* first illegal keyword or nullobj */ \
    var object bad_value = nullobj; /* its value */                     \
    var bool allow_flag =          /* Flag for allow-other-keys (if */  \
      /* &ALLOW-OTHER-KEYS was specified or ':ALLOW-OTHER-KEY T' occurred) */ \
      (allow_flag_expr);                                                \
    /* But ':ALLOW-OTHER-KEYS NIL' hides a subsequent ':ALLOW-OTHER-KEYS T' \
     (see CLHS 3.4.1.4.1.1). */                                         \
    var bool allow_hidden = false; /* true if seen ':ALLOW-OTHER-KEYS NIL' */ \
    var uintC check_count=argcount;                                     \
    while (check_count--) {                                             \
      var object kw = NEXT(argptr);                /* next Argument */  \
      var object val = NEXT(argptr);            /* and value for it */  \
      /* must be a symbol, should be a keyword: */                      \
      if (!symbolp(kw)) error_key_notkw(kw,caller);                     \
      if (!allow_flag) {       /* other keywords allowed? yes -> ok */  \
        if (eq(kw,S(Kallow_other_keys))) {                              \
          if (!allow_hidden) {                                          \
            if (!nullp(val))                                            \
              allow_flag = true;                                        \
            else                                                        \
              allow_hidden = true;                                      \
          }                                                             \
        } else {                                                        \
          /* up to now :ALLOW-OTHER-KEYS was not there, and NOALLOW */  \
          if (eq(bad_keyword,nullobj)) { /* all Keywords ok so far? */  \
            /* must test, if the keyword kw is allowed. */              \
            for_every_keyword({ if (eq(keyword,kw)) goto kw_ok; });     \
            /* keyword kw was not allowed. */                           \
            bad_keyword = kw;                                           \
            bad_value = val;                                            \
            kw_ok: ;                                                    \
          }                                                             \
        }                                                               \
      }                                                                 \
    };                                                                  \
    if (!allow_flag)                                                    \
      if (!eq(bad_keyword,nullobj)) {                                   \
        /* wrong keyword occurred */                                    \
        error_statement                                                 \
      }                                                                 \
  }

/* For a Keyword 'keyword' search the pair Key.Value:
 find_keyword_value( notfound_statement, found_statement );
 > keyword: Keyword
 > uintC argcount: Number of Keyword/Value-Pairs
 > gcv_object_t* rest_args_pointer: Pointer to the 2*argcount remaining Arguments
 > notfound_statement: what is to be done, if not found
 > found_statement: what is to be done, if value found */
#define find_keyword_value(notfound_statement,found_statement)          \
  { var gcv_object_t* argptr = rest_args_pointer;                       \
    var uintC find_count;                                               \
    dotimesC(find_count,argcount, {                                     \
      if (eq(NEXT(argptr),keyword)) goto kw_found; /* right keyword? */ \
      argptr skipSTACKop -1;   /* NEXT */                               \
    });                                                                 \
    if (true) { notfound_statement } /* not found */                    \
    else { kw_found:           /* found */                              \
      {var object value = NEXT(argptr);                                 \
      found_statement }}                                                \
  }

/* UP: Applies an interpreted closure to arguments.
 funcall_iclosure(closure,args_pointer,argcount);
 > closure: Closure
 > args_pointer: Pointer to the arguments (in Stack)
 > argcount: Number of Arguments
 < mv_count/mv_space: values
 < STACK: cleaned up, = args_pointer
 can trigger GC */
local maygc Values funcall_iclosure (object closure, gcv_object_t* args_pointer,
                                     uintC argcount)
{
  /* 1st step: finish building of APPLY-frame: */
  var sp_jmp_buf my_jmp_buf;
  TRACE_CALL(closure,'F','I');
  {
    var gcv_object_t* top_of_frame = args_pointer; /* Pointer to frame */
    pushSTACK(closure);
    finish_entry_frame(APPLY,my_jmp_buf,,{
      if (mv_count==0) { /* after reentry: pass form? */
        closure = STACK_(frame_closure); /* try the same APPLY again */
        args_pointer = topofframe(STACK_0);
        argcount = STACK_item_count(STACK STACKop frame_args,args_pointer);
      } else {
        setSTACK(STACK = topofframe(STACK_0)); /* clean STACK ?or unwind()?*/
        eval_noenv(value1); return; /* evaluate passed form */
      }
    });
  }
  var gcv_object_t* closure_ = &STACK_(frame_closure); /* &closure */
  var gcv_object_t* frame_pointer; /* pointer to the frame */
  var uintC spec_count = posfixnum_to_V(TheIclosure(closure)->clos_spec_count);
  var gcv_object_t *spec_ptr;
  { /* 2nd step: build variable-binding-frame: */
    var gcv_object_t* top_of_frame = STACK; /* Pointer to Frame */
    var object vars = TheIclosure(closure)->clos_vars; /* Vector of variable-names */
    var uintL var_count = Svector_length(vars); /* number of variables */
    get_space_on_STACK(var_count*varframe_binding_size*sizeof(gcv_object_t));
    {
      var gcv_object_t* varptr = &TheSvector(vars)->data[0]; /* Pointer to variables in vector */
      var uintC count;
      /* the special-references first: */
      spec_ptr = args_end_pointer;
      dotimesC(count,spec_count, {
        pushSTACK(specdecl); /* SPECDECL as "value" */
        pushSTACK_symbolwithflags(*varptr++,0); /* INactive */
      });
      frame_pointer = args_end_pointer;
      if (var_count-spec_count > 0) {
        var uintB* varflagsptr = &TheSbvector(TheIclosure(closure)->clos_varflags)->data[0];
        dotimespC(count,var_count-spec_count, {
          pushSTACK(NIL); /* NIL as preliminary value */
          var object next_var = *varptr++; /* next variable */
          var oint next_varflags = (oint)(*varflagsptr++)<<oint_symbolflags_shift; /* with poss. dynam_bit, svar_bit */
          if (special_var_p(TheSymbol(next_var))) /* proclaimed SPECIAL? */
            next_varflags |= wbit(dynam_bit_o); /* -> bind dynamically */
          pushSTACK_symbolwithflags(next_var,next_varflags);
        });
      }
    }
    /* VAR_ENV of closure becomes NEXT_ENV in frame: */
    pushSTACK(TheIclosure(closure)->clos_var_env);
    pushSTACK(fake_gcv_object(var_count)); /* var_count bindungs, all still un-nested */
    finish_frame(VAR);
  }
  /* STACK now points below the variable-binding-frame.
     frame_pointer = Pointer in the variable-binding-frame, above the first
     still inactive binding, below the already active SPECIAL-references. */
  { /* 3rd step: bind current environments: */
    var object new_var_env = make_framepointer(STACK);
    /* this frame will become the new VAR_ENV later. */
    make_ENV5_frame();
    /* activate the closure-environment: */
    aktenv.var_env   = new_var_env; /* variable-binding-frame */
    aktenv.fun_env   = TheIclosure(closure)->clos_fun_env;
    aktenv.block_env = TheIclosure(closure)->clos_block_env;
    aktenv.go_env    = TheIclosure(closure)->clos_go_env;
    aktenv.decl_env  = TheIclosure(closure)->clos_decl_env;
  }
  /* stack layout: APPLY-frame, variable-binding-frame, ENV-frame */
  { /* 4th step: process parameters: */
    check_SP();
    /* Macro for binding of variables in variable-frame:
       binds the next variable to value, decreases frame_pointer by 2 resp. 3.
       (takes advantage of varframe_binding_mark = 0 !) */
   #define bind_next_var(value,markptr_assignment)                       \
    { frame_pointer skipSTACKop -varframe_binding_size;                 \
     {var gcv_object_t* markptr = markptr_assignment &Before(frame_pointer); \
      if (as_oint(*markptr) & wbit(dynam_bit_o)) {                      \
        /* activate dynamic Binding: */                                 \
        var object sym = *(markptr STACKop varframe_binding_sym); /* var */ \
        *(markptr STACKop varframe_binding_value) = /* old value in frame */ \
          TheSymbolflagged(sym)->symvalue;                              \
        /* new value in value-cell: */                                  \
        TheSymbolflagged(sym)->symvalue = (value);                      \
        activate_specdecl(sym,spec_ptr,spec_count);                     \
      } else { /* activate static binding: */                           \
        /* new value in frame: */                                       \
        *(markptr STACKop varframe_binding_value) = (value);            \
      }                                                                 \
      *markptr = SET_BIT(*markptr,active_bit_o);/* activate binding */  \
     }}
    { /* process required parameters: fetch next argument and bind in stack */
      var uintC count = posfixnum_to_V(TheIclosure(closure)->clos_req_count);
      if (count>0) {
        if (argcount < count) {
          pushSTACK(TheIclosure(closure)->clos_name);
          /* ANSI CL 3.5.1.2. wants a PROGRAM-ERROR here. */
          error(program_error,
                 GETTEXT("EVAL/APPLY: too few arguments given to ~S"));
        }
        argcount -= count;
        dotimespC(count,count, {
          var object next_arg = NEXT(args_pointer); /* next argument */
          bind_next_var(next_arg,); /* bind next variable */
        });
      }
    }
    { /* process optional parameters:
         fetch next argument; if there is none,
         execute an Init-form; then bind in stack. */
      var uintC count = posfixnum_to_V(TheIclosure(closure)->clos_opt_count);
      if (count==0)
        goto optional_ende;
      {
        var object inits = TheIclosure(closure)->clos_opt_inits; /*init forms*/
        do {
          if (argcount==0)
            goto optional_aus;
          argcount--;
          var object next_arg = NEXT(args_pointer); /* next argument */
          var gcv_object_t* optmarkptr;
          bind_next_var(next_arg,optmarkptr=); /* bind next variable */
          if (as_oint(*optmarkptr) & wbit(svar_bit_o)) {
            /* supplied-p-Parameter follows? */
            *optmarkptr = CLR_BIT(*optmarkptr,svar_bit_o);
            bind_next_var(T,); /* yes -> bind to T */
          }
          inits = Cdr(inits); /* shorten Init-Forms-List */
          count--;
        } while (count);
        goto optional_ende;
       optional_aus: /* no more optional arguments here. */
        pushSTACK(inits);
      }
      /* execute all Init-forms of the optional parameters here: */
      dotimespC(count,count, {
        var object inits = STACK_0; /* remaining Initforms */
        STACK_0 = Cdr(inits);
        inits = (eval(Car(inits)),value1); /* next Initform, evaluated */
        var gcv_object_t* optmarkptr;
        bind_next_var(inits,optmarkptr=); /* bind next variable */
        if (as_oint(*optmarkptr) & wbit(svar_bit_o)) {
          /* supplied-p-Parameter follows? */
          *optmarkptr = CLR_BIT(*optmarkptr,svar_bit_o);
          bind_next_var(NIL,); /* yes -> bind to NIL */
        }
      });
      closure = *closure_;
      /* initialize &REST-parameters without arguments: */
      if (!nullp(TheIclosure(closure)->clos_rest_flag)) /* Rest-Flag? */
        bind_next_var(NIL,); /* yes -> bind to NIL */
      /* initialize &KEY-parameters without arguments : */
      count = posfixnum_to_V(TheIclosure(closure)->clos_key_count); /* number of Keyword-parameters */
      if (count>0) {
        STACK_0 = TheIclosure(closure)->clos_key_inits; /* their Init-forms */
        dotimespC(count,count, {
          var object inits = STACK_0; /* remaining Initforms */
          STACK_0 = Cdr(inits);
          inits = (eval(Car(inits)),value1); /* next Initform, evaluated */
          var gcv_object_t* keymarkptr;
          bind_next_var(inits,keymarkptr=); /* bind next Variable */
          if (as_oint(*keymarkptr) & wbit(svar_bit_o)) {
            /* supplied-p-Parameter follows? */
            *keymarkptr = CLR_BIT(*keymarkptr,svar_bit_o);
            bind_next_var(NIL,); /* yes -> bind to NIL */
          }
        });
        closure = *closure_;
      }
      skipSTACK(1); /* remaining Init-forms forgotten */
      goto aux; /* go to the AUX-variables */
    }
   optional_ende:
    /* prepare &KEY-parameters and &REST-parameters: */
    if (numberp(TheIclosure(closure)->clos_keywords) /* is keyword a number? */
        && nullp(TheIclosure(closure)->clos_rest_flag)) { /* and no Rest-parameter? */
      /* yes -> neither &KEY nor &REST specified */
      if (argcount>0) { /* still arguments there? -> Error */
        pushSTACK(TheIclosure(closure)->clos_name);
        /* ANSI CL 3.5.1.3. wants a PROGRAM-ERROR here. */
        error(program_error,
               GETTEXT("EVAL/APPLY: too many arguments given to ~S"));
      }
    } else { /* &KEY or &REST present. */
      /* process &REST-parameters: */
      if (!nullp(TheIclosure(closure)->clos_rest_flag)) { /* &rest? */
        /* yes -> collect residual arguments in a list: */
        pushSTACK(NIL); /* start of list */
        if (argcount>0) {
          var gcv_object_t* ptr = args_pointer STACKop -(uintP)argcount;
          var uintC count;
          dotimespC(count,argcount, {
            var object new_cons = allocate_cons();
            Car(new_cons) = BEFORE(ptr);
            Cdr(new_cons) = STACK_0;
            STACK_0 = new_cons;
          });
          closure = *closure_;
        }
        var object list = popSTACK(); /* entire list */
        bind_next_var(list,); /* bind &REST-parameter to this list */
      }
      /* process &KEY-parameters: */
      if (!numberp(TheIclosure(closure)->clos_keywords)) {
        /* Keyword-parameters present */
        var gcv_object_t* rest_args_pointer = args_pointer;
        /* argcount = number of remaining arguments */
        /* halve argcount --> number of pairs Key.Value: */
        if (argcount%2) { /* number was odd -> not paired: */
          var uintC count = 0;
          while (count<argcount) pushSTACK(rest_args_pointer[count++]);
          error_key_odd(argcount,TheIclosure(closure)->clos_name);
        }
        argcount = argcount/2;
        { /* test for illegal keywords: */
          var object keywords = TheIclosure(closure)->clos_keywords;
         #define for_every_keyword(statement)           \
            { var object keywordsr = keywords;          \
              while (consp(keywordsr)) {                \
                var object keyword = Car(keywordsr);    \
                statement;                              \
                keywordsr = Cdr(keywordsr);             \
              }}
          check_for_illegal_keywords
            (!nullp(TheIclosure(closure)->clos_allow_flag),
             TheIclosure(closure)->clos_name,
             { error_key_badkw(TheIclosure(closure)->clos_name,
                                bad_keyword,bad_value,
                                TheIclosure(closure)->clos_keywords);});
         #undef for_every_keyword
          /* Now assign the Key-values and evaluate the Key-Inits: */
          var uintC count = posfixnum_to_V(TheIclosure(closure)->clos_key_count);
          if (count > 0) {
            var object key_inits = TheIclosure(closure)->clos_key_inits;
            dotimespC(count,count, {
              var object keyword = Car(keywords); /* Keyword */
              var object var_value;
              var object svar_value;
              /* Find the pair Key.Value for Keyword: */
              find_keyword_value({ /* not found, must evaluate the Init: */
                pushSTACK(keywords); pushSTACK(key_inits);
                var_value = (eval(Car(key_inits)),value1);
                key_inits = popSTACK(); keywords = popSTACK();
                svar_value = NIL; /* NIL for poss. supplied-p-Parameter */
              },{ /* found -> take value: */
                var_value = value;
                svar_value = T; /* T for poss. supplied-p-Parameter */
              });
              {
                var gcv_object_t* keymarkptr;
                bind_next_var(var_value,keymarkptr=); /* bind keyword-var */
                if (as_oint(*keymarkptr) & wbit(svar_bit_o)) { /* supplied-p-Parameter follows? */
                  *keymarkptr = CLR_BIT(*keymarkptr,svar_bit_o);
                  bind_next_var(svar_value,); /* yes -> bind to NIL resp. T */
                }
              }
              keywords = Cdr(keywords);
              key_inits = Cdr(key_inits);
            });
          }
        }
        closure = *closure_;
      }
    }
   aux: { /* process &AUX-parameter: */
      var uintC count = posfixnum_to_V(TheIclosure(closure)->clos_aux_count);
      if (count>0) {
        pushSTACK(TheIclosure(closure)->clos_aux_inits); /* Init-forms for &AUX-variables */
        dotimespC(count,count, {
          var object inits = STACK_0;
          STACK_0 = Cdr(inits);
          inits = (eval(Car(inits)),value1); /* evaluate nnext Init */
          bind_next_var(inits,); /* and bind next variable to it */
        });
        skipSTACK(1); /* forget remaining Init-forms */
        closure = *closure_;
      }
    }
   #undef bind_next_var
  }
  if (spec_count > 0) activate_specdecls(spec_ptr,spec_count);
  /* 5th step: evaluate Body: */
  implicit_progn(TheIclosure(closure)->clos_body,NIL);
  unwind(); /* unwind ENV-frame */
  unwind(); /* unwind variable-binding-frame */
  unwind(); /* unwind APPLY-frame */
}

/* UP: provides the assignment of the Key-arguments for SUBRs.
 call only, if key_flag /= subr_nokey.
 > fun: function, a SUBR
 > argcount: number of arguments after optional ones
 > STACK_(argcount-1),...,STACK_0: the argcount arguments after the optional ones
 > key_args_pointer: Pointer to the Key-parameters in the STACK
 > rest_args_pointer: Pointer to the remaining arguments in the STACK
 < STACK: set correctly
 changes STACK */
local void match_subr_key (object fun, uintL argcount,
                           gcv_object_t* key_args_pointer,
                           gcv_object_t* rest_args_pointer) {
  /* halve argcount --> the number of pairs Key.Value: */
  if (argcount%2) /* number was odd -> not paired: */
    error_key_odd(argcount,TheSubr(fun)->name);
  if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1))
    error_too_many_args(unbound,fun,argcount,ca_limit_1);
  /* Due to argcount <= ca_limit_1, all count's fit in a uintC. */
  argcount = argcount/2;
  { /* test for illegal Keywords: */
    var gcv_object_t* keywords_pointer =
      &TheSvector(TheSubr(fun)->keywords)->data[0];
    var uintC key_count = TheSubr(fun)->key_count;
    #define for_every_keyword(statement)                    \
      if (key_count > 0) {                                  \
        var gcv_object_t* keywordptr = keywords_pointer;    \
        var uintC count = key_count;                        \
        do {                                                \
          var object keyword = *keywordptr++;               \
          statement;                                        \
        } while (--count);                                  \
      }
    check_for_illegal_keywords
      (TheSubr(fun)->key_flag == subr_key_allow,TheSubr(fun)->name,
       { pushSTACK(bad_keyword); /* save bad keyword */
         pushSTACK(bad_value);  /* save bad value */
         pushSTACK(fun); /* save the function */
         /* convert Keyword-Vector to a List:
          (SYS::COERCE-SEQUENCE kwvec 'LIST) */
         coerce_sequence(TheSubr(fun)->keywords,S(list),true);
         fun = popSTACK(); bad_value = popSTACK();
         bad_keyword = popSTACK();
         error_key_badkw(TheSubr(fun)->name,bad_keyword,
                          bad_value,value1);
       });
    #undef for_every_keyword
    /* now assign Arguments and Parameters: */
    if (key_count > 0) {
      var gcv_object_t* keywordptr = keywords_pointer;
      var gcv_object_t* key_args_ptr = key_args_pointer;
      var uintC count;
      dotimespC(count,key_count, {
        var object keyword = *keywordptr++; /* Keyword */
        /* find the pair Key.Value for this Keyword: */
        find_keyword_value(
          /* not found -> value remains #<UNBOUND> : */
          { (void)NEXT(key_args_ptr); },
          /* found -> save value: */
          { NEXT(key_args_ptr) = value; }
          );
      });
    }
  }
  /* poss. process Rest-Parameters: */
  if (TheSubr(fun)->rest_flag == subr_norest) {
    /* SUBR without &REST-Flag: forget remaining Arguments: */
    set_args_end_pointer(rest_args_pointer);
  }
  /* SUBR with &REST-Flag: leave remaining Arguments in Stack */
}

/* UP: provides the assignment between Argument-list and Keyword-parameters
 and poss. Rest-parameters of a compiled Closure.
 > closure: compiled Closure with &KEY-parameters
 > argcount: number of arguments after optional ones
 > STACK_(argcount-1),...,STACK_0: the argcount arguments after the optional ones
 > key_args_pointer: Pointer to the Key-parameters in the STACK
                 (poss. also Pointer beneath the Rest-parameters in the STACK,
                  which is #<UNBOUND>, if it is still to be supplied with)
 > rest_args_pointer: Pointer to the remaining Arguments in the STACK
 < STACK: set correctly
 < result: closure
 changes STACK
 can trigger GC */
local maygc object match_cclosure_key (object closure, uintL argcount,
                                       gcv_object_t* key_args_pointer,
                                       gcv_object_t* rest_args_pointer) {
  /* half argcount --> the number of pairs Key.Value: */
  if (argcount%2) /* number was odd -> not paired: */
    error_key_odd(argcount,Closure_name(closure));
  if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1))
    error_too_many_args(unbound,closure,argcount,ca_limit_1);
  /* Due to argcount <= ca_limit_1, all count's fit in a uintC. */
  argcount = argcount/2;
  var object codevec = TheCclosure(closure)->clos_codevec; /* Code-Vector */
  {
    var uintC key_count = TheCodevec(codevec)->ccv_numkey; /* number of Keywords */
    var uintL keywords_offset = TheCodevec(codevec)->ccv_keyconsts; /* Offset of Keywords in FUNC */
    var gcv_object_t* keywords_pointer = /* points to the first Keyword */
      (TheCodevec(codevec)->ccv_flags & bit(4) /* generic function? */
       ? &TheSvector(TheCclosure(closure)->clos_consts[0])->data[keywords_offset]
       : &TheCclosure(closure)->clos_consts[keywords_offset]
      );
    /* test for illegal Keywords: */
    #define for_every_keyword(statement)                    \
      if (key_count > 0) {                                  \
        var gcv_object_t* keywordptr = keywords_pointer;    \
        var uintC count = key_count;                        \
        do {                                                \
          var object keyword = *keywordptr++;               \
          statement;                                        \
        } while (--count);                                  \
      }
    check_for_illegal_keywords
      (!((TheCodevec(codevec)->ccv_flags & bit(6)) == 0),
       Closure_name(closure),
       { pushSTACK(bad_keyword); /* save */
         pushSTACK(bad_value);  /* save */
         pushSTACK(closure); /* save the closure */
         /* build list of legal Keywords: */
         for_every_keyword( { pushSTACK(keyword); } );
        {var object kwlist = listof(key_count);
         closure = popSTACK(); bad_value = popSTACK();
         bad_keyword = popSTACK(); /* report errors: */
         error_key_badkw(Closure_name(closure),
                          bad_keyword,bad_value,kwlist);}});
    #undef for_every_keyword
    /* now assign Arguments and Parameters: */
    if (key_count > 0) {
      var gcv_object_t* keywordptr = keywords_pointer;
      var gcv_object_t* key_args_ptr = key_args_pointer;
      var uintC count;
      dotimespC(count,key_count, {
        var object keyword = *keywordptr++; /* Keyword */
        /* find the pair Key.value for this keyword: */
        find_keyword_value(
          /* not found -> Wert remains #<UNBOUND> : */
          { (void)NEXT(key_args_ptr); },
          /* found -> save value: */
          { NEXT(key_args_ptr) = value; }
          );
      });
    }
  }
  /* poss. process Rest-parameters: */
  if (TheCodevec(codevec)->ccv_flags & bit(0)) { /* Rest-Flag? */
    /* Closure with Keywords and &REST-Flag: */
    var gcv_object_t* rest_arg_ = &BEFORE(key_args_pointer); /* Pointer to the REST-Parameter */
    if (!boundp(*rest_arg_)) {
      /* must still be filed: handicraft list */
      *rest_arg_ = closure;     /* save Closure */
      var object rest_arg = NIL;
      while (args_end_pointer != rest_args_pointer) {
        pushSTACK(rest_arg);
        rest_arg = allocate_cons();
        Cdr(rest_arg) = popSTACK();
        Car(rest_arg) = popSTACK();
      }
      closure = *rest_arg_;     /* return Closure */
      *rest_arg_ = rest_arg;
    } else {
      /* forget remaining arguments: */
      set_args_end_pointer(rest_args_pointer);
    }
  } else {
    /* Closure without &REST-Flag: forget remaining arguments: */
    set_args_end_pointer(rest_args_pointer);
  }
  return closure;
}


/* ----------------------- E V A L ----------------------- */

/* later: */
local Values eval1 (object form);
local Values eval_fsubr (object fun, object args);
local Values eval_applyhook (object fun);
local Values eval_subr (object fun);
local Values eval_closure (object fun);
#ifdef DYNAMIC_FFI
local Values eval_ffunction (object fun);
#endif

/* UP: evaluates a form in the current environment.
 eval(form);
 > form: form
 < mv_count/mv_space: values
 can trigger GC */
global maygc Values eval (object form)
{
 start:
  /* Test for Keyboard-Interrupt: */
  interruptp({
    pushSTACK(form);                  /* save form */
    pushSTACK(S(eval)); tast_break(); /* call break-loop */
    form = popSTACK();
    goto start;
  });
  var sp_jmp_buf my_jmp_buf;
  /* build EVAL-frame: */
  {
    var gcv_object_t* top_of_frame = STACK; /* Pointer to Frame */
    pushSTACK(form);                        /* Form */
    finish_entry_frame(EVAL,my_jmp_buf,,
      {
        if (mv_count==0) {      /* after reentry: Form passed over? */
          form = STACK_(frame_form); /* evaluate the same form again */
        } else {
          form = STACK_(frame_form) = value1; /* evaluate form passed over */
        }
      });
  }
  /* Test for *EVALHOOK*: */
  {
    var object evalhook_value = Symbol_value(S(evalhookstern)); /* *EVALHOOK* */
    if (nullp(evalhook_value)) { /* *EVALHOOK* = NIL ? */
      /* yes -> continue evaluation normally */
      pushSTACK(Symbol_value(S(applyhookstern))); eval1(form);
    } else {
      /* bind *EVALHOOK*, *APPLYHOOK* to NIL: */
      bindhooks_NIL();
      /* execute (FUNCALL *EVALHOOK* form env) : */
      pushSTACK(form);           /* Form as 1st Argument */
      pushSTACK(evalhook_value); /* save Function */
      var gcv_environment_t* stack_env = nest_aktenv(); /* Environments in the Stack, */
      var object env = allocate_vector(5); /* in newly allocated Vector */
      *(gcv_environment_t*)(&TheSvector(env)->data[0]) = *stack_env; /* push in */
      skipSTACK(5);
      evalhook_value = popSTACK(); /* return Function */
      pushSTACK(env);           /* entire Environment as 2nd Argument */
      funcall(evalhook_value,2);
      /* restore old values of *EVALHOOK*, *APPLYHOOK* : */
      unwind();
      /* unwind EVAL-Frame: */
      unwind();
    }
  }
}

/* UP: evaluates a form in the current Environment. Does not take
 *EVALHOOK* and *APPLYHOOK* into consideration.
 eval_no_hooks(form);
 > form: Form
 < mv_count/mv_space: values
 can trigger GC */
global maygc Values eval_no_hooks (object form) {
  var sp_jmp_buf my_jmp_buf;
  /* build EVAL-Frame: */
  {
    var gcv_object_t* top_of_frame = STACK; /* Pointer to Frame */
    pushSTACK(form);                        /* Form */
    finish_entry_frame(EVAL,my_jmp_buf,,
    {
      if (mv_count==0) {        /* after reentry: Form passed over? */
        form = STACK_(frame_form); /* evaluate the same form again */
      } else {
        form = STACK_(frame_form) = value1; /* evaluate form passed over */
      }
    });
  }
  /* continue evaluation, consider *APPLYHOOK* as being NIL: */
  pushSTACK(NIL); eval1(form);
}

/* UP: evaluates a form in the current environment.
 Does not take the value of *EVALHOOK* into consideration
 and expects the value of *APPLYHOOK*.
 the EVAL-frame must already have been built; it will then be unwound.
 eval1(form);
 > form: form
 > STACK_3..STACK_1: EVAL-Frame, with form in STACK_3
 > STACK_0: value of *APPLYHOOK*
 < mv_count/mv_space: values
 changes STACK
 can trigger GC */
local maygc Values eval1 (object form)
{
  if (atomp(form)) {
    if (symbolp(form)) { /* Form is a Symbol */
      /* value1 = value in the current Environment - not unbound! */
      var object symbolmacro;
      value1 = sym_value(form,aktenv.var_env,&symbolmacro);
      if (!eq(symbolmacro,nullobj)) { /* Symbol-Macro? */
        /* yes -> expand and evaluate again: */
        skipSTACK(1); /* forget value of *APPLYHOOK* */
        check_SP(); check_STACK();
        eval(TheSymbolmacro(symbolmacro)->symbolmacro_expansion); /* evaluate Expansion */
        unwind(); /* unwind EVAL-Frame */
      } else {
        if (!boundp(value1)) {
          do {
            pushSTACK(form); /* PLACE */
            pushSTACK(form); /* CELL-ERROR slot NAME */
            pushSTACK(form);
            check_value(unbound_variable,GETTEXT("EVAL: variable ~S has no value"));
            form = STACK_(frame_form+1);
          } while (!boundp(value1));
          if (!nullp(value2)) /* STORE-VALUE */
            value1 = setq(form,value1);
        }
        mv_count=1; /* value1 as value */
        skipSTACK(1);
        unwind(); /* unwind EVAL-Frame */
      }
    } else {
      /* self-evaluating form */
      VALUES1(form);
      skipSTACK(1);
      unwind(); /* unwind EVAL-Frame */
    }
  } else { /* Form is a Cons */
   eval_cons:
    /* determine, if Macro-call, poss. expand: */
    macroexp(form,aktenv.var_env,aktenv.fun_env); form = value1;
    if (!nullp(value2)) { /* expanded ? */
      /* now really evaluate: */
      skipSTACK(1); /* forget value of *APPLYHOOK* */
      check_SP(); check_STACK();
      eval(form); /* evaluate expanded form */
      unwind(); /* unwind EVAL-Frame */
    } else {
      var object fun = Car(form); /* function designation */
      if (funnamep(fun)) {
        /* fetch function-definition in the environment: */
        fun = sym_function(fun,aktenv.fun_env);
       fun_dispatch:
        /* branch according to type of function:
           unbound / SUBR/FSUBR/Closure / FunctionMacro / Macro */
       #ifdef TYPECODES
        switch (typecode(fun))
       #else
        if (immsubrp(fun))
          goto case_subr;
        else if (orecordp(fun))
          goto case_orecord;
        else
          switch (0)
       #endif
        {
         case_subr: /* SUBR */
          pushSTACK(Cdr(form)); /* argument list */
          if (!nullp(STACK_1))
            goto applyhook;
          eval_subr(fun);
          break;
         case_closure: /* closure */
          pushSTACK(Cdr(form)); /* argument list */
         closure: /* fun is a closure */
          if (!nullp(STACK_1))
            goto applyhook;
          eval_closure(fun);
          break;
         applyhook: /* value of *APPLYHOOK* is /= NIL. */
          eval_applyhook(fun);
          break;
         case_orecord:
          switch (Record_type(fun)) {
            case_Rectype_Closure_above;
            case_Rectype_Subr_above;
            case Rectype_Fsubr: /* Fsubr */
              eval_fsubr(fun,Cdr(form));
              break;
           #ifdef DYNAMIC_FFI
            case Rectype_Ffunction: /* Foreign-Function */
              pushSTACK(Cdr(form)); /* argument list */
              if (!nullp(STACK_1))
                goto applyhook;
              eval_ffunction(fun);
              break;
           #endif
            case Rectype_FunctionMacro:
              /* FunctionMacro -> treat like a function */
              fun = TheFunctionMacro(fun)->functionmacro_function;
              goto fun_dispatch;
            default:
              goto undef;
          }
          break;
          default: undef: {
            pushSTACK(form);
            fun = check_fdefinition(Car(form),S(eval));
            form = popSTACK();
            goto fun_dispatch;
          }
        }
      } else if (consp(fun) && eq(Car(fun),S(lambda))) {
        /* lambda-expression? */
        pushSTACK(Cdr(form)); /* Argument list */
        fun = get_closure(Cdr(fun),S(Klambda),false,&aktenv); /* create closure in current environment */
        goto closure; /* und apply it to the arguments, as above */
      } else {
        pushSTACK(Cdr(form));
        fun = check_funname_replacement(source_program_error,S(eval),fun);
        pushSTACK(fun);
        form = allocate_cons();
        Car(form) = popSTACK(); /* fun */
        Cdr(form) = popSTACK(); /* Cdr(form) */
        goto eval_cons;
      }
    }
  }
}

#define CHECK_STACK(stack_before,fun) do {                              \
  if (STACK != stack_before) { /* STACK as before? */                   \
    fprintf(stderr,"\n[%s:%d] STACK is not restored: %d in ",           \
            __FILE__,__LINE__,STACK_item_count(STACK,stack_before));    \
    nobject_out(stderr,fun); fprintf(stderr,"\n");                      \
    abort();                   /* no -> go to Debugger */               \
  }} while(0)
#if STACKCHECKS
#define CHECK_STACK_S(stack_before,fun)  CHECK_STACK(stack_before,fun)
#else
#define CHECK_STACK_S(stack_before,fun)
#endif
#if STACKCHECKC
#define CHECK_STACK_C(stack_before,fun)  CHECK_STACK(stack_before,fun)
#else
#define CHECK_STACK_C(stack_before,fun)
#endif

/* In EVAL: Applies a FSUBR to an argument-list, cleans up STACK
 and returns the values.
 eval_fsubr(fun,args);
 > fun: a FSUBR
 > args: argument-list
 > STACK-layout: EVAL-Frame, *APPLYHOOK*.
 < STACK: cleaned up
 < mv_count/mv_space: values
 changes STACK
 can trigger GC */
local maygc Values eval_fsubr (object fun, object args)
{
  skipSTACK(1);                 /* forget value of *APPLYHOOK* */
  check_SP(); check_STACK();
  #if STACKCHECKS
  var gcv_object_t* STACKbefore = STACK;
  #endif
  /* put arguments in the STACK: */
  switch ((uintW)posfixnum_to_V(TheFsubr(fun)->argtype)) {
    /* Macro for 1 required-Parameter: */
    #define REQ_PAR()                                                   \
      { if (atomp(args)) goto error_toofew;                             \
        pushSTACK(Car(args));        /* next parameter in the STACK */  \
        args = Cdr(args);                                               \
      }
    case (uintW)fsubr_argtype_2_0_nobody:
      /* FSUBR with 2 required-Parameters */
      REQ_PAR();
    case (uintW)fsubr_argtype_1_0_nobody:
      /* FSUBR with 1 required-Parameter */
      REQ_PAR();
      if (!nullp(args)) goto error_toomany;
      break;
    case (uintW)fsubr_argtype_2_1_nobody:
      /* FSUBR with 2 required-Parameters and 1 optional-Parameter */
      REQ_PAR();
    case (uintW)fsubr_argtype_1_1_nobody:
      /* FSUBR with 1 required-Parameter and 1 optional-Parameter */
      REQ_PAR();
      if (consp(args)) {
        pushSTACK(Car(args));   /* optional parameter into STACK */
        args = Cdr(args);
        if (!nullp(args)) goto error_toomany;
      } else {
        pushSTACK(unbound);     /* unbound into STACK instead */
        if (!nullp(args)) goto error_dotted;
      }
      break;
    case (uintW)fsubr_argtype_2_body:
      /* FSUBR with 2 required-Parameters and Body-Parameter */
      REQ_PAR();
    case (uintW)fsubr_argtype_1_body:
      /* FSUBR with 1 required-Parameter and Body-Parameter */
      REQ_PAR();
    case (uintW)fsubr_argtype_0_body:
      /* FSUBR with 0 required-Parameters and Body-Parameter */
      pushSTACK(args);          /* remaining body into STACK */
      break;
    default: NOTREACHED;
    error_toofew:       /* argument-list args is an atom, prematurely */
      if (!nullp(args)) goto error_dotted;
      /* clean up STACK up to the calling EVAL-Frame: */
      while (!(framecode(STACK_0) & bit(frame_bit_t))) {
        skipSTACK(1);
      }
      {
        var object form = STACK_(frame_form); /* Form from EVAL-Frame */
        pushSTACK(form); /* SOURCE-PROGRAM-ERROR slot DETAIL */
        pushSTACK(form); pushSTACK(Car(form));
        error(source_program_error,
               GETTEXT("EVAL: too few parameters for special operator ~S: ~S"));
      }
    error_toomany:       /* argument-list args is not NIL at the tail */
      if (atomp(args)) goto error_dotted;
      /* clean up STACK up to the calling EVAL-Frame: */
      while (!(framecode(STACK_0) & bit(frame_bit_t))) {
        skipSTACK(1);
      }
      {
        var object form = STACK_(frame_form); /* Form from EVAL-Frame */
        pushSTACK(form); /* SOURCE-PROGRAM-ERROR slot DETAIL */
        pushSTACK(form); pushSTACK(Car(form));
        error(source_program_error,
               GETTEXT("EVAL: too many parameters for special operator ~S: ~S"));
      }
    error_dotted:         /* argument-list args ends with Atom /= NIL */
      /* clean up STACK up to the calling EVAL-Frame: */
      while (!(framecode(STACK_0) & bit(frame_bit_t))) {
        skipSTACK(1);
      }
      {
        var object form = STACK_(frame_form); /* Form from EVAL-Frame */
        pushSTACK(form); /* SOURCE-PROGRAM-ERROR slot DETAIL */
        pushSTACK(form); pushSTACK(Car(form));
        error(source_program_error,
               GETTEXT("EVAL: dotted parameter list for special operator ~S: ~S"));
      }
    #undef REQ_PAR
  }
  /* Now STACK = STACKbefore STACKop - (req + opt + (body-flag ? 1 : 0)).
   Call FSUBR: */
  with_saved_back_trace_fsubr(fun,
    (*(fsubr_function_t*)(TheFsubr(fun)->function))(); );
  CHECK_STACK_S(STACKbefore,fun);
  unwind();                     /* unwind EVAL-Frame */
}

/* In EVAL: Applies *APPLYHOOK* to a function (SUBR or Closure) and
 an argument-list, cleans up the STACK and returns the values.
 eval_applyhook(fun);
 > fun: function, a SUBR or a closure
 > STACK-layout: EVAL-Frame, *APPLYHOOK* (/= NIL), argument-list.
 < STACK: cleaned up
 < mv_count/mv_space: values
 changes STACK
 can trigger GC */
local maygc Values eval_applyhook(object fun) {
  var object args = popSTACK();            /* argument-list */
  var object applyhook_value = popSTACK(); /* value of *APPLYHOOK* */
  check_SP();
  /* bind *EVALHOOK*, *APPLYHOOK* to NIL: */
  bindhooks_NIL();
  #ifndef X3J13_005
  /* execute (FUNCALL *APPLYHOOK* fun args env) : */
  pushSTACK(fun);               /* Funktion as 1st Argument */
  pushSTACK(args);              /* argument-list as 2nd Argument */
  pushSTACK(applyhook_value);   /* save function */
  {
    var gcv_environment_t* stack_env = nest_aktenv(); /* Environments into Stack, */
    var object env = allocate_vector(5); /* in newly allocated Vector */
    *(gcv_environment_t*)(&TheSvector(env)->data[0]) = *stack_env; /* push in */
    skipSTACK(5);
  }
  applyhook_value = popSTACK(); /* function back */
  pushSTACK(env);               /* entire Environment as 3rd Argument */
  funcall(applyhook_value,3);
  #else
  /* execute (FUNCALL *APPLYHOOK* fun args) : */
  pushSTACK(fun);               /* function as 1st Argument */
  pushSTACK(args);              /* argument-list as 2nd Argument */
  funcall(applyhook_value,2);
  #endif
  /* old values of *EVALHOOK*, *APPLYHOOK* back: */
  unwind();
  /* unwind EVAL-Frame: */
  unwind();
}

/* In EVAL: error, if too few arguments */
nonreturning_function(local, error_eval_toofew, (object fun)) {
  var object form = STACK_(frame_form); /* Form */
  pushSTACK(form); /* SOURCE-PROGRAM-ERROR slot DETAIL */
  pushSTACK(form); pushSTACK(fun);
  /* ANSI CL 3.5.1.2. wants a PROGRAM-ERROR here. */
  error(source_program_error,
        GETTEXT("EVAL: too few arguments given to ~S: ~S"));
}

/* In EVAL: error, if too many arguments */
nonreturning_function(local, error_eval_toomany, (object fun)) {
  var object form = STACK_(frame_form); /* Form */
  pushSTACK(form); /* SOURCE-PROGRAM-ERROR slot DETAIL */
  pushSTACK(form); pushSTACK(fun);
  /* ANSI CL 3.5.1.3. wants a PROGRAM-ERROR here. */
  error(source_program_error,
        GETTEXT("EVAL: too many arguments given to ~S: ~S"));
}

/* In EVAL: error, if dotted argument-list */
nonreturning_function(global, error_dotted_form, (object form, object fun)) {
  pushSTACK(form); /* SOURCE-PROGRAM-ERROR slot DETAIL */
  pushSTACK(form); pushSTACK(fun);
  error(source_program_error,
        GETTEXT("EVAL: argument list given to ~S is dotted: ~S"));
}
#define error_eval_dotted(fun)  error_dotted_form(STACK_(frame_form),fun)

/* In EVAL: Applies an SUBR to an argument-list, cleans up STACK
 and returns the values.
 eval_subr(fun);
 > fun: function, a SUBR
 > STACK-layout: EVAL-Frame, *APPLYHOOK*, argument-list.
 < STACK: cleaned up
 < mv_count/mv_space: values
 changes STACK
 can trigger GC */
local maygc Values eval_subr (object fun)
{
  var object args = popSTACK(); /* argument-list */
  skipSTACK(1);                 /* forget value of *APPLYHOOK* */
  check_SP(); check_STACK();
  var gcv_object_t* args_pointer = args_end_pointer; /* Pointer to the arguments */
  var gcv_object_t* rest_args_pointer; /* Pointer to the remaining arguments */
  var uintL argcount;       /* number of remaining arguments */
  /* push arguments evaluated in the STACK:
   first a Dispatch for most important cases: */
  switch (TheSubr(fun)->argtype) {
    /* Macro for a required-argument: */
    #define REQ_ARG()                                                   \
      { if (atomp(args)) goto error_toofew;                             \
        pushSTACK(Cdr(args));      /* remaining arguments */            \
        eval(Car(args));           /* evaluate next argument */         \
        args = STACK_0; STACK_0 = value1;         /* and into STACK */  \
      }
    /* Macro for the n-th last optional-argument: */
    #define OPT_ARG(n)                                                  \
      { if (atomp(args)) goto unbound_optional_##n ;                    \
        pushSTACK(Cdr(args));      /* remaining arguments */            \
        eval(Car(args));           /* evaluate next argument */         \
        args = STACK_0; STACK_0 = value1;         /* and into STACK */  \
      }
    case (uintW)subr_argtype_6_0: /* SUBR with 6 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_5_0: /* SUBR with 5 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_4_0: /* SUBR with 4 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_3_0: /* SUBR with 3 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_2_0: /* SUBR with 2 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_1_0: /* SUBR with 1 required argument */
      REQ_ARG();
    case (uintW)subr_argtype_0_0: /* SUBR without Arguments */
      if (!nullp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_4_1: /* SUBR with 4 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_3_1: /* SUBR with 3 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_2_1: /* SUBR with 2 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_1_1: /* SUBR with 1 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_0_1: /* SUBR with 1 optional argument */
      OPT_ARG(1);
      if (!nullp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_3_2: /* SUBR with 3 required and 2 optional */
      REQ_ARG();
    case (uintW)subr_argtype_2_2: /* SUBR with 2 required and 2 optional */
      REQ_ARG();
    case (uintW)subr_argtype_1_2: /* SUBR with 1 required and 2 optional */
      REQ_ARG();
    case (uintW)subr_argtype_0_2: /* SUBR with 2 optional arguments */
      OPT_ARG(2);
      OPT_ARG(1);
      if (!nullp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_2_3: /* SUBR with 2 required and 3 optional */
      REQ_ARG();
    case (uintW)subr_argtype_1_3: /* SUBR with 1 required and 3 optional */
      REQ_ARG();
    case (uintW)subr_argtype_0_3: /* SUBR with 3 optional arguments */
      OPT_ARG(3);
      OPT_ARG(2);
      OPT_ARG(1);
      if (!nullp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_0_5: /* SUBR with 5 optional arguments */
      OPT_ARG(5);
    case (uintW)subr_argtype_0_4: /* SUBR with 4 optional arguments */
      OPT_ARG(4);
      OPT_ARG(3);
      OPT_ARG(2);
      OPT_ARG(1);
      if (!nullp(args)) goto error_toomany;
      goto apply_subr_norest;
    unbound_optional_5: /* Still 5 optional Arguments, but atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_4: /* Still 4 optional Arguments, but atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_3: /* Still 3 optional Arguments, but atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_2: /* Still 2 optional Arguments, but atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_1: /* Still 1 optional Argument, but atomp(args) */
      { pushSTACK(unbound); }
      if (!nullp(args)) goto error_dotted;
      goto apply_subr_norest;
    case (uintW)subr_argtype_3_0_rest: /* SUBR with 3 required and rest */
      REQ_ARG();
    case (uintW)subr_argtype_2_0_rest: /* SUBR with 2 required and rest */
      REQ_ARG();
    case (uintW)subr_argtype_1_0_rest: /* SUBR with 1 required and rest */
      REQ_ARG();
    case (uintW)subr_argtype_0_0_rest: /* SUBR with &rest Arguments */
      rest_args_pointer = args_end_pointer; /* Pointer to the remaining arguments */
      /* evaluate all further arguments and into Stack: */
      argcount = 0;            /* counter for the remaining arguments */
      while (consp(args)) {
        check_STACK();
        pushSTACK(Cdr(args));             /* remaining arguments */
        eval(Car(args));                  /* evaluate next argument */
        args = STACK_0; STACK_0 = value1; /* and into STACK */
        argcount++;
      }
      goto apply_subr_rest;
    case (uintW)subr_argtype_4_0_key: /* SUBR with 4 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_3_0_key: /* SUBR with 3 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_2_0_key: /* SUBR with 2 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_1_0_key: /* SUBR with 1 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_0_0_key: /* SUBR with &key */
      if (atomp(args)) goto unbound_optional_key_0;
      goto apply_subr_key;
    case (uintW)subr_argtype_1_1_key:
      /* SUBR with 1 required argument, 1 optional argument and &key */
      REQ_ARG();
    case (uintW)subr_argtype_0_1_key: /* SUBR with 1 optional and &key */
      OPT_ARG(key_1);
      if (atomp(args)) goto unbound_optional_key_0;
      goto apply_subr_key;
    case (uintW)subr_argtype_1_2_key:
      /* SUBR with 1 required argument, 2 optional arguments and &key */
      REQ_ARG();
      OPT_ARG(key_2);
      OPT_ARG(key_1);
      if (atomp(args)) goto unbound_optional_key_0;
      goto apply_subr_key;
    unbound_optional_key_2: /* Silll 2 optional Arguments, but atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_key_1: /* Still 1 optional Argument, but atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_key_0:     /* Before the keywords is atomp(args) */
      {
        var uintC count;
        dotimesC(count,TheSubr(fun)->key_count, { pushSTACK(unbound); } );
      }
      if (!nullp(args)) goto error_dotted;
      goto apply_subr_norest;
    default: NOTREACHED;
    #undef OPT_ARG
    #undef REQ_ARG
  }
  /* Now the general Version:
   reserve space on the STACK: */
  get_space_on_STACK(sizeof(gcv_object_t) *
                     (uintL)(TheSubr(fun)->req_count +
                             TheSubr(fun)->opt_count +
                             TheSubr(fun)->key_count));
  /* evaluate required parameters and push into Stack: */
  {
    var uintC count;
    dotimesC(count,TheSubr(fun)->req_count, {
      if (atomp(args)) goto error_toofew; /* at the end of argument-list? */
      pushSTACK(Cdr(args));               /* remaining argument-list */
      eval(Car(args));                    /* evaluate next argument */
      args = STACK_0; STACK_0 = value1;   /* and into Stack */
    });
  }
  { /* evaluate optional parameters and push into Stack: */
    var uintC count = TheSubr(fun)->opt_count;
    while (!atomp(args)) { /* argument-list not finished? */
      if (count==0)        /* all optional parameters supplied with? */
        goto optionals_ok;
      count--;
      pushSTACK(Cdr(args));             /* remaining argument-list */
      eval(Car(args));                  /* evaluate next argument */
      args = STACK_0; STACK_0 = value1; /* and into Stack */
    }
    /* argument-list finished.
     All further count optional parameters get the "value"
     #<UNBOUND>, the same for the Keyword-parameters: */
    dotimesC(count,count + TheSubr(fun)->key_count, { pushSTACK(unbound); } );
    if (TheSubr(fun)->rest_flag == subr_rest) { /* &REST-Flag? */
      /* yes -> 0 additional arguments: */
      argcount = 0; rest_args_pointer = args_end_pointer;
    }
    /* no -> nothing to do */
    goto los;
  }
 optionals_ok:
  /* process Rest- and Keyword-parameters.
   args = remaining argument-list (not yet finished) */
  if (TheSubr(fun)->key_flag == subr_nokey) {
    /* SUBR without KEY */
    if (TheSubr(fun)->rest_flag == subr_norest) {
      /* SUBR without REST or KEY -> argument-list should be finished */
      goto error_toomany;
    } else {
      /* SUBR with only REST, without KEY: treatment of remaining arguments */
      rest_args_pointer = args_end_pointer;
      argcount = 0;            /* counter for the remaining arguments */
      do {
        check_STACK();
        pushSTACK(Cdr(args));             /* remaining argument-list */
        eval(Car(args));                  /* evaluate next argument */
        args = STACK_0; STACK_0 = value1; /* and into Stack */
        argcount++;
      } while (consp(args));
      if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1))
        goto error_toomany;
    }
  } else
  apply_subr_key: { /* SUBR with Keywords. */
    /* args = remaining argument-list (not yet finished)
     First initialize the Keyword-parameters with #<UNBOUND> , then
     evaluate the remaining arguments and push into Stack, then
     assign the Keywords: */
    var gcv_object_t* key_args_pointer = args_end_pointer; /* Pointer to Keyword-parameters */
    /* initialize all Keyword-parameters with  #<UNBOUND> : */
    {
      var uintC count;
      dotimesC(count,TheSubr(fun)->key_count, { pushSTACK(unbound); } );
    }
    rest_args_pointer = args_end_pointer; /* Pointer to the remaining arguments */
    /* evaluate all further arguments and into Stack: */
    argcount = 0;              /* counter for the remaining arguments */
    do {
      check_STACK();
      pushSTACK(Cdr(args));             /* remaining argument-list */
      eval(Car(args));                  /* evaluate next argument */
      args = STACK_0; STACK_0 = value1; /* and into Stack */
      argcount++;
    } while (consp(args));
    if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1))
      goto error_toomany;
    /* assign Keywords and poss. discard remaining arguments: */
    match_subr_key(fun,argcount,key_args_pointer,rest_args_pointer);
  }
 los:                           /* call function */
  /* remaining argument-list must be NIL : */
  if (!nullp(args)) goto error_dotted;
  if (TheSubr(fun)->rest_flag == subr_norest) {
    /* SUBR without &REST-Flag: */
   apply_subr_norest:
    with_saved_back_trace_subr(fun,STACK,-1,
      (*(subr_norest_function_t*)(TheSubr(fun)->function))(); );
  } else {
    /* SUBR with &REST-Flag: */
   apply_subr_rest:
    with_saved_back_trace_subr(fun,STACK,
                               TheSubr(fun)->req_count + TheSubr(fun)->opt_count + argcount,
      (*(subr_rest_function_t*)(TheSubr(fun)->function))(argcount,rest_args_pointer); );
  }
  CHECK_STACK_S(args_end_pointer,fun);
  unwind();                  /* unwind EVAL-Frame */
  return;                    /* finished */
  /* Gathered error-messages: */
 error_toofew:           /* Argument-List args is prematurely an Atom */
  if (!nullp(args)) goto error_dotted;
  set_args_end_pointer(args_pointer); /* clean up STACK */
  error_eval_toofew(TheSubr(fun)->name);
 error_toomany:           /* Argument-List args is not NIL at the end */
  if (atomp(args)) goto error_dotted;
  set_args_end_pointer(args_pointer); /* clean up STACK */
  error_eval_toomany(TheSubr(fun)->name);
 error_dotted:            /* Argument-List args ends with Atom /= NIL */
  set_args_end_pointer(args_pointer); /* clean up STACK */
  error_eval_dotted(TheSubr(fun)->name);
}

/* In EVAL: Applies a Closure to an argument-list, cleans up the STACK
 and returns the values.
 eval_closure(fun);
 > fun: function, a Closure
 > STACK-layout: EVAL-Frame, *APPLYHOOK*, argument-list.
 < STACK: cleaned up
 < mv_count/mv_space: values
 changes STACK
 can trigger GC */
local maygc Values eval_closure (object closure)
{
  var object args = popSTACK(); /* argument-list */
  skipSTACK(1);                 /* forget value of *APPLYHOOK* */
  /* STACK-layout: EVAL-Frame. */
  check_SP(); check_STACK();
  pushSTACK(closure);                    /* save Closure */
  var gcv_object_t* closure_ = &STACK_0; /* and memorize, where it is */
  var gcv_object_t* STACKbefore = STACK;
  if (simple_bit_vector_p(Atype_8Bit,TheClosure(closure)->clos_codevec)) {
    /* closure is a compiled Closure */
    var object codevec = TheCclosure(closure)->clos_codevec; /* Code-Vector */
    /* push arguments evaluated into STACK:
     first a dispatch for the most important cases: */
    switch (TheCodevec(codevec)->ccv_signature) {
      /* Macro for a required-argument: */
      #define REQ_ARG()                                                 \
        { if (atomp(args)) goto error_toofew;                           \
          pushSTACK(Cdr(args));    /* remaining arguments */            \
          eval(Car(args));         /* evaluate next argument */         \
          args = STACK_0; STACK_0 = value1;       /* and into STACK */  \
        }
      /* Macro for the n-last optional-argument: */
      #define OPT_ARG(n)                                                \
        { if (atomp(args)) goto unbound_optional_##n ;                  \
          pushSTACK(Cdr(args));    /* remaining arguments */            \
          eval(Car(args));         /* evaluate next argument */         \
          args = STACK_0; STACK_0 = value1;       /* and into STACK */  \
        }
      case (uintB)cclos_argtype_5_0: /* 5 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_4_0: /* 4 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_3_0: /* 3 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_2_0: /* 2 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_1_0: /* 1 required argument */
        REQ_ARG();
      case (uintB)cclos_argtype_0_0: /* no Arguments */
      noch_0_opt_args:
        if (!nullp(args)) goto error_toomany;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_4_1: /* 4 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_3_1: /* 3 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_2_1: /* 2 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_1_1: /* 1 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_1: /* 1 optional argument */
      noch_1_opt_args:
        OPT_ARG(1);
        goto noch_0_opt_args;
      case (uintB)cclos_argtype_3_2: /* 3 required and 2 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_2_2: /* 2 required and 2 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_1_2: /* 1 required and 2 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_2: /* 2 optional arguments */
      noch_2_opt_args:
        OPT_ARG(2);
        goto noch_1_opt_args;
      case (uintB)cclos_argtype_2_3: /* 2 required and 3 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_1_3: /* 1 required and 3 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_3: /* 3 optional arguments */
      noch_3_opt_args:
        OPT_ARG(3);
        goto noch_2_opt_args;
      case (uintB)cclos_argtype_1_4: /* 1 required and 4 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_4: /* 4 optional arguments */
      noch_4_opt_args:
        OPT_ARG(4);
        goto noch_3_opt_args;
      case (uintB)cclos_argtype_0_5: /* 5 optional arguments */
        OPT_ARG(5);
        goto noch_4_opt_args;
      unbound_optional_5: /* Still 5 optional Arguments, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_4: /* Still 4 optional Arguments, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_3: /* Still 3 optional Arguments, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_2: /* Still 2 optional Arguments, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_1: /* Still 1 optional Argument, but atomp(args) */
        { pushSTACK(unbound); }
        if (!nullp(args)) goto error_dotted;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_4_0_rest: /* 4 required  + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_3_0_rest: /* 3 required  + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_2_0_rest: /* 2 required  + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_1_0_rest: /* 1 required  + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_0_0_rest: /* no Arguments, Rest-Parameter */
        if (consp(args)) goto apply_cclosure_rest_nokey;
        if (!nullp(args)) goto error_dotted;
        { pushSTACK(NIL); }     /* Rest-Parameter := NIL */
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_4_0_key: /* 4 required arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_3_0_key: /* 3 required arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_2_0_key: /* 2 required arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_1_0_key: /* 1 required argument, &key */
        REQ_ARG();
      noch_0_opt_args_key:
        closure = *closure_; codevec = TheCclosure(closure)->clos_codevec;
      case (uintB)cclos_argtype_0_0_key:
        /* only &key */
        if (atomp(args)) goto unbound_optional_key_0;
        goto apply_cclosure_key;
      case (uintB)cclos_argtype_3_1_key:
        /* 3 required arguments and 1 optional argument, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_2_1_key:
        /* 2 required arguments and 1 optional argument, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_1_1_key:
        /* 1 required argument and 1 optional argument, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_0_1_key:
        /* 1 optional argument, &key */
      noch_1_opt_args_key:
        OPT_ARG(key_1);
        goto noch_0_opt_args_key;
      case (uintB)cclos_argtype_2_2_key: /* 2 required and 2 optional, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_1_2_key: /* 1 required and 2 optional, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_0_2_key: /* 2 optional arguments, &key */
      noch_2_opt_args_key:
        OPT_ARG(key_2);
        goto noch_1_opt_args_key;
      case (uintB)cclos_argtype_1_3_key: /* 1 required and 3 optional, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_0_3_key: /* 3 optional arguments, &key */
      noch_3_opt_args_key:
        OPT_ARG(key_3);
        goto noch_2_opt_args_key;
      case (uintB)cclos_argtype_0_4_key: /* 4 optional arguments, &key */
        OPT_ARG(key_4);
        goto noch_3_opt_args_key;
      unbound_optional_key_4: /* Still 4 optional Arguments, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_3: /* Still 3 optional Arguments, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_2: /* Still 2 optional Arguments, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_1: /* Still 1 optional Argument, but atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_0:   /* Before the Keywords is atomp(args) */
        if (!nullp(args)) goto error_dotted;
        goto apply_cclosure_key_noargs;
      case (uintB)cclos_argtype_default:
        /* General Version */
        break;
      default: NOTREACHED;
      #undef OPT_ARG
      #undef REQ_ARG
    }
    /* Now the general Version: */
    {
      var uintL req_count = TheCodevec(codevec)->ccv_numreq; /* number of required parameters */
      var uintL opt_count = TheCodevec(codevec)->ccv_numopt; /* number of optional parameters */
      var uintB flags = TheCodevec(codevec)->ccv_flags; /* Flags */
      /* reserve space on STACK: */
      get_space_on_STACK(sizeof(gcv_object_t) * (req_count+opt_count));
      /* evaluate required parameters and push into Stack: */
      {
        var uintC count;
        dotimesC(count,req_count, {
          if (atomp(args)) goto error_toofew; /* argument-list finished? */
          pushSTACK(Cdr(args)); /* remaining argument-list */
          eval(Car(args));      /* evaluate nnext argument */
          args = STACK_0; STACK_0 = value1; /* and into Stack */
        });
      }
      { /* evaluate optional parameters and push into Stack: */
        var uintC count = opt_count;
        while (!atomp(args)) { /* argument-list not finished? */
          if (count==0)     /* all optional parameters supplied with? */
            goto optionals_ok;
          count--;
          pushSTACK(Cdr(args)); /* remaining argument-list */
          eval(Car(args));      /* evaluate next argument */
          args = STACK_0; STACK_0 = value1; /* and into Stack */
        }
        /* argument-list finished. */
        if (!nullp(args)) goto error_dotted;
        /* All further count optional parameters get the "value"
         #<UNBOUND>, the &REST-parameter gets the value NIL,
         the Keyword-parameter gets the value #<UNBOUND> : */
        dotimesC(count,count, { pushSTACK(unbound); } );
      }
      closure = *closure_; codevec = TheCclosure(closure)->clos_codevec;
      if (flags & bit(0))       /* &REST-Flag? */
        pushSTACK(NIL);         /* yes -> initialize with NIL */
      if (flags & bit(7))       /* &KEY-Flag? */
        goto apply_cclosure_key_noargs;
      else
        goto apply_cclosure_nokey_;
     optionals_ok:
      /* process Rest- and Keyword-parameters.
       args = remaining argument-list (not yet finished) */
      closure = *closure_; codevec = TheCclosure(closure)->clos_codevec;
      if (flags == 0)
        /* Closure without REST or KEY -> argument-list should be finished */
        goto error_toomany;
      else if (flags & bit(7)) { /* Key-Flag? */
        /* Closure with Keywords.
         args = remaining argument-list (not yet finished)
         First initialize the Keyword-parameters with #<UNBOUND> , then
         evaluate the remaining arguments and push into Stack, then
         assign the Keywords:
         poss. initialize the Rest-Parameter: */
        if (flags & bit(0))
          pushSTACK(unbound);
        goto apply_cclosure_key;
      } else
          goto apply_cclosure_rest_nokey;
    }
   apply_cclosure_key_noargs:
    {
      var uintC count = TheCodevec(codevec)->ccv_numkey; /* number of Keyword-parameters */
      dotimesC(count,count, { pushSTACK(unbound); } ); /* initialize with #<UNBOUND> */
      interpret_bytecode(closure,codevec,CCV_START_KEY); /* interprete bytecode starting at Byte 12 */
    }
    goto done;
   apply_cclosure_key:          /* jump to Closure only with &KEY: */
    {
      var gcv_object_t* key_args_pointer = args_end_pointer; /* Pointer to Keyword-Parameter */
      /* initialize all Keyword-parameters with #<UNBOUND> : */
      {
        var uintC count = TheCodevec(codevec)->ccv_numkey;
        dotimesC(count,count, { pushSTACK(unbound); } );
      }
      var gcv_object_t* rest_args_pointer = args_end_pointer; /* Pointer to the remaining arguments */
      /* evaluate all further arguments and push into Stack: */
      var uintL argcount = 0;  /* counter for the remaining arguments */
      do {
        check_STACK();
        pushSTACK(Cdr(args));             /* remaining argument-list */
        eval(Car(args));                  /* evaluate next argument */
        args = STACK_0; STACK_0 = value1; /* and into Stack */
        argcount++;
      } while (consp(args));
      /* argument-list finished. */
      if (!nullp(args)) goto error_dotted;
      /* assign Keywords, build Rest-Parameter
       and poss. discard remaining arguments: */
      closure = match_cclosure_key(*closure_,argcount,key_args_pointer,rest_args_pointer);
      codevec = TheCclosure(closure)->clos_codevec;
      interpret_bytecode(closure,codevec,CCV_START_KEY); /* interprete bytecode starting at Byte 12 */
    }
    goto done;
   apply_cclosure_rest_nokey: {
      /* Closure with only REST, without KEY:
         evaluate remaining arguments one by on, put into list
         args = remaining argument-list (not yet finished) */
      pushSTACK(NIL);           /* so far evaluated remaining arguments */
      pushSTACK(args);          /* remaining arguments, unevaluated */
      do {
        args = STACK_0; STACK_0 = Cdr(args);
        eval(Car(args));          /* evaluate next argument */
        pushSTACK(value1);
        /* and cons onto the list: */
        var object new_cons = allocate_cons();
        Car(new_cons) = popSTACK();
        Cdr(new_cons) = STACK_1;
        STACK_1 = new_cons;
      } while (mconsp(STACK_0));
      args = popSTACK();
      /* reverse list STACK_0 and use as REST-parameter: */
      nreverse(STACK_0);
      /* argument-list finished. */
      if (!nullp(args)) goto error_dotted;
    }
   apply_cclosure_nokey:        /* jump to Closure without &KEY : */
    closure = *closure_; codevec = TheCclosure(closure)->clos_codevec;
   apply_cclosure_nokey_:
    interpret_bytecode(closure,codevec,CCV_START_NONKEY); /* interprete bytecode starting at Byte 8 */
   done:
    CHECK_STACK_C(STACKbefore,closure);
    skipSTACK(1);               /* discard Closure */
    unwind();                   /* unwind EVAL-Frame */
    return;                     /* finished */
  } else {
    /* closure is an interpreted Closure */
    var gcv_object_t* args_pointer = args_end_pointer; /* Pointer to the arguments */
    var uintC args_on_stack = 0; /* number of arguments */
    while (consp(args)) {
      pushSTACK(Cdr(args));             /* save rest of list */
      eval(Car(args));                  /* evaluate next element */
      args = STACK_0; STACK_0 = value1; /* result into STACK */
      args_on_stack += 1;
      if (((uintL)~(uintL)0 > ca_limit_1) && (args_on_stack > ca_limit_1))
        goto error_toomany;
    }
    with_saved_back_trace_iclosure(*closure_,args_pointer,args_on_stack,
      funcall_iclosure(*closure_,args_pointer,args_on_stack); );
    skipSTACK(1);               /* discard Closure */
    unwind();                   /* unwind EVAL-Frame */
    return;                     /* finished */
  }
  /* Gathered errormessages: */
 error_toofew:           /* Argument-list args is prematurely an Atom */
  if (!nullp(args)) goto error_dotted;
  setSTACK(STACK = STACKbefore); /* clean up STACK */
  closure = popSTACK();
  error_eval_toofew(Closure_name(closure));
 error_toomany:           /* Argument-list args is not NIL at the end */
  if (atomp(args)) goto error_dotted;
  setSTACK(STACK = STACKbefore); /* clean up STACK */
  closure = popSTACK();
  error_eval_toomany(Closure_name(closure));
 error_dotted:            /* Argument-list args ends with Atom /= NIL */
  setSTACK(STACK = STACKbefore); /* clean up STACK */
  closure = popSTACK();
  error_eval_dotted(Closure_name(closure));
}

#ifdef DYNAMIC_FFI
/* In EVAL: Applies a Foreign-Function to an argument-list,
 cleans up STACK and returns the values.
 eval_ffunction(fun);
 > fun: function, a Foreign-Function
 > STACK-layout: EVAL-Frame, *APPLYHOOK*, argument-list.
 < STACK: cleaned up
 < mv_count/mv_space: values
 changes STACK
 can trigger GC */
local maygc Values eval_ffunction(object ffun) {
  var object args = popSTACK(); /* Argument-list */
  skipSTACK(1);                 /* skip value of *APPLYHOOK* */
  /* STACK-layout: EVAL-Frame.
   (ffun arg ...) --> (FFI::FOREIGN-CALL-OUT ffun arg ...) */
  check_SP(); check_STACK();
  pushSTACK(ffun);              /* Foreign-Function as 1st Argument */
  {
    var gcv_object_t* args_pointer = args_end_pointer; /* Pointer to the arguments */
    var uintC args_on_stack = 1; /* number of arguments */
    while (consp(args)) {
      pushSTACK(Cdr(args));             /* save list-rest */
      eval(Car(args));                  /* evaluate next element */
      args = STACK_0; STACK_0 = value1; /* result into STACK */
      args_on_stack += 1;
      if (((uintL)~(uintL)0 > ca_limit_1) && (args_on_stack > ca_limit_1)) {
        set_args_end_pointer(args_pointer);
        error_eval_toomany(popSTACK());
      }
    }
    funcall(L(foreign_call_out),args_on_stack);
  }
  unwind();                     /* unwind EVAL-Frame */
  return;                       /* finished */
}
#endif


/* ----------------------- A P P L Y ----------------------- */

/* later: */
local Values apply_subr (object fun, uintC args_on_stack, object other_args);
local Values apply_closure(object fun, uintC args_on_stack, object other_args);

/* UP: Applies a function to its arguments.
 apply(function,args_on_stack,other_args);
 > function: function
 > arguments: args_on_stack arguments on the STACK,
              remaining argument-list in other_args
 < STACK: cleaned up (i.e. STACK is increased by args_on_stack)
 < mv_count/mv_space: values
 changes STACK, can trigger GC */
global maygc Values apply (object fun, uintC args_on_stack, object other_args)
{
 apply_restart:
  /* fun must be a SUBR or a Closure or a Cons (LAMBDA ...) : */
  if (subrp(fun)) { /* SUBR ? */
    return_Values apply_subr(fun,args_on_stack,other_args);
  } else if (closurep(fun)) { /* Closure ? */
    return_Values apply_closure(fun,args_on_stack,other_args);
  } else if (symbolp(fun)) { /* Symbol ? */
    /* apply Symbol: global Definition Symbol_function(fun) applies. */
    var object fdef = Symbol_function(fun);
    if (subrp(fdef)) { /* SUBR -> apply */
      return_Values apply_subr(fdef,args_on_stack,other_args);
    } else if (closurep(fdef)) { /* Closure -> apply */
      return_Values apply_closure(fdef,args_on_stack,other_args);
    } else if (orecordp(fdef)) {
     #ifdef DYNAMIC_FFI
      if (ffunctionp(fdef)) { /* Foreign-Function ? */
        fun = fdef; goto call_ffunction;
      }
     #endif
      switch (Record_type(fdef)) {
        case Rectype_Fsubr: { error_specialform(S(apply),fun); }
        case Rectype_Macro: { error_macro(S(apply),fun); }
        default: NOTREACHED;
      }
    } else
      /* if no SUBR, no Closure, no FSUBR, no Macro:
         Symbol_function(fun) must be #<UNBOUND> . */
      goto undef;
  } else if (funnamep(fun)) { /* List (SETF symbol) ? */
    /* global Definition (symbol-function (get-setf-symbol symbol)) applies. */
    var object symbol = get(Car(Cdr(fun)),S(setf_function)); /* (get ... 'SYS::SETF-FUNCTION) */
    if (!symbolp(symbol)) /* should be (uninterned) Symbol */
      goto undef; /* else undefined */
    var object fdef = Symbol_function(symbol);
    if (closurep(fdef)) { /* Closure -> apply */
      return_Values apply_closure(fdef,args_on_stack,other_args);
    } else if (subrp(fdef)) { /* SUBR -> apply */
      return_Values apply_subr(fdef,args_on_stack,other_args);
    }
   #ifdef DYNAMIC_FFI
    else if (ffunctionp(fdef)) { /* Foreign-Function ? */
      fun = fdef; goto call_ffunction;
    }
   #endif
    else
      /* Such function-names cannot denote FSUBRs or Macros.
         fdef is presumably #<UNBOUND> . */
      goto undef;
  }
 #ifdef DYNAMIC_FFI
  else if (ffunctionp(fun)) /* Foreign-Function ? */
  call_ffunction: { /* call (SYS::FOREIGN-CALL-OUT foreign-function . args) */
    /* Therefore first shift down the arguments in Stack by 1. */
    var uintC count;
    var gcv_object_t* ptr = &STACK_0;
    dotimesC(count,args_on_stack, {
      *(ptr STACKop -1) = *ptr; ptr skipSTACKop 1;
    });
    *(ptr STACKop -1) = fun;
    skipSTACK(-1);
    return_Values apply_subr(L(foreign_call_out),args_on_stack+1,other_args);
  }
 #endif
  else if (consp(fun) && eq(Car(fun),S(lambda))) /* Cons (LAMBDA ...) ? */
    error_lambda_expression(S(apply),fun);
  else {
    pushSTACK(other_args);
    fun = check_funname_replacement(type_error,S(apply),fun);
    other_args = popSTACK();
    goto apply_restart;
  }
  return;
 undef:
  pushSTACK(other_args);
  fun = check_fdefinition(fun,S(apply));
  other_args = popSTACK();
  goto apply_restart;
}

/* Error because of dotted argument-list
 > name: name of function */
nonreturning_function(local, error_apply_dotted, (object name, object end)) {
  pushSTACK(end);
  pushSTACK(name);
  pushSTACK(S(apply));
  error(program_error,GETTEXT("~S: argument list given to ~S is dotted (terminated by ~S)"));
}

/* Error because of too many arguments
 > name: name of function */
nonreturning_function(local, error_apply_toomany, (object name)) {
  pushSTACK(name);
  /* ANSI CL 3.5.1.3. wants a PROGRAM-ERROR here. */
  error(program_error,GETTEXT("APPLY: too many arguments given to ~S"));
}

/* Error because of too few arguments
 > name: name of function
 > tail: atom at the end of the argument list */
nonreturning_function(local, error_apply_toofew, (object name, object tail)) {
  if (!nullp(tail)) {
    pushSTACK(tail); /* ARGUMENT-LIST-DOTTED slot DATUM */
    pushSTACK(tail); pushSTACK(name);
    error(argument_list_dotted,
          GETTEXT("APPLY: dotted argument list given to ~S : ~S"));
  } else {
    pushSTACK(name);
    /* ANSI CL 3.5.1.2. wants a PROGRAM-ERROR here. */
    error(program_error,GETTEXT("APPLY: too few arguments given to ~S"));
  }
}

/* Error because of too many arguments for a SUBR
 > fun: function, a SUBR */
nonreturning_function(local, error_subr_toomany, (object fun));
#define error_subr_toomany(fun)  error_apply_toomany(TheSubr(fun)->name)

/* Error because of too few arguments for a SUBR
 > fun: function, a SUBR
 > tail: atom at the end of the argument list */
nonreturning_function(local, error_subr_toofew, (object fun, object tail));
#define error_subr_toofew(fun,tail)  \
  error_apply_toofew(TheSubr(fun)->name,tail)

/* In APPLY: Applies a SUBR to an argument-list, cleans up STACK
 and returns the values.
 apply_subr(fun,args_on_stack,other_args);
 > fun: function, a SUBR
 > Arguments: args_on_stack Arguments on STACK,
              remaining argument-list in other_args
 < STACK: cleaned up (i.e. STACK is increased by args_on_stack)
 < mv_count/mv_space: values
 changes STACK, can trigger GC */
local maygc Values apply_subr (object fun, uintC args_on_stack, object args)
{
  #if STACKCHECKS
  var gcv_object_t* args_pointer = args_end_pointer STACKop args_on_stack; /* Pointer to the arguments */
  #endif
  var gcv_object_t* key_args_pointer; /* Pointer to the &key */
  var gcv_object_t* rest_args_pointer; /* Pointer to the remaining Arguments */
  var uintL argcount;           /* number of remaining Arguments */
  TRACE_CALL(fun,'A','S');
  /* push Arguments on STACK:
   first a Dispatch for the most important cases: */
  switch (TheSubr(fun)->argtype) {
    /* Macro for a required argument: */
    #define REQ_ARG()  \
      { if (args_on_stack>0) { args_on_stack--; }                     \
        else if (consp(args)) { pushSTACK(Car(args)); args = Cdr(args); } \
        else goto error_toofew;                                       \
      }
    /* Macro for the n-last optional argument: */
    #define OPT_ARG(n)  \
      { if (args_on_stack>0) { args_on_stack--; }                      \
        else if (consp(args)) { pushSTACK(Car(args)); args = Cdr(args); } \
        else goto unbound_optional_##n;                                \
      }
    case (uintW)subr_argtype_6_0: /* SUBR with 6 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_5_0: /* SUBR with 5 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_4_0: /* SUBR with 4 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_3_0: /* SUBR with 3 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_2_0: /* SUBR with 2 required arguments */
      REQ_ARG();
    case (uintW)subr_argtype_1_0: /* SUBR with 1 required argument */
      REQ_ARG();
    case (uintW)subr_argtype_0_0: /* SUBR without Arguments */
      if ((args_on_stack>0) || consp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_4_1: /* SUBR with 4 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_3_1: /* SUBR with 3 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_2_1: /* SUBR with 2 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_1_1: /* SUBR with 1 required and 1 optional */
      REQ_ARG();
    case (uintW)subr_argtype_0_1: /* SUBR with 1 optional argument */
      OPT_ARG(1);
      if ((args_on_stack>0) || consp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_3_2: /* SUBR with 3 required and 2 optional */
      REQ_ARG();
    case (uintW)subr_argtype_2_2: /* SUBR with 2 required and 2 optional */
      REQ_ARG();
    case (uintW)subr_argtype_1_2: /* SUBR with 1 required and 2 optional */
      REQ_ARG();
    case (uintW)subr_argtype_0_2: /* SUBR with 2 optional arguments */
      OPT_ARG(2);
      OPT_ARG(1);
      if ((args_on_stack>0) || consp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_2_3: /* SUBR with 2 required and 3 optional */
      REQ_ARG();
    case (uintW)subr_argtype_1_3: /* SUBR with 1 required and 3 optional */
      REQ_ARG();
    case (uintW)subr_argtype_0_3: /* SUBR with 3 optional arguments */
      OPT_ARG(3);
      OPT_ARG(2);
      OPT_ARG(1);
      if ((args_on_stack>0) || consp(args)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_0_5: /* SUBR with 5 optional arguments */
      OPT_ARG(5);
    case (uintW)subr_argtype_0_4: /* SUBR with 4 optional arguments */
      OPT_ARG(4);
      OPT_ARG(3);
      OPT_ARG(2);
      OPT_ARG(1);
      if ((args_on_stack>0) || consp(args)) goto error_toomany;
      goto apply_subr_norest;
    unbound_optional_5: /* Still 5 optionals Arguments, but args_on_stack=0 and atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_4: /* Still 4 optional Arguments, but args_on_stack=0 and atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_3: /* Still 3 optional Arguments, but args_on_stack=0 and atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_2: /* Still 2 optional Arguments, but args_on_stack=0 and atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_1: /* Still 1 optionals Argument, but args_on_stack=0 and atomp(args) */
      { pushSTACK(unbound); }
      goto apply_subr_norest;
    case (uintW)subr_argtype_3_0_rest: /* SUBR with 3 required and &rest */
      REQ_ARG();
    case (uintW)subr_argtype_2_0_rest: /* SUBR with 2 required and &rest */
      REQ_ARG();
    case (uintW)subr_argtype_1_0_rest: /* SUBR with 1 required and &rest */
      REQ_ARG();
    case (uintW)subr_argtype_0_0_rest: /* SUBR with rest arguments */
      if (args_on_stack==0)
        goto apply_subr_rest_onlylist;
      else
        goto apply_subr_rest_withlist;
    case (uintW)subr_argtype_4_0_key: /* SUBR with 4 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_3_0_key: /* SUBR with 3 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_2_0_key: /* SUBR with 2 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_1_0_key: /* SUBR with 1 required and &key */
      REQ_ARG();
    case (uintW)subr_argtype_0_0_key: /* SUBR with &key */
      if ((args_on_stack==0) && atomp(args)) goto unbound_optional_key_0;
      goto apply_subr_key;
    case (uintW)subr_argtype_1_1_key:
      /* SUBR with 1 required argument, 1 optional argument and &key */
      REQ_ARG();
    case (uintW)subr_argtype_0_1_key:
      /* SUBR with 1 optional argument and &key */
      OPT_ARG(key_1);
      if ((args_on_stack==0) && atomp(args)) goto unbound_optional_key_0;
      goto apply_subr_key;
    case (uintW)subr_argtype_1_2_key:
      /* SUBR with 1 required argument, 2 optional arguments and &key */
      REQ_ARG();
      OPT_ARG(key_2);
      OPT_ARG(key_1);
      if ((args_on_stack==0) && atomp(args)) goto unbound_optional_key_0;
      goto apply_subr_key;
    unbound_optional_key_2: /* Still 2 optional Arguments, but args_on_stack=0 and atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_key_1: /* Still 1 optional Argument, but args_on_stack=0 and atomp(args) */
      { pushSTACK(unbound); }
    unbound_optional_key_0: /* Before the Keywords is args_on_stack=0 and atomp(args) */
      {
        var uintC count;
        dotimesC(count,TheSubr(fun)->key_count, { pushSTACK(unbound); } );
      }
      goto apply_subr_norest;
    default: NOTREACHED;
    #undef OPT_ARG
    #undef REQ_ARG
  }
  /* Now the general Version: */
  {
    var uintC key_count;
    {
      var uintC req_count = TheSubr(fun)->req_count;
      var uintC opt_count = TheSubr(fun)->opt_count;
      key_count = TheSubr(fun)->key_count;
      if (args_on_stack < req_count) {
        /* fewer Arguments there than required */
        req_count = req_count - args_on_stack; /* as many as these must go on STACK */
        /* reserve space on STACK: */
        get_space_on_STACK(sizeof(gcv_object_t) * (uintL)(req_count + opt_count + key_count));
        /* store required Parameter in Stack: */
        {
          var uintC count;
          dotimespC(count,req_count, {
            if (atomp(args))
              goto error_toofew;
            pushSTACK(Car(args)); /* store next Argument */
            args = Cdr(args);
          });
        }
        goto optionals_from_list;
      }
      args_on_stack -= req_count; /* remaining number */
      if (args_on_stack < opt_count) {
        /* Arguments in Stack don't last for the optional ones */
        opt_count = opt_count - args_on_stack; /* as many as these must go on STACK */
        /* reserve space on STACK: */
        get_space_on_STACK(sizeof(gcv_object_t) * (uintL)(opt_count + key_count));
       optionals_from_list:
        { /* store optional Parameters on Stack: */
          var uintC count = opt_count;
          while (!atomp(args)) { /* argument-list not finished? */
            if (count==0) /* all optional Parameters supplied with? */
              goto optionals_ok;
            count--;
            pushSTACK(Car(args)); /* store next Argument */
            args = Cdr(args);
          }
          /* Argument-list finished.
           All further count optional Parameters receive the "value"
           #<UNBOUND>, including the Keyword-Parameters: */
          dotimesC(count,count + key_count, { pushSTACK(unbound); } );
          if (TheSubr(fun)->rest_flag == subr_rest) { /* &REST-Flag? */
            /* yes -> 0 additional Arguments: */
            argcount = 0; rest_args_pointer = args_end_pointer;
            goto apply_subr_rest;
          } else {
            /* no -> nothing to do */
            goto apply_subr_norest;
          }
        }
       optionals_ok: /* optional Argument OK, continue processing (non-empty) list */
        if (TheSubr(fun)->key_flag == subr_nokey) {
          /* SUBR without KEY */
          if (TheSubr(fun)->rest_flag == subr_norest)
            /* SUBR without REST or KEY */
            error_subr_toomany(fun); /* too many Arguments */
          else
            /* SUBR with only REST, without KEY */
            goto apply_subr_rest_onlylist;
        } else {
          /* SUBR with KEY */
          key_args_pointer = args_end_pointer;
          {
            var uintC count;
            dotimesC(count,key_count, { pushSTACK(unbound); } );
          }
          rest_args_pointer = args_end_pointer;
          argcount = 0;
          goto key_from_list;
        }
      }
      args_on_stack -= opt_count; /* remaining number */
      if (TheSubr(fun)->key_flag == subr_nokey) {
        /* SUBR without KEY */
        if (TheSubr(fun)->rest_flag == subr_norest) {
          /* SUBR without REST or KEY */
          if ((args_on_stack>0) || consp(args)) /* still Arguments? */
            error_subr_toomany(fun);
          goto apply_subr_norest;
        } else
          /* SUBR with only REST, without KEY */
          goto apply_subr_rest_withlist;
      } else
        /* SUBR with Keywords. */
        goto apply_subr_key_;
    }
   apply_subr_key:
    key_count = TheSubr(fun)->key_count;
   apply_subr_key_:
    /* shift down remaining Arguments on STACK and thus
     create room for the Keyword-Parameters: */
    argcount = args_on_stack;
    get_space_on_STACK(sizeof(gcv_object_t) * (uintL)key_count);
    {
      var gcv_object_t* new_args_end_pointer = args_end_pointer STACKop -(uintP)key_count;
      var gcv_object_t* ptr1 = args_end_pointer;
      var gcv_object_t* ptr2 = new_args_end_pointer;
      var uintC count;
      dotimesC(count,args_on_stack, { BEFORE(ptr2) = BEFORE(ptr1); } );
      key_args_pointer = ptr1;
      rest_args_pointer = ptr2;
      dotimesC(count,key_count, { NEXT(ptr1) = unbound; } );
      set_args_end_pointer(new_args_end_pointer);
    }
   key_from_list:  /* take remaining Arguments for Keywords from list */
    while (consp(args)) {
      check_STACK(); pushSTACK(Car(args)); /* push next argument onto Stack */
      args = Cdr(args);
      argcount++;
    }
    /* assign Keywords and poss. discard remaining arguments: */
    match_subr_key(fun,argcount,key_args_pointer,rest_args_pointer);
    if (TheSubr(fun)->rest_flag != subr_norest)
      /* SUBR with &REST-Flag: */
      goto apply_subr_rest;
    else
      /* SUBR without &REST-Flag: */
      goto apply_subr_norest;
  }
 apply_subr_rest_onlylist:
  argcount = 0; rest_args_pointer = args_end_pointer;
  goto rest_from_list;
 apply_subr_rest_withlist:
  argcount = args_on_stack;
  rest_args_pointer = args_end_pointer STACKop argcount;
 rest_from_list:                /* take remaining Arguments from list */
  while (consp(args)) {
    check_STACK(); pushSTACK(Car(args)); /* next argument onto Stack */
    args = Cdr(args);
    argcount++;
  }
  if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1)) /* too many arguments? */
    goto error_toomany;
 apply_subr_rest:
  if (!nullp(args))
    goto error_dotted;
  with_saved_back_trace_subr(fun,STACK,
                             TheSubr(fun)->req_count + TheSubr(fun)->opt_count + argcount,
    (*(subr_rest_function_t*)(TheSubr(fun)->function))(argcount,rest_args_pointer); );
  goto done;
 apply_subr_norest:
  if (!nullp(args))
    goto error_dotted;
  with_saved_back_trace_subr(fun,STACK,-1,
    (*(subr_norest_function_t*)(TheSubr(fun)->function))(); );
 done:
  CHECK_STACK_S(args_end_pointer,fun);
  return;                       /* finished */
  /* gathered error messages: */
 error_toofew: error_subr_toofew(fun,args);
 error_toomany: error_subr_toomany(fun);
 error_dotted: error_apply_dotted(TheSubr(fun)->name,args);
}

/* Error because of too many arguments for a Closure
 > closure: function, a Closure */
nonreturning_function(local, error_closure_toomany, (object closure));
#define error_closure_toomany(closure)  error_apply_toomany(closure)

/* Error because of too few arguments for a Closure
 > closure: function, a Closure
 > tail: atom at the end of the argument list */
nonreturning_function(local, error_closure_toofew, (object closure, object tail));
#define error_closure_toofew(closure,tail)  error_apply_toofew(closure,tail)

/* In APPLY: Applies a Closure to an argument-list, cleans up STACK
 and returns the values.
 apply_closure(fun,args_on_stack,other_args);
 > fun: function, a Closure
 > Argumente: args_on_stack arguments on STACK,
              remaining argument-list in other_args
 < STACK: cleaned up (i.e. STACK is increased by args_on_stack)
 < mv_count/mv_space: values
 changes STACK, can trigger GC */
local maygc Values apply_closure (object closure, uintC args_on_stack, object args)
{
  TRACE_CALL(closure,'A','C');
  if (simple_bit_vector_p(Atype_8Bit,TheClosure(closure)->clos_codevec)) {
    /* closure is a compiled Closure */
    #if STACKCHECKC
    var gcv_object_t* args_pointer = args_end_pointer STACKop args_on_stack; /* Pointer to the arguments */
    #endif
    var object codevec = TheCclosure(closure)->clos_codevec; /* Code-Vector */
    var gcv_object_t* key_args_pointer; /* Pointer to the Keyword-arguments */
    var gcv_object_t* rest_args_pointer; /* Pointer to the remaining arguments */
    var uintL argcount;         /* number of remaining arguments */
    check_SP(); check_STACK();
    /* put argumente in STACK:
     first a Dispatch for the most important cases: */
    switch (TheCodevec(codevec)->ccv_signature) {
      /* Macro for a required-argument: */
      #define REQ_ARG()  \
        { if (args_on_stack>0) { args_on_stack--; }                      \
          else if (consp(args)) { pushSTACK(Car(args)); args = Cdr(args); } \
          else goto error_toofew;                                      \
        }
      /* Macro for the n-last optional-argument: */
      #define OPT_ARG(n)  \
        { if (args_on_stack>0) { args_on_stack--; }                      \
          else if (consp(args)) { pushSTACK(Car(args)); args = Cdr(args); } \
          else goto unbound_optional_##n;                                \
        }
      case (uintB)cclos_argtype_5_0: /* 5 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_4_0: /* 4 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_3_0: /* 3 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_2_0: /* 2 required arguments */
        REQ_ARG();
      case (uintB)cclos_argtype_1_0: /* 1 required argument */
        REQ_ARG();
      case (uintB)cclos_argtype_0_0: /* no Arguments */
        noch_0_opt_args:
        if (args_on_stack>0) goto error_toomany;
        if (!nullp(args)) {
          if (consp(args))
            goto error_toomany;
          else
            goto error_dotted;
        }
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_4_1: /* 4 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_3_1: /* 3 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_2_1: /* 2 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_1_1: /* 1 required and 1 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_1: /* 1 optional argument */
        noch_1_opt_args:
        OPT_ARG(1);
        goto noch_0_opt_args;
      case (uintB)cclos_argtype_3_2: /* 3 required and 2 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_2_2: /* 2 required and 2 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_1_2: /* 1 required and 2 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_2: /* 2 optional arguments */
        noch_2_opt_args:
        OPT_ARG(2);
        goto noch_1_opt_args;
      case (uintB)cclos_argtype_2_3: /* 2 required and 3 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_1_3: /* 1 required and 3 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_3: /* 3 optional arguments */
        noch_3_opt_args:
        OPT_ARG(3);
        goto noch_2_opt_args;
      case (uintB)cclos_argtype_1_4: /* 1 required and 4 optional */
        REQ_ARG();
      case (uintB)cclos_argtype_0_4: /* 4 optional arguments */
        noch_4_opt_args:
        OPT_ARG(4);
        goto noch_3_opt_args;
      case (uintB)cclos_argtype_0_5: /* 5 optional arguments */
        OPT_ARG(5);
        goto noch_4_opt_args;
      unbound_optional_5: /* Still 5 optional Arguments, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_4: /* Still 4 optional Arguments, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_3: /* Still 3 optional Arguments, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_2: /* Still 2 optional Arguments, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_1: /* Still 1 optional Argument, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
        if (!nullp(args)) goto error_dotted;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_4_0_rest: /* 4 required + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_3_0_rest: /* 3 required + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_2_0_rest: /* 2 required + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_1_0_rest: /* 1 required + &rest */
        REQ_ARG();
      case (uintB)cclos_argtype_0_0_rest: /* no Arguments, Rest-Parameter */
        goto apply_cclosure_rest_nokey;
      case (uintB)cclos_argtype_4_0_key: /* 4 required arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_3_0_key: /* 3 required arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_2_0_key: /* 2 required arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_1_0_key: /* 1 required argument, &key */
        REQ_ARG();
        noch_0_opt_args_key:
      case (uintB)cclos_argtype_0_0_key: /* only &key */
        if ((args_on_stack==0) && atomp(args)) goto unbound_optional_key_0;
        goto apply_cclosure_key_withlist;
      case (uintB)cclos_argtype_3_1_key:
        /* 3 required arguments and 1 optional argument, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_2_1_key:
        /* 2 required arguments and 1 optional argument, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_1_1_key:
        /* 1 required argument and 1 optional argument, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_0_1_key: /* 1 optional argument, &key */
        noch_1_opt_args_key:
        OPT_ARG(key_1);
        goto noch_0_opt_args_key;
      case (uintB)cclos_argtype_2_2_key:
        /* 2 required arguments and 2 optional arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_1_2_key:
        /* 1 required argument and 2 optional arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_0_2_key:
        /* 2 optional arguments, &key */
        noch_2_opt_args_key:
        OPT_ARG(key_2);
        goto noch_1_opt_args_key;
      case (uintB)cclos_argtype_1_3_key:
        /* 1 required argument and 3 optional arguments, &key */
        REQ_ARG();
      case (uintB)cclos_argtype_0_3_key:
        /* 3 optional arguments, &key */
        noch_3_opt_args_key:
        OPT_ARG(key_3);
        goto noch_2_opt_args_key;
      case (uintB)cclos_argtype_0_4_key:
        /* 4 optional arguments, &key */
        OPT_ARG(key_4);
        goto noch_3_opt_args_key;
      unbound_optional_key_4: /* Still 4 optional Arguments, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_3: /* Still 3 optional Arguments, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_2: /* Still 2 optional Arguments, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_1: /* Still 1 optional Argument, but args_on_stack=0 and atomp(args) */
        { pushSTACK(unbound); }
      unbound_optional_key_0: /* Before the Keywords is args_on_stack=0 and atomp(args) */
        if (!nullp(args)) goto error_dotted;
        goto apply_cclosure_key_noargs;
      case (uintB)cclos_argtype_default:
        /* General Version */
        break;
      default: NOTREACHED;
      #undef OPT_ARG
      #undef REQ_ARG
    }
    /* Now the general Version: */
    {
      var uintB flags;
      {
        var uintC req_count = TheCodevec(codevec)->ccv_numreq; /* number of required Parameters */
        var uintC opt_count = TheCodevec(codevec)->ccv_numopt; /* number of optional Parameters */
        flags = TheCodevec(codevec)->ccv_flags; /* Flags */
        if (args_on_stack < req_count) {
          /* fewer Arguments than demanded */
          req_count = req_count - args_on_stack; /* as many as these must on STACK */
          /* reserve space on STACK: */
          get_space_on_STACK(sizeof(gcv_object_t) * (uintL)(req_count + opt_count));
          /* store required Parameters on Stack: */
          {
            var uintC count;
            dotimespC(count,req_count, {
              if (atomp(args))
                goto error_toofew;
              pushSTACK(Car(args)); /* store next argument */
              args = Cdr(args);
            });
          }
          goto optionals_from_list;
        }
        args_on_stack -= req_count; /* remaining number */
        if (args_on_stack < opt_count) {
          /* Arguments in Stack don't last for the optional ones */
          opt_count = opt_count - args_on_stack; /* as many as these must go on STACK */
          /* reserve space on STACK: */
          get_space_on_STACK(sizeof(gcv_object_t) * (uintL)opt_count);
          optionals_from_list:
          { /* store optional parameters on Stack: */
            var uintC count = opt_count;
            while (!atomp(args)) { /* argument-list not finished? */
              if (count==0) /* all optional parameters supplied with? */
                goto optionals_ok;
              count--;
              pushSTACK(Car(args)); /* store next argument */
              args = Cdr(args);
            }
            /* argument-list finished. */
            if (!nullp(args)) goto error_dotted;
            /* All further count optional parameters receive the "value"
             #<UNBOUND>, the &REST-parameter receives NIL,
             the Keyword-parameters receive the value #<UNBOUND> : */
            dotimesC(count,count, { pushSTACK(unbound); } );
          }
          if (flags & bit(0))   /* &REST-Flag? */
            pushSTACK(NIL);     /* yes -> initialize with NIL */
          if (flags & bit(7))   /* &KEY-Flag? */
            goto apply_cclosure_key_noargs;
          else
            goto apply_cclosure_nokey;
         optionals_ok:
          /* process Rest- and Keyword-parameters.
           args = remaining argument-list (not yet finished) */
          if (flags == 0)
            /* Closure without REST or KEY -> argument-list should be finished */
            goto error_toomany;
          /* poss. fill the Rest-parameter: */
          if (flags & bit(0))
            pushSTACK(args);
          if (flags & bit(7)) { /* Key-Flag? */
            /* Closure with Keywords.
             args = remaining argument-list (not yet finished)
             First initialize the Keyword-parameters with #<UNBOUND> ,
             the store the remaining arguments in Stack,
             then assign the Keywords: */
            key_args_pointer = args_end_pointer; /* Pointer to the Keyword-parameters */
            /* initialize all Keyword-parameters with #<UNBOUND> : */
            {
              var uintC count = TheCodevec(codevec)->ccv_numkey;
              dotimesC(count,count, { pushSTACK(unbound); } );
            }
            rest_args_pointer = args_end_pointer; /* Pointer to the remaining arguments */
            argcount = 0;      /* counter for the remaining arguments */
            goto key_from_list;
          } else
            /* Closure with only REST, without KEY: */
            goto apply_cclosure_nokey;
        }
        args_on_stack -= opt_count; /* remaining number */
        if (flags & bit(7))         /* Key-Flag? */
          goto apply_cclosure_key_withlist_;
        else if (flags & bit(0))
          goto apply_cclosure_rest_nokey;
        else {
          /* Closure without REST or KEY */
          if ((args_on_stack>0) || consp(args)) /* still arguments? */
            goto error_toomany;
          goto apply_cclosure_nokey;
        }
      }
     apply_cclosure_key_noargs:
      {
        var uintC key_count = TheCodevec(codevec)->ccv_numkey; /* number of Keyword-parameters */
        if (key_count > 0) {
          get_space_on_STACK(sizeof(gcv_object_t) * (uintL)key_count);
          var uintC count;
          dotimespC(count,key_count, { pushSTACK(unbound); } ); /* initialize with #<UNBOUND> */
        }
        goto apply_cclosure_key;
      }
     apply_cclosure_key_withlist:
      flags = TheCodevec(codevec)->ccv_flags; /* initialize flags! */
     apply_cclosure_key_withlist_:
      /* Closure with Keywords */
      {
        var uintC key_count = TheCodevec(codevec)->ccv_numkey; /* number of Keyword-parameters */
        /* shift down remaining arguments in STACK and thus
         create room for the Keyword-parameters
         (and poss. Rest-parameters): */
        var uintL shift = key_count;
        if (flags & bit(0))
          shift++;              /* poss. 1 more for Rest-Parameter */
        argcount = args_on_stack;
        get_space_on_STACK(sizeof(gcv_object_t) * shift);
        var gcv_object_t* new_args_end_pointer = args_end_pointer STACKop -(uintP)shift;
        var gcv_object_t* ptr1 = args_end_pointer;
        var gcv_object_t* ptr2 = new_args_end_pointer;
        var uintC count;
        dotimesC(count,args_on_stack, { BEFORE(ptr2) = BEFORE(ptr1); } );
        if (flags & bit(0))
          NEXT(ptr1) = args;    /* Rest-Parameter (preliminary) */
        key_args_pointer = ptr1;
        rest_args_pointer = ptr2;
        dotimesC(count,key_count, { NEXT(ptr1) = unbound; } );
        set_args_end_pointer(new_args_end_pointer);
        if (flags & bit(0))
          /* fill Rest-Parameter, less effort than with match_cclosure_key: */
          if (args_on_stack > 0) {
            var gcv_object_t* ptr3 = new_args_end_pointer;
            pushSTACK(closure); /* save Closure */
            pushSTACK(args);    /* save args */
            dotimespC(count,args_on_stack, {
              var object new_cons = allocate_cons();
              Car(new_cons) = BEFORE(ptr3);
              Cdr(new_cons) = Before(key_args_pointer);
              Before(key_args_pointer) = new_cons;
            });
            args = popSTACK();
            closure = popSTACK();
          }
      }
     key_from_list: /* remove remaining arguments for Keywords from list */
      while (consp(args)) {
        check_STACK(); pushSTACK(Car(args)); /* store next argument in Stack */
        args = Cdr(args);
        argcount++;
      }
      /* argument-list finished. */
      if (!nullp(args)) goto error_dotted;
      /* assign Keywords, build Rest-parameter
       and poss. discard remaining arguments: */
      closure = match_cclosure_key(closure,argcount,key_args_pointer,rest_args_pointer);
      codevec = TheCclosure(closure)->clos_codevec;
     apply_cclosure_key:
      interpret_bytecode(closure,codevec,CCV_START_KEY); /* process Bytecode starting at Byte 12 */
      goto done;
    }
   apply_cclosure_rest_nokey:
    /* Closure with only REST, without KEY:
     still has to cons args_on_stack Arguments from Stack to args: */
    pushSTACK(args);
    if (args_on_stack > 0) {
      pushSTACK(closure);       /* Closure must be saved */
      dotimespC(args_on_stack,args_on_stack, {
        var object new_cons = allocate_cons();
        Cdr(new_cons) = STACK_1;
        Car(new_cons) = STACK_2; /* cons next argument to it */
        STACK_2 = new_cons;
        STACK_1 = STACK_0; skipSTACK(1);
      });
      closure = popSTACK(); codevec = TheCclosure(closure)->clos_codevec;
    }
    goto apply_cclosure_nokey;
   apply_cclosure_nokey:        /* jump to Closure without &KEY: */
    interpret_bytecode(closure,codevec,CCV_START_NONKEY); /* process Bytecode starting at Byte 8 */
   done:
    CHECK_STACK_C(args_end_pointer,closure);
    return;                     /* finished */
  } else {
    /* closure is an interpreted Closure
     reserve space on STACK: */
    get_space_on_STACK(sizeof(gcv_object_t) * llength(args));
    while (consp(args)) {       /* Still Arguments in list? */
      pushSTACK(Car(args));     /* push next Element in STACK */
      args = Cdr(args);
      args_on_stack += 1;
      if (((uintL)~(uintL)0 > ca_limit_1) && (args_on_stack > ca_limit_1))
        goto error_toomany;
    }
    var gcv_object_t* args_pointer = args_end_pointer STACKop args_on_stack;
    with_saved_back_trace_iclosure(closure,args_pointer,args_on_stack,
      funcall_iclosure(closure,args_pointer,args_on_stack); );
    return;                     /* finished */
  }
  /* Gathered error-messages: */
 error_toofew: error_closure_toofew(closure,args);
 error_toomany: error_closure_toomany(closure);
 error_dotted: error_apply_dotted(closure,args);
}


/*        ----------------------- F U N C A L L ----------------------- */

/* later: */
local Values funcall_subr (object fun, uintC args_on_stack);
local Values funcall_closure (object fun, uintC args_on_stack);

/* UP: Applies a function to its arguments.
 funcall(function,argcount);
 > function: function
 > Argumente: argcount arguments on STACK
 < STACK: cleaned up (i.e. STACK is increased by argcount)
 < mv_count/mv_space: values
 changes STACK, can trigger GC */
global maygc Values funcall (object fun, uintC args_on_stack)
{
 funcall_restart:
  /* fun must be a SUBR or a Closure or a Cons (LAMBDA ...) : */
  if (subrp(fun)) { /* SUBR ? */
    return_Values funcall_subr(fun,args_on_stack);
  } else if (closurep(fun)) { /* Closure ? */
    return_Values funcall_closure(fun,args_on_stack);
  } else if (symbolp(fun)) { /* Symbol ? */
    /* apply Symbol: global Definition Symbol_function(fun) applies. */
    var object fdef = Symbol_function(fun);
    if (subrp(fdef)) { /* SUBR -> apply */
      return_Values funcall_subr(fdef,args_on_stack);
    } else if (closurep(fdef)) { /* Closure -> apply */
      return_Values funcall_closure(fdef,args_on_stack);
    } else if (orecordp(fdef)) {
     #ifdef DYNAMIC_FFI
      if (ffunctionp(fdef)) { /* Foreign-Function ? */
        fun = fdef; goto call_ffunction;
      }
     #endif
      switch (Record_type(fdef)) {
        case Rectype_Fsubr: { error_specialform(S(funcall),fun); }
        case Rectype_Macro: { error_macro(S(funcall),fun); }
        default: NOTREACHED;
      }
    } else
      /* if no SUBR, no Closure, no FSUBR, no Macro:
         Symbol_function(fun) must be #<UNBOUND> . */
      goto undef;
  } else if (funnamep(fun)) { /* list (SETF symbol) ? */
    /* global definition (symbol-function (get-setf-symbol symbol)) applies. */
    var object symbol = get(Car(Cdr(fun)),S(setf_function)); /* (get ... 'SYS::SETF-FUNCTION) */
    if (!symbolp(symbol)) /* should be (uninterned) symbol */
      goto undef; /* else undefined */
    var object fdef = Symbol_function(symbol);
    if (closurep(fdef)) { /* Closure -> apply */
      return_Values funcall_closure(fdef,args_on_stack);
    } else if (subrp(fdef)) { /* SUBR -> apply */
      return_Values funcall_subr(fdef,args_on_stack);
    }
   #ifdef DYNAMIC_FFI
    else if (ffunctionp(fdef)) { /* Foreign-Function ? */
      fun = fdef; goto call_ffunction;
    }
   #endif
    else
      /* Such function-names cannot denote FSUBRs or Macros.
         fdef is presumable #<UNBOUND> . */
      goto undef;
  }
 #ifdef DYNAMIC_FFI
  else if (ffunctionp(fun)) /* Foreign-Function ? */
  call_ffunction: { /* call (SYS::FOREIGN-CALL-OUT foreign-function . args) */
    /* First shift down the arguments in Stack by 1. */
    var uintC count;
    var gcv_object_t* ptr = &STACK_0;
    dotimesC(count,args_on_stack, {
      *(ptr STACKop -1) = *ptr; ptr skipSTACKop 1;
    });
    *(ptr STACKop -1) = fun;
    skipSTACK(-1);
    return_Values funcall_subr(L(foreign_call_out),args_on_stack+1);
  }
 #endif
  else if (consp(fun) && eq(Car(fun),S(lambda))) /* Cons (LAMBDA ...) ? */
    error_lambda_expression(S(funcall),fun);
  else {
    fun = check_funname_replacement(type_error,S(funcall),fun);
    goto funcall_restart;
  }
  return;
 undef:
  fun = check_fdefinition(fun,S(funcall));
  goto funcall_restart;
}

/* In FUNCALL: Applies a SUBR to arguments, cleans up STACK
 and returns the values.
 funcall_subr(fun,args_on_stack);
 > fun: function, a SUBR
 > Arguments: args_on_stack arguments on STACK
 < STACK: cleaned up (i.e. STACK is increased by args_on_stack)
 < mv_count/mv_space: values
 changes STACK, can trigger GC */
local maygc Values funcall_subr (object fun, uintC args_on_stack)
{
  #if STACKCHECKS
  var gcv_object_t* args_pointer = args_end_pointer STACKop args_on_stack; /* Pointer to the arguments */
  #endif
  var gcv_object_t* key_args_pointer; /* Pointer to the Keyword-arguments */
  var gcv_object_t* rest_args_pointer; /* Pointer to the remaining arguments */
  var uintL argcount;           /* number of remaining arguments */
  TRACE_CALL(fun,'F','S');
  /* store arguments in STACK:
   First a Dispatch for the most important cases: */
  switch (TheSubr(fun)->argtype) {
    case (uintW)subr_argtype_0_0: /* SUBR without Arguments */
      if (!(args_on_stack==0)) goto error_toomany;
      goto apply_subr_norest;
    case (uintW)subr_argtype_1_0: /* SUBR with 1 required argument */
      if (!(args_on_stack==1)) goto error_count;
      goto apply_subr_norest;
    case (uintW)subr_argtype_2_0: /* SUBR with 2 required arguments */
      if (!(args_on_stack==2)) goto error_count;
      goto apply_subr_norest;
    case (uintW)subr_argtype_3_0: /* SUBR with 3 required arguments */
      if (!(args_on_stack==3)) goto error_count;
      goto apply_subr_norest;
    case (uintW)subr_argtype_4_0: /* SUBR with 4 required arguments */
      if (!(args_on_stack==4)) goto error_count;
      goto apply_subr_norest;
    case (uintW)subr_argtype_5_0: /* SUBR with 5 required arguments */
      if (!(args_on_stack==5)) goto error_count;
      goto apply_subr_norest;
    case (uintW)subr_argtype_6_0: /* SUBR with 6 required arguments */
      if (!(args_on_stack==6)) goto error_count;
      goto apply_subr_norest;
    case (uintW)subr_argtype_0_1: /* SUBR with 1 optional argument */
      if (args_on_stack==1) goto apply_subr_norest;
      else if (args_on_stack>1) goto error_toomany;
      else { pushSTACK(unbound); goto apply_subr_norest; }
    case (uintW)subr_argtype_1_1: /* SUBR with 1 required and 1 optional */
      if (args_on_stack==2) goto apply_subr_norest;
      else if (args_on_stack>2) goto error_toomany;
      else if (args_on_stack==0) goto error_toofew;
      else { pushSTACK(unbound); goto apply_subr_norest; }
    case (uintW)subr_argtype_2_1: /* SUBR with 2 required and 1 optional */
      if (args_on_stack==3) goto apply_subr_norest;
      else if (args_on_stack>3) goto error_toomany;
      else if (args_on_stack<2) goto error_toofew;
      else { pushSTACK(unbound); goto apply_subr_norest; }
    case (uintW)subr_argtype_3_1: /* SUBR with 3 required and 1 optional */
      if (args_on_stack==4) goto apply_subr_norest;
      else if (args_on_stack>4) goto error_toomany;
      else if (args_on_stack<3) goto error_toofew;
      else { pushSTACK(unbound); goto apply_subr_norest; }
    case (uintW)subr_argtype_4_1: /* SUBR with 4 required and 1 optional */
      if (args_on_stack==5) goto apply_subr_norest;
      else if (args_on_stack>5) goto error_toomany;
      else if (args_on_stack<4) goto error_toofew;
      else { pushSTACK(unbound); goto apply_subr_norest; }
    case (uintW)subr_argtype_0_2: /* SUBR with 2 optional arguments */
      switch (args_on_stack) {
        case 0: { pushSTACK(unbound); }
        case 1: { pushSTACK(unbound); }
        case 2: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_1_2: /* SUBR with 1 required and 2 optional */
      switch (args_on_stack) {
        case 0: goto error_toofew;
        case 1: { pushSTACK(unbound); }
        case 2: { pushSTACK(unbound); }
        case 3: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_2_2: /* SUBR with 2 required and 2 optional */
      switch (args_on_stack) {
        case 0: goto error_toofew;
        case 1: goto error_toofew;
        case 2: { pushSTACK(unbound); }
        case 3: { pushSTACK(unbound); }
        case 4: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_3_2: /* SUBR with 3 required and 2 optional */
      switch (args_on_stack) {
        case 0: goto error_toofew;
        case 1: goto error_toofew;
        case 2: goto error_toofew;
        case 3: { pushSTACK(unbound); }
        case 4: { pushSTACK(unbound); }
        case 5: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_0_3: /* SUBR with 3 optional arguments */
      switch (args_on_stack) {
        case 0: { pushSTACK(unbound); }
        case 1: { pushSTACK(unbound); }
        case 2: { pushSTACK(unbound); }
        case 3: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_1_3: /* SUBR with 1 required and 3 optional */
      switch (args_on_stack) {
        case 0: goto error_toofew;
        case 1: { pushSTACK(unbound); }
        case 2: { pushSTACK(unbound); }
        case 3: { pushSTACK(unbound); }
        case 4: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_2_3: /* SUBR with 2 required and 3 optional */
      switch (args_on_stack) {
        case 0: goto error_toofew;
        case 1: goto error_toofew;
        case 2: { pushSTACK(unbound); }
        case 3: { pushSTACK(unbound); }
        case 4: { pushSTACK(unbound); }
        case 5: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_0_4: /* SUBR with 4 optional arguments */
      switch (args_on_stack) {
        case 0: { pushSTACK(unbound); }
        case 1: { pushSTACK(unbound); }
        case 2: { pushSTACK(unbound); }
        case 3: { pushSTACK(unbound); }
        case 4: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_0_5: /* SUBR with 5 optional arguments */
      switch (args_on_stack) {
        case 0: { pushSTACK(unbound); }
        case 1: { pushSTACK(unbound); }
        case 2: { pushSTACK(unbound); }
        case 3: { pushSTACK(unbound); }
        case 4: { pushSTACK(unbound); }
        case 5: goto apply_subr_norest;
        default: goto error_toomany;
      }
    case (uintW)subr_argtype_0_0_rest: /* SUBR with &rest arguments */
      goto apply_subr_rest_ok;
    case (uintW)subr_argtype_1_0_rest: /* SUBR with 1 required and &rest */
      if (args_on_stack==0) goto error_toofew;
      args_on_stack -= 1;
      goto apply_subr_rest_ok;
    case (uintW)subr_argtype_2_0_rest: /* SUBR with 2 requireden and &rest */
      if (args_on_stack<2) goto error_toofew;
      args_on_stack -= 2;
      goto apply_subr_rest_ok;
    case (uintW)subr_argtype_3_0_rest: /* SUBR with 3 requireden and &rest */
      if (args_on_stack<3) goto error_toofew;
      args_on_stack -= 3;
      goto apply_subr_rest_ok;
    case (uintW)subr_argtype_0_0_key: /* SUBR with &key */
      if (args_on_stack==0) goto unbound_optional_key_0;
      else goto apply_subr_key;
    case (uintW)subr_argtype_1_0_key: /* SUBR with 1 required and &key */
      if (args_on_stack==1) goto unbound_optional_key_0;
      else if (args_on_stack<1) goto error_toofew;
      else { args_on_stack -= 1; goto apply_subr_key; }
    case (uintW)subr_argtype_2_0_key: /* SUBR with 2 required and &key */
      if (args_on_stack==2) goto unbound_optional_key_0;
      else if (args_on_stack<2) goto error_toofew;
      else { args_on_stack -= 2; goto apply_subr_key; }
    case (uintW)subr_argtype_3_0_key: /* SUBR with 3 required and &key */
      if (args_on_stack==3) goto unbound_optional_key_0;
      else if (args_on_stack<3) goto error_toofew;
      else { args_on_stack -= 3; goto apply_subr_key; }
    case (uintW)subr_argtype_4_0_key: /* SUBR with 4 required and &key */
      if (args_on_stack==4) goto unbound_optional_key_0;
      else if (args_on_stack<4) goto error_toofew;
      else { args_on_stack -= 4; goto apply_subr_key; }
    case (uintW)subr_argtype_0_1_key: /* SUBR with 1 optional and &key */
      switch (args_on_stack) {
        case 0: goto unbound_optional_key_1;
        case 1: goto unbound_optional_key_0;
        default: args_on_stack -= 1; goto apply_subr_key;
      }
    case (uintW)subr_argtype_1_1_key:
      /* SUBR with 1 required argument, 1 optional argument and &key */
      switch (args_on_stack) {
        case 0: goto error_toofew;
        case 1: goto unbound_optional_key_1;
        case 2: goto unbound_optional_key_0;
        default: args_on_stack -= 2; goto apply_subr_key;
      }
    case (uintW)subr_argtype_1_2_key:
      /* SUBR with 1 required argument, 2 optional arguments and &key */
      switch (args_on_stack) {
        case 0: goto error_toofew;
        case 1: goto unbound_optional_key_2;
        case 2: goto unbound_optional_key_1;
        case 3: goto unbound_optional_key_0;
        default: args_on_stack -= 3; goto apply_subr_key;
      }
    unbound_optional_key_2: /* Still 2 optional Arguments, but args_on_stack=0 */
      { pushSTACK(unbound); }
    unbound_optional_key_1: /* Still 1 optional Argument, but args_on_stack=0 */
      { pushSTACK(unbound); }
    unbound_optional_key_0: /* Before the Keywords is args_on_stack=0 */
      {
        var uintC count;
        dotimesC(count,TheSubr(fun)->key_count, { pushSTACK(unbound); } );
      }
      goto apply_subr_norest;
    default: NOTREACHED;
    #undef OPT_ARG
    #undef REQ_ARG
  }
  /* Now the general Version: */
  {
    var uintC key_count;
    {
      var uintC req_count = TheSubr(fun)->req_count;
      var uintC opt_count = TheSubr(fun)->opt_count;
      key_count = TheSubr(fun)->key_count;
      if (args_on_stack < req_count)
        /* fewer Arguments than demanded */
        goto error_toofew;
      args_on_stack -= req_count; /* remaining number */
      if (args_on_stack <= opt_count) {
        /* Arguments in Stack don't last for the optional ones */
        opt_count = opt_count - args_on_stack; /* as many as these must go on STACK */
        if (opt_count + key_count > 0) {
          /* reserve space on STACK: */
          get_space_on_STACK(sizeof(gcv_object_t) * (uintL)(opt_count + key_count));
          /* All further count optional parameters receive the "value"
           #<UNBOUND>, including the Keyword-parameters: */
          var uintC count;
          dotimespC(count,opt_count + key_count, { pushSTACK(unbound); } );
        }
        if (TheSubr(fun)->rest_flag == subr_rest) { /* &REST-Flag? */
          /* yes -> 0 additional Arguments: */
          argcount = 0; rest_args_pointer = args_end_pointer;
          goto apply_subr_rest;
        } else {
          /* no -> nothing to do */
          goto apply_subr_norest;
        }
      }
      args_on_stack -= opt_count; /* remaining number (> 0) */
      if (TheSubr(fun)->key_flag == subr_nokey) {
        /* SUBR without KEY */
        if (TheSubr(fun)->rest_flag == subr_norest)
          /* SUBR without REST or KEY */
          goto error_toomany;   /* still Arguments! */
        else
          /* SUBR with only REST, without KEY */
          goto apply_subr_rest_ok;
      } else
        /* SUBR with Keywords. */
        goto apply_subr_key_;
    }
   apply_subr_key:
    key_count = TheSubr(fun)->key_count;
   apply_subr_key_:
    /* shift down remaining arguments in STACK and thus
     create room for the Keyword-parameters: */
    argcount = args_on_stack;                 /* (> 0) */
    get_space_on_STACK(sizeof(gcv_object_t) * (uintL)key_count);
    {
      var gcv_object_t* new_args_end_pointer = args_end_pointer STACKop -(uintP)key_count;
      var gcv_object_t* ptr1 = args_end_pointer;
      var gcv_object_t* ptr2 = new_args_end_pointer;
      var uintC count;
      dotimespC(count,args_on_stack, { BEFORE(ptr2) = BEFORE(ptr1); } );
      key_args_pointer = ptr1;
      rest_args_pointer = ptr2;
      dotimesC(count,key_count, { NEXT(ptr1) = unbound; } );
      set_args_end_pointer(new_args_end_pointer);
    }
    /* assign Keywords and poss. discard remaining Arguments: */
    match_subr_key(fun,argcount,key_args_pointer,rest_args_pointer);
    if (TheSubr(fun)->rest_flag != subr_norest)
      /* SUBR with &REST-Flag: */
      goto apply_subr_rest;
    else
      /* SUBR without &REST-Flag: */
      goto apply_subr_norest;
  }
 apply_subr_rest_ok:
  argcount = args_on_stack;
  rest_args_pointer = args_end_pointer STACKop argcount;
 apply_subr_rest:
  with_saved_back_trace_subr(fun,STACK,
                             TheSubr(fun)->req_count + TheSubr(fun)->opt_count + argcount,
    (*(subr_rest_function_t*)(TheSubr(fun)->function))(argcount,rest_args_pointer); );
  goto done;
 apply_subr_norest:
  with_saved_back_trace_subr(fun,STACK,args_on_stack,
    (*(subr_norest_function_t*)(TheSubr(fun)->function))(); );
 done:
  CHECK_STACK_S(args_end_pointer,fun);
  return;                       /* finished */
  /* Gathered error-messages: */
 error_count:
  if (args_on_stack < TheSubr(fun)->req_count)
    goto error_toofew;          /* too few Arguments */
  else
    goto error_toomany;         /* too many Arguments */
 error_toofew: { error_subr_toofew(fun,NIL); }
 error_toomany: { error_subr_toomany(fun); }
}

/* In FUNCALL: Applies a Closure to Arguments, cleans up STACK
 and returns the values.
 funcall_closure(fun,args_on_stack);
 > fun: function, a Closure
 > Argumente: args_on_stack Arguments on STACK
 < STACK: cleaned up (i.e. STACK is increased by args_on_stack)
 < mv_count/mv_space: values
 changes STACK, can trigger GC */
local maygc Values funcall_closure (object closure, uintC args_on_stack)
{
  TRACE_CALL(closure,'F','C');
  if (simple_bit_vector_p(Atype_8Bit,TheClosure(closure)->clos_codevec)) {
    /* closure is a compiled Closure */
    #if STACKCHECKC
    var gcv_object_t* args_pointer = args_end_pointer STACKop args_on_stack; /* Pointer to the Arguments */
    #endif
    var object codevec = TheCclosure(closure)->clos_codevec; /* Code-Vector */
    var gcv_object_t* key_args_pointer; /* Pointer to the &key */
    var gcv_object_t* rest_args_pointer; /* Pointer to the remaining Arguments */
    var uintL argcount;         /* number of remaining Arguments */
    check_SP(); check_STACK();
    /* store arguments in STACK:
     First a Dispatch for the most important cases: */
    switch (TheCodevec(codevec)->ccv_signature) {
      case (uintB)cclos_argtype_0_0: /* no Arguments */
        if (!(args_on_stack==0)) goto error_toomany;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_1_0: /* 1 required argument */
        if (!(args_on_stack==1)) goto error_count;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_2_0: /* 2 required arguments */
        if (!(args_on_stack==2)) goto error_count;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_3_0: /* 3 required arguments */
        if (!(args_on_stack==3)) goto error_count;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_4_0: /* 4 required arguments */
        if (!(args_on_stack==4)) goto error_count;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_5_0: /* 5 required arguments */
        if (!(args_on_stack==5)) goto error_count;
        goto apply_cclosure_nokey;
      case (uintB)cclos_argtype_0_1: /* 1 optional argument */
        if (args_on_stack==1) goto apply_cclosure_nokey;
        else if (args_on_stack>1) goto error_toomany;
        else { pushSTACK(unbound); goto apply_cclosure_nokey; }
      case (uintB)cclos_argtype_1_1: /* 1 required and 1 optional */
        if (args_on_stack==2) goto apply_cclosure_nokey;
        else if (args_on_stack>2) goto error_toomany;
        else if (args_on_stack==0) goto error_toofew;
        else { pushSTACK(unbound); goto apply_cclosure_nokey; }
      case (uintB)cclos_argtype_2_1: /* 2 required and 1 optional */
        if (args_on_stack==3) goto apply_cclosure_nokey;
        else if (args_on_stack>3) goto error_toomany;
        else if (args_on_stack<2) goto error_toofew;
        else { pushSTACK(unbound); goto apply_cclosure_nokey; }
      case (uintB)cclos_argtype_3_1: /* 3 required and 1 optional */
        if (args_on_stack==4) goto apply_cclosure_nokey;
        else if (args_on_stack>4) goto error_toomany;
        else if (args_on_stack<3) goto error_toofew;
        else { pushSTACK(unbound); goto apply_cclosure_nokey; }
      case (uintB)cclos_argtype_4_1: /* 4 required and 1 optional */
        if (args_on_stack==5) goto apply_cclosure_nokey;
        else if (args_on_stack>5) goto error_toomany;
        else if (args_on_stack<4) goto error_toofew;
        else { pushSTACK(unbound); goto apply_cclosure_nokey; }
      case (uintB)cclos_argtype_0_2: /* 2 optional arguments */
        switch (args_on_stack) {
          case 0: { pushSTACK(unbound); }
          case 1: { pushSTACK(unbound); }
          case 2: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_1_2: /* 1 required and 2 optional */
        switch (args_on_stack) {
          case 0: goto error_toofew;
          case 1: { pushSTACK(unbound); }
          case 2: { pushSTACK(unbound); }
          case 3: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_2_2: /* 2 required and 2 optional */
        switch (args_on_stack) {
          case 0: case 1: goto error_toofew;
          case 2: { pushSTACK(unbound); }
          case 3: { pushSTACK(unbound); }
          case 4: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_3_2: /* 3 required and 2 optional */
        switch (args_on_stack) {
          case 0: case 1: case 2: goto error_toofew;
          case 3: { pushSTACK(unbound); }
          case 4: { pushSTACK(unbound); }
          case 5: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_0_3: /* 3 optional arguments */
        switch (args_on_stack) {
          case 0: { pushSTACK(unbound); }
          case 1: { pushSTACK(unbound); }
          case 2: { pushSTACK(unbound); }
          case 3: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_1_3: /* 1 required and 3 optional */
        switch (args_on_stack) {
          case 0: goto error_toofew;
          case 1: { pushSTACK(unbound); }
          case 2: { pushSTACK(unbound); }
          case 3: { pushSTACK(unbound); }
          case 4: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_2_3: /* 2 required and 3 optional */
        switch (args_on_stack) {
          case 0: case 1: goto error_toofew;
          case 2: { pushSTACK(unbound); }
          case 3: { pushSTACK(unbound); }
          case 4: { pushSTACK(unbound); }
          case 5: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_0_4: /* 4 optional arguments */
        switch (args_on_stack) {
          case 0: { pushSTACK(unbound); }
          case 1: { pushSTACK(unbound); }
          case 2: { pushSTACK(unbound); }
          case 3: { pushSTACK(unbound); }
          case 4: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_1_4: /* 1 required and 4 optional */
        switch (args_on_stack) {
          case 0: goto error_toofew;
          case 1: { pushSTACK(unbound); }
          case 2: { pushSTACK(unbound); }
          case 3: { pushSTACK(unbound); }
          case 4: { pushSTACK(unbound); }
          case 5: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_0_5: /* 5 optional arguments */
        switch (args_on_stack) {
          case 0: { pushSTACK(unbound); }
          case 1: { pushSTACK(unbound); }
          case 2: { pushSTACK(unbound); }
          case 3: { pushSTACK(unbound); }
          case 4: { pushSTACK(unbound); }
          case 5: goto apply_cclosure_nokey;
          default: goto error_toomany;
        }
      case (uintB)cclos_argtype_0_0_rest: /* no Arguments, &rest */
        goto apply_cclosure_rest_nokey;
      case (uintB)cclos_argtype_1_0_rest: /* 1 required + &rest */
        if (args_on_stack==0) goto error_toofew;
        args_on_stack -= 1;
        goto apply_cclosure_rest_nokey;
      case (uintB)cclos_argtype_2_0_rest: /* 2 required + &rest */
        if (args_on_stack<2) goto error_toofew;
        args_on_stack -= 2;
        goto apply_cclosure_rest_nokey;
      case (uintB)cclos_argtype_3_0_rest: /* 3 required + &rest */
        if (args_on_stack<3) goto error_toofew;
        args_on_stack -= 3;
        goto apply_cclosure_rest_nokey;
      case (uintB)cclos_argtype_4_0_rest: /* 4 required + &rest */
        if (args_on_stack<4) goto error_toofew;
        args_on_stack -= 4;
        goto apply_cclosure_rest_nokey;
      case (uintB)cclos_argtype_0_0_key: /* only &key */
        if (args_on_stack==0) goto unbound_optional_key_0;
        else goto apply_cclosure_key_withargs;
      case (uintB)cclos_argtype_1_0_key: /* 1 required argument, &key */
        if (args_on_stack==1) goto unbound_optional_key_0;
        else if (args_on_stack<1) goto error_toofew;
        else { args_on_stack -= 1; goto apply_cclosure_key_withargs; }
      case (uintB)cclos_argtype_2_0_key: /* 2 required arguments, &key */
        if (args_on_stack==2) goto unbound_optional_key_0;
        else if (args_on_stack<2) goto error_toofew;
        else { args_on_stack -= 2; goto apply_cclosure_key_withargs; }
      case (uintB)cclos_argtype_3_0_key: /* 3 required arguments, &key */
        if (args_on_stack==3) goto unbound_optional_key_0;
        else if (args_on_stack<3) goto error_toofew;
        else { args_on_stack -= 3; goto apply_cclosure_key_withargs; }
      case (uintB)cclos_argtype_4_0_key: /* 4 required arguments, &key */
        if (args_on_stack==4) goto unbound_optional_key_0;
        else if (args_on_stack<4) goto error_toofew;
        else { args_on_stack -= 4; goto apply_cclosure_key_withargs; }
      case (uintB)cclos_argtype_0_1_key: /* 1 optional argument, &key */
        switch (args_on_stack) {
          case 0: goto unbound_optional_key_1;
          case 1: goto unbound_optional_key_0;
          default: args_on_stack -= 1; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_1_1_key:
        /* 1 required argument and 1 optional argument, &key */
        switch (args_on_stack) {
          case 0: goto error_toofew;
          case 1: goto unbound_optional_key_1;
          case 2: goto unbound_optional_key_0;
          default: args_on_stack -= 2; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_2_1_key:
        /* 2 required arguments and 1 optional argument, &key */
        switch (args_on_stack) {
          case 0: case 1: goto error_toofew;
          case 2: goto unbound_optional_key_1;
          case 3: goto unbound_optional_key_0;
          default: args_on_stack -= 3; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_3_1_key:
        /* 3 required arguments and 1 optional argument, &key */
        switch (args_on_stack) {
          case 0: case 1: case 2: goto error_toofew;
          case 3: goto unbound_optional_key_1;
          case 4: goto unbound_optional_key_0;
          default: args_on_stack -= 4; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_0_2_key: /* 2 optional arguments, &key */
        switch (args_on_stack) {
          case 0: goto unbound_optional_key_2;
          case 1: goto unbound_optional_key_1;
          case 2: goto unbound_optional_key_0;
          default: args_on_stack -= 2; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_1_2_key:
        /* 1 required argument and 2 optional arguments, &key */
        switch (args_on_stack) {
          case 0: goto error_toofew;
          case 1: goto unbound_optional_key_2;
          case 2: goto unbound_optional_key_1;
          case 3: goto unbound_optional_key_0;
          default: args_on_stack -= 3; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_2_2_key:
        /* 2 required arguments and 2 optional arguments, &key */
        switch (args_on_stack) {
          case 0: case 1: goto error_toofew;
          case 2: goto unbound_optional_key_2;
          case 3: goto unbound_optional_key_1;
          case 4: goto unbound_optional_key_0;
          default: args_on_stack -= 4; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_0_3_key: /* 3 optional arguments, &key */
        switch (args_on_stack) {
          case 0: goto unbound_optional_key_3;
          case 1: goto unbound_optional_key_2;
          case 2: goto unbound_optional_key_1;
          case 3: goto unbound_optional_key_0;
          default: args_on_stack -= 3; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_1_3_key:
        /* 1 required argument and 3 optional arguments, &key */
        switch (args_on_stack) {
          case 0: goto error_toofew;
          case 1: goto unbound_optional_key_3;
          case 2: goto unbound_optional_key_2;
          case 3: goto unbound_optional_key_1;
          case 4: goto unbound_optional_key_0;
          default: args_on_stack -= 4; goto apply_cclosure_key_withargs;
        }
      case (uintB)cclos_argtype_0_4_key: /* 4 optional arguments, &key */
        switch (args_on_stack) {
          case 0: goto unbound_optional_key_4;
          case 1: goto unbound_optional_key_3;
          case 2: goto unbound_optional_key_2;
          case 3: goto unbound_optional_key_1;
          case 4: goto unbound_optional_key_0;
          default: args_on_stack -= 4; goto apply_cclosure_key_withargs;
        }
      unbound_optional_key_4: /* Still 4 optionals, but args_on_stack=0 */
        { pushSTACK(unbound); }
      unbound_optional_key_3: /* Still 3 optionals, but args_on_stack=0 */
        { pushSTACK(unbound); }
      unbound_optional_key_2: /* Still 2 optionals, but args_on_stack=0 */
        { pushSTACK(unbound); }
      unbound_optional_key_1: /* Still 1 optional, but args_on_stack=0 */
        { pushSTACK(unbound); }
      unbound_optional_key_0: /* Before the Keywords is args_on_stack=0 */
        goto apply_cclosure_key_noargs;
      case (uintB)cclos_argtype_default:
        /* General Version */
        break;
      default: NOTREACHED;
    }
    /* Now the general version: */
    {
      var uintB flags;
      {
        var uintC req_count = TheCodevec(codevec)->ccv_numreq; /* number of required Parameters */
        var uintC opt_count = TheCodevec(codevec)->ccv_numopt; /* number of optional Parameters */
        flags = TheCodevec(codevec)->ccv_flags; /* Flags */
        if (args_on_stack < req_count)
          /* fewer Arguments than demanded */
          goto error_toofew;
        args_on_stack -= req_count; /* remaining number */
        if (args_on_stack <= opt_count) {
          /* Arguments in Stack don't last for the optional ones */
          opt_count = opt_count - args_on_stack; /* as many as these must go on STACK */
          if (opt_count > 0) {
            /* reserve space on STACK: */
            get_space_on_STACK(sizeof(gcv_object_t) * (uintL)opt_count);
            /* All further count optional parameters receive the "value"
             #<UNBOUND>, the &REST-parameter receives NIL,
             the Keyword-parameters receive the value #<UNBOUND> : */
            var uintC count;
            dotimespC(count,opt_count, { pushSTACK(unbound); } );
          }
          if (flags & bit(0))   /* &REST-Flag? */
            pushSTACK(NIL);     /* yes -> initialize with NIL */
          if (flags & bit(7))   /* &KEY-Flag? */
            goto apply_cclosure_key_noargs;
          else
            goto apply_cclosure_nokey;
        }
        args_on_stack -= opt_count; /* remaining number */
        if (flags & bit(7))         /* Key-Flag? */
          goto apply_cclosure_key_withargs_;
        else if (flags & bit(0))
          goto apply_cclosure_rest_nokey;
        else {
          /* Closure without REST or KEY */
          if (args_on_stack>0)  /* still arguments? */
            goto error_toomany;
          goto apply_cclosure_nokey;
        }
      }
     apply_cclosure_key_noargs:
      {
        var uintC key_count = TheCodevec(codevec)->ccv_numkey; /* number of Keyword-Parameters */
        if (key_count > 0) {
          get_space_on_STACK(sizeof(gcv_object_t) * (uintL)key_count);
          var uintC count;
          dotimespC(count,key_count, { pushSTACK(unbound); } ); /* initialize with #<UNBOUND> */
        }
        goto apply_cclosure_key;
      }
     apply_cclosure_key_withargs:
      flags = TheCodevec(codevec)->ccv_flags; /* initialize Flags! */
     apply_cclosure_key_withargs_:
      /* Closure with Keywords */
      {
        var uintC key_count = TheCodevec(codevec)->ccv_numkey; /* number of Keyword-Parameters */
        /* shift down remaining arguments in STACK and thus
         create room for the Keyword-parameters
         (and poss. Rest-parameters): */
        var uintL shift = key_count;
        if (flags & bit(0))
          shift++;              /* poss. 1 more for Rest-Parameter */
        argcount = args_on_stack;
        get_space_on_STACK(sizeof(gcv_object_t) * shift);
        var gcv_object_t* new_args_end_pointer = args_end_pointer STACKop -(uintP)shift;
        var gcv_object_t* ptr1 = args_end_pointer;
        var gcv_object_t* ptr2 = new_args_end_pointer;
        var uintC count;
        dotimesC(count,args_on_stack, { BEFORE(ptr2) = BEFORE(ptr1); } );
        if (flags & bit(0))
          NEXT(ptr1) = unbound; /* Rest-Parameter */
        key_args_pointer = ptr1;
        rest_args_pointer = ptr2;
        dotimesC(count,key_count, { NEXT(ptr1) = unbound; } );
        set_args_end_pointer(new_args_end_pointer);
      }
      /* assign Keywords, build Rest-Parameter
       and poss. discard remaining arguments: */
      closure = match_cclosure_key(closure,argcount,key_args_pointer,rest_args_pointer);
      codevec = TheCclosure(closure)->clos_codevec;
     apply_cclosure_key:
      interpret_bytecode(closure,codevec,CCV_START_KEY); /* process Bytecode starting at Byte 12 */
      goto done;
    }
   apply_cclosure_rest_nokey:
    /* Closure with only REST, without KEY:
     still must cons args_on_stack arguments from stack Stack: */
    { pushSTACK(NIL); }
    if (args_on_stack > 0) {
      pushSTACK(closure);       /* Closure must be saved */
      dotimesC(args_on_stack,args_on_stack, {
        var object new_cons = allocate_cons();
        Cdr(new_cons) = STACK_1;
        Car(new_cons) = STACK_2; /* cons next argument to it */
        STACK_2 = new_cons;
        STACK_1 = STACK_0; skipSTACK(1);
      });
      closure = popSTACK(); codevec = TheCclosure(closure)->clos_codevec;
    }
   apply_cclosure_nokey:        /* jump to Closure without &KEY: */
    interpret_bytecode(closure,codevec,CCV_START_NONKEY); /* process Bytecode starting at Byte 8 */
   done:
    CHECK_STACK_C(args_end_pointer,closure);
    return;                     /* finished */
   error_count:               /* collected error-messages: */
    if (args_on_stack < TheCodevec(codevec)->ccv_numreq)
      goto error_toofew;      /* too few arguments */
    else
      goto error_toomany;     /* too many arguments */
   error_toofew: { error_closure_toofew(closure,NIL); }
   error_toomany: { error_closure_toomany(closure); }
  } else {
    /* closure is an interpreted Closure */
    var gcv_object_t* args_pointer = args_end_pointer STACKop args_on_stack;
    with_saved_back_trace_iclosure(closure,args_pointer,args_on_stack,
      funcall_iclosure(closure,args_pointer,args_on_stack); );
  }
}


/* ---------------------- BYTECODE-INTERPRETER ---------------------- */

/* Interpretes the bytecode of a compiled Closure.
 interpret_bytecode_(closure,codeptr,byteptr);
 > closure: compiled closure
 > codeptr: its Codevector, a Simple-Bit-Vector, pointable
 > byteptr: Start-Bytecodepointer
 < mv_count/mv_space: values
 changes STACK, can trigger GC
   Syntax of local labels in GNU-C assembler-statements: */
#if (defined(GNU) || defined(INTEL)) && !defined(NO_ASM)
  /* LD(x) defines Label with number x
   LR(x,f) references label with number x forwards
   LR(x,b) references label with number x backwards
   The scope of the labels is only one assembler-statement. */
  #if defined(I80386) && !defined(UNIX_NEXTSTEP)
    #ifdef ASM_UNDERSCORE
      #define LD(nr)  "LASM%=X" STRING(nr)
      #define LR(nr,fb)  "LASM%=X" STRING(nr)
    #else
      #define LD(nr)  ".LASM%=X" STRING(nr)
      #define LR(nr,fb)  ".LASM%=X" STRING(nr)
    #endif
  #elif defined(ARM)
    #define LD(nr)  "LASM%=X" STRING(nr)
    #define LR(nr,fb)  "LASM%=X" STRING(nr)
  #else
    #define LD(nr)  STRING(nr)
    #define LR(nr,fb)  STRING(nr) STRING(fb)
  #endif
#endif
/* Persuade GNU-C, to keep closure and byteptr in registers: */
#ifdef GNU
  #ifdef MC680X0
    #define closure_register  "a2"
    #define byteptr_register  "a3"
  #endif
  #ifdef SPARC
    #define closure_register  "%l0"
    #define byteptr_register  "%l1"
  #endif
  #ifdef I80386
    #if (__GNUC__ >= 2)         /* The register-names have changed */
      #define byteptr_register  "%edi"
    #else
      #define byteptr_register  "di"
    #endif
  #endif
  #ifdef ARM
    /* Code is better without defining registers for closure and byteptr,
     says Peter Burwood.
     not define closure_register  "%r6"
     not define byteptr_register  "%r7"
     We have assembler macros below, but if they are used with gcc-2.7.2.1,
     (setf cdddr) is miscompiled. So here we temporarily disable them. */
    #ifndef NO_ASM
      #define NO_ASM
    #endif
  #endif
  #ifdef DECALPHA
    #define byteptr_register  "$14"
  #endif
  #if defined(WIDE) && !defined(WIDE_HARD)
    /* An `object' does not fit into a single register, GCC is overcharged. */
    #undef closure_register
  #endif
#endif
#ifndef closure_register
  #define closure_in  closure
#endif
#ifndef byteptr_register
  #define byteptr_in  byteptr
#endif
#ifdef DEBUG_BYTECODE
  #define GOTO_ERROR(label)  \
    do {                                              \
      fprintf(stderr,"\n[%s:%d] ",__FILE__,__LINE__); \
      goto label;                                     \
    } while(0)
  #define DEBUG_CHECK_BYTEPTR(nb) do {                                \
    var const uintL b = nb - codeptr->data;                           \
    if ((b < byteptr_min) || (b > byteptr_max)) {                     \
      var uintL bp = byteptr - codeptr->data;                         \
      fprintf(stderr,"\n[%s:%d] ",__FILE__,__LINE__);                 \
      byteptr_bad_jump = b - bp;                                      \
      /*nobject_out(stderr,closure);*/                                \
      /*fprintf(stderr," jump by %d takes %d outside [%d;%d]",byteptr_bad_jump,bp,byteptr_min,byteptr_max);*/ \
      goto error_byteptr;                                            \
    }} while(0)
#else
  #define GOTO_ERROR(label)  goto label
  #define DEBUG_CHECK_BYTEPTR(b)     do{}while(0)
#endif
local /*maygc*/ Values interpret_bytecode_ (object closure_in, Sbvector codeptr,
                                            const uintB* byteptr_in)
{
  GCTRIGGER_IF(true, {
    if (*byteptr_in == cod_handler_begin_push)
      GCTRIGGER3(closure_in,handler_args.condition,handler_args.spdepth);
    else
      GCTRIGGER1(closure_in);
  });
 #if STACKCHECKC || defined(DEBUG_BYTECODE)
  var const uintL byteptr_min = ((Codevec)codeptr)->ccv_flags & bit(7)
    ? CCV_START_KEY : CCV_START_NONKEY;
 #endif
 #ifdef DEBUG_BYTECODE
  var const uintL byteptr_max = sbvector_length(codeptr)-1;
  var sintL byteptr_bad_jump;
 #endif
  /* situate argument closure in register: */
 #ifdef closure_register
  var object closure __asm__(closure_register);
  closure = closure_in;
 #endif
  /* situate argument byteptr in register: */
 #ifdef byteptr_register
  var register const uintB* byteptr __asm__(byteptr_register);
  byteptr = byteptr_in;
 #endif
  TRACE_CALL(closure,'B','C');
  /* situate closure in STACK, below the arguments: */
  var gcv_object_t* closureptr = (pushSTACK(closure), &STACK_0);
 #ifndef FAST_SP
  /* If there is no fast SP-Access, one has to introduce
   an extra pointer: */
  var uintL private_SP_length =
    (uintL)(((Codevec)codeptr)->ccv_spdepth_1)
    + jmpbufsize * (uintL)(((Codevec)codeptr)->ccv_spdepth_jmpbufsize);
  var DYNAMIC_ARRAY(private_SP_space,SPint,private_SP_length);
  var SPint* private_SP = &private_SP_space[private_SP_length];
  #undef SP_
  #undef _SP_
  #undef skipSP
  #undef pushSP
  #undef popSP
  #define SP_(n)  (private_SP[n])
  #define _SP_(n)  &SP_(n)
  #define skipSP(n)  (private_SP += (n))
  #define pushSP(item)  (*--private_SP = (item))
  #define popSP(item_assignment)  (item_assignment *private_SP++)
 #endif
  /* var JMPBUF_on_SP(name);  allocates a sp_jmp_buf in SP.
   FREE_JMPBUF_on_SP();  deallocates it.
   finish_entry_frame_1(frametype,returner,reentry_statement);  is like
   finish_entry_frame(frametype,returner,,reentry_statement);  but
   also private_SP is saved. */
 #ifndef FAST_SP
  #define JMPBUF_on_SP(name)  \
    sp_jmp_buf* name = (sp_jmp_buf*)(private_SP -= jmpbufsize);
  #define FREE_JMPBUF_on_SP()  \
    private_SP += jmpbufsize;
  #define finish_entry_frame_1(frametype,returner,reentry_statement)  \
    finish_entry_frame(frametype,*returner, /* On entry: returner = private_SP */ \
                       returner = (sp_jmp_buf*) , /* returner is set again on return */ \
        { private_SP = (SPint*)returner; reentry_statement }) /* and private_SP is reconstructed */
 #else
  #ifdef SP_DOWN
   #define JMPBUF_on_SP(name)  \
     sp_jmp_buf* name;                         \
    {var SPint* sp = (SPint*)SP();      \
     sp -= jmpbufsize;                  \
     setSP(sp);                         \
     name = (sp_jmp_buf*)&sp[SPoffset];}
  #endif
  #ifdef SP_UP
   #define JMPBUF_on_SP(name)  \
     sp_jmp_buf* name;                     \
    {var SPint* sp = (SPint*)SP();        \
     name = (sp_jmp_buf*)&sp[SPoffset+1]; \
     sp += jmpbufsize;                    \
     setSP(sp);}
  #endif
  #define FREE_JMPBUF_on_SP()                     \
    skipSP(jmpbufsize);
  #define finish_entry_frame_1(frametype,returner,reentry_statement)      \
    finish_entry_frame(frametype,*returner,,reentry_statement)
 #endif
 #ifdef FAST_DISPATCH
  static void* const cod_labels[] = {
   #define BYTECODE(code)  &&code,
     #include "bytecode.c"
   #undef BYTECODE
  };
 #endif
  /* next Byte to be interpreted
   > mv_count/mv_space: current values
   > closureptr: pointer to the compiled closure on Stack
   > closure: compiled closure
   > codeptr: its codevector, a Simple-Bit-Vektor, pointable
              (no LISP-object, but nevertheless endangered by GC!)
   > byteptr: pointer to the next byte in code
              (no LISP-object, but nevertheless endangered by GC!) */
 next_byte:
  /* definition by cases, according to byte to be interpreted byte */
 #ifndef FAST_DISPATCH
  switch (*byteptr++)
  #define CASE  case (uintB)
 #else  /* FAST_DISPATCH */
    /* This is faster by about 2%, because the index-check is dropped. */
  goto *cod_labels[*byteptr++];
  #define CASE
  #ifdef FAST_DISPATCH_THREADED
  /* The jump-statement  goto next_byte;  can be omitted: */
   #define next_byte  *cod_labels[*byteptr++]
  #endif
 #endif
  {
    /* Operand-Fetch:
       next Byte:
         Bit 7 = 0 --> Bits 6..0 are the Operand (7 Bits).
         Bit 7 = 1 --> Bits 6..0 and next Byte form the
                       Operand (15 Bits).
                       For jump-distances: Should this be =0, the next
                       4 Bytes form the Operand
                       (32 Bits).

       Macro B_operand(where);
       moves the next Operand (a Byte as Unsigned Integer)
       to (uintL)where and advances  bytecodepointer. */
      #define B_operand(where)  \
        { where = *byteptr++; }

    /* Macro U_operand(where);
     moves the next Operand (an Unsigned Integer)
     to (uintL)where or (uintC)where
     and advances the Bytecodepointer. */
      #define U_operand(where)  \
        { where = *byteptr++;           /* read first Byte */ \
          if ((uintB)where & bit(7))    /* Bit 7 set? */ \
            { where &= ~bit(7);         /* yes -> delete */ \
              where = where << 8;                            \
              where |= *byteptr++;          /* and read next Byte */ \
        }   }
    #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM)
      #undef U_operand
      #define U_operand(where)  \
        __asm__(                 \
          "moveq #0,%0"   "\n\t" \
          "moveb %1@+,%0" "\n\t" \
          "bpl 1f"        "\n\t" \
          "addb %0,%0"    "\n\t" \
          "lslw #7,%0"    "\n\t" \
          "moveb %1@+,%0" "\n"   \
          "1:"                   \
          : "=d" (where), "=a" (byteptr) : "1" (byteptr) )
    #endif
    #if defined(GNU) && defined(SPARC) && !defined(NO_ASM)
      #undef U_operand
      #define U_operand(where)  \
        { var uintL dummy;              \
          __asm__(                      \
            "ldub [%1],%0"       "\n\t" \
            "andcc %0,0x80,%%g0" "\n\t" \
            "be 1f"              "\n\t" \
            " add %1,1,%1"       "\n\t" \
            "sll %0,25,%2"       "\n\t" \
            "ldub [%1],%0"       "\n\t" \
            "srl %2,17,%2"       "\n\t" \
            "add %1,1,%1"        "\n\t" \
            "or %0,%2,%0"        "\n"   \
            "1:"                        \
            : "=r" (where), "=r" (byteptr), "=r" (dummy) : "1" (byteptr) : "ccr" ); \
        }
    #endif
    #if (defined(GNU) || defined(INTEL)) && defined(I80386) && !defined(NO_ASM)
      #if 0
        /* In earlier times, the GNU assembler assembled
         "testb %edx,%edx" as "testb %dl,%dl". This made possible to
         produce the output in any register. */
        #define OUT_EAX  "=q"
        #define EAX      "%0"
        #define AL       "%0"
      #else
        /* Now "testb %edx,%edx" is invalid everywhere. The macros must
         put their result in %eax. */
        #define OUT_EAX  "=a"
        #define EAX      "%%eax"
        #define AL       "%%al"
      #endif
      #undef U_operand
      #define U_operand(where)  \
        __asm__(                   \
          "movzbl (%1),"EAX "\n\t" \
          "incl %1"         "\n\t" \
          "testb "AL","AL   "\n\t" \
          "jge "LR(1,f)     "\n\t" \
          "andb $127,"AL    "\n\t" \
          "sall $8,"EAX     "\n\t" \
          "movb (%1),"AL    "\n\t" \
          "incl %1"         "\n"   \
          LD(1)":"                 \
          : OUT_EAX (where), "=r" (byteptr) : "1" (byteptr) );
    /* Caution: 1. The Sun Assembler doesn't know this Syntax for local labels.
                   That's why we generate our local labels ourselves.
       Caution: 2. ccr is changed. How is this to be declared?? */
    #endif
    #if defined(GNU) && defined(ARM) && !defined(NO_ASM)
      /* Macros written by Peter Burwood.
       Two versions. Which one to choose?
              instructions      short case        long case
       v1:          5           2 + 3 skipped     5
       v2:          5           3 + 2 skipped     4 + 1 skipped
       Let's choose the first one. 1-byte operands are most frequent. */
      #undef U_operand
      #define U_operand(where)               /* (v1) */ \
        { var uintL dummy;                 \
          __asm__(                         \
            "ldrb   %0,[%1],#1"     "\n\t" \
            "tst    %0,#0x80"       "\n\t" \
            "bicne  %0,%0,#0x80"    "\n\t" \
            "ldrneb %2,[%1],#1"     "\n\t" \
            "orrne  %0,%2,%0,LSL#8"        \
            : "=r" (where), "=r" (byteptr), "=r" (dummy) : "1" (byteptr) : "cc" ); \
        }
      #if 0
      #undef U_operand
      #define U_operand(where)               /* (v2) */ \
        { var uintL dummy;                 \
          __asm__(                         \
            "ldrb   %0,[%1],#1"     "\n\t" \
            "movs   %0,%0,LSL#25"   "\n\t" \
            "movcc  %0,%0,LSR#25"   "\n\t" \
            "ldrcsb %2,[%1],#1"     "\n\t" \
            "orrcs  %0,%2,%0,LSR#17"       \
            : "=r" (where), "=r" (byteptr), "=r" (dummy) : "1" (byteptr) : "cc" ); \
        }
      #endif
    #endif

    /* Macro S_operand(where);
     moves the next Operand (a Signed Integer)
     to (uintL)where and advances the bytecodepointer. */
      #define S_operand(where)                                          \
        { where = *byteptr++;                    /* read first byte */  \
          if ((uintB)where & bit(7))                                    \
            /* Bit 7 was set */                                         \
            { where = where << 8;                                       \
              where |= *byteptr++;             /* subjoin next Byte */  \
              /* Sign-Extend from 15 to 32 Bits: */                     \
              where = (sintL)((sintL)(sintWL)((sintWL)where << (intWLsize-15)) >> (intWLsize-15)); \
              if (where == 0)                                           \
                /* special case: 2-Byte-Operand = 0 -> 6-Byte-Operand */ \
                { where = (uintL)( ((uintWL)(byteptr[0]) << 8)          \
                                  | (uintWL)(byteptr[1])                \
                                 ) << 16                                \
                        | (uintL)( ((uintWL)(byteptr[2]) << 8)          \
                                  | (uintWL)(byteptr[3])                \
                                 );                                     \
                  byteptr += 4;                                         \
            }   }                                                       \
            else                                                        \
            /* Bit 7 was deleted */                                     \
            {                     /* Sign-Extend from 7 to 32 Bits: */  \
              where = (sintL)((sintL)(sintBWL)((sintBWL)where << (intBWLsize-7)) >> (intBWLsize-7)); \
            }                                                           \
        }
    #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM)
      #undef S_operand
      #define S_operand(where)  \
        __asm__(                   \
          "moveb %1@+,%0"   "\n\t" \
          "bpl 1f"          "\n\t" \
          "lslw #8,%0"      "\n\t" \
          "moveb %1@+,%0"   "\n\t" \
          "addw %0,%0"      "\n\t" \
          "asrw #1,%0"      "\n\t" \
          "bne 2f"          "\n\t" \
          "moveb %1@(2),%0" "\n\t" \
          "swap %0"         "\n\t" \
          "moveb %1@+,%0"   "\n\t" \
          "lsll #8,%0"      "\n\t" \
          "moveb %1@,%0"    "\n\t" \
          "swap %0"         "\n\t" \
          "addql #2,%0"     "\n\t" \
          "moveb %1@+,%0"   "\n\t" \
          "jra 3f"          "\n"   \
          "1:"                "\t" \
          "addb %0,%0"      "\n\t" \
          "asrb #1,%0"      "\n\t" \
          "extw %0"         "\n"   \
          "2:"                "\t" \
          "extl %0"         "\n"   \
          "3:"                     \
          : "=d" (where), "=a" (byteptr) : "1" (byteptr) )
    #endif
    #if defined(GNU) && defined(SPARC) && !defined(NO_ASM)
      #undef S_operand
      #define S_operand(where)  \
        { var uintL dummy;              \
          __asm__(                      \
            "ldub [%1],%0"       "\n\t" \
            "andcc %0,0x80,%%g0" "\n\t" \
            "be 2f"              "\n\t" \
            " add %1,1,%1"       "\n\t" \
            "sll %0,25,%2"       "\n\t" \
            "ldub [%1],%0"       "\n\t" \
            "sra %2,17,%2"       "\n\t" \
            "orcc %2,%0,%0"      "\n\t" \
            "bne 3f"             "\n\t" \
            " add %1,1,%1"       "\n\t" \
            "ldub [%1],%0"       "\n\t" \
            "sll %0,24,%2"       "\n\t" \
            "ldub [%1+1],%0"     "\n\t" \
            "sll %0,16,%0"       "\n\t" \
            "or %2,%0,%2"        "\n\t" \
            "ldub [%1+2],%0"     "\n\t" \
            "sll %0,8,%0"        "\n\t" \
            "or %2,%0,%2"        "\n\t" \
            "ldub [%1+3],%0"     "\n\t" \
            "or %2,%0,%0"        "\n\t" \
            "b 3f"               "\n\t" \
            " add %1,4,%1"       "\n"   \
            "2:"                   "\t" \
            "sll %0,25,%0"       "\n\t" \
            "sra %0,25,%0"       "\n"   \
            "3:"                   "\t" \
            : "=r" (where), "=r" (byteptr), "=r" (dummy) : "1" (byteptr) : "ccr" ); \
        }
    #endif
    #if (defined(GNU) || defined(INTEL)) && defined(I80386) && !defined(NO_ASM)
      #undef S_operand
      #define S_operand(where)  \
        __asm__(                   \
          "movzbl (%1),"EAX "\n\t" \
          "incl %1"         "\n\t" \
          "testb "AL","AL   "\n\t" \
          "jge "LR(1,f)     "\n\t" \
          "sall $8,"EAX     "\n\t" \
          "movb (%1),"AL    "\n\t" \
          "incl %1"         "\n\t" \
          "sall $17,"EAX    "\n\t" \
          "sarl $17,"EAX    "\n\t" \
          "jne "LR(2,f)     "\n\t" \
          "movb (%1),"AL    "\n\t" \
          "sall $8,"EAX     "\n\t" \
          "movb 1(%1),"AL   "\n\t" \
          "sall $8,"EAX     "\n\t" \
          "movb 2(%1),"AL   "\n\t" \
          "sall $8,"EAX     "\n\t" \
          "movb 3(%1),"AL   "\n\t" \
          "addl $4,"EAX     "\n\t" \
          "jmp "LR(2,f)     "\n"   \
          LD(1)":"            "\t" \
          "sall $25,"EAX    "\n\t" \
          "sarl $25,"EAX    "\n"   \
          LD(2)":"                 \
          : OUT_EAX (where), "=r" (byteptr) : "1" (byteptr) );
    #endif
    #if defined(GNU) && defined(ARM) && !defined(NO_ASM)
      /* Macro written by Peter Burwood. */
      #undef S_operand
      #define S_operand(where)  \
        { var uintL dummy;                  \
          __asm__(                          \
            "ldrb   %0,[%1],#1"      "\n\t" \
            "movs   %0,%0,LSL#25"    "\n\t" \
            "movcc  %0,%0,ASR#25"    "\n\t" \
            "bcc    "LR(1,f)         "\n\t" \
            "ldrb   %2,[%1],#1"      "\n\t" \
            "orr    %0,%0,%2,LSL#17" "\n\t" \
            "movs   %0,%0,ASR#17"    "\n\t" \
            "bne    "LR(1,f)         "\n\t" \
            "ldrb   %0,[%1],#1"      "\n\t" \
            "ldrb   %2,[%1],#1"      "\n\t" \
            "orr    %0,%2,%0,LSL#8"  "\n\t" \
            "ldrb   %2,[%1],#1"      "\n\t" \
            "orr    %0,%2,%0,LSL#8"  "\n\t" \
            "ldrb   %2,[%1],#1"      "\n\t" \
            "orr    %0,%2,%0,LSL#8"  "\n"   \
            LD(1)":"                        \
            : "=r" (where), "=r" (byteptr), "=r" (dummy) : "1" (byteptr) : "cc" ); \
        }
    #endif

    /* Macro S_operand_ignore();
     skips the next Operand (a Signed Integer)
     and advances the bytecodepointer. */
      #define S_operand_ignore()                                        \
        { var uintB where = *byteptr++;          /* read first byte */  \
          if ((uintB)where & bit(7))                                    \
            /* Bit 7 was set */                                         \
            { if ((uintB)((where<<1) | *byteptr++) == 0) /* next Byte */ \
                /* special case: 2-Byte-Operand = 0 -> 6-Byte-Operand */ \
                { byteptr += 4; }                                       \
        }   }
    #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM)
      #undef S_operand_ignore
      #define S_operand_ignore()  \
        { var uintB where;           \
          __asm__(                   \
            "moveb %1@+,%0"   "\n\t" \
            "bpl 1f"          "\n\t" \
            "addb %0,%0"      "\n\t" \
            "orb %1@+,%0"     "\n\t" \
            "bne 1f"          "\n\t" \
            "addql #4,%1"     "\n"   \
            "1:"                     \
            : "=d" (where), "=a" (byteptr) : "1" (byteptr) ); \
        }
    #endif
    #if defined(GNU) && defined(SPARC) && !defined(NO_ASM)
      #undef S_operand_ignore
      #define S_operand_ignore()  \
        { var uintL where;              \
          var uintL dummy;              \
          __asm__(                      \
            "ldub [%1],%0"       "\n\t" \
            "andcc %0,0x80,%%g0" "\n\t" \
            "be 1f"              "\n\t" \
            " add %1,1,%1"       "\n\t" \
            "sll %0,1,%2"        "\n\t" \
            "ldub [%1],%0"       "\n\t" \
            "orcc %2,%0,%0"      "\n\t" \
            "bne 1f"             "\n\t" \
            " add %1,1,%1"       "\n\t" \
            "add %1,4,%1"        "\n"   \
            "1:"                        \
            : "=r" (where), "=r" (byteptr), "=r" (dummy) : "1" (byteptr) : "ccr" ); \
        }
    #endif
    #if defined(GNU) && defined(ARM) && !defined(NO_ASM)
      /* Macro written by Peter Burwood. */
      #undef S_operand_ignore
      #define S_operand_ignore()  \
        { var uintL where;                  \
          var uintL dummy;                  \
          __asm__(                          \
            "ldrb   %0,[%1],#1"      "\n\t" \
            "movs   %0,%0,LSL#25"    "\n\t" \
            "bcc    "LR(1,f)         "\n\t" \
            "ldrb   %2,[%1],#1"      "\n\t" \
            "orrs   %0,%2,%0,LSR#24" "\n\t" \
            "addeq  %1,%1,#4"        "\n"   \
            LD(1)":"                        \
            : "=r" (where), "=r" (byteptr), "=r" (dummy) : "1" (byteptr) : "cc" ); \
        }
    #endif

    /* Macro L_operand(where);
     moves the next Operand (a Label)
     to (uintB*)where and advances the bytecodepointer. */
      #define L_operand(Lwhere)                                         \
        { var uintL where;         /* variable for the displacement */  \
          S_operand(where);        /* Displacement */                   \
          Lwhere = byteptr + (sintL)where;             /* add */        \
        }

    /* Macro L_operand_ignore();
     skips the next Operand (a Label)
     and advances the Bytecodepointer. */
      #define L_operand_ignore()  S_operand_ignore()
    /* Each of the bytecodes is interpreted:
     for the most part: mv_count/mv_space = values,
     closureptr = pointer to the compiled closure in Stack,
     closure = compiled closure,
     codeptr = pointer to its codevector,
     byteptr = pointer to the next Byte in code.
     (byteptr is no LISP-object, but nevertheless endangered by GC!
      To make it GC-invariant, substract CODEPTR from it.
      If one then adds Fixnum_0 to it,
      one receives the bytenumber as Fixnum.) */
    #if 0
      #define CODEPTR  (&codeptr->data[0])
    #else  /* returns more efficient Code */
      #define CODEPTR  (uintB*)(codeptr)
    #endif

    /* store context-information:
     If sth. is called, that can trigger a GC, this must be framed within
     with_saved_context( ... ) . */
      #define with_saved_context(statement)  \
        { var uintL index = byteptr - CODEPTR;                       \
          statement;                                                 \
          closure = *closureptr;        /* fetch Closure from Stack */ \
          codeptr = TheSbvector(TheCclosure(closure)->clos_codevec); \
          byteptr = CODEPTR + index;                                 \
        }

    /* ------------------- (1) Constants ----------------------- */
    CASE cod_nil: code_nil: {   /* (NIL) */
      VALUES1(NIL);
    } goto next_byte;
    CASE cod_nil_push: {        /* (NIL&PUSH) */
      pushSTACK(NIL);
    } goto next_byte;
    CASE cod_push_nil: {        /* (PUSH-NIL n) */
      var uintC n;
      U_operand(n);
      dotimesC(n,n, { pushSTACK(NIL); } );
    } goto next_byte;
    CASE cod_t: code_t: {       /* (T) */
      VALUES1(T);
    } goto next_byte;
    CASE cod_t_push: {          /* (T&PUSH) */
      pushSTACK(T);
    } goto next_byte;
    CASE cod_const: {           /* (CONST n) */
      var uintL n;
      U_operand(n);
      VALUES1(TheCclosure(closure)->clos_consts[n]);
    } goto next_byte;
    CASE cod_const_push: {      /* (CONST&PUSH n) */
      var uintL n;
      U_operand(n);
      pushSTACK(TheCclosure(closure)->clos_consts[n]);
    } goto next_byte;
    /* ------------------- (2) static Variables ----------------------- */
    CASE cod_load: {            /* (LOAD n) */
      var uintL n;
      U_operand(n);
      VALUES1(STACK_(n));
    } goto next_byte;
    CASE cod_load_push: {       /* (LOAD&PUSH n) */
      var uintL n;
      U_operand(n);
      pushSTACK(STACK_(n));
    } goto next_byte;
    CASE cod_loadi: {           /* (LOADI k1 k2 n) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      var gcv_object_t* FRAME = (gcv_object_t*) SP_(k1+jmpbufsize*k2);
      VALUES1(FRAME_(n));
    } goto next_byte;
    CASE cod_loadi_push: {      /* (LOADI&PUSH k1 k2 n) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      var gcv_object_t* FRAME = (gcv_object_t*) SP_(k1+jmpbufsize*k2);
      pushSTACK(FRAME_(n));
    } goto next_byte;
    CASE cod_loadc: {           /* (LOADC n m) */
      var uintL n;
      var uintL m;
      U_operand(n);
      U_operand(m);
      VALUES1(TheSvector(STACK_(n))->data[1+m]);
    } goto next_byte;
    CASE cod_loadc_push: {      /* (LOADC&PUSH n m) */
      var uintL n;
      var uintL m;
      U_operand(n);
      U_operand(m);
      pushSTACK(TheSvector(STACK_(n))->data[1+m]);
    } goto next_byte;
    CASE cod_loadv: {           /* (LOADV k m) */
      var uintC k;
      var uintL m;
      U_operand(k);
      U_operand(m);
      var object venv = TheCclosure(closure)->clos_venv; /* VenvConst */
      /* take (svref ... 0) k times: */
      dotimesC(k,k, { venv = TheSvector(venv)->data[0]; } );
      /* fetch (svref ... m) : */
      VALUES1(TheSvector(venv)->data[m]);
    } goto next_byte;
    CASE cod_loadv_push: {      /* (LOADV&PUSH k m) */
      var uintC k;
      var uintL m;
      U_operand(k);
      U_operand(m);
      var object venv = TheCclosure(closure)->clos_venv; /* VenvConst */
      /* take (svref ... 0) k times: */
      dotimesC(k,k, { venv = TheSvector(venv)->data[0]; } );
      /* fetch (svref ... m) : */
      pushSTACK(TheSvector(venv)->data[m]);
    } goto next_byte;
    CASE cod_loadic: {          /* (LOADIC k1 k2 n m) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      var uintL m;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      U_operand(m);
      var gcv_object_t* FRAME = (gcv_object_t*) SP_(k1+jmpbufsize*k2);
      VALUES1(TheSvector(FRAME_(n))->data[1+m]);
    } goto next_byte;
    CASE cod_store: store: {    /* (STORE n) */
      var uintL n;
      U_operand(n);
      VALUES1(STACK_(n) = value1);
    } goto next_byte;
    CASE cod_pop_store: {       /* (POP&STORE n) */
      var uintL n;
      U_operand(n);
      var object obj = popSTACK();
      VALUES1(STACK_(n) = obj);
    } goto next_byte;
    CASE cod_storei: {          /* (STOREI k1 k2 n) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      var gcv_object_t* FRAME = (gcv_object_t*) SP_(k1+jmpbufsize*k2);
      VALUES1(FRAME_(n) = value1);
    } goto next_byte;
    CASE cod_load_storec: {     /* (LOAD&STOREC k m n) */
      var uintL k;
      U_operand(k);
      value1 = STACK_(k);
    } /* FALLTHROUGH */
    CASE cod_storec: {          /* (STOREC n m) */
      var uintL n;
      var uintL m;
      U_operand(n);
      U_operand(m);
      TheSvector(STACK_(n))->data[1+m] = value1; mv_count=1;
    } goto next_byte;
    CASE cod_storev: {          /* (STOREV k m) */
      var uintC k;
      var uintL m;
      U_operand(k);
      U_operand(m);
      var object venv = TheCclosure(closure)->clos_venv; /* VenvConst */
      /* take (svref ... 0) k times: */
      dotimesC(k,k, { venv = TheSvector(venv)->data[0]; } );
      /* save (svref ... m) : */
      TheSvector(venv)->data[m] = value1; mv_count=1;
    } goto next_byte;
    CASE cod_storeic: {         /* (STOREIC k1 k2 n m) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      var uintL m;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      U_operand(m);
      var gcv_object_t* FRAME = (gcv_object_t*) SP_(k1+jmpbufsize*k2);
      TheSvector(FRAME_(n))->data[1+m] = value1; mv_count=1;
    } goto next_byte;
    /* ------------------- (3) dynamic Variables ----------------------- */
    CASE cod_getvalue: {        /* (GETVALUE n) */
      var uintL n;
      U_operand(n);
      var object symbol = TheCclosure(closure)->clos_consts[n];
      /* The Compiler has already checked, that it's a Symbol. */
      if (!boundp(Symbol_value(symbol))) {
        pushSTACK(symbol);      /* CELL-ERROR slot NAME */
        pushSTACK(symbol); pushSTACK(Closure_name(closure));
        error(unbound_variable,GETTEXT("~S: symbol ~S has no value"));
      }
      VALUES1(Symbol_value(symbol));
    } goto next_byte;
    CASE cod_getvalue_push: {   /* (GETVALUE&PUSH n) */
      var uintL n;
      U_operand(n);
      var object symbol = TheCclosure(closure)->clos_consts[n];
      /* The Compiler has already checked, that it's a Symbol. */
      if (!boundp(Symbol_value(symbol))) {
        pushSTACK(symbol);    /* CELL-ERROR slot NAME */
        pushSTACK(symbol); pushSTACK(Closure_name(closure));
        error(unbound_variable,GETTEXT("~S: symbol ~S has no value"));
      }
      pushSTACK(Symbol_value(symbol));
    } goto next_byte;
    CASE cod_setvalue: {        /* (SETVALUE n) */
      var uintL n;
      U_operand(n);
      var object symbol = TheCclosure(closure)->clos_consts[n];
      /* The Compiler has already checked, that it's a Symbol. */
      if (constant_var_p(TheSymbol(symbol))) {
        pushSTACK(symbol); pushSTACK(Closure_name(closure));
        error(error_condition,GETTEXT("~S: assignment to constant symbol ~S is impossible"));
      }
      Symbol_value(symbol) = value1; mv_count=1;
    } goto next_byte;
    CASE cod_bind: {            /* (BIND n) */
      var uintL n;
      U_operand(n);
      dynamic_bind(TheCclosure(closure)->clos_consts[n],value1);
    } goto next_byte;
    CASE cod_unbind1:           /* (UNBIND1) */
      #if STACKCHECKC
      if (!(framecode(STACK_0) == DYNBIND_frame_info))
        GOTO_ERROR(error_STACK_putt);
      #endif
      { /* unwind variable-binding-frame: */
        var gcv_object_t* new_STACK = topofframe(STACK_0); /* pointer above frame */
        var gcv_object_t* frame_end = STACKpointable(new_STACK);
        var gcv_object_t* bindingptr = &STACK_1; /* begin of bindings */
        /* bindingptr loops upwards through the bindings */
        while (bindingptr != frame_end) {
          /* write back old value: */
          Symbol_value(*(bindingptr STACKop 0)) = *(bindingptr STACKop 1);
          bindingptr skipSTACKop 2; /* next binding */
        }
        /* set STACK newly, thus unwind frame: */
        setSTACK(STACK = new_STACK);
      } goto next_byte;
    CASE cod_unbind: {          /* (UNBIND n) */
      var uintC n;
      U_operand(n);           /* n>0 */
      var gcv_object_t* FRAME = STACK;
      do {
       #if STACKCHECKC
        if (!(framecode(FRAME_(0)) == DYNBIND_frame_info))
          GOTO_ERROR(error_STACK_putt);
       #endif
        /* unwind variable-binding-frame: */
        var gcv_object_t* new_FRAME = topofframe(FRAME_(0)); /* pointer above frame */
        var gcv_object_t* frame_end = STACKpointable(new_FRAME);
        var gcv_object_t* bindingptr = &FRAME_(1); /* begin of the bindings */
        /* bindingptr loops upwards through the bindings */
        while (bindingptr != frame_end) {
          /* write back old value: */
          Symbol_value(*(bindingptr STACKop 0)) = *(bindingptr STACKop 1);
          bindingptr skipSTACKop 2; /* next binding */
        }
        FRAME = new_FRAME;
      } while (--n != 0);
      setSTACK(STACK = FRAME); /* set STACK newly */
    } goto next_byte;
    CASE cod_progv: {                  /* (PROGV) */
      var object vallist = value1;     /* value-list */
      var object symlist = popSTACK(); /* symbol-list */
      pushSP((aint)STACK);             /* push STACK into SP */
      with_saved_context( progv(symlist,vallist); ); /* build frame */
    } goto next_byte;
    /* ------------------- (4) Stackoperations ----------------------- */
    CASE cod_push:              /* (PUSH) */
      pushSTACK(value1);
      goto next_byte;
    CASE cod_pop:               /* (POP) */
      VALUES1(popSTACK());
      goto next_byte;
    CASE cod_skip: {            /* (SKIP n) */
      var uintL n;
      U_operand(n);
      skipSTACK(n);
    } goto next_byte;
    CASE cod_skipi: {           /* (SKIPI k1 k2 n) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      skipSP(k1+jmpbufsize*k2);
      var gcv_object_t* newSTACK;
      popSP( newSTACK = (gcv_object_t*) );
      setSTACK(STACK = newSTACK STACKop n);
    } goto next_byte;
    CASE cod_skipsp: {          /* (SKIPSP k1 k2) */
      var uintL k1;
      var uintL k2;
      U_operand(k1);
      U_operand(k2);
      skipSP(k1+jmpbufsize*k2);
    } goto next_byte;
    /* ------------------- (5) Control Flow and Jumps --------------------- */
    CASE cod_skip_ret: {        /* (SKIP&RET n) */
      var uintL n;
      U_operand(n);
      skipSTACK(n);
    } goto finished;            /* return (jump) to caller */
    CASE cod_skip_retgf: {      /* (SKIP&RETGF n) */
      var uintL n;
      U_operand(n);
      if (((Codevec)codeptr)->ccv_flags & bit(3)) { /* call inhibition? */
        skipSTACK(n);
        mv_count=1;
        goto finished;          /* return (jump) to caller */
      }
      /* It is known (refer to clos.lisp), that this function
       has no optional parameters, but poss. Rest-parameters.
       If there's no Rest-parameter: (FUNCALL value1 arg1 ... argr)
       If there's a  Rest-Parameter: (APPLY value1 arg1 ... argr restarg) */
      var uintL r = ((Codevec)codeptr)->ccv_numreq;
      n -= r;
      if (((Codevec)codeptr)->ccv_flags & bit(0)) {
        skipSTACK(n-1); apply(value1,r,popSTACK());
      } else {
        skipSTACK(n); funcall(value1,r);
      } goto finished;          /* return (jump) to caller */
    }
    #define JMP()                             \
      { var const uintB* label_byteptr;       \
        L_operand(label_byteptr);             \
        DEBUG_CHECK_BYTEPTR(label_byteptr);   \
        byteptr = label_byteptr;              \
        goto next_byte;                       \
      }
    #define NOTJMP()  \
      { L_operand_ignore(); goto next_byte; }
    jmp1: mv_count=1;
    CASE cod_jmp: jmp:          /* (JMP label) */
      JMP();
    CASE cod_jmpif:             /* (JMPIF label) */
      if (!nullp(value1)) goto jmp;
      notjmp:
      NOTJMP();
    CASE cod_jmpifnot:          /* (JMPIFNOT label) */
      if (nullp(value1)) goto jmp;
      NOTJMP();
    CASE cod_jmpif1:            /* (JMPIF1 label) */
      if (!nullp(value1)) goto jmp1;
      NOTJMP();
    CASE cod_jmpifnot1:         /* (JMPIFNOT1 label) */
      if (nullp(value1)) goto jmp1;
      NOTJMP();
    CASE cod_jmpifatom:         /* (JMPIFATOM label) */
      if (atomp(value1)) goto jmp;
      NOTJMP();
    CASE cod_jmpifconsp:        /* (JMPIFCONSP label) */
      if (consp(value1)) goto jmp;
      NOTJMP();
    CASE cod_jmpifeq:           /* (JMPIFEQ label) */
      if (eq(popSTACK(),value1)) goto jmp;
      NOTJMP();
    CASE cod_jmpifnoteq:        /* (JMPIFNOTEQ label) */
      if (!eq(popSTACK(),value1)) goto jmp;
      NOTJMP();
    CASE cod_jmpifeqto: {       /* (JMPIFEQTO n label) */
      var uintL n;
      U_operand(n);
      if (eq(popSTACK(),TheCclosure(closure)->clos_consts[n])) goto jmp;
    } NOTJMP();
    CASE cod_jmpifnoteqto: {    /* (JMPIFNOTEQTO n label) */
      var uintL n;
      U_operand(n);
      if (!eq(popSTACK(),TheCclosure(closure)->clos_consts[n])) goto jmp;
    } NOTJMP();
    CASE cod_jmphash: {         /* (JMPHASH n label) */
      var uintL n;
      U_operand(n);
      var object hashvalue =  /* search value1 in the Hash-table */
        gethash(value1,TheCclosure(closure)->clos_consts[n],false);
      if (eq(hashvalue,nullobj))
        goto jmp;             /* not found -> jump to label */
      else { /* interpret found Fixnum as label: */
        DEBUG_CHECK_BYTEPTR(byteptr + fixnum_to_V(hashvalue));
        byteptr += fixnum_to_V(hashvalue);
      }
    } goto next_byte;
    CASE cod_jmphashv: {        /* (JMPHASHV n label) */
      var uintL n;
      U_operand(n);
      var object hashvalue =  /* search value1 in the Hash-table */
        gethash(value1,TheSvector(TheCclosure(closure)->clos_consts[0])->data[n],false);
      if (eq(hashvalue,nullobj))
        goto jmp;             /* not found -> jump to label */
      else { /* interpret found Fixnum as label: */
        DEBUG_CHECK_BYTEPTR(byteptr + fixnum_to_V(hashvalue));
        byteptr += fixnum_to_V(hashvalue);
      }
    } goto next_byte;
    /* executes a (JSR label)-command. */
    #define JSR()  \
      check_STACK(); check_SP();                                \
      { var const uintB* label_byteptr;                         \
        L_operand(label_byteptr);                               \
        with_saved_context(                                     \
          with_saved_back_trace_cclosure(closure,               \
            interpret_bytecode_(closure,codeptr,label_byteptr); \
        ));                                                     \
      }
    CASE cod_jsr:               /* (JSR label) */
      JSR();
      goto next_byte;
    CASE cod_jsr_push:          /* (JSR&PUSH label) */
      JSR(); pushSTACK(value1);
      goto next_byte;
    CASE cod_jmptail: {         /* (JMPTAIL m n label) */
      var uintL m;
      var uintL n;
      U_operand(m);
      U_operand(n);
      /* It is n>=m. Copy m stack-entries upwards by n-m : */
      var gcv_object_t* ptr1 = STACK STACKop m;
      var gcv_object_t* ptr2 = STACK STACKop n;
      var uintC count;
      dotimesC(count,m, { NEXT(ptr2) = NEXT(ptr1); } );
      /* Now ptr1 = STACK and ptr2 = STACK STACKop (n-m). */
      *(closureptr = &NEXT(ptr2)) = closure; /* store closure in stack */
      setSTACK(STACK = ptr2);                /* shorten STACK */
    } JMP();                                 /* jump to label */
    /* ------------------- (6) Environments and Closures -------------------- */
    CASE cod_venv:              /* (VENV) */
      /* fetch VenvConst from the closure: */
      VALUES1(TheCclosure(closure)->clos_venv);
      goto next_byte;
    CASE cod_make_vector1_push: { /* (MAKE-VECTOR1&PUSH n) */
      var uintL n;
      U_operand(n);
      pushSTACK(value1);
      /* create vector: */
      var object vec;
      with_saved_context( { vec = allocate_vector(n+1); } );
      /* fill first element: */
      TheSvector(vec)->data[0] = STACK_0;
      STACK_0 = vec;
    } goto next_byte;
    CASE cod_copy_closure: {    /* (COPY-CLOSURE m n) */
      var object oldclos;
      { /* fetch closure to be copied: */
        var uintL m;
        U_operand(m);
        oldclos = TheCclosure(closure)->clos_consts[m];
      }
      /* allocate closure of equal length: */
      var object newclos;
      pushSTACK(oldclos);
      with_saved_context(newclos = allocate_cclosure_copy(oldclos););
      oldclos = popSTACK();
      /* copy contents of the old closure into the new one: */
      do_cclosure_copy(newclos,oldclos);
      {                   /* copy stack content into the new closure: */
        var uintL n;
        U_operand(n);
        var gcv_object_t* newptr = &TheCclosure(newclos)->clos_consts[n];
        dotimespL(n,n, { *--newptr = popSTACK(); } );
      }
      VALUES1(newclos);
    } goto next_byte;
    CASE cod_copy_closure_push: { /* (COPY-CLOSURE&PUSH m n) */
      var object oldclos;
      { /* fetch closure to be copied: */
        var uintL m;
        U_operand(m);
        oldclos = TheCclosure(closure)->clos_consts[m];
      }
      /* allocate closure of equal length: */
      var object newclos;
      pushSTACK(oldclos);
      with_saved_context(newclos = allocate_cclosure_copy(oldclos););
      oldclos = popSTACK();
      /* copy contents of the old closure into the new one: */
      do_cclosure_copy(newclos,oldclos);
      { /* copy stack content into the new closure: */
        var uintL n;
        U_operand(n);
        var gcv_object_t* newptr = &TheCclosure(newclos)->clos_consts[n];
        dotimespL(n,n, { *--newptr = popSTACK(); } );
      }
      pushSTACK(newclos);
    } goto next_byte;
    /* ------------------- (7) Function Calls -----------------------
     executes (CALL k n)-command. */
    #define CALL()  \
      { var uintC k;             /* number of arguments */ \
        var uintL n;                                       \
        U_operand(k);                                      \
        U_operand(n);                                      \
        with_saved_context(                                \
          funcall(TheCclosure(closure)->clos_consts[n],k); \
        );                                                 \
      }
    /* executes (CALL0 n)-command. */
    #define CALL0()  \
      { var uintL n;                                       \
        U_operand(n);                                      \
        with_saved_context(                                \
          funcall(TheCclosure(closure)->clos_consts[n],0); \
        );                                                 \
      }
    /* executes (CALL1 n)-command. */
    #define CALL1()  \
      { var uintL n;                                       \
        U_operand(n);                                      \
        with_saved_context(                                \
          funcall(TheCclosure(closure)->clos_consts[n],1); \
        );                                                 \
      }
    /* executes (CALL2 n)-command. */
    #define CALL2()  \
      { var uintL n;                                       \
        U_operand(n);                                      \
        with_saved_context(                                \
          funcall(TheCclosure(closure)->clos_consts[n],2); \
        );                                                 \
      }
    /* executes (CALLS1 n)-command. */
    #define CALLS1()                                                    \
      { var uintL n;                                                    \
        B_operand(n);                                                   \
        /* The compiler has already done the argument-check. */         \
       {var Subr fun = FUNTAB1[n];                                      \
        with_saved_context(                                             \
          with_saved_back_trace_subr(subr_tab_ptr_as_object(fun),STACK,-1, \
            (*(subr_norest_function_t*)(fun->function))();              \
          ));                                                           \
      }}
    /* executes (CALLS2 n)-command. */
    #define CALLS2()                                                    \
      { var uintL n;                                                    \
        B_operand(n);                                                   \
        /* The compiler has already done the argument-check. */         \
       {var Subr fun = FUNTAB2[n];                                      \
        with_saved_context(                                             \
          with_saved_back_trace_subr(subr_tab_ptr_as_object(fun),STACK,-1, \
            (*(subr_norest_function_t*)(fun->function))();              \
          ));                                                           \
      }}                                                                \
    /* executes (CALLSR m n)-command. */
    #define CALLSR()                                                    \
      { var uintL m;                                                    \
        var uintL n;                                                    \
        U_operand(m);                                                   \
        B_operand(n);                                                   \
        /* The compiler has already done the argument-check. */         \
       {var Subr fun = FUNTABR[n];                                      \
        with_saved_context(                                             \
          with_saved_back_trace_subr(subr_tab_ptr_as_object(fun),STACK,-1, \
            (*(subr_rest_function_t*)(fun->function))(m,args_end_pointer STACKop m); \
          ));                                                           \
      }}
    CASE cod_call:              /* (CALL k n) */
      CALL();
      goto next_byte;
    CASE cod_call_push:         /* (CALL&PUSH k n) */
      CALL(); pushSTACK(value1);
      goto next_byte;
    CASE cod_call0:             /* (CALL0 n) */
      CALL0();
      goto next_byte;
    CASE cod_call1:             /* (CALL1 n) */
      CALL1();
      goto next_byte;
    CASE cod_call1_push:        /* (CALL1&PUSH n) */
      CALL1(); pushSTACK(value1);
      goto next_byte;
    CASE cod_call2:             /* (CALL2 n) */
      CALL2();
      goto next_byte;
    CASE cod_call2_push:        /* (CALL2&PUSH n) */
      CALL2(); pushSTACK(value1);
      goto next_byte;
    CASE cod_calls1:            /* (CALLS1 n) */
      CALLS1();
      goto next_byte;
    CASE cod_calls1_push:       /* (CALLS1&PUSH n) */
      CALLS1(); pushSTACK(value1);
      goto next_byte;
    CASE cod_calls2:            /* (CALLS2 n) */
      CALLS2();
      goto next_byte;
    CASE cod_calls2_push:       /* (CALLS2&PUSH n) */
      CALLS2(); pushSTACK(value1);
      goto next_byte;
    CASE cod_callsr:            /* (CALLSR m n) */
      CALLSR();
      goto next_byte;
    CASE cod_callsr_push:       /* (CALLSR&PUSH m n) */
      CALLSR(); pushSTACK(value1);
      goto next_byte;
    /* executes a (CALLC)-command. */
    #define CALLC()  \
      { check_STACK(); check_SP();            /* check STACK and SP */ \
        with_saved_context(                                  \
          /* interprete compiled closure starting at Byte 8 */ \
          interpret_bytecode(value1,TheCclosure(value1)->clos_codevec,CCV_START_NONKEY); \
        );                                                   \
      }
    /* executes a (CALLCKEY)-command. */
    #define CALLCKEY()  \
      { check_STACK(); check_SP();            /* check STACK and SP */ \
        with_saved_context(                                  \
          /* interprete compiled closure starting at Byte 12: */ \
          interpret_bytecode(value1,TheCclosure(value1)->clos_codevec,CCV_START_KEY); \
        );                                                   \
      }
    CASE cod_callc:             /* (CALLC) */
      CALLC();
      goto next_byte;
    CASE cod_callc_push:        /* (CALLC&PUSH) */
      CALLC(); pushSTACK(value1);
      goto next_byte;
    CASE cod_callckey:          /* (CALLCKEY) */
      CALLCKEY();
      goto next_byte;
    CASE cod_callckey_push:     /* (CALLCKEY&PUSH) */
      CALLCKEY(); pushSTACK(value1);
      goto next_byte;
    CASE cod_funcall: {         /* (FUNCALL n) */
      var uintL n;
      U_operand(n);
      var object fun = STACK_(n);            /* Function */
      with_saved_context( funcall(fun,n); ); /* call Function */
      skipSTACK(1);           /* discard function from Stack */
    } goto next_byte;
    CASE cod_funcall_push: {    /* (FUNCALL&PUSH n) */
      var uintL n;
      U_operand(n);
      var object fun = STACK_(n);            /* Function */
      with_saved_context( funcall(fun,n); ); /* call Function */
      STACK_0 = value1;       /* replace Function in Stack by value */
    } goto next_byte;
    CASE cod_apply: {           /* (APPLY n) */
      var uintL n;
      U_operand(n);
      var object fun = STACK_(n);                 /* Function */
      with_saved_context( apply(fun,n,value1); ); /* call Function */
      skipSTACK(1);           /* discard Function from Stack */
    } goto next_byte;
    CASE cod_apply_push: {      /* (APPLY&PUSH n) */
      var uintL n;
      U_operand(n);
      var object fun = STACK_(n);                 /* Function */
      with_saved_context( apply(fun,n,value1); ); /* call Function */
      STACK_0 = value1;       /* replace Function in Stack by value */
    } goto next_byte;
    /* ---------------- (8) optional and Keyword-arguments ---------------- */
    CASE cod_push_unbound: {    /* (PUSH-UNBOUND n) */
      var uintC n;
      U_operand(n);
      dotimesC(n,n, { pushSTACK(unbound); } );
    } goto next_byte;
    CASE cod_unlist: {          /* (UNLIST n m) */
      var uintC n;
      var uintC m;
      U_operand(n);
      U_operand(m);
      var object l = value1;
      if (n > 0)
        do {
          if (atomp(l)) goto unlist_unbound;
          pushSTACK(Car(l)); l = Cdr(l);
        } while (--n != 0);
      if (atomp(l))
        goto next_byte;
      else
        error_apply_toomany(S(lambda));
     unlist_unbound:
      if (n > m) error_apply_toofew(S(lambda),l);
      do { pushSTACK(unbound); } while (--n != 0);
    } goto next_byte;
    CASE cod_unliststar: {      /* (UNLIST* n m) */
      var uintC n;
      var uintC m;
      U_operand(n);
      U_operand(m);
      var object l = value1;
      do {
        if (atomp(l)) goto unliststar_unbound;
        pushSTACK(Car(l)); l = Cdr(l);
      } while (--n != 0);
      pushSTACK(l);
      goto next_byte;
     unliststar_unbound:
      if (n > m) error_apply_toofew(S(lambda),l);
      do { pushSTACK(unbound); } while (--n != 0);
      pushSTACK(NIL);
    } goto next_byte;
    CASE cod_jmpifboundp: {     /* (JMPIFBOUNDP n label) */
      var uintL n;
      U_operand(n);
      var object obj = STACK_(n);
      if (!boundp(obj)) goto notjmp;
      VALUES1(obj);
    } JMP();
    CASE cod_boundp: {          /* (BOUNDP n) */
      var uintL n;
      U_operand(n);
      var object obj = STACK_(n);
      if (!boundp(obj)) goto code_nil; else goto code_t;
    }
    CASE cod_unbound_nil: {     /* (UNBOUND->NIL n) */
      var uintL n;
      U_operand(n);
      if (!boundp(STACK_(n))) { STACK_(n) = NIL; }
    } goto next_byte;
    /* ------------------- (9) Treatment of multiple values -------------- */
    CASE cod_values0:           /* (VALUES0) */
      VALUES0;
      goto next_byte;
    CASE cod_values1:           /* (VALUES1) */
      mv_count = 1;
      goto next_byte;
    CASE cod_stack_to_mv: {     /* (STACK-TO-MV n) */
      var uintL n;
      U_operand(n);
      if (n >= mv_limit) GOTO_ERROR(error_toomany_values);
      STACK_to_mv(n);
    } goto next_byte;
    CASE cod_mv_to_stack:       /* (MV-TO-STACK) */
      mv_to_STACK();            /* push values on Stack */
      goto next_byte;
    CASE cod_nv_to_stack: {     /* (NV-TO-STACK n) */
      var uintL n;
      U_operand(n);
      /* test for Stack-Overflow: */
      get_space_on_STACK(n*sizeof(gcv_object_t));
      /* push n values in the Stack: */
      var uintC count = mv_count;
      if (n==0) goto nv_to_stack_end; /* no value desired -> finished */
      /* at least 1 value desired */
      pushSTACK(value1);
      n--; if (n==0) goto nv_to_stack_end; /* only 1 value desired -> finished */
      if (count<=1) goto nv_to_stack_fill; /* only 1 value present -> fill with NILs */
      count--;
      { /* at least 2 values desired and present */
        var object* mvp = &mv_space[1];
        while (1) {
          pushSTACK(*mvp++);
          n--; if (n==0) goto nv_to_stack_end; /* no further value desired -> finished */
          count--; if (count==0) goto nv_to_stack_fill; /* no further value present -> fill with NILs */
        }
      }
     nv_to_stack_fill: /* fill up with n>0 NILs as additional values: */
      dotimespL(n,n, { pushSTACK(NIL); } );
       nv_to_stack_end: ;
    } goto next_byte;
    CASE cod_mv_to_list:        /* (MV-TO-LIST) */
      with_saved_context(
        /* push values on Stack and handicraft list out of it: */
        mv_to_list();
      );
      VALUES1(popSTACK());
      goto next_byte;
    CASE cod_list_to_mv:        /* (LIST-TO-MV) */
      list_to_mv(value1, GOTO_ERROR(error_toomany_values));
      goto next_byte;
    CASE cod_mvcallp:           /* (MVCALLP) */
      pushSP((aint)STACK);      /* save STACK */
      pushSTACK(value1);        /* save function to be executed */
      goto next_byte;
    CASE cod_mvcall: {          /* (MVCALL) */
      var gcv_object_t* FRAME; popSP( FRAME = (gcv_object_t*) ); /* Pointer to Arguments and Function */
      var object fun = NEXT(FRAME); /* Function */
      with_saved_context({
        var uintL argcount =  /* number of arguments on stack */
          STACK_item_count(STACK,FRAME);
        if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1)) {
          pushSTACK(fun);
          pushSTACK(S(multiple_value_call));
          /* ANSI CL 3.5.1.3. wants a PROGRAM-ERROR here. */
          error(program_error,
                GETTEXT("~S: too many arguments given to ~S"));
        }
        /* apply Function, lift Stack until below the Function: */
        funcall(fun,argcount);
        skipSTACK(1);         /* discard Function from STACK */
      });
    } goto next_byte;
    /* ------------------- (10) BLOCK ----------------------- */
    CASE cod_block_open: {      /* (BLOCK-OPEN n label) */
      /* occupies 3 STACK-entries and 1 SP-jmp_buf-entry and 2 SP-entries */
      var uintL n;
      var sintL label_dist;
      U_operand(n);
      S_operand(label_dist);
      /* create Block_Cons: */
      var object block_cons;
      with_saved_context(
        block_cons = allocate_cons();
        label_dist += index; /* CODEPTR+label_dist is the jump destination */
      );
      /* fill Block-Cons: (CONST n) as CAR */
      Car(block_cons) = TheCclosure(closure)->clos_consts[n];
      /* jump destination into SP: */
      pushSP(label_dist); pushSP((aint)closureptr);
      { /* build up CBLOCK-Frame: */
        var gcv_object_t* top_of_frame = STACK; /* Pointer above Frame */
        pushSTACK(block_cons);      /* Cons ( (CONST n) . ...) */
        var JMPBUF_on_SP(returner); /* memorize return-point */
        finish_entry_frame_1(CBLOCK,returner, goto block_return; );
      }
      /* store Framepointer in Block-Cons: */
      Cdr(block_cons) = make_framepointer(STACK);
    } goto next_byte;
   block_return: { /* jump to this label takes place, if the previously
                      built CBLOCK-Frame has catched a RETURN-FROM. */
      FREE_JMPBUF_on_SP();
      skipSTACK(2);               /* unwind CBLOCK-Frame and mark */
      Cdr(popSTACK()) = disabled; /* Block-Cons as Disabled */
      var uintL index;
      /* get closure back, byteptr:=label_byteptr : */
      popSP(closureptr = (gcv_object_t*) ); popSP(index = );
      closure = *closureptr;  /* fetch Closure from Stack */
      codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
      DEBUG_CHECK_BYTEPTR(CODEPTR + index);
      byteptr = CODEPTR + index;
    } goto next_byte;           /* continue interpretation at Label */
    CASE cod_block_close:       /* (BLOCK-CLOSE) */
      /* unwind CBLOCK-Frame: */
      #if STACKCHECKC
      if (!(framecode(STACK_0) == CBLOCK_frame_info))
        GOTO_ERROR(error_STACK_putt);
      #endif
      {
        FREE_JMPBUF_on_SP();
        skipSTACK(2);               /* unwind CBLOCK-Frame and mark */
        Cdr(popSTACK()) = disabled; /* Block-Cons as Disabled */
        skipSP(2); /* we know Destination-Closureptr and Destination-Label */
    } goto next_byte;           /* at Label continue interpretation */
    CASE cod_return_from: {     /* (RETURN-FROM n) */
      var uintL n;
      U_operand(n);
      var object block_cons = TheCclosure(closure)->clos_consts[n];
      if (eq(Cdr(block_cons),disabled))
        error_block_left(Car(block_cons));
      /* unwind upto Block-Frame, then jump to its routine for freeing: */
     #ifndef FAST_SP
      FREE_DYNAMIC_ARRAY(private_SP_space);
     #endif
      unwind_upto(uTheFramepointer(Cdr(block_cons)));
    }
    CASE cod_return_from_i: {   /* (RETURN-FROM-I k1 k2 n) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      var gcv_object_t* FRAME = (gcv_object_t*) SP_(k1+jmpbufsize*k2);
      var object block_cons = FRAME_(n);
      if (eq(Cdr(block_cons),disabled))
        error_block_left(Car(block_cons));
      /* unwind upto Block-Frame, then jump to its routine for freeing: */
     #ifndef FAST_SP
      FREE_DYNAMIC_ARRAY(private_SP_space);
     #endif
      unwind_upto(uTheFramepointer(Cdr(block_cons)));
    }
    /* ------------------- (11) TAGBODY ----------------------- */
    CASE cod_tagbody_open: {    /* (TAGBODY-OPEN n label1 ... labelm) */
      /* occupies 3+m STACK-Entries and 1 SP-jmp_buf-Entry and 1 SP-Entry */
      var uintL n;
      U_operand(n);
      /* create Tagbody-Cons: */
      var object tagbody_cons;
      with_saved_context(tagbody_cons = allocate_cons(););
      { /* fill Tagbody-Cons: Tag-Vector (CONST n) as CAR */
        var object tag_vector = TheCclosure(closure)->clos_consts[n];
        var uintL m = Svector_length(tag_vector);
        Car(tagbody_cons) = tag_vector;
        get_space_on_STACK(m*sizeof(gcv_object_t)); /* allocate space */
        /* push all labeli as Fixnums on the STACK: */
        var uintL count;
        dotimespL(count,m, {
          var const uintB* label_byteptr;
          L_operand(label_byteptr);
          pushSTACK(fixnum(label_byteptr - CODEPTR));
        });
      }
      /* jump destination in the SP: */
      pushSP((aint)closureptr);
      { /* build upCTAGBODY-Frame: */
        var gcv_object_t* top_of_frame = STACK; /* Pointer above Frame */
        pushSTACK(tagbody_cons);    /* Cons ( (CONST n) . ...) */
        var JMPBUF_on_SP(returner); /* memorize return-point */
        finish_entry_frame_1(CTAGBODY,returner, goto tagbody_go; );
      }
      /* store Framepointer in Tagbody-Cons: */
      Cdr(tagbody_cons) = make_framepointer(STACK);
    } goto next_byte;
   tagbody_go: { /* jump to this label takes place, if the previously
                    built CTAGBODY-Frame has catched a GO to Label nr. i. */
      var uintL m = Svector_length(Car(STACK_2)); /* Number of Labels */
      /* (I could also declare the m above as 'auto' and use it here.) */
      var uintL i = posfixnum_to_V(value1); /* Number of Labels */
      var uintL index = posfixnum_to_V(STACK_((m-i)+3)); /* labeli */
      /* get closure back, byteptr:=labeli_byteptr : */
      closureptr = (gcv_object_t*) SP_(jmpbufsize+0);
      closure = *closureptr;  /* fetch Closure from Stack */
      codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
      DEBUG_CHECK_BYTEPTR(CODEPTR + index);
      byteptr = CODEPTR + index;
    } goto next_byte;           /* continue interpretation at Label i */
    CASE cod_tagbody_close_nil: /* (TAGBODY-CLOSE-NIL) */
      VALUES1(NIL); /* value of Tagbody is NIL */
    CASE cod_tagbody_close:     /* (TAGBODY-CLOSE) */
      /* unwind CTAGBODY-Frame: */
      #if STACKCHECKC
      if (!(framecode(STACK_0) == CTAGBODY_frame_info))
        GOTO_ERROR(error_STACK_putt);
      #endif
      {
        FREE_JMPBUF_on_SP();
        var object tagbody_cons = STACK_2; /* Tagbody-Cons */
        Cdr(tagbody_cons) = disabled;      /* mark as Disabled */
        skipSTACK(3+Svector_length(Car(tagbody_cons)));
        skipSP(1);
    } goto next_byte;
    CASE cod_go: {              /* (GO n l) */
      var uintL n;
      var uintL l;
      U_operand(n);
      U_operand(l);
      var object tagbody_cons = /* (CONST n) */
        TheCclosure(closure)->clos_consts[n];
      if (eq(Cdr(tagbody_cons),disabled)) {
        var object tag_vector = Car(tagbody_cons);
        pushSTACK(tag_vector);
        pushSTACK(TheSvector(tag_vector)->data[l]); /* label l */
        pushSTACK(S(go));
        error(control_error,GETTEXT("(~S ~S): the tagbody of the tags ~S has already been left"));
      }
      /* value passed to the Tagbody:
         For CTAGBODY-Frames: 1+l as Fixnum,
         For ITAGBODY-Frames: the form-list for Tag nr. l. */
      var gcv_object_t* FRAME = uTheFramepointer(Cdr(tagbody_cons));
      VALUES1(framecode(FRAME_(0)) == CTAGBODY_frame_info
              ? fixnum(1+l)
              : (object)FRAME_(frame_bindings+2*l+1));
      /* unwind upto Tagbody-Frame, then jump to its Routine,
         which then jumps to Label l: */
     #ifndef FAST_SP
      FREE_DYNAMIC_ARRAY(private_SP_space);
     #endif
      unwind_upto(FRAME);
    }
    CASE cod_go_i: {            /* (GO-I k1 k2 n l) */
      var uintL k1;
      var uintL k2;
      var uintL n;
      var uintL l;
      U_operand(k1);
      U_operand(k2);
      U_operand(n);
      U_operand(l);
      var gcv_object_t* FRAME = (gcv_object_t*) SP_(k1+jmpbufsize*k2);
      var object tagbody_cons = FRAME_(n);
      if (eq(Cdr(tagbody_cons),disabled)) {
        var object tag_vector = Car(tagbody_cons);
        pushSTACK(tag_vector);
        pushSTACK(TheSvector(tag_vector)->data[l]); /* label l */
        pushSTACK(S(go));
        error(control_error,GETTEXT("(~S ~S): the tagbody of the tags ~S has already been left"));
      }
      /* value passed to Tagbody:
         For CTAGBODY-Frames 1+l as Fixnum. */
      FRAME = uTheFramepointer(Cdr(tagbody_cons));
      VALUES1(fixnum(1+l));
      /* unwind upto Tagbody-Frame, then jump to its Routine,
         which then jumps to Label l: */
     #ifndef FAST_SP
      FREE_DYNAMIC_ARRAY(private_SP_space);
     #endif
      unwind_upto(FRAME);
    }
    /* ------------------- (12) CATCH and THROW ----------------------- */
    CASE cod_catch_open:        /* (CATCH-OPEN label) */
      { /* occupies 3 STACK-Entries and 1 SP-jmp_buf-Entry and 2 SP-Entries */
        var const uintB* label_byteptr;
        L_operand(label_byteptr);
        /* save closureptr, label_byteptr: */
        pushSP(label_byteptr - CODEPTR); pushSP((aint)closureptr);
      }
      { /* build up Frame: */
        var gcv_object_t* top_of_frame = STACK;
        pushSTACK(value1);          /* Tag */
        var JMPBUF_on_SP(returner); /* memorize return-point */
        finish_entry_frame_1(CATCH,returner, goto catch_return; );
    } goto next_byte;
   catch_return: { /* jump to this label takes place, if the previoulsy
                      built Catch-Frame has catched a Throw. */
      FREE_JMPBUF_on_SP();
      skipSTACK(3);           /* unwind CATCH-Frame */
      var uintL index;
      /* get closure back, byteptr:=label_byteptr : */
      popSP(closureptr = (gcv_object_t*) ); popSP(index = );
      closure = *closureptr;  /* fetch Closure from Stack */
      codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
      DEBUG_CHECK_BYTEPTR(CODEPTR + index);
      byteptr = CODEPTR + index;
    } goto next_byte;           /* continue interpretation at Label */
    CASE cod_catch_close:       /* (CATCH-CLOSE) */
      /* a CATCH-Frame has to come: */
      #if STACKCHECKC
      if (!(framecode(STACK_0) == CATCH_frame_info))
        GOTO_ERROR(error_STACK_putt);
      #endif
      FREE_JMPBUF_on_SP();
      #if STACKCHECKC
      if (!(closureptr == (gcv_object_t*)SP_(0))) /* that Closureptr must be the current one */
        GOTO_ERROR(error_STACK_putt);
      #endif
      skipSP(2); skipSTACK(3);  /* unwind CATCH-Frame */
      goto next_byte;
    CASE cod_throw: {           /* (THROW) */
      var object tag = popSTACK();
      throw_to(tag);
      pushSTACK(tag);
      pushSTACK(S(throw));
      error(control_error,GETTEXT("~S: there is no CATCHer for tag ~S"));
    }
    /* ------------------- (13) UNWIND-PROTECT ----------------------- */
    CASE cod_uwp_open:          /* (UNWIND-PROTECT-OPEN label) */
      { /* occupies 2 STACK-Entries and 1 SP-jmp_buf-Entry and 2 SP-Entries */
        var const uintB* label_byteptr;
        L_operand(label_byteptr);
        /* save closureptr, label_byteptr: */
        pushSP(label_byteptr - CODEPTR); pushSP((aint)closureptr);
      }
      { /* build Frame: */
        var gcv_object_t* top_of_frame = STACK;
        var JMPBUF_on_SP(returner); /* memorize return-point */
        finish_entry_frame_1(UNWIND_PROTECT,returner, goto throw_save; );
    } goto next_byte;
   throw_save: /* jump to this label takes place, if the previously
                  built Unwind-Protect-Frame has stopped a Throw.
       unwind_protect_to_save is to be saved and jumped to at the end. */
      #if STACKCHECKC
      if (!(framecode(STACK_0) == UNWIND_PROTECT_frame_info)) {
        error(serious_condition,GETTEXT("STACK corrupted"));
      }
      #endif
      /* unwind Frame: */
      FREE_JMPBUF_on_SP();
      skipSTACK(2);
      {
        var uintL index;
        /* get closure back, byteptr:=label_byteptr : */
        popSP(closureptr = (gcv_object_t*) );
        popSP(index = );
        /* save unwind_protect_to_save: */
        pushSP((aint)unwind_protect_to_save.fun);
        pushSP((aint)unwind_protect_to_save.upto_frame);
        pushSP((aint)STACK); /* push Pointer above Frame additionally on the SP */
        /* move all values to the Stack: */
        mv_to_STACK();
        /* execute Cleanup-Forms: */
        closure = *closureptr;  /* fetch Closure from Stack */
        codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
        DEBUG_CHECK_BYTEPTR(CODEPTR + index);
        byteptr = CODEPTR + index;
    } goto next_byte;
    CASE cod_uwp_normal_exit:   /* (UNWIND-PROTECT-NORMAL-EXIT) */
      #if STACKCHECKC
      if (!(framecode(STACK_0) == UNWIND_PROTECT_frame_info))
        GOTO_ERROR(error_STACK_putt);
      if (!(closureptr == (gcv_object_t*)SP_(jmpbufsize+0))) /* that Closureptr must be the current one */
        GOTO_ERROR(error_STACK_putt);
      #endif
      /* unwind Frame:
       nothing to do, because closure and byteptr stay unmodified. */
      FREE_JMPBUF_on_SP(); skipSP(2);
      skipSTACK(2);
      /* dummy value for 'unwind_protect_to_save': */
      pushSP((aint)NULL); pushSP((aint)NULL); /* NULL,NULL -> uwp_continue */
      pushSP((aint)STACK); /* push Pointer above Frame additionally on the SP */
      /* move all values to the Stack: */
      mv_to_STACK();
      /* execute Cleanup-Forms: */
      goto next_byte;
    CASE cod_uwp_close:         /* (UNWIND-PROTECT-CLOSE) */
      { /* jump to this label takes place at the end of the Cleanup-Forms. */
        var gcv_object_t* oldSTACK; /* value of STACK before saveing the values */
        popSP( oldSTACK = (gcv_object_t*) );
        var uintL mvcount =     /* number of saved values on Stack */
          STACK_item_count(STACK,oldSTACK);
        if (mvcount >= mv_limit) GOTO_ERROR(error_toomany_values);
        STACK_to_mv(mvcount);
      }
      { /* return to the saved unwind_protect_to_save.fun : */
        var restartf_t fun;
        var gcv_object_t* arg;
        popSP( arg = (gcv_object_t*) ); popSP( fun = (restartf_t) );
        /* return to uwp_continue or uwp_jmpback or unwind_upto: */
        if (fun != NULL) {
          (*fun)(arg);          /* return to unwind_upto or similar. */
          NOTREACHED;
        }
        if (arg == (gcv_object_t*)NULL) {
          /* uwp_continue:
           jump to this label takes place, if after the execution of
           the Cleanup-Forms simply interpretation shall continue. */
          goto next_byte;
        } else {
          /* uwp_jmpback:
           jump to this label takes place, if after the execution of
           the Cleanup-Forms interpretation shall continue at the old
           location in the same Closure. */
          DEBUG_CHECK_BYTEPTR(CODEPTR + (uintP)arg);
          byteptr = CODEPTR + (uintP)arg;
          goto next_byte;
        }
      }
    CASE cod_uwp_cleanup:       /* (UNWIND-PROTECT-CLEANUP) */
      /* this is executed, if within the same Closure an execution
       of the Cleanup-Code is necessary. */
      #if STACKCHECKC
      if (!(framecode(STACK_0) == UNWIND_PROTECT_frame_info))
        GOTO_ERROR(error_STACK_putt);
      if (!(closureptr == (gcv_object_t*)SP_(jmpbufsize+0))) /* that Closureptr must be the current one */
        GOTO_ERROR(error_STACK_putt);
      #endif
      { /* closure remains, byteptr:=label_byteptr : */
        var uintL index = SP_(jmpbufsize+1);
        /* unwind Frame: */
        FREE_JMPBUF_on_SP(); skipSP(2);
        skipSTACK(2);
        /* Dummy-values for 'unwind_protect_to_save': */
        pushSP((aint)NULL);     /* NULL -> uwp_jmpback */
        pushSP(byteptr - CODEPTR);
        pushSP((aint)STACK); /* push Pointer above Frame additionally on the SP */
        /* move all values to the Stack: */
        mv_to_STACK();
        /* execute Cleanup-Forms: */
        DEBUG_CHECK_BYTEPTR(CODEPTR + index);
        byteptr = CODEPTR + index;
    } goto next_byte;
    /* ------------------- (14) HANDLER-BIND ----------------------- */
    CASE cod_handler_open: {    /* (HANDLER-OPEN n) */
      /* occupies 4 STACK-Entries */
      var uintL n;
      U_operand(n);
      /* build up Frame: */
      var gcv_object_t* top_of_frame = STACK; /* Pointer above Frame */
      pushSTACK(TheCclosure(closure)->clos_consts[n]);
      pushSTACK(closure);
      pushSTACK(fake_gcv_object((aint)(_SP_(0))));
      finish_frame(HANDLER);
    } goto next_byte;
    CASE cod_handler_begin_push: /* (HANDLER-BEGIN&PUSH) */
      /* builds up SP newly, occupies 1 SP-Entry and
         starts a new STACK-Region. */
      {
        var uintL count = (uintL)posfixnum_to_V(Car(handler_args.spdepth))
          + jmpbufsize * (uintL)posfixnum_to_V(Cdr(handler_args.spdepth));
        if (count > 0) {
          var SPint* oldsp = handler_args.sp; /* was formerly &SP_(0) */
          /* copy oldsp[0..count-1] to the current SP: */
          oldsp skipSPop count;
          dotimespL(count,count, { oldsp skipSPop -1; pushSP(*oldsp); } );
        }
      }
      pushSP((aint)handler_args.stack); /* Pointer above Handler-Frame */
      VALUES1(handler_args.condition);
      pushSTACK(value1);
      goto next_byte;
    /* ------------------- (15) a few Functions ----------------------- */
    CASE cod_not:               /* (NOT) */
      if (nullp(value1)) goto code_t; else goto code_nil;
    CASE cod_eq:                /* (EQ) */
      if (!eq(value1,popSTACK())) goto code_nil; else goto code_t;
    CASE cod_car: {             /* (CAR) */
      var object arg = value1;
      if (consp(arg)) {
        value1 = Car(arg);    /* CAR of a Cons */
      } else if (nullp(arg)) {
        /* (CAR NIL) = NIL: value1 remains NIL */
      } else
        with_saved_back_trace_subr(L(car),STACK STACKop -1,-1,
                                   error_list(arg); );
      mv_count=1;
    } goto next_byte;
    CASE cod_car_push: {        /* (CAR&PUSH) */
      var object arg = value1;
      if (consp(arg)) {
        pushSTACK(Car(arg));  /* CAR of a Cons */
      } else if (nullp(arg)) {
        pushSTACK(arg);       /* (CAR NIL) = NIL */
      } else
        with_saved_back_trace_subr(L(car),STACK STACKop -1,-1,
                                   error_list(arg); );
    } goto next_byte;
    CASE cod_load_car_push: {   /* (LOAD&CAR&PUSH n) */
      var uintL n;
      U_operand(n);
      var object arg = STACK_(n);
      if (consp(arg)) {
        pushSTACK(Car(arg));  /* CAR of a Cons */
      } else if (nullp(arg)) {
        pushSTACK(arg);       /* (CAR NIL) = NIL */
      } else
        with_saved_back_trace_subr(L(car),STACK STACKop -1,-1,
                                   error_list(arg); );
    } goto next_byte;
    CASE cod_load_car_store: {  /* (LOAD&CAR&STORE m n) */
      var uintL m;
      var uintL n;
      U_operand(m);
      U_operand(n);
      var object arg = STACK_(m);
      if (consp(arg)) {
        STACK_(n) = value1 = Car(arg); /* CAR of a Cons */
      } else if (nullp(arg)) {
        STACK_(n) = value1 = arg; /* (CAR NIL) = NIL */
      } else
        with_saved_back_trace_subr(L(car),STACK STACKop -1,-1,
                                   error_list(arg); );
      mv_count=1;
    } goto next_byte;
    CASE cod_cdr: {             /* (CDR) */
      var object arg = value1;
      if (consp(arg)) {
        value1 = Cdr(arg);    /* CDR of a Cons */
      } else if (nullp(arg)) {
        /* (CDR NIL) = NIL: value1 remains NIL */
      } else
        with_saved_back_trace_subr(L(cdr),STACK STACKop -1,-1,
                                   error_list(arg); );
      mv_count=1;
    } goto next_byte;
    CASE cod_cdr_push: {        /* (CDR&PUSH) */
      var object arg = value1;
      if (consp(arg)) {
        pushSTACK(Cdr(arg));  /* CDR of a Cons */
      } else if (nullp(arg)) {
        pushSTACK(arg);       /* (CDR NIL) = NIL */
      } else
        with_saved_back_trace_subr(L(cdr),STACK STACKop -1,-1,
                                   error_list(arg); );
    } goto next_byte;
    CASE cod_load_cdr_push: {   /* (LOAD&CDR&PUSH n) */
      var uintL n;
      U_operand(n);
      var object arg = STACK_(n);
      if (consp(arg)) {
        pushSTACK(Cdr(arg));  /* CDR of a Cons */
      } else if (nullp(arg)) {
        pushSTACK(arg);       /* (CDR NIL) = NIL */
      } else
        with_saved_back_trace_subr(L(cdr),STACK STACKop -1,-1,
                                   error_list(arg); );
    } goto next_byte;
    CASE cod_load_cdr_store: {  /* (LOAD&CDR&STORE n) */
      var uintL n;
      U_operand(n);
      var gcv_object_t* arg_ = &STACK_(n);
      var object arg = *arg_;
      if (consp(arg)) {
        *arg_ = value1 = Cdr(arg); /* CDR of a Cons */
      } else if (nullp(arg)) {
        value1 = arg;         /* (CDR NIL) = NIL */
      } else
        with_saved_back_trace_subr(L(cdr),STACK STACKop -1,-1,
                                   error_list(arg); );
      mv_count=1;
    } goto next_byte;
    CASE cod_cons: {            /* (CONS) */
      pushSTACK(value1);
      /* request Cons: */
      var object new_cons;
      with_saved_context( { new_cons = allocate_cons(); } );
      /* fill Cons: */
      Cdr(new_cons) = popSTACK();
      Car(new_cons) = popSTACK();
      VALUES1(new_cons);
    } goto next_byte;
    CASE cod_cons_push: {       /* (CONS&PUSH) */
      pushSTACK(value1);
      /* request Cons: */
      var object new_cons;
      with_saved_context( { new_cons = allocate_cons(); } );
      /* fill Cons: */
      Cdr(new_cons) = popSTACK();
      Car(new_cons) = STACK_0;
      STACK_0 = new_cons;
    } goto next_byte;
    CASE cod_load_cons_store: { /* (LOAD&CONS&STORE n) */
      var uintL n;
      U_operand(n);
      /* request Cons: */
      var object new_cons;
      with_saved_context( { new_cons = allocate_cons(); } );
      /* fill Cons: */
      Car(new_cons) = popSTACK();
      var gcv_object_t* arg_ = &STACK_(n);
      Cdr(new_cons) = *arg_;
      VALUES1(*arg_ = new_cons);
    } goto next_byte;
    {var object symbol;
     var object fdef;
     #define CHECK_FDEF()                                                   \
       if (!symbolp(symbol))                                                \
         with_saved_back_trace_subr(L(symbol_function),STACK STACKop -1,-1, \
           symbol = check_symbol(symbol); );                                \
       fdef = Symbol_function(symbol);                                      \
       if (!boundp(fdef))                                                   \
         /* (symbol may be not the actual function-name, for e.g.           \
            (FUNCTION (SETF FOO)) shows as (SYMBOL-FUNCTION '#:|(SETF FOO)|),\
            but that should be enough for the error message.) */            \
         fdef = check_fdefinition(symbol,S(symbol_function))
    CASE cod_symbol_function:   /* (SYMBOL-FUNCTION) */
      symbol = value1;
      CHECK_FDEF();
      VALUES1(fdef);
      goto next_byte;
    CASE cod_const_symbol_function: { /* (CONST&SYMBOL-FUNCTION n) */
      var uintL n;
      U_operand(n);
      symbol = TheCclosure(closure)->clos_consts[n];
    } CHECK_FDEF();
      VALUES1(fdef);
      goto next_byte;
    CASE cod_const_symbol_function_push: { /* (CONST&SYMBOL-FUNCTION&PUSH n) */
      var uintL n;
      U_operand(n);
      symbol = TheCclosure(closure)->clos_consts[n];
    } CHECK_FDEF();
      pushSTACK(fdef);
      goto next_byte;
    CASE cod_const_symbol_function_store: { /* (CONST&SYMBOL-FUNCTION&STORE n k) */
      var uintL n;
      U_operand(n);
      symbol = TheCclosure(closure)->clos_consts[n];
    } CHECK_FDEF(); {
      var uintL k;
      U_operand(k);
      STACK_(k) = value1 = fdef; mv_count=1;
    } goto next_byte;
    }
    {var object vec; var object index;
    CASE cod_svref:             /* (SVREF) */
      /* STACK_0 must be a Simple-Vector: */
      if (!simple_vector_p(STACK_0)) goto svref_not_a_svector;
      vec = popSTACK();         /* Simple-Vector */
      index = value1;
      { /* and the Index must be Fixnum >= 0, < length(vec) : */
        var uintV i;
        if (!(posfixnump(index)
              && ((i = posfixnum_to_V(index)) < Svector_length(vec))))
          goto svref_not_an_index;
        VALUES1(TheSvector(vec)->data[i]); /* indexed Element as value */
    } goto next_byte;
    CASE cod_svset:             /* (SVSET) */
      /* STACK_0 must be a Simple-Vector: */
      if (!simple_vector_p(STACK_0)) goto svref_not_a_svector;
      vec = popSTACK();         /* Simple-Vector */
      index = value1;
      { /* and the Index must be a Fixnum >=0, <Length(vec) : */
        var uintV i;
        if (!(posfixnump(index)
              && ((i = posfixnum_to_V(index)) < Svector_length(vec))))
          goto svref_not_an_index;
        VALUES1(TheSvector(vec)->data[i] = popSTACK()); /* put in new element */
    } goto next_byte;
    svref_not_a_svector:         /* Non-Simple-Vector in STACK_0 */
      { error_no_svector(S(svref),STACK_0); }
    svref_not_an_index:    /* unsuitable Index in index, for Vector vec */
      pushSTACK(vec);
      pushSTACK(index);
      pushSTACK(index);         /* TYPE-ERROR slot DATUM */
      {
        var object tmp;
        pushSTACK(S(integer)); pushSTACK(Fixnum_0); pushSTACK(UL_to_I(Svector_length(vec)));
        tmp = listof(1); pushSTACK(tmp); tmp = listof(3);
        pushSTACK(tmp);         /* TYPE-ERROR slot EXPECTED-TYPE */
      }
      pushSTACK(STACK_(1+2));   /* vec */
      pushSTACK(STACK_(0+3));   /* index */
      pushSTACK(S(svref));
      error(type_error,GETTEXT("~S: ~S is not a correct index into ~S"));
    }
    CASE cod_list: {            /* (LIST n) */
      var uintC n;
      U_operand(n);
      with_saved_context( { value1 = listof(n); mv_count=1; } );
    } goto next_byte;
    CASE cod_list_push: {       /* (LIST&PUSH n) */
      var uintC n;
      U_operand(n);
      with_saved_context( { object res = listof(n); pushSTACK(res); } );
    } goto next_byte;
    CASE cod_liststar: { /* (LIST* n) */
      var uintC n;
      U_operand(n);
      with_saved_context({
        pushSTACK(value1);
        dotimespC(n,n, {
          var object new_cons = allocate_cons();
          Cdr(new_cons) = popSTACK();
          Car(new_cons) = STACK_0;
          STACK_0 = new_cons;
        });
        value1 = popSTACK(); mv_count=1;
      });
    } goto next_byte;
    CASE cod_liststar_push: {   /* (LIST*&PUSH n) */
      var uintC n;
      U_operand(n);
      with_saved_context({
        pushSTACK(value1);
        dotimespC(n,n, {
          var object new_cons = allocate_cons();
          Cdr(new_cons) = popSTACK();
          Car(new_cons) = STACK_0;
          STACK_0 = new_cons;
        });
      });
    } goto next_byte;
    /* ------------------- (16) combined Operations ----------------------- */
    CASE cod_nil_store: {       /* (NIL&STORE n) */
      var uintL n;
      U_operand(n);
      STACK_(n) = value1 = NIL; mv_count=1;
    } goto next_byte;
    CASE cod_t_store: {         /* (T&STORE n) */
      var uintL n;
      U_operand(n);
      STACK_(n) = value1 = T; mv_count=1;
    } goto next_byte;
    CASE cod_calls1_store:      /* (CALLS1&STORE n k) */
      CALLS1();
      goto store;
    CASE cod_calls2_store:      /* (CALLS2&STORE n k) */
      CALLS2();
      goto store;
    CASE cod_callsr_store:      /* (CALLSR&STORE m n k) */
      CALLSR();
      goto store;
    /* Increment. Optimized specifically for Fixnums >=0. */
    #define INC(arg,statement)  \
      { if (posfixnump(arg) /* Fixnum >= 0 and < most-positive-fixnum ? */ \
            && !eq(arg,fixnum(vbitm(oint_data_len)-1))) {              \
          arg = fixnum_inc(arg,1); statement;                          \
        } else {                                                       \
          with_saved_context(                                          \
            /* funcall(L(plus_one),1): */                              \
            pushSTACK(arg);                                            \
            with_saved_back_trace_subr(L(plus_one),STACK,1,            \
              { C_plus_one(); });                                      \
          );                                                           \
          arg = value1;                                                \
        }                                                              \
      }
    /* Decrement. Optimized specifically for Fixnums >=0. */
    #define DEC(arg,statement)  \
      { if (posfixnump(arg) && !eq(arg,Fixnum_0)) { /* Fixnum > 0 ? */ \
          arg = fixnum_inc(arg,-1); statement;                     \
        } else {                                                   \
          with_saved_context(                                      \
            /* funcall(L(minus_one),1): */                         \
            pushSTACK(arg);                                        \
            with_saved_back_trace_subr(L(minus_one),STACK,1,       \
              { C_minus_one(); });                                 \
          );                                                       \
          arg = value1;                                            \
        }                                                          \
      }
    CASE cod_load_inc_push: {   /* (LOAD&INC&PUSH n) */
      var uintL n;
      U_operand(n);
      var object arg = STACK_(n);
      INC(arg,);              /* increment */
      pushSTACK(arg);
    } goto next_byte;
    CASE cod_load_inc_store: {  /* (LOAD&INC&STORE n) */
      var uintL n;
      U_operand(n);
      var gcv_object_t* arg_ = &STACK_(n);
      var object arg = *arg_;
      INC(arg,mv_count=1);    /* increment, one value */
      value1 = *arg_ = arg;
    } goto next_byte;
    CASE cod_load_dec_push: {   /* (LOAD&DEC&PUSH n) */
      var uintL n;
      U_operand(n);
      var object arg = STACK_(n);
      DEC(arg,);              /* decrement */
      pushSTACK(arg);
    } goto next_byte;
    CASE cod_load_dec_store: {  /* (LOAD&DEC&STORE n) */
      var uintL n;
      U_operand(n);
      var gcv_object_t* arg_ = &STACK_(n);
      var object arg = *arg_;
      DEC(arg,mv_count=1);    /* decrement, one value */
      value1 = *arg_ = arg;
    } goto next_byte;
    CASE cod_call1_jmpif:       /* (CALL1&JMPIF n label) */
      CALL1();
      if (!nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_call1_jmpifnot:    /* (CALL1&JMPIFNOT n label) */
      CALL1();
      if (nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_call2_jmpif:       /* (CALL2&JMPIF n label) */
      CALL2();
      if (!nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_call2_jmpifnot:    /* (CALL2&JMPIFNOT n label) */
      CALL2();
      if (nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_calls1_jmpif:      /* (CALLS1&JMPIF n label) */
      CALLS1();
      if (!nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_calls1_jmpifnot:   /* (CALLS1&JMPIFNOT n label) */
      CALLS1();
      if (nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_calls2_jmpif:      /* (CALLS2&JMPIF n label) */
      CALLS2();
      if (!nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_calls2_jmpifnot:   /* (CALLS2&JMPIFNOT n label) */
      CALLS2();
      if (nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_callsr_jmpif:      /* (CALLSR&JMPIF m n label) */
      CALLSR();
      if (!nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_callsr_jmpifnot:   /* (CALLSR&JMPIFNOT m n label) */
      CALLSR();
      if (nullp(value1)) goto jmp; else goto notjmp;
    CASE cod_load_jmpif: {      /* (LOAD&JMPIF n label) */
      var uintL n;
      U_operand(n);
      mv_count=1;
      if (!nullp(value1 = STACK_(n))) goto jmp; else goto notjmp;
    }
    CASE cod_load_jmpifnot: {   /* (LOAD&JMPIFNOT n label) */
      var uintL n;
      U_operand(n);
      mv_count=1;
      if (nullp(value1 = STACK_(n))) goto jmp; else goto notjmp;
    }
    CASE cod_apply_skip_ret: {  /* (APPLY&SKIP&RET n k) */
      var uintL n;
      var uintL k;
      U_operand(n);
      U_operand(k);
      var object fun = STACK_(n); /* Function */
      with_saved_context({
        apply(fun,n,value1);  /* call Function */
        skipSTACK(k+1);   /* discard Function and others from Stack */
        goto finished;    /* return (jump) to caller */
      });                 /* the context is not restored */
    }
    CASE cod_funcall_skip_retgf: { /* (FUNCALL&SKIP&RETGF n k) */
      var uintL n;
      var uintL k;
      U_operand(n);
      U_operand(k);
      var object fun = STACK_(n); /* Function */
      var uintL r = ((Codevec)codeptr)->ccv_numreq;
      var uintB flags = ((Codevec)codeptr)->ccv_flags;
      with_saved_context({
        funcall(fun,n);       /* call Function */
        if (flags & bit(3)) { /* call inhibition? */
          skipSTACK(k+1);
          mv_count=1;
          goto finished;      /* return (jump) to caller */
        }
        k -= r;
        if (flags & bit(0)) {
          skipSTACK(k); apply(value1,r,popSTACK());
        } else {
          skipSTACK(k+1); funcall(value1,r);
        }
        goto finished;        /* return (jump) to caller */
      });                     /* the context is not restored */
    }
    /* ------------------- (17) short codes ----------------------- */
    CASE cod_load0:             /* (LOAD.S 0) */
      VALUES1(STACK_(0));
      goto next_byte;
    CASE cod_load1:             /* (LOAD.S 1) */
      VALUES1(STACK_(1));
      goto next_byte;
    CASE cod_load2:             /* (LOAD.S 2) */
      VALUES1(STACK_(2));
      goto next_byte;
    CASE cod_load3:             /* (LOAD.S 3) */
      VALUES1(STACK_(3));
      goto next_byte;
    CASE cod_load4:             /* (LOAD.S 4) */
      VALUES1(STACK_(4));
      goto next_byte;
    CASE cod_load5:             /* (LOAD.S 5) */
      VALUES1(STACK_(5));
      goto next_byte;
    CASE cod_load6:             /* (LOAD.S 6) */
      VALUES1(STACK_(6));
      goto next_byte;
    CASE cod_load7:             /* (LOAD.S 7) */
      VALUES1(STACK_(7));
      goto next_byte;
    CASE cod_load8:             /* (LOAD.S 8) */
      VALUES1(STACK_(8));
      goto next_byte;
    CASE cod_load9:             /* (LOAD.S 9) */
      VALUES1(STACK_(9));
      goto next_byte;
    CASE cod_load10:            /* (LOAD.S 10) */
      VALUES1(STACK_(10));
      goto next_byte;
    CASE cod_load11:            /* (LOAD.S 11) */
      VALUES1(STACK_(11));
      goto next_byte;
    CASE cod_load12:            /* (LOAD.S 12) */
      VALUES1(STACK_(12));
      goto next_byte;
    CASE cod_load13:            /* (LOAD.S 13) */
      VALUES1(STACK_(13));
      goto next_byte;
    CASE cod_load14:            /* (LOAD.S 14) */
      VALUES1(STACK_(14));
      goto next_byte;
   #if 0
    CASE cod_load15:            /* (LOAD.S 15) */
      VALUES1(STACK_(15));
      goto next_byte;
    CASE cod_load16:            /* (LOAD.S 16) */
      VALUES1(STACK_(16));
      goto next_byte;
    CASE cod_load17:            /* (LOAD.S 17) */
      VALUES1(STACK_(17));
      goto next_byte;
    CASE cod_load18:            /* (LOAD.S 18) */
      VALUES1(STACK_(18));
      goto next_byte;
    CASE cod_load19:            /* (LOAD.S 19) */
      VALUES1(STACK_(19));
      goto next_byte;
    CASE cod_load20:            /* (LOAD.S 20) */
      VALUES1(STACK_(20));
      goto next_byte;
    CASE cod_load21:            /* (LOAD.S 21) */
      VALUES1(STACK_(21));
      goto next_byte;
   #endif
    CASE cod_load_push0:        /* (LOAD&PUSH.S 0) */
      pushSTACK(STACK_(0));
      goto next_byte;
    CASE cod_load_push1:        /* (LOAD&PUSH.S 1) */
      pushSTACK(STACK_(1));
      goto next_byte;
    CASE cod_load_push2:        /* (LOAD&PUSH.S 2) */
      pushSTACK(STACK_(2));
      goto next_byte;
    CASE cod_load_push3:        /* (LOAD&PUSH.S 3) */
      pushSTACK(STACK_(3));
      goto next_byte;
    CASE cod_load_push4:        /* (LOAD&PUSH.S 4) */
      pushSTACK(STACK_(4));
      goto next_byte;
    CASE cod_load_push5:        /* (LOAD&PUSH.S 5) */
      pushSTACK(STACK_(5));
      goto next_byte;
    CASE cod_load_push6:        /* (LOAD&PUSH.S 6) */
      pushSTACK(STACK_(6));
      goto next_byte;
    CASE cod_load_push7:        /* (LOAD&PUSH.S 7) */
      pushSTACK(STACK_(7));
      goto next_byte;
    CASE cod_load_push8:        /* (LOAD&PUSH.S 8) */
      pushSTACK(STACK_(8));
      goto next_byte;
    CASE cod_load_push9:        /* (LOAD&PUSH.S 9) */
      pushSTACK(STACK_(9));
      goto next_byte;
    CASE cod_load_push10:       /* (LOAD&PUSH.S 10) */
      pushSTACK(STACK_(10));
      goto next_byte;
    CASE cod_load_push11:       /* (LOAD&PUSH.S 11) */
      pushSTACK(STACK_(11));
      goto next_byte;
    CASE cod_load_push12:       /* (LOAD&PUSH.S 12) */
      pushSTACK(STACK_(12));
      goto next_byte;
    CASE cod_load_push13:       /* (LOAD&PUSH.S 13) */
      pushSTACK(STACK_(13));
      goto next_byte;
    CASE cod_load_push14:       /* (LOAD&PUSH.S 14) */
      pushSTACK(STACK_(14));
      goto next_byte;
    CASE cod_load_push15:       /* (LOAD&PUSH.S 15) */
      pushSTACK(STACK_(15));
      goto next_byte;
    CASE cod_load_push16:       /* (LOAD&PUSH.S 16) */
      pushSTACK(STACK_(16));
      goto next_byte;
    CASE cod_load_push17:       /* (LOAD&PUSH.S 17) */
      pushSTACK(STACK_(17));
      goto next_byte;
    CASE cod_load_push18:       /* (LOAD&PUSH.S 18) */
      pushSTACK(STACK_(18));
      goto next_byte;
    CASE cod_load_push19:       /* (LOAD&PUSH.S 19) */
      pushSTACK(STACK_(19));
      goto next_byte;
    CASE cod_load_push20:       /* (LOAD&PUSH.S 20) */
      pushSTACK(STACK_(20));
      goto next_byte;
    CASE cod_load_push21:       /* (LOAD&PUSH.S 21) */
      pushSTACK(STACK_(21));
      goto next_byte;
    CASE cod_load_push22:       /* (LOAD&PUSH.S 22) */
      pushSTACK(STACK_(22));
      goto next_byte;
    CASE cod_load_push23:       /* (LOAD&PUSH.S 23) */
      pushSTACK(STACK_(23));
      goto next_byte;
    CASE cod_load_push24:       /* (LOAD&PUSH.S 24) */
      pushSTACK(STACK_(24));
      goto next_byte;
    CASE cod_const0:            /* (CONST.S 0) */
      VALUES1(TheCclosure(closure)->clos_consts[0]);
      goto next_byte;
    CASE cod_const1:            /* (CONST.S 1) */
      VALUES1(TheCclosure(closure)->clos_consts[1]);
      goto next_byte;
    CASE cod_const2:            /* (CONST.S 2) */
      VALUES1(TheCclosure(closure)->clos_consts[2]);
      goto next_byte;
    CASE cod_const3:            /* (CONST.S 3) */
      VALUES1(TheCclosure(closure)->clos_consts[3]);
      goto next_byte;
    CASE cod_const4:            /* (CONST.S 4) */
      VALUES1(TheCclosure(closure)->clos_consts[4]);
      goto next_byte;
    CASE cod_const5:            /* (CONST.S 5) */
      VALUES1(TheCclosure(closure)->clos_consts[5]);
      goto next_byte;
    CASE cod_const6:            /* (CONST.S 6) */
      VALUES1(TheCclosure(closure)->clos_consts[6]);
      goto next_byte;
    CASE cod_const7:            /* (CONST.S 7) */
      VALUES1(TheCclosure(closure)->clos_consts[7]);
      goto next_byte;
    CASE cod_const8:            /* (CONST.S 8) */
      VALUES1(TheCclosure(closure)->clos_consts[8]);
      goto next_byte;
    CASE cod_const9:            /* (CONST.S 9) */
      VALUES1(TheCclosure(closure)->clos_consts[9]);
      goto next_byte;
    CASE cod_const10:           /* (CONST.S 10) */
      VALUES1(TheCclosure(closure)->clos_consts[10]);
      goto next_byte;
    CASE cod_const11:           /* (CONST.S 11) */
      VALUES1(TheCclosure(closure)->clos_consts[11]);
      goto next_byte;
    CASE cod_const12:           /* (CONST.S 12) */
      VALUES1(TheCclosure(closure)->clos_consts[12]);
      goto next_byte;
    CASE cod_const13:           /* (CONST.S 13) */
      VALUES1(TheCclosure(closure)->clos_consts[13]);
      goto next_byte;
    CASE cod_const14:           /* (CONST.S 14) */
      VALUES1(TheCclosure(closure)->clos_consts[14]);
      goto next_byte;
    CASE cod_const15:           /* (CONST.S 15) */
      VALUES1(TheCclosure(closure)->clos_consts[15]);
      goto next_byte;
    CASE cod_const16:           /* (CONST.S 16) */
      VALUES1(TheCclosure(closure)->clos_consts[16]);
      goto next_byte;
    CASE cod_const17:           /* (CONST.S 17) */
      VALUES1(TheCclosure(closure)->clos_consts[17]);
      goto next_byte;
    CASE cod_const18:           /* (CONST.S 18) */
      VALUES1(TheCclosure(closure)->clos_consts[18]);
      goto next_byte;
    CASE cod_const19:           /* (CONST.S 19) */
      VALUES1(TheCclosure(closure)->clos_consts[19]);
      goto next_byte;
    CASE cod_const20:           /* (CONST.S 20) */
      VALUES1(TheCclosure(closure)->clos_consts[20]);
      goto next_byte;
   #if 0
    CASE cod_const21:           /* (CONST.S 21) */
      VALUES1(TheCclosure(closure)->clos_consts[21]);
      goto next_byte;
    CASE cod_const22:           /* (CONST.S 22) */
      VALUES1(TheCclosure(closure)->clos_consts[22]);
      goto next_byte;
    CASE cod_const23:           /* (CONST.S 23) */
      VALUES1(TheCclosure(closure)->clos_consts[23]);
      goto next_byte;
    CASE cod_const24:           /* (CONST.S 24) */
      VALUES1(TheCclosure(closure)->clos_consts[24]);
      goto next_byte;
   #endif
    CASE cod_const_push0:       /* (CONST&PUSH.S 0) */
      pushSTACK(TheCclosure(closure)->clos_consts[0]);
      goto next_byte;
    CASE cod_const_push1:       /* (CONST&PUSH.S 1) */
      pushSTACK(TheCclosure(closure)->clos_consts[1]);
      goto next_byte;
    CASE cod_const_push2:       /* (CONST&PUSH.S 2) */
      pushSTACK(TheCclosure(closure)->clos_consts[2]);
      goto next_byte;
    CASE cod_const_push3:       /* (CONST&PUSH.S 3) */
      pushSTACK(TheCclosure(closure)->clos_consts[3]);
      goto next_byte;
    CASE cod_const_push4:       /* (CONST&PUSH.S 4) */
      pushSTACK(TheCclosure(closure)->clos_consts[4]);
      goto next_byte;
    CASE cod_const_push5:       /* (CONST&PUSH.S 5) */
      pushSTACK(TheCclosure(closure)->clos_consts[5]);
      goto next_byte;
    CASE cod_const_push6:       /* (CONST&PUSH.S 6) */
      pushSTACK(TheCclosure(closure)->clos_consts[6]);
      goto next_byte;
    CASE cod_const_push7:       /* (CONST&PUSH.S 7) */
      pushSTACK(TheCclosure(closure)->clos_consts[7]);
      goto next_byte;
    CASE cod_const_push8:       /* (CONST&PUSH.S 8) */
      pushSTACK(TheCclosure(closure)->clos_consts[8]);
      goto next_byte;
    CASE cod_const_push9:       /* (CONST&PUSH.S 9) */
      pushSTACK(TheCclosure(closure)->clos_consts[9]);
      goto next_byte;
    CASE cod_const_push10:      /* (CONST&PUSH.S 10) */
      pushSTACK(TheCclosure(closure)->clos_consts[10]);
      goto next_byte;
    CASE cod_const_push11:      /* (CONST&PUSH.S 11) */
      pushSTACK(TheCclosure(closure)->clos_consts[11]);
      goto next_byte;
    CASE cod_const_push12:      /* (CONST&PUSH.S 12) */
      pushSTACK(TheCclosure(closure)->clos_consts[12]);
      goto next_byte;
    CASE cod_const_push13:      /* (CONST&PUSH.S 13) */
      pushSTACK(TheCclosure(closure)->clos_consts[13]);
      goto next_byte;
    CASE cod_const_push14:      /* (CONST&PUSH.S 14) */
      pushSTACK(TheCclosure(closure)->clos_consts[14]);
      goto next_byte;
    CASE cod_const_push15:      /* (CONST&PUSH.S 15) */
      pushSTACK(TheCclosure(closure)->clos_consts[15]);
      goto next_byte;
    CASE cod_const_push16:      /* (CONST&PUSH.S 16) */
      pushSTACK(TheCclosure(closure)->clos_consts[16]);
      goto next_byte;
    CASE cod_const_push17:      /* (CONST&PUSH.S 17) */
      pushSTACK(TheCclosure(closure)->clos_consts[17]);
      goto next_byte;
    CASE cod_const_push18:      /* (CONST&PUSH.S 18) */
      pushSTACK(TheCclosure(closure)->clos_consts[18]);
      goto next_byte;
    CASE cod_const_push19:      /* (CONST&PUSH.S 19) */
      pushSTACK(TheCclosure(closure)->clos_consts[19]);
      goto next_byte;
    CASE cod_const_push20:      /* (CONST&PUSH.S 20) */
      pushSTACK(TheCclosure(closure)->clos_consts[20]);
      goto next_byte;
    CASE cod_const_push21:      /* (CONST&PUSH.S 21) */
      pushSTACK(TheCclosure(closure)->clos_consts[21]);
      goto next_byte;
    CASE cod_const_push22:      /* (CONST&PUSH.S 22) */
      pushSTACK(TheCclosure(closure)->clos_consts[22]);
      goto next_byte;
    CASE cod_const_push23:      /* (CONST&PUSH.S 23) */
      pushSTACK(TheCclosure(closure)->clos_consts[23]);
      goto next_byte;
    CASE cod_const_push24:      /* (CONST&PUSH.S 24) */
      pushSTACK(TheCclosure(closure)->clos_consts[24]);
      goto next_byte;
    CASE cod_const_push25:      /* (CONST&PUSH.S 25) */
      pushSTACK(TheCclosure(closure)->clos_consts[25]);
      goto next_byte;
    CASE cod_const_push26:      /* (CONST&PUSH.S 26) */
      pushSTACK(TheCclosure(closure)->clos_consts[26]);
      goto next_byte;
    CASE cod_const_push27:      /* (CONST&PUSH.S 27) */
      pushSTACK(TheCclosure(closure)->clos_consts[27]);
      goto next_byte;
    CASE cod_const_push28:      /* (CONST&PUSH.S 28) */
      pushSTACK(TheCclosure(closure)->clos_consts[28]);
      goto next_byte;
    CASE cod_const_push29:      /* (CONST&PUSH.S 29) */
      pushSTACK(TheCclosure(closure)->clos_consts[29]);
      goto next_byte;
   #if 0
    CASE cod_const_push30:      /* (CONST&PUSH.S 30) */
      pushSTACK(TheCclosure(closure)->clos_consts[30]);
      goto next_byte;
    CASE cod_const_push31:      /* (CONST&PUSH.S 31) */
      pushSTACK(TheCclosure(closure)->clos_consts[31]);
      goto next_byte;
    CASE cod_const_push32:      /* (CONST&PUSH.S 32) */
      pushSTACK(TheCclosure(closure)->clos_consts[32]);
      goto next_byte;
   #endif
    CASE cod_store0:            /* (STORE.S 0) */
      STACK_(0) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store1:            /* (STORE.S 1) */
      STACK_(1) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store2:            /* (STORE.S 2) */
      STACK_(2) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store3:            /* (STORE.S 3) */
      STACK_(3) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store4:            /* (STORE.S 4) */
      STACK_(4) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store5:            /* (STORE.S 5) */
      STACK_(5) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store6:            /* (STORE.S 6) */
      STACK_(6) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store7:            /* (STORE.S 7) */
      STACK_(7) = value1; mv_count=1;
      goto next_byte;
   #if 0
    CASE cod_store8:            /* (STORE.S 8) */
      STACK_(8) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store9:            /* (STORE.S 9) */
      STACK_(9) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store10:           /* (STORE.S 10) */
      STACK_(10) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store11:           /* (STORE.S 11) */
      STACK_(11) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store12:           /* (STORE.S 12) */
      STACK_(12) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store13:           /* (STORE.S 13) */
      STACK_(13) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store14:           /* (STORE.S 14) */
      STACK_(14) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store15:           /* (STORE.S 15) */
      STACK_(15) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store16:           /* (STORE.S 16) */
      STACK_(16) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store17:           /* (STORE.S 17) */
      STACK_(17) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store18:           /* (STORE.S 18) */
      STACK_(18) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store19:           /* (STORE.S 19) */
      STACK_(19) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store20:           /* (STORE.S 20) */
      STACK_(20) = value1; mv_count=1;
      goto next_byte;
    CASE cod_store21:           /* (STORE.S 21) */
      STACK_(21) = value1; mv_count=1;
      goto next_byte;
   #endif
    /* ------------------- miscellaneous ----------------------- */
   #ifndef FAST_DISPATCH
    default:
   #endif
      /* undefined Code */
      #if defined(GNU) && defined(FAST_SP)
        /* Undo the effect of -fomit-frame-pointer for this function,
           hereby allowing utilization of %sp resp. %esp as private_SP: */
        alloca(1);
      #endif
      pushSTACK(fixnum(byteptr-&codeptr->data[0]-1)); /* bad byte number */
      pushSTACK(closure);                             /* Closure */
      error(serious_condition,GETTEXT("undefined bytecode in ~S at byte ~S"));
    #undef L_operand
    #undef S_operand
    #undef U_operand
    #undef B_operand
    #undef CASE
  }
 #if DEBUG_BYTECODE
 error_byteptr: {
    pushSTACK(fixnum(byteptr_max));
    pushSTACK(fixnum(byteptr_min));
    pushSTACK(fixnum(byteptr - codeptr->data));
    pushSTACK(sfixnum(byteptr_bad_jump));
    pushSTACK(closure);
    error(error_condition,GETTEXT("~S: jump by ~S takes ~S outside [~S;~S]"));
  }
 #endif
 error_toomany_values: {
    pushSTACK(closure);
    error(error_condition,GETTEXT("~S: too many return values"));
  }
 #if STACKCHECKC
 error_STACK_putt: {
    pushSTACK(fixnum(byteptr - codeptr->data - byteptr_min)); /* PC */
    pushSTACK(closure);                       /* FUNC */
    error(serious_condition,GETTEXT("Corrupted STACK in ~S at byte ~S"));
  }
 #endif
 finished:
  #undef FREE_JMPBUF_on_SP
  #undef JMPBUF_on_SP
  #ifndef FAST_SP
  FREE_DYNAMIC_ARRAY(private_SP_space);
  #endif
  return;
}


/* UP: initialize hand-made compiled closures
 init_cclosures();
 can trigger GC */
global maygc void init_cclosures (void) {
  /* Build #13Y(00 00 00 00 00 00 00 00 00 01 C5 19 01) ; (CONST 0) (SKIP&RET 1) */
  {
    var object codevec = allocate_bit_vector(Atype_8Bit,CCV_START_NONKEY+3);
    TheCodevec(codevec)->ccv_spdepth_1 = 0;
    TheCodevec(codevec)->ccv_spdepth_jmpbufsize = 0;
    TheCodevec(codevec)->ccv_numreq = 0;
    TheCodevec(codevec)->ccv_numopt = 0;
    TheCodevec(codevec)->ccv_flags = 0;
    TheCodevec(codevec)->ccv_signature = cclos_argtype_0_0;
    TheSbvector(codevec)->data[CCV_START_NONKEY+0] = cod_const0;
    TheSbvector(codevec)->data[CCV_START_NONKEY+1] = cod_skip_ret;
    TheSbvector(codevec)->data[CCV_START_NONKEY+2] = 1;
    O(constant_initfunction_code) = codevec;
  }
  /* Build #12Y(00 00 00 00 00 00 00 00 11 16 1B 7E) ; L0 (JMP L0) */
  {
    var object codevec = allocate_bit_vector(Atype_8Bit,CCV_START_NONKEY+2);
    TheCodevec(codevec)->ccv_spdepth_1 = 0;
    TheCodevec(codevec)->ccv_spdepth_jmpbufsize = 0;
    TheCodevec(codevec)->ccv_numreq = 0;
    TheCodevec(codevec)->ccv_numopt = 0;
    TheCodevec(codevec)->ccv_flags = bit(4)|bit(0);
    TheCodevec(codevec)->ccv_signature = cclos_argtype_0_0_rest;
    TheSbvector(codevec)->data[CCV_START_NONKEY+0] = cod_jmp;
    TheSbvector(codevec)->data[CCV_START_NONKEY+1] = 128 - 2;
    O(endless_loop_code) = codevec;
  }
}

#if defined(USE_JITC)
 #if defined(lightning)
  #include "lightning.c"
 #else
  #error USE_JITC: what is your JITC flavor?
 #endif
#endif

/* where is check_SP() or check_STACK() to be inserted??
 is nest_env supposed to receive its target-environment as parameter??
 register-allocation in eval_subr and eval_cclosure etc.??
 eliminate subr_self?? */