# EVAL, APPLY and bytecode interpreter for CLISP
# Bruno Haible 1990-2002
# Sam Steingold 1998-2002
# 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 : 2 SUBRs
    _(funtabref), _(subr_info),
    # 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 : 47 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_gleich),
    _(string_ungleich), _(string_kleiner), _(string_groesser),
    _(string_klgleich), _(string_grgleich), _(string_equal),
    _(string_not_equal), _(string_lessp), _(string_greaterp),
    _(string_not_greaterp), _(string_not_lessp), _(search_string_gleich),
    _(search_string_equal), _(make_string), _(string_both_trim),
    _(nstring_upcase), _(string_upcase), _(nstring_downcase),
    _(string_downcase), _(nstring_capitalize), _(string_capitalize),
    _(string), _(name_char), _(substring),
    # CONTROL : 21-2 SUBRs
    _(symbol_value), /* _(symbol_function), */ _(boundp), _(fboundp),
    _(special_operator_p), _(set), _(makunbound), _(fmakunbound), /* _(values_list), */
    _(driver), _(unwind_to_driver), _(macro_function), _(macroexpand),
    _(macroexpand_1), _(proclaim), _(eval), _(evalhook), _(applyhook),
    _(constantp), _(parse_body), _(keyword_test),
    # 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 : 36 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), _(write), _(prin1), _(print), _(pprint), _(princ),
    _(write_to_string), _(prin1_to_string), _(princ_to_string), _(write_char),
    _(write_string), _(write_line), _(terpri), _(fresh_line),
    _(finish_output), _(force_output), _(clear_output), _(line_position),
    # LIST : 83-36 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),
    _(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 : 26 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),
    _(find_symbol), _(unintern), _(export), _(unexport), _(import),
    _(shadowing_import), _(shadow), _(use_package), _(unuse_package),
    _(make_package), _(pin_package), _(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_dir), _(delete_dir), _(file_write_date), _(file_author),
    _(savemem),
    # PREDTYPE : 46-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), _(generic_function_p), _(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),
    # RECORD : 23 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_code_vector), _(make_closure),
    _(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),
    # SEQUENCE : 40 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), _(keywordp), _(gensym), _(special_variable_p), _(gensym),
    # LISPARIT : 84 SUBRs
    _(decimal_string), _(zerop), _(plusp), _(minusp), _(oddp), _(evenp),
    _(einsplus), _(einsminus), _(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), _(fakultaet), _(exquo), _(long_float_digits),
    _(set_long_float_digits), _(log2), _(log10),
    # other:
    };
  # that were 526-43 SUBRs.
  # 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_gleich), _(char_ungleich), _(char_kleiner), _(char_groesser),
    _(char_klgleich), _(char_grgleich), _(char_equal), _(char_not_equal),
    _(char_lessp), _(char_greaterp), _(char_not_greaterp), _(char_not_lessp),
    _(string_concat),
    # CONTROL : 10 SUBRs
    _(apply), _(pfuncall), _(funcall), _(mapcar), _(maplist), _(mapc),
    _(mapl), _(mapcan), _(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), _(liststern), _(append), _(nconc),
    # MISC : 0 SUBRs
    # PACKAGE : 0 SUBRs
    # PATHNAME : 0 SUBRs
    # PREDTYPE : 0 SUBRs
    # RECORD : 1 SUBR
    _(pallocate_instance),
    # SEQUENCE : 6 SUBRs
    _(concatenate), _(map), _(some), _(every), _(notany), _(notevery),
    # STREAM : 2 SUBRs
    _(make_broadcast_stream), _(make_concatenated_stream),
    # SYMBOL : 0 SUBRs
    # LISPARIT : 18 SUBRs
    _(gleich), _(ungleich), _(kleiner), _(groesser), _(klgleich),
    _(grgleich), _(max), _(min), _(plus), _(minus), _(mal), _(durch), _(gcd),
    _(lcm), _(logior), _(logxor), _(logand), _(logeqv),
    };
  # That were 64 SUBRs.
  #undef _
  #define FUNTAB1  (&FUNTAB[0])
  #define FUNTAB2  (&FUNTAB[256])
  #define FUNTAB_length  (sizeof(FUNTAB)/sizeof(Subr))
  #define FUNTABR_length  (sizeof(FUNTABR)/sizeof(Subr))

# 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_;

# 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 Values interpret_bytecode_ (object closure, Sbvector codeptr, const uintB* byteptr);
  #define interpret_bytecode(closure,codevec,index)  \
    interpret_bytecode_(closure,TheSbvector(codevec),&TheSbvector(codevec)->data[index])

# GCC2 can jump directly to labels. This results in faster code than switch().
  #ifdef GNU
    #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

# Values of the bytecodes (256 totally):
  #ifndef FAST_DISPATCH
    typedef enum {
      #define BYTECODE(code)  code,
      #include "bytecode.c"
      #undef BYTECODE
      cod_for_broken_compilers_that_dont_like_trailing_commas
    } bytecode_enum;
  #endif


#        ---------------------- 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.
LISPFUNN(funtabref,1)
  {
    var object arg = popSTACK(); # argument
    var uintL i;
    if (posfixnump(arg) # should be Fixnum >=0
        && (i = posfixnum_to_L(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-anz           number of required parameters,
#   opt-anz           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.
LISPFUNN(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_anz)); # req-anz (req-nr)
    pushSTACK(fixnum(TheSubr(obj)->opt_anz)); # opt-anz (opt-nr)
    pushSTACK(TheSubr(obj)->rest_flag == subr_norest ? NIL : T); # rest-p
    coerce_sequence(TheSubr(obj)->keywords,S(list),true);
    pushSTACK(value1); # keyword-vector as list
    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 void unwind (void);
  global void unwind()
    {
      var fcint frame_info = framecode(STACK_0);
      #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
        # (no at APPLY, EVAL ungetrapped, CATCH, HANDLER,
        #  IBLOCK and ITAGBODY unnested)
        {
          if ((frame_info & bit(skip2_bit_t)) == 0) { # ENV-Frame 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
                             fehler_mv_zuviel(framecode(STACK_(0+3))==TRAPPED_EVAL_frame_info
                                              ? S(eval)
                                              : S(apply)););
                  dynamic_unbind(); # unbind
                }
              }
            else {
              #ifdef HAVE_SAVED_REGISTERS
              if ((frame_info & bit(callback_bit_t)) == 0) {
                # CALLBACK_FRAME
                var object* 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 fertig;
              } else
              #endif
              {
                # VAR_FRAME or FUN_FRAME
                var object* 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 object* frame_end = STACKpointable(new_STACK);
                  var object* bindingptr = &STACK_(frame_bindings); # start of the variable-/functionbindings
                  until (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 fertig;
              }
            }
          } else {
            # DYNBIND_FRAME or CALLBACK_FRAME or ENV_FRAME
            if (frame_info & bit(envbind_bit_t)) {
              # ENV_FRAME
              var object* 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 object* new_STACK = topofframe(STACK_0); # Pointer to Frame
              var object* frame_end = STACKpointable(new_STACK);
              var object* bindingptr = &STACK_1; # start of the bindings
              # bindingptr iterates through the bindings
              until (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 fertig;
            }
          }
        }
      # set STACK, thus unwind frame:
      setSTACK(STACK = topofframe(STACK_0));
      fertig: ;
    }

# UP: "unwinds" the STACK up to the next DRIVER_FRAME and
# jumps into the corresponding top-level-loop.
# reset();
nonreturning_function(global, reset, (void)) {
  # when unwinding UNWIND-PROTECT-frames, don't save values:
  VALUES0;
  unwind_protect_to_save.fun = (restart)&reset;
  loop {
    # does STACK end here?
    if (eq(STACK_0,nullobj) && eq(STACK_1,nullobj)) {
      driver(); quit(); # STACK completely gone -> restart
    }
    if (framecode(STACK_0) & bit(frame_bit_t)) {
      # at STACK_0: beginning of a frame
      if (framecode(STACK_0) == DRIVER_frame_info) # DRIVER_FRAME ?
        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
global void progv (object symlist, object vallist) {
  # demand room on STACK:
  get_space_on_STACK(llength(symlist)*2*sizeof(object));
  # build frame:
  var object* top_of_frame = STACK; # Pointer to Frame
  var object symlistr = symlist;
  while (consp(symlistr)) { # loop over symbol list
    var object sym = Car(symlistr);
    if (!symbolp(sym))
      fehler_kein_symbol(S(progv),sym);
    if (constantp(TheSymbol(sym))) {
      pushSTACK(sym);
      pushSTACK(S(progv));
      fehler(program_error,
             GETTEXT("~: ~ is a constant, cannot be bound dynamically"));
    }
    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, unwind_upto, (object* upto_frame)) {
  unwind_protect_to_save.fun        = &unwind_upto;
  unwind_protect_to_save.upto_frame = upto_frame;
  until (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 object* FRAME = STACK;
  loop { # 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 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 object* FRAME = STACK;
  loop { # 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;
    } elif (eq(FRAME_(0),nullobj)) { # End of Stack?
      break; # yes -> finised, jump back
    } elif (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 object* top_of_frame = STACK;
            var sp_jmp_buf returner; # return point
            finish_entry_frame(UNWIND_PROTECT,&!returner,, {
              var restart fun = unwind_protect_to_save.fun;
              var object* 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)
                + posfixnum_to_L(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*, object*, 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;
    }
  }
}

# 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: returns the value of a symbol in an environment.
# sym_value(symbol,venv)
# > symbol: Symbol
# > venv: a Variable- and Symbolmacro-Environment
# < result: value of the Symbols in this Environment
  local object sym_value (object sym, object venv);
  local object sym_value(sym,env)
    var object sym;
    var object env;
    {
      if (constantp(TheSymbol(sym))) # constants have only global values
        goto global_value;
      if (special_var_p(TheSymbol(sym))) # the same for symbols declared special
        goto global_value;
      {
        #ifdef NO_symbolflags
          #define binds_sym_p(bindptr) # Does the binding at bindptr bind the Symbol sym? \
            (eq(*(bindptr STACKop 1),sym) # right Symbol?                                  \
             && eq(*(bindingsptr STACKop 0),fixnum(bit(active_bit))) # and active and static? \
            )
        #else
        var object cmp = as_object(as_oint(sym) | wbit(active_bit_o)); # for comparison: binding must be active
          #define binds_sym_p(bindptr) # Does the binding at bindptr bind the Symbol sym? \
            (eq(*(bindingsptr STACKop 0),cmp)) # right Symbol and active and static?
        #endif
       next_env:
        if (framepointerp(env)) {
          # Environment is a Pointer to a variable-binding-frame
          var object* FRAME = TheFramepointer(env);
          var uintL count = as_oint(FRAME_(frame_anz)); # number of bindings
          if (count > 0) {
            var object* bindingsptr = &FRAME_(frame_bindings); # pointer to the first binding
            dotimespL(count,count, {
              if (binds_sym_p(bindingsptr)) { # right Symbol and active and static?
                var object value = *(bindingsptr STACKop varframe_binding_value);
                if (eq(value,specdecl))
                  goto global_value;
                else
                  return value;
              }
              bindingsptr skipSTACKop varframe_binding_size; # no: next binding
            });
          }
          env = FRAME_(frame_next_env);
          goto next_env;
        } elif (simple_vector_p(env))
          # Environment is a Simple-Vector
          goto next_vector;
        else
          # Environment is NIL
          goto global_value;
       next_vector:
        # Environment is a Simple-Vector
        {
          var uintL count = floor(Svector_length(env),2); # number of bindings
          var object* ptr = &TheSvector(env)->data[0];
          dotimesL(count,count, {
            if (eq(*ptr,sym)) { # right Symbol?
              var object value = *(ptr+1);
              if (eq(value,specdecl))
                goto global_value;
              else
                return value;
            }
            ptr += 2; # next binding
          });
          env = *ptr; # next environment
          if (simple_vector_p(env)) # a Simple-Vector?
            goto next_vector;
          # else: Environment is NIL
        }
        #undef binds_sym_p
      }
     global_value: # the global (dynamic) value of the Symbol
      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 val = sym_value(sym,aktenv.var_env);
  return (symbolmacrop(val) ? true : false);
}

# UP: Sets the value of a Symbol in the current Environment.
# setq(symbol,value);
# > symbol: Symbol, no constant
# > value: desired value of the Symbols in the current Environment
  global void setq (object sym, object value);
  global void setq(sym,value)
    var object sym;
    var object value;
    {
      if (special_var_p(TheSymbol(sym))) # the same for special declared symbols
        goto global_value;
      {
        var object env = aktenv.var_env; # current VAR_ENV
        #ifdef NO_symbolflags
          #define binds_sym_p(bindptr) # Does the binding at bindptr bind the Symbol sym? \
            (eq(*(bindptr STACKop 1),sym) # right Symbol?                                  \
             && eq(*(bindingsptr STACKop 0),fixnum(bit(active_bit))) # active and static? \
            )
        #else
        var object cmp = as_object(as_oint(sym) | wbit(active_bit_o)); # for comparison: binding must be active
          #define binds_sym_p(bindptr) # Does the binding at bindptr bind the Symbol sym? \
            (eq(*(bindingsptr STACKop 0),cmp)) # right Symbol and active and static?
        #endif
       next_env:
        if (framepointerp(env)) {
          # Environment is a Pointer to a variable-binding-frame
          var object* FRAME = TheFramepointer(env);
          var uintL count = as_oint(FRAME_(frame_anz)); # number of bindings
          if (count > 0) {
            var object* bindingsptr = &FRAME_(frame_bindings); # pointer to the first binding
            dotimespL(count,count, {
              if (binds_sym_p(bindingsptr)) { # right Symbol and active and static?
                if (eq(*(bindingsptr STACKop varframe_binding_value),specdecl)) {
                  goto global_value;
                } else {
                  *(bindingsptr STACKop varframe_binding_value) = value;
                  return;
                }
              }
              bindingsptr skipSTACKop varframe_binding_size; # no: next binding
            });
          }
          env = FRAME_(frame_next_env);
          goto next_env;
        } elif (simple_vector_p(env))
          # Environment is a Simple-Vector
          goto next_vector;
        else
          # Environment is NIL
          goto global_value;
       next_vector:
        # Environment is a Simple-Vector
        {
          var uintL count = floor(Svector_length(env),2); # number of bindings
          var object* ptr = &TheSvector(env)->data[0];
          dotimesL(count,count, {
            if (eq(*ptr,sym)) { # right Symbol?
              if (eq(*(ptr+1),specdecl)) {
                goto global_value;
              } else {
                *(ptr+1) = value;
                return;
              }
            }
            ptr += 2; # next binding
          });
          env = *ptr; # next Environment
          if (simple_vector_p(env)) # a Simple-Vector?
            goto next_vector;
          # else: Environment is NIL
        }
        #undef binds_sym_p
      }
     global_value: #  global (dynamic) value of the Symbols
      pushSTACK(value); pushSTACK(sym);
      symbol_value_check_lock(S(setq),sym);
      Symbol_value(STACK_0) = STACK_1;
      skipSTACK(2); return;
    }

# 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 fenv);
  global object sym_function(sym,env)
    var object sym;
    var object env;
    {
      var object value;
      {
       next_env:
        if (framepointerp(env)) {
          # Environment is a Pointer to a function-binding-frame
          var object* FRAME = TheFramepointer(env);
          var uintL count = as_oint(FRAME_(frame_anz)); # number of bindings
          if (count > 0) {
            var object* 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 fertig;
              }
              bindingsptr skipSTACKop 2; # no: next binding
            });
          }
          env = FRAME_(frame_next_env);
          goto next_env;
        } elif (simple_vector_p(env))
          # Environment is a Simple-Vector
          goto next_vector;
        else
          # Environment is NIL
          goto global_value;
       next_vector:
        # Environment is a Simple-Vector
        {
          var uintL count = floor(Svector_length(env),2); # number of bindings
          var object* ptr = &TheSvector(env)->data[0];
          dotimesL(count,count, {
            if (equal(*ptr,sym)) { # right Symbol?
              value = *(ptr+1); goto fertig;
            }
            ptr += 2; # next binding
          });
          env = *ptr; # next Environment
          if (simple_vector_p(env)) # a Simple-Vector?
            goto next_vector;
          # else: Environment is NIL
        }
      }
     global_value: # global function-definition
      if (!symbolp(sym)) {
        sym = get(Car(Cdr(sym)),S(setf_function)); # (get ... 'SYS::SETF-FUNCTION)
        if (!symbolp(sym)) # should be (uninterned) Symbol
          return unbound; # else undefined
      }
      return Symbol_function(sym);
     fertig: # 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;
    }

# 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 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 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 object nest_fun (object env);
  global object nest_fun(env)
    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_fun(NEXT_ENV(env)) "disrecursified" :-) :
        {
          var object* FRAME = TheFramepointer(env);
          env = FRAME_(frame_next_env); depth++; goto nest_start;
        }
       nest_reentry: depth--;
        # NEXT_ENV is now nested.
        {
          var object* FRAME = TheFramepointer(STACK_0); # next STACK-Frame to be nested
          STACK_0 = env; # bisher genestetes Environment
          var uintL anzahl = as_oint(FRAME_(frame_anz)); # number of not yet netsted bindings
          if (anzahl == 0) {
            # no bindings -> unnecessary, to create a vector.
            env = popSTACK();
          } else {
            # create vector for anzahl bindings:
            env = allocate_vector(2*anzahl+1);
            # and fill:
            {
              var object* ptr = &TheSvector(env)->data[0];
              var object* bindingsptr = &FRAME_(frame_bindings); # Pointer to the first binding
              # put anzahl bindings starting at bindingsptr into the vector at ptr:
              dotimespL(anzahl,anzahl, {
                *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_anz) = 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 object nest_var (object env);
  local object nest_var(env)
    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 object* FRAME = TheFramepointer(env);
          env = FRAME_(frame_next_env); depth++; goto nest_start;
        }
       nest_reentry: depth--;
        # NEXT_ENV is now nested.
        {
          var object* 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 anzahl = as_oint(FRAME_(frame_anz)); # number of not yet nested bindings
          var uintL count = 0;
          var object* bindingsptr = &FRAME_(frame_bindings); # Pointer to the first binding
          until ((count>=anzahl) # 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 anzahl-count active, to be nested bindings.
          anzahl = anzahl-count; # number of bindings to be nested
          if (anzahl == 0) {
            # no bindings -> creating a vector is unnecessary.
            env = popSTACK();
          } else {
            # create vector for anzahl bindings:
            env = allocate_vector(2*anzahl+1);
            # and fill:
            {
              var object* ptr = &TheSvector(env)->data[0];
              # put bindungs starting at bindingsptr in the vector at ptr:
              dotimespL(anzahl,anzahl, {
                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) =
                    as_object(as_oint(*(bindingsptr STACKop varframe_binding_mark)) & ~wbit(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_anz) = as_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)
# > environment_t* env: Pointer to five Environments
# < environment_t* result: Pointer to the Environments in the STACK
# changes STACK, can trigger GC
  global environment_t* nest_env (environment_t* env);
  global environment_t* nest_env(env5)
    var 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
        if (framepointerp(env)) {
          # env is a pointer into the STACK to a ITAGBODY-frame.
          check_STACK();
          var object* 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 object* tagsptr = &FRAME_(frame_bindings); # Pointer to the bottom Tag
              var object* 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 object* 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
        if (framepointerp(env)) {
          # env is a pointer into the STACK to a IBLOCK-Frame.
          check_STACK();
          var object* 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);
      # finished.
      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()
# < 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 object augment_decl_env (object new_declspec, object env);
  global object augment_decl_env(new_declspec,env)
    var object new_declspec;
    var 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 void macroexp (object form, object venv, object fenv);
  global void macroexp(form,venv,fenv)
    var object form;
    var object venv;
    var 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 1. component
            TheSvector(env)->data[1] = STACK_0;    # fenv as 2. component
            STACK_0 = env; # Environment as third Argument
            funcall(Symbol_value(S(macroexpand_hook)),3);
            value2 = T; # expanded Form as 1. value, T as 2. 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 void macroexp0 (object form, object env);
  global void macroexp0(form,env)
    var object form;
    var 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 1. value, t as 2. 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* 'SYS::%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 1. value, T as 2. value
              return;
            } elif (symbolp(fdef)) {
              # fdef a Symbol
              # Must be expanded to (SYS::%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(pfuncall); Cdr(new_cons) = popSTACK();
                value1 = new_cons; # (cons 'SYS::%FUNCALL (cons Symbol (cdr form)))
              }
              value2 = T; return; # expansion has taken place.
            }
          }
        }
      } elif (symbolp(form)) {
        var object val = sym_value(form,TheSvector(env)->data[0]);
        if (symbolmacrop(val)) { # found Symbol-Macro?
          # yes -> expand
          value1 = TheSymbolmacro(val)->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,venv,fenv)
# > formlist: ( {decl|doc-string} . body )
# > venv: a variable- and Symbolmacro-Environment (for the macro expansions)
# > fenv: function- and macrobinding-environment (for the macro expansions)
# < 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 bool parse_dd (object formlist, object venv, object fenv);
  global bool parse_dd(formlist,venv,fenv)
    var object formlist;
    var object venv;
    var object fenv;
    {
      pushSTACK(formlist); # store formlist for error message
      pushSTACK(venv); # variable-environment
      pushSTACK(fenv); # Macrobinding-Environment
      pushSTACK(NIL); # preliminary Doc-String
      pushSTACK(NIL); # start of decl-spec-Liste
      # Stack Structure: formlist, venv, fenv, docstring, declspecs.
      var bool compile_decl = false; # Flag, if a (COMPILE)-declaration occurred
      var object body = formlist; # rest of the form-list
      while (consp(body)) {
        pushSTACK(body); # save body
        var object form = Car(body); # next form
        # poss. macroexpand (without expanding FSUBRs, Symbols, FunctionMacros):
        do {
          macroexp(form,STACK_(3+1),STACK_(2+1)); form = value1;
        } until (nullp(value2));
         body = popSTACK();
        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?
            goto fertig; # 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_4); # formlist
            fehler(source_program_error,
                   GETTEXT("Too many documentation strings in ~"));
          }
          STACK_1 = form; # new Doc-String
          body = body_rest;
        } elif (consp(form) && eq(Car(form),S(declare))) { # Declaration (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
              # Test, if (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;
            }
            # Cons this declaration onto STACK_(0+2) :
            {
              var object new_cons = allocate_cons();
              Car(new_cons) = Car(STACK_0);
              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 {
         fertig: # finished with loop over the form list
          #if 0
          # Once, this has been a nice optimization, that avoided twofold
          # macro-expansion. Unfortunately it is not save anymore,
          # because in (FUNCTION (LAMBDA ...)), LET, LET*, MULTIPLE-VALUE-BIND
          # the outer(!) Variable-Environment is passed, so that in
          # (SYMBOL-MACROLET ((X Y)) (LET ((X (FOO))) (SETF X ...) ...))
          # the SETF-Macro would get a wrong venv and would be expanded to
          # (SETQ Y ...) .
          if (!eq(form,Car(body))) { # if the Form was expanded,
            # replace body by (cons form (cdr body)) :
            pushSTACK(body_rest); pushSTACK(form);
            body = allocate_cons();
            Car(body) = popSTACK(); # form
            Cdr(body) = popSTACK(); # body_rest
          }
          #endif
          break;
        }
      }
      value1 = body;
      value2 = nreverse(popSTACK()); # decl-spec-Liste
      value3 = popSTACK(); # Doc-String
      skipSTACK(3);
      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 object* 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 is 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 void add_implicit_block (void);
  local void add_implicit_block()
    {
      # Replace lambdabody by
      # (cons (car lambdabody) (add-implicit-block name (cdr lambdabody))):
      var object new_body;
      pushSTACK(value2); # declarations
      pushSTACK(value3); # docstring
      pushSTACK(funname_blockname(STACK_(1+2))); # blockname
      pushSTACK(value1); # body-rest
      # stack structure: 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 structure: name, lambdabody, declarations, docstring, block-form.
      {
        var object tmp = allocate_cons();
        Car(tmp) = popSTACK();
        new_body = tmp;
      }
      # stack structure: 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 structure: 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 structure: name, lambdabody, new-body.
      {
        var object tmp = allocate_cons();
        Cdr(tmp) = popSTACK(); Car(tmp) = Car(STACK_0);
        STACK_0 = tmp;
      }
    }

# 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,
#        end->decl_env = DENV.
# < result: Closure
# can trigger GC
  global object get_closure (object lambdabody, object name, bool blockp, environment_t* env);
  global object get_closure(lambdabody,name,blockp,env)
    var object lambdabody;
    var object name;
    var bool blockp;
    var environment_t* env;
    {
      # Lambdabody must be a Cons:
      if (atomp(lambdabody)) {
        pushSTACK(name);
        fehler(source_program_error,
               GETTEXT("FUNCTION: lambda-list for ~ is missing"));
      }
      # and the CAR must be a List:
      {
        var object lambdalist = Car(lambdabody);
        if (!listp(lambdalist)) {
          pushSTACK(lambdalist);
          pushSTACK(name);
          fehler(source_program_error,
                 GETTEXT("FUNCTION: lambda-list for ~ should be a list, not ~"));
        }
      }
      pushSTACK(name);
      pushSTACK(lambdabody);
      # stack structure: name, lambdabody.
      if (parse_dd(Cdr(lambdabody),env->var_env,env->fun_env)) { # decompose ({decl|doc} {form})
        # 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 environment_t* stack_env = nest_env(env); # nest, push on STACK
          #if !defined(STACK_UP)
          var environment_t my_env;
          my_env = *stack_env; # and transfer over here
          skipSTACK(5); # and pop from STACK again
          pushSTACK(my_env.var_env);
          pushSTACK(my_env.fun_env);
          pushSTACK(my_env.block_env);
          pushSTACK(my_env.go_env);
          pushSTACK(my_env.decl_env);
          #endif
          # stack structure: name, lambdabody, venv, fenv, benv, genv, denv.
        }
        # execute (SYS::COMPILE-LAMBDA name lambdabody venv fenv benv genv denv) :
        funcall(S(compile_lambda),7);
        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 as 1. Argument
          pushSTACK(nest_var(env->var_env)); # Variable-Environment nested as 2. Argument
          pushSTACK(nest_fun(env->fun_env)); # Function-Environment nested as 3. Argument
          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
      parse_dd(Cdr(lambdabody),env->var_env,env->fun_env); # decompose ({decl|doc} {form})
      pushSTACK(value1); # Body
      pushSTACK(value2); # Declarations
      pushSTACK(value3); # Doc-String or NIL
      var object* closure_; # Pointer to the Closure in the STACK
      # create Closure (filled with NIL):
      {
        var object closure = allocate_closure(iclos_length);
        # 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 structure: closure.
        closure_ = &STACK_0; # Pointer to the Closure in the STACK
        pushSTACK(lambdalist); pushSTACK(declarations);
      }
      # nest Environments and put them nested in the closure:
      {
        var 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);
        TheIclosure(closure)->clos_keywords = Fixnum_0; # keywords:=0, as long as &KEY is missing
      }
      # stack structure: closure, lambdalist, 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 lying on the STACK
      {
        var object declarations = popSTACK();
        # process deklarations:
        # 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.
        while (consp(declarations)) { # all decl-specs processed?
          var object declspec = Car(declarations);
          # declspec must be a List:
          if (atomp(declspec)) {
            pushSTACK(declspec);
            fehler(source_program_error,
                   GETTEXT("FUNCTION: illegal declaration ~"));
          }
          # 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(sym);
                fehler(source_program_error,
                       GETTEXT("FUNCTION: ~ is not a symbol, cannot be declared SPECIAL"));
              }
              # 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();
        }
      }
      var object lambdalist = *(closure_ STACKop -1); # remaining lambda list
      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(lambdalist)) goto end_label; # Lambda-List finished?              \
            item = Car(lambdalist); # next Element                                      \
            lambdalist = Cdr(lambdalist); # 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:
      loop {
        NEXT_ITEM(opt,rest,key,badLLkey,aux,ende);
        if (!symbolp(item))
          goto fehler_symbol;
        if (constantp(TheSymbol(item)))
          goto fehler_constant;
        # push Variable on STACK:
        check_STACK();
        pushSTACK(item); pushSTACK(Fixnum_0); req_count++; var_count++;
      }
     opt: # process &OPTIONAL-parameter, push on STACK ablegen and
          # put Init-Forms into the Closure:
      loop {
        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)) {
          if (!symbolp(item))
            goto fehler_symbol;
          if (constantp(TheSymbol(item)))
            goto fehler_constant;
          # push variable on STACK:
          pushSTACK(item); pushSTACK(Fixnum_0); opt_count++; var_count++;
          init_form = NIL; # Default-Init
        } else {
          var object item_rest = Cdr(item);
          item = Car(item); # first list-element: var
          if (!symbolp(item))
            goto fehler_symbol;
          if (constantp(TheSymbol(item)))
            goto fehler_constant;
          # 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(*(closure_ STACKop -1)); # entire Lambda-Liste
                fehler(source_program_error,
                       GETTEXT("FUNCTION: too long variable specification after &OPTIONAL: ~"));
              }
              item = Car(item_rest); # third list-element: svar
              if (!symbolp(item))
                goto fehler_symbol;
              if (constantp(TheSymbol(item)))
                goto fehler_constant;
              # 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(lambdalist); 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;
        }
        lambdalist = popSTACK();
      }
     rest: # process &REST-parameter and push on Stack:
      NEXT_ITEM(badrest,badrest,badrest,badrest,badrest,badrest);
      if (!symbolp(item))
        goto fehler_symbol;
      if (constantp(TheSymbol(item)))
        goto fehler_constant;
      # 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(*(closure_ STACKop -1)); # entire Lambda-List
      fehler(source_program_error,
             GETTEXT("FUNCTION: &REST var must be followed by &KEY or &AUX or end of list: ~"));
     badrest:
      pushSTACK(*(closure_ STACKop -1)); # entire Lambda-List
      fehler(source_program_error,
             GETTEXT("FUNCTION: &REST must be followed by a variable: ~"));
     key: # process &KEY-Parameter, push on STACK
          # and put Init-Forms in the Closure:
      TheIclosure(*closure_)->clos_keywords = NIL; # keywords:=NIL
      loop {
        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)) {
          if (!symbolp(item))
            goto fehler_symbol;
          if (constantp(TheSymbol(item)))
            goto fehler_constant;
          # push variable on STACK:
          pushSTACK(item); pushSTACK(Fixnum_0); key_count++; var_count++;
          # fetch Keyword:
          pushSTACK(lambdalist);
          keyword = intern_keyword(Symbol_name(item));
          lambdalist = popSTACK();
          # Default-Init:
          init_form = NIL;
        } else {
          var object item_rest = Cdr(item); # ([init [svar]])
          item = Car(item); # first list-element: var or (key var)
          if (atomp(item)) {
            # item = var
            if (!symbolp(item))
              goto fehler_symbol;
            if (constantp(TheSymbol(item)))
              goto fehler_constant;
            # push variable on STACK:
            pushSTACK(item); pushSTACK(Fixnum_0); key_count++; var_count++;
            # fetch Keyword:
            pushSTACK(item_rest); pushSTACK(lambdalist);
            keyword = intern_keyword(Symbol_name(item));
            lambdalist = popSTACK(); item_rest = popSTACK();
          } else {
            # item = (key var)
            keyword = Car(item); # key
            # should be a Symbol (formerly: Keyword) :
            if (!symbolp(keyword)) {
              pushSTACK(*(closure_ STACKop -1)); # entire Lambda-List
              pushSTACK(keyword);
              fehler(source_program_error,
                     GETTEXT("FUNCTION: ~ in ~ is not a symbol"));
            }
            item = Cdr(item); # (var)
            if (!(consp(item) && matomp(Cdr(item))))
              goto fehler_keyspec;
            item = Car(item); # var
            if (!symbolp(item))
              goto fehler_symbol;
            if (constantp(TheSymbol(item)))
              goto fehler_constant;
            # 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 fehler_keyspec;
              item = Car(item_rest); # third list-element: svar
              if (!symbolp(item))
                goto fehler_symbol;
              if (constantp(TheSymbol(item)))
                goto fehler_constant;
              # 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(lambdalist); 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;
        }
        lambdalist = popSTACK();
      }
     fehler_keyspec:
      pushSTACK(*(closure_ STACKop -1)); # entire Lambda-List
      fehler(source_program_error,
             GETTEXT("FUNCTION: incorrect variable specification after &KEY: ~"));
     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
      fehler(source_program_error,
             GETTEXT("FUNCTION: &ALLOW-OTHER-KEYS must be followed by &AUX or end of list: ~"));
     aux: # process &AUX-Parameter, push on STACK and
          # put Init-Forms in the Closure:
      loop {
        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)) {
          if (!symbolp(item))
            goto fehler_symbol;
          if (constantp(TheSymbol(item)))
            goto fehler_constant;
          # push variable on STACK:
          pushSTACK(item); pushSTACK(Fixnum_0); aux_count++; var_count++;
          init_form = NIL; # Default-Init
        } else {
          var object item_rest = Cdr(item);
          item = Car(item); # first list-element: var
          if (!symbolp(item))
            goto fehler_symbol;
          if (constantp(TheSymbol(item)))
            goto fehler_constant;
          # 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(*(closure_ STACKop -1)); # entire Lambda-List
              fehler(source_program_error,
                     GETTEXT("FUNCTION: too long variable specification after &AUX: ~"));
            }
          } else {
            init_form = NIL; # Default-Init
          }
        }
        # push init_form in front of (clos_aux_inits closure) :
        pushSTACK(lambdalist); 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;
        }
        lambdalist = popSTACK();
      }
      # Collected error messages:
     badLLkey:
      pushSTACK(*(closure_ STACKop -1)); # entire Lambda-List
      pushSTACK(item);
      fehler(source_program_error,
             GETTEXT("FUNCTION: badly placed lambda-list keyword ~: ~"));
     fehler_symbol:
      pushSTACK(item);
      fehler(source_program_error,
             GETTEXT("FUNCTION: ~ is not a symbol, may not be used as a variable"));
     fehler_constant:
      pushSTACK(item);
      fehler(program_error,
             GETTEXT("FUNCTION: ~ is a constant, may not be used as a variable"));
     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
        fehler(source_program_error,
               GETTEXT("FUNCTION: too many parameters in the lambda-list ~"));
      }
      # var_count <= lp_limit_1, therefore all counts fit in an uintC.
      if (!nullp(lambdalist)) { # is Lambda-List a Dotted List?
        pushSTACK(*(closure_ STACKop -1)); # entire Lambda-List
        fehler(source_program_error,
               GETTEXT("FUNCTION: a dot in a lambda-list is allowed only for macros, not here: ~"));
      }
      # 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 object* ptr = &TheSvector(vars)->data[var_count];
        var uintB* ptrflags = &TheSbvector(varflags)->data[var_count-spec_count];
        var uintC count;
        dotimesC(count,var_count-spec_count, {
          *--ptrflags = (uintB)posfixnum_to_L(popSTACK());
          *--ptr = popSTACK();
        });
        dotimesC(count,spec_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_anz = fixnum(spec_count);
      TheIclosure(closure)->clos_req_anz  = fixnum(req_count);
      TheIclosure(closure)->clos_opt_anz  = fixnum(opt_count);
      TheIclosure(closure)->clos_key_anz  = fixnum(key_count);
      TheIclosure(closure)->clos_aux_anz  = 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==0)) {
        # loop over the remaining variables:
        if (var_count-spec_count > 0) {
          var object* othervarptr = &TheSvector(vars)->data[spec_count];
          var uintB* othervarflagsptr = &TheSbvector(varflags)->data[0];
          var uintC count1;
          dotimespC(count1,var_count-spec_count, {
            var object othervar = *othervarptr++; # next variable
            # Search it among the SPECIAL-declared variables:
            {
              var object* specvarptr = &TheSvector(vars)->data[0];
              var uintC count2;
              dotimespC(count2,spec_count, {
                if (eq(*specvarptr++,othervar)) { # found?
                  # yes -> so the variable othervar is to be bound dynamically.
                  *othervarflagsptr |= bit(dynam_bit); break;
                }
              });
            }
            othervarflagsptr++;
          });
        }
      }
      # 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);
      # finished.
      # stack structure: closure, lambdalist.
      skipSTACK(2);
      return closure;
    }

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

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

# error-message  because of undefined function.
# fehler_undefined(caller,funname);
# > caller: caller (a symbol)
# > funname: symbol or (SETF symbol)
nonreturning_function(local, fehler_undefined, (object caller, object funname)) {
  pushSTACK(funname); # CELL-ERROR slot NAME
  pushSTACK(funname);
  pushSTACK(caller);
  fehler(undefined_function,GETTEXT("~: the function ~ is undefined"));
}

# UP: Alters argument to a function.
# coerce_function(obj)
# > obj: object
# > subr_self: caller (a SUBR)
# < result: object as function (SUBR or Closure)
# can trigger GC
  global object coerce_function (object obj);
  global object coerce_function(obj)
    var object obj;
    {
      # obj should be a symbol, a SUBR or a Closure.
      if (functionp(obj)) {
        return obj; # function is OK
      } elif (symbolp(obj)) {
        var object fdef = Symbol_function(obj);
        if (functionp(fdef))
          return fdef;
        elif (orecordp(fdef)) {
          switch (Record_type(fdef)) {
            case Rectype_Fsubr:
              fehler_specialform(TheSubr(subr_self)->name,obj);
            case Rectype_Macro:
              fehler_macro(TheSubr(subr_self)->name,obj);
            default: NOTREACHED;
          }
        } else
          fehler_undefined(TheSubr(subr_self)->name,obj);
      } elif (funnamep(obj)) {
        var object symbol = get(Car(Cdr(obj)),S(setf_function)); # (get ... 'SYS::SETF-FUNCTION)
        if (!symbolp(symbol)) # should be (uninterned) symbol
          fehler_undefined(TheSubr(subr_self)->name,obj);
        var object fdef = Symbol_function(symbol);
        if (functionp(fdef))
          return fdef;
        else
          fehler_undefined(TheSubr(subr_self)->name,obj);
      } elif (consp(obj) && eq(Car(obj),S(lambda))) { # Cons (LAMBDA . ...) ?
        fehler_lambda_expression(obj);
      } else {
        pushSTACK(obj);
        pushSTACK(TheSubr(subr_self)->name);
        fehler(error,
               GETTEXT("~: ~ is not a function"));
      }
    }

#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 void trace_call (object fun, uintB type_of_call, uintB caller_type);
  local void trace_call(fun,type_of_call,caller_type)
    var object fun;
    var uintB type_of_call;
    var 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(TheCclosure(fun)->clos_name);
        write_ascii_char(&STACK_1,'c');
      } elif (closurep(fun)) {
        pushSTACK(TheClosure(fun)->clos_name);
        write_ascii_char(&STACK_1,'C');
      } elif (subrp(fun)) {
        pushSTACK(TheSubr(fun)->name);
        write_ascii_char(&STACK_1,'S');
      } elif (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);
    }

#endif

# error-message for non-paired keyword-arguments
# fehler_key_unpaarig(fun); (transl.: error_key_non_paired)
# > fun: function
nonreturning_function(local, fehler_key_unpaarig, (object fun)) {
  pushSTACK(fun);
  fehler(program_error,
         GETTEXT("EVAL/APPLY: keyword arguments for ~ should occur pairwise"));
}

# error-message for flawed keyword
# fehler_key_notkw(kw);
# > kw: Non-Symbol
nonreturning_function(local, fehler_key_notkw, (object kw)) {
  pushSTACK(kw); # KEYWORD-ERROR slot DATUM
  pushSTACK(S(symbol)); # KEYWORD-ERROR slot EXPECTED-TYPE
  pushSTACK(kw);
  fehler(keyword_error,
         GETTEXT("EVAL/APPLY: ~ is not a symbol"));
}

# error-message for flawed keyword
# fehler_key_badkw(fun,kw,kwlist);
# > fun: function
# > kw: illegal keyword
# > kwlist: list of legal keywords
nonreturning_function(local, fehler_key_badkw, (object fun, object kw, object kwlist)) {
  pushSTACK(kw); # KEYWORD-ERROR slot DATUM
  pushSTACK(kwlist);
  pushSTACK(kwlist);
  pushSTACK(fun);
  pushSTACK(kw);
  {
    var object type = allocate_cons();
    Car(type) = S(member); Cdr(type) = STACK_3;
    STACK_3 = type; # `(MEMBER ,@kwlist) = KEYWORD-ERROR slot EXPECTED-TYPE
  }
  fehler(keyword_error,
         GETTEXT("EVAL/APPLY: keyword ~ is illegal for ~. The possible keywords are ~"));
}

# Test for illegal keywords
# check_for_illegal_keywords(allow_flag,fehler_statement);
# > uintC argcount: Number of Keyword/Value-pairs
# > object* 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'.
# > fehler_statement: Statement, that reports, that bad_keyword is illegal.
  #define check_for_illegal_keywords(allow_flag_expr,fehler_statement)  \
    { var object* argptr = rest_args_pointer; # Pointer to the arguments    \
      var object bad_keyword = nullobj; # first illegal keyword or nullobj  \
      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;                                                \
      dotimesC(check_count,argcount, {                                      \
        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))                                                   \
          fehler_key_notkw(kw);                                             \
        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;                                             \
              kw_ok: ;                                                      \
            }                                                               \
          }                                                                 \
        }                                                                   \
      });                                                                   \
      if (!allow_flag)                                                      \
        if (!eq(bad_keyword,nullobj))                                       \
          # wrong keyword occurred                                          \
          { fehler_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
# > object* 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 object* argptr = rest_args_pointer;                             \
      var uintC find_count;                                               \
      dotimesC(find_count,argcount, {                                     \
        if (eq(NEXT(argptr),keyword)) goto kw_found; # right keyword?     \
        NEXT(argptr);                                                     \
      });                                                                 \
      if (true)                                                           \
        # not found                                                       \
        { notfound_statement }                                            \
        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 Values funcall_iclosure (object closure, object* args_pointer, uintC argcount);
  local Values funcall_iclosure(closure,args_pointer,argcount)
    var object closure;
    var object* args_pointer;
    var uintC argcount;
    {
      # 1. step: finish building ofAPPLY-frame:
      var sp_jmp_buf my_jmp_buf;
      #ifdef DEBUG_EVAL
      if (streamp(Symbol_value(S(funcall_trace_output)))) {
        pushSTACK(closure); trace_call(closure,'F','I'); closure = popSTACK();
      }
      #endif
      {
        var object* 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 object* closure_ = &STACK_(frame_closure); # Pointer to the closure
      var object* frame_pointer; # Pointer to Frame
      # 2. Schritt: build variable-binding-frame:
      {
        var object* 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 * 2 * sizeof(object)); # reserve space
        {
          var object* varptr = &TheSvector(vars)->data[0]; # Pointer to variables in vector
          var uintC spec_count = posfixnum_to_L(TheIclosure(closure)->clos_spec_anz);
          var uintC count;
          # the special-references first:
          dotimesC(count,spec_count, {
            # binding with "value" specdecl:
            pushSTACK(specdecl);
            pushSTACK_symbolwithflags(*varptr++,wbit(active_bit_o)); # make a note of binding as being active
          });
          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 as 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(as_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.
      {
        var object new_var_env = make_framepointer(STACK);
        # this frame will become the new VAR_ENV later.
      # third step: bind current environments:
        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
      # 4. 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_zuweisung)  \
          { frame_pointer skipSTACKop -varframe_binding_size;                                  \
           {var object* markptr = markptr_zuweisung &Before(frame_pointer);                    \
            if (as_oint(*markptr) & wbit(dynam_bit_o))                                         \
              # activate dynamic Binding:                                                      \
              { var object sym = *(markptr STACKop varframe_binding_sym); # variable           \
                *(markptr STACKop varframe_binding_value) = TheSymbolflagged(sym)->symvalue; # old value in frame \
                *markptr = as_object(as_oint(*markptr) | wbit(active_bit_o)); # activate binding \
                TheSymbolflagged(sym)->symvalue = (value); # new value in value-cell           \
              }                                                                                \
              else                                                                             \
              # activate static binding:                                                       \
              { *(markptr STACKop varframe_binding_value) = (value); # new value in frame      \
                *markptr = as_object(as_oint(*markptr) | wbit(active_bit_o)); # activate binding \
              }                                                                                \
          }}
        # process required-parameters:
        # fetch next argument and bind in stack.
        {
          var uintC count = posfixnum_to_L(TheIclosure(closure)->clos_req_anz);
          if (count>0) {
            if (argcount < count) {
              pushSTACK(TheIclosure(closure)->clos_name);
              fehler(program_error,
                     GETTEXT("EVAL/APPLY: too few arguments given to ~"));
            }
            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_L(TheIclosure(closure)->clos_opt_anz);
          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 object* optmarkptr;
              bind_next_var(next_arg,optmarkptr=); # bind next variable
              if (as_oint(*optmarkptr) & wbit(svar_bit_o)) { # supplied-p-Parameter follows?
                *optmarkptr = as_object(as_oint(*optmarkptr) & ~wbit(svar_bit_o));
                bind_next_var(T,); # yes -> bind to T
              }
              inits = Cdr(inits); # shorten Init-Forms-List
              count--;
            } until (count==0);
            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 object* optmarkptr;
            bind_next_var(inits,optmarkptr=); # bind next variable
            if (as_oint(*optmarkptr) & wbit(svar_bit_o)) { # supplied-p-Parameter follows?
              *optmarkptr = as_object(as_oint(*optmarkptr) & ~wbit(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_L(TheIclosure(closure)->clos_key_anz); # number of Keyword-parameters
          if (count>0) {
            STACK_0 = TheIclosure(closure)->clos_key_inits; # belonging 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 object* keymarkptr;
              bind_next_var(inits,keymarkptr=); # bind next Variable
              if (as_oint(*keymarkptr) & wbit(svar_bit_o)) { # supplied-p-Parameter follows?
                *keymarkptr = as_object(as_oint(*keymarkptr) & ~wbit(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);
            fehler(program_error,
                   GETTEXT("EVAL/APPLY: too many arguments given to ~"));
          }
        } else {
          # &KEY or &REST present.
          # process &REST-parameters:
          if (!nullp(TheIclosure(closure)->clos_rest_flag)) { # Rest-parameters present?
            # yes -> collect residual arguments in a list:
            pushSTACK(NIL); # start of list
            if (argcount>0) {
              var object* 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 object* rest_args_pointer = args_pointer;
            # argcount = number of remaining arguments
            # halve argcount --> number of pairs Key.Value:
            if (!((argcount%2)==0))
              # number was odd ->  not paired:
              fehler_key_unpaarig(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),
                { fehler_key_badkw(TheIclosure(closure)->clos_name,
                                   bad_keyword,
                                   TheIclosure(closure)->clos_keywords);
                });
              #undef for_every_keyword
              # Now assign the Key-values and evaluate the Key-Inits:
              var uintC count = posfixnum_to_L(TheIclosure(closure)->clos_key_anz);
              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, mus 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 object* keymarkptr;
                    bind_next_var(var_value,keymarkptr=); # bind Keyword-Variable
                    if (as_oint(*keymarkptr) & wbit(svar_bit_o)) { # supplied-p-Parameter follows?
                      *keymarkptr = as_object(as_oint(*keymarkptr) & ~wbit(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_L(TheIclosure(closure)->clos_aux_anz);
          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
      }
      # 5. step: evaluate Body:
      implicit_progn(TheIclosure(closure)->clos_body,NIL);
      unwind(); # unwind ENV-frame
      unwind(); # unwind variable-binding-frame
      unwind(); # unwind APPLY-frame
      # finished
    }

# 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, object* key_args_pointer, object* rest_args_pointer);
  local void match_subr_key(fun,argcount,key_args_pointer,rest_args_pointer)
    var object fun;
    var uintL argcount;
    var object* key_args_pointer;
    var object* rest_args_pointer;
    {
      # halve argcount --> the number of pairs Key.Value:
      if (!((argcount%2)==0))
        # number was odd -> not paired:
        fehler_key_unpaarig(fun);
      if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1))
        fehler_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 object* keywords_pointer = &TheSvector(TheSubr(fun)->keywords)->data[0];
        var uintC key_anz = TheSubr(fun)->key_anz;
        #define for_every_keyword(statement)  \
          if (key_anz > 0)                               \
            { var object* keywordptr = keywords_pointer; \
              var uintC count;                           \
              dotimespC(count,key_anz,                   \
                { var object keyword = *keywordptr++;    \
                  statement;                             \
                });                                      \
            }
        check_for_illegal_keywords(
          TheSubr(fun)->key_flag == subr_key_allow,
          { pushSTACK(bad_keyword); # save bad Keyword
            # convert Keyword-Vector to a List:
            # (SYS::COERCE-SEQUENCE kwvec 'LIST)
            coerce_sequence(TheSubr(fun)->keywords,S(list),true);
           {var object kwlist = value1;
            fehler_key_badkw(fun,popSTACK(),kwlist);
          }}
          );
        #undef for_every_keyword
      # now assign Arguments and Parameters:
        if (key_anz > 0) {
          var object* keywordptr = keywords_pointer;
          var object* key_args_ptr = key_args_pointer;
          var uintC count;
          dotimespC(count,key_anz, {
            var object keyword = *keywordptr++; # Keyword
            # find the pair Key.Value for this Keyword:
            find_keyword_value(
              # not found -> value remains #<UNBOUND> :
              { 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
# < ergebnis: closure
# changes STACK
# can trigger GC
  local object match_cclosure_key (object closure, uintL argcount, object* key_args_pointer, object* rest_args_pointer);
  local object match_cclosure_key(closure,argcount,key_args_pointer,rest_args_pointer)
    var object closure;
    var uintL argcount;
    var object* key_args_pointer;
    var object* rest_args_pointer;
    {
      # halve argcount --> number of pairs Key.Value:
      if (!((argcount%2)==0))
        # number was odd -> not paired:
        fehler_key_unpaarig(closure);
      if (((uintL)~(uintL)0 > ca_limit_1) && (argcount > ca_limit_1))
        fehler_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_anz = TheCodevec(codevec)->ccv_numkey; # number of Keywords
        var uintL keywords_offset = TheCodevec(codevec)->ccv_keyconsts; # Offset of Keywords in FUNC
        var object* 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_anz > 0)                               \
            { var object* keywordptr = keywords_pointer; \
              var uintC count;                           \
              dotimespC(count,key_anz,                   \
                { var object keyword = *keywordptr++;    \
                  statement;                             \
                });                                      \
            }
        check_for_illegal_keywords(
          !((TheCodevec(codevec)->ccv_flags & bit(6)) == 0),
          { pushSTACK(bad_keyword); # save
            # build list of legal Keywords:
            for_every_keyword( { pushSTACK(keyword); } );
            var object kwlist = listof(key_anz);
            bad_keyword = popSTACK();
            # report errors:
            fehler_key_badkw(closure,bad_keyword,kwlist);
          }
          );
        #undef for_every_keyword
      # now assign Arguments and Parameters:
        if (key_anz > 0) {
          var object* keywordptr = keywords_pointer;
          var object* key_args_ptr = key_args_pointer;
          var uintC count;
          dotimespC(count,key_anz, {
            var object keyword = *keywordptr++; # Keyword
            # find the pair Key.value for this keyword:
            find_keyword_value(
              # not found -> Wert remains #<UNBOUND> :
              { 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 object* 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;
          until (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 Values eval (object form);
  global Values eval(form)
    var 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 object* 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 1. Argument
          pushSTACK(evalhook_value); # save Function
          var environment_t* stack_env = nest_aktenv(); # Environments in the Stack,
          var object env = allocate_vector(5); # in newly allocated Vector
          *(environment_t*)(&TheSvector(env)->data[0]) = *stack_env; # push in
          skipSTACK(5);
          evalhook_value = popSTACK(); # return Function
          pushSTACK(env); # entire Environment as 2. 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 Values eval_no_hooks (object form) {
  var sp_jmp_buf my_jmp_buf;
  # build EVAL-Frame:
  {
    var object* 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 Values eval1(form)
    var object form;
    {
      if (atomp(form)) {
        if (symbolp(form)) {
          # Form is a Symbol
          value1 = sym_value(form,aktenv.var_env); # value in the current Environment
          if (!boundp(value1)) {
            pushSTACK(form); # CELL-ERROR slot NAME
            pushSTACK(form);
            fehler(unbound_variable,GETTEXT("EVAL: variable ~ has no value"));
          } else if (symbolmacrop(value1)) { # Symbol-Macro?
            # yes -> expand and evaluate again:
            skipSTACK(1); # forget value of *APPLYHOOK*
            check_SP(); check_STACK();
            eval(TheSymbolmacro(value1)->symbolmacro_expansion); # evaluate Expansion
            unwind(); # unwind EVAL-Frame
          } else {
            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
        # 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 (subrp(fun))
              goto case_subr;
            elif (orecordp(fun))
              goto case_orecord;
            else
              switch (0)
            #endif
            {
              case_subr: # SUBR
                pushSTACK(Cdr(form)); # argumentlist
                if (!nullp(STACK_1))
                  goto applyhook;
                eval_subr(fun);
                break;
              case_closure: # closure
                pushSTACK(Cdr(form)); # argumentlist
               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_Fsubr:
                    # Fsubr
                    eval_fsubr(fun,Cdr(form));
                    break;
                  #ifdef DYNAMIC_FFI
                  case Rectype_Ffunction:
                    # Foreign-Function
                    pushSTACK(Cdr(form)); # argumentlist
                    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:
                fehler_undefined(S(eval),Car(form));
            }
          } elif (consp(fun) && eq(Car(fun),S(lambda))) { # lambda-expression?
            pushSTACK(Cdr(form)); # Argumentlist
            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
            fehler_funname_source(S(eval),fun);
        }
      }
    }

# 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 Values eval_fsubr(fun,args)
    var object fun;
    var object args;
    {
      skipSTACK(1); # forget value of *APPLYHOOK*
      check_SP(); check_STACK();
      #if STACKCHECKS
      var object* STACKbefore = STACK;
      #endif
      # put arguments in the STACK:
      switch ((uintW)posfixnum_to_L(TheFsubr(fun)->argtype)) {
        # Macro for 1 required-Parameter:
        #define REQ_PAR()  \
          { if (atomp(args)) goto fehler_zuwenig;                   \
            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 fehler_zuviel;
          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 fehler_zuviel;
          } else {
            pushSTACK(unbound); # unbound into STACK instead
            if (!nullp(args)) goto fehler_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;
        fehler_zuwenig: # argument-list args is an atom, prematurely
          if (!nullp(args)) goto fehler_dotted;
          # clean up STACK up to the calling EVAL-Frame:
          until (framecode(STACK_0) & bit(frame_bit_t)) {
            skipSTACK(1);
          }
          {
            var object form = STACK_(frame_form); # Form from EVAL-Frame
            pushSTACK(form);
            pushSTACK(Car(form));
            fehler(source_program_error,
                   GETTEXT("EVAL: too few parameters for special operator ~: ~"));
          }
        fehler_zuviel: # argument-list args is not NIL at the tail
          if (atomp(args)) goto fehler_dotted;
          # clean up STACK up to the calling EVAL-Frame:
          until (framecode(STACK_0) & bit(frame_bit_t)) {
            skipSTACK(1);
          }
          {
            var object form = STACK_(frame_form); # Form from EVAL-Frame
            pushSTACK(form);
            pushSTACK(Car(form));
            fehler(source_program_error,
                   GETTEXT("EVAL: too many parameters for special operator ~: ~"));
          }
        fehler_dotted: # argument-list args ends with Atom /= NIL
          # clean up STACK up to the calling EVAL-Frame:
          until (framecode(STACK_0) & bit(frame_bit_t)) {
            skipSTACK(1);
          }
          {
            var object form = STACK_(frame_form); # Form from EVAL-Frame
            pushSTACK(form);
            pushSTACK(Car(form));
            fehler(source_program_error,
                   GETTEXT("EVAL: dotted parameter list for special operator ~: ~"));
          }
        #undef REQ_PAR
      }
      # call FSUBR:
      subr_self = fun;
      (*(fsubr_function_t*)(TheFsubr(fun)->function))();
      #if STACKCHECKS
       if (!(STACK == STACKbefore)) # STACK as before?
         abort(); # no -> go to Debugger
      #endif
      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 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 1. Argument
  pushSTACK(args); # argument-list as 2. Argument
  pushSTACK(applyhook_value); # save function
  {
    var environment_t* stack_env = nest_aktenv(); # Environments into Stack,
    var object env = allocate_vector(5); # in newly allocated Vector
    *(environment_t*)(&TheSvector(env)->data[0]) = *stack_env; # push in
    skipSTACK(5);
  }
  applyhook_value = popSTACK(); # function back
  pushSTACK(env); # entire Environment as 3. Argument
  funcall(applyhook_value,3);
  #else
  # execute (FUNCALL *APPLYHOOK* fun args) :
  pushSTACK(fun); # function as 1. Argument
  pushSTACK(args); # argument-list as 2. 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, fehler_eval_zuwenig, (object fun)) {
  var object form = STACK_(frame_form); # Form
  pushSTACK(form);
  pushSTACK(fun);
  fehler(source_program_error,
         GETTEXT("EVAL: too few arguments given to ~: ~"));
}

# In EVAL: error, if too many arguments
nonreturning_function(local, fehler_eval_zuviel, (object fun)) {
  var object form = STACK_(frame_form); # Form
  pushSTACK(form);
  pushSTACK(fun);
  fehler(source_program_error,
         GETTEXT("EVAL: too many arguments given to ~: ~"));
}

# In EVAL: error, if dotted argument-list
nonreturning_function(local, fehler_eval_dotted, (object fun)) {
  var object form = STACK_(frame_form); # Form
  pushSTACK(form);
  pushSTACK(fun);
  fehler(source_program_error,
         GETTEXT("EVAL: argument list given to ~ is dotted: ~"));
}

# 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 Values eval_subr(fun)
    var object fun;
    {
      var object args = popSTACK(); # argument-list
      skipSTACK(1); # forget value of *APPLYHOOK*
      check_SP(); check_STACK();
      var object* args_pointer = args_end_pointer; # Pointer to the arguments
      var object* 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 fehler_zuwenig;                \
            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 fehler_zuviel;
          goto apply_subr_norest;
        case (uintW)subr_argtype_4_1:
          # SUBR with 4 required-Arguments and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_3_1:
          # SUBR with 3 required-Arguments and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_2_1:
          # SUBR with 2 required-Arguments and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_1_1:
          # SUBR with 1 required-Argument and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_0_1:
          # SUBR with 1 optional-Argument
          OPT_ARG(1);
          if (!nullp(args)) goto fehler_zuviel;
          goto apply_subr_norest;
        case (uintW)subr_argtype_3_2:
          # SUBR with 3 required-Arguments and 2 optional-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_2_2:
          # SUBR with 2 required-Arguments and 2 optional-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_2:
          # SUBR with 1 required-Argument and 2 optional-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_0_2:
          # SUBR with 2 optional-Arguments
          OPT_ARG(2);
          OPT_ARG(1);
          if (!nullp(args)) goto fehler_zuviel;
          goto apply_subr_norest;
        case (uintW)subr_argtype_2_3:
          # SUBR with 2 required-Arguments and 3 optional-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_3:
          # SUBR with 1 required-Argument and 3 optional-Arguments
          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 fehler_zuviel;
          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 fehler_zuviel;
          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 fehler_dotted;
          goto apply_subr_norest;
        case (uintW)subr_argtype_3_0_rest:
          # SUBR with 3 required-Arguments and further Arguments
          REQ_ARG();
        case (uintW)subr_argtype_2_0_rest:
          # SUBR with 2 required-Arguments and further Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_0_rest:
          # SUBR with 1 required-Argument and further Arguments
          REQ_ARG();
        case (uintW)subr_argtype_0_0_rest:
          # SUBR with further 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-Arguments and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_3_0_key:
          # SUBR with 3 required-Arguments and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_2_0_key:
          # SUBR with 2 required-Arguments and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_0_key:
          # SUBR with 1 required-Argument and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_0_0_key:
          # SUBR with Keyword-Arguments
          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 Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_0_1_key:
          # SUBR with 1 optional-Argument and Keyword-Arguments
          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 Keyword-Arguments
          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_anz, { pushSTACK(unbound); } );
          }
          if (!nullp(args)) goto fehler_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(object) *
                         (uintL)(TheSubr(fun)->req_anz +
                                 TheSubr(fun)->opt_anz +
                                 TheSubr(fun)->key_anz));
      # evaluate required parameters and push into Stack:
      {
        var uintC count;
        dotimesC(count,TheSubr(fun)->req_anz, {
          if (atomp(args)) goto fehler_zuwenig; # 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_anz;
        loop {
          if (atomp(args)) break; # at the end of argument-list?
          if (count==0) goto optionals_ok; # all optional parameters supplied with?
          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_anz, { 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 fehler_zuviel;
        } 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 fehler_zuviel;
        }
      } else {
        # SUBR with Keywords.
       apply_subr_key:
        # 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 object* key_args_pointer = args_end_pointer; # Pointer to Keyword-parameters
        # initialize all Keyword-parameters with  #<UNBOUND> :
        {
          var uintC count;
          dotimesC(count,TheSubr(fun)->key_anz, { 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 fehler_zuviel;
        # 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 fehler_dotted;
      if (TheSubr(fun)->rest_flag == subr_norest) {
        # SUBR without &REST-Flag:
       apply_subr_norest:
        subr_self = fun;
        (*(subr_norest_function_t*)(TheSubr(fun)->function))();
      } else {
        # SUBR with &REST-Flag:
       apply_subr_rest:
        subr_self = fun;
        (*(subr_rest_function_t*)(TheSubr(fun)->function))(argcount,rest_args_pointer);
      }
      #if STACKCHECKS
      if (!(args_pointer == args_end_pointer)) # Stack cleaned up?
        abort(); # no -> leave to Debugger
      #endif
      unwind(); # unwind EVAL-Frame
      return; # finished
      # Gathered error-messages:
     fehler_zuwenig: # Argument-List args is prematurely an Atom
      if (!nullp(args)) goto fehler_dotted;
      set_args_end_pointer(args_pointer); # clean up STACK
      fehler_eval_zuwenig(TheSubr(fun)->name);
     fehler_zuviel: # Argument-List args is not NIL at the end
      if (atomp(args)) goto fehler_dotted;
      set_args_end_pointer(args_pointer); # clean up STACK
      fehler_eval_zuviel(TheSubr(fun)->name);
     fehler_dotted: # Argument-List args ends with Atom /= NIL
      set_args_end_pointer(args_pointer); # clean up STACK
      fehler_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 Values eval_closure(closure)
    var 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 object* closure_ = &STACK_0; # and memorize, where it is
      if (simple_bit_vector_p(Atype_8Bit,TheClosure(closure)->clos_codevec)) {
        # closure is a compiled Closure
        var object* STACKbefore = STACK;
        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 fehler_zuwenig;                \
              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 fehler_zuviel;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_4_1:
            # 4 required-Arguments and 1 optional-Argument
            REQ_ARG();
          case (uintB)cclos_argtype_3_1:
            # 3 required-Arguments and 1 optional-Argument
            REQ_ARG();
          case (uintB)cclos_argtype_2_1:
            # 2 required-Arguments and 1 optional-Argument
            REQ_ARG();
          case (uintB)cclos_argtype_1_1:
            # 1 required-Argument and 1 optional-Argument
            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-Arguments and 2 optional-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_2_2:
            # 2 required-Arguments and 2 optional-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_2:
            # 1 required-Argument and 2 optional-Arguments
            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-Arguments and 3 optional-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_3:
            # 1 required-Argument and 3 optional-Arguments
            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-Argument and 4 optional-Arguments
            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 fehler_dotted;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_4_0_rest:
            # 4 required-Arguments, Rest-Parameter
            REQ_ARG();
          case (uintB)cclos_argtype_3_0_rest:
            # 3 required-Arguments, Rest-Parameter
            REQ_ARG();
          case (uintB)cclos_argtype_2_0_rest:
            # 2 required-Arguments, Rest-Parameter
            REQ_ARG();
          case (uintB)cclos_argtype_1_0_rest:
            # 1 required-Argument, Rest-Parameter
            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 fehler_dotted;
            pushSTACK(NIL); # Rest-Parameter := NIL
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_4_0_key:
            # 4 required-Arguments, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_3_0_key:
            # 3 required-Arguments, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_2_0_key:
            # 2 required-Arguments, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_0_key:
            # 1 required-Argument, Keyword-Arguments
            REQ_ARG();
          noch_0_opt_args_key:
            closure = *closure_; codevec = TheCclosure(closure)->clos_codevec;
          case (uintB)cclos_argtype_0_0_key:
            # only Keyword-Arguments
            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, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_2_1_key:
            # 2 required-Arguments and 1 optional-Argument, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_1_key:
            # 1 required-Argument and 1 optional-Argument, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_0_1_key:
            # 1 optional-Argument, Keyword-Arguments
          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, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_2_key:
            # 1 required-Argument and 2 optional-Arguments, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_0_2_key:
            # 2 optional-Arguments, Keyword-Arguments
          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, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_0_3_key:
            # 3 optional-Arguments, Keyword-Arguments
          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, Keyword-Arguments
            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 fehler_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_anz = TheCodevec(codevec)->ccv_numreq; # number of required parameters
          var uintL opt_anz = 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(object) * (req_anz+opt_anz));
          # evaluate required parameters and push into Stack:
          {
            var uintC count;
            dotimesC(count,req_anz, {
              if (atomp(args)) goto fehler_zuwenig; # 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_anz;
            loop {
              if (atomp(args)) break; # argument-list finished?
              if (count==0) goto optionals_ok; # all optional parameters supplied with?
              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 fehler_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 fehler_zuviel;
          elif (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 object* 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 object* 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 fehler_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 fehler_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:
        #if STACKCHECKC
        if (!(STACK == STACKbefore)) # STACK as before?
          abort(); # no -> go to Debugger
        #endif
        skipSTACK(1); # discard Closure
        unwind(); # unwind EVAL-Frame
        return; # finished
        # Gathered errormessages:
       fehler_zuwenig: # Argument-list args is prematurely an Atom
        if (!nullp(args)) goto fehler_dotted;
        setSTACK(STACK = STACKbefore); # clean up STACK
        closure = popSTACK();
        fehler_eval_zuwenig(TheCclosure(closure)->clos_name);
       fehler_zuviel: # Argument-list args is not NIL at the end
        if (atomp(args)) goto fehler_dotted;
        setSTACK(STACK = STACKbefore); # clean up STACK
        closure = popSTACK();
        fehler_eval_zuviel(TheCclosure(closure)->clos_name);
       fehler_dotted: # Argument-list args ends with Atom /= NIL
        setSTACK(STACK = STACKbefore); # clean up STACK
        closure = popSTACK();
        fehler_eval_dotted(TheCclosure(closure)->clos_name);
      } else {
        # closure is an interpreted Closure
        var object* args_pointer = args_end_pointer; # Pointer to the arguments
        var uintC args_on_stack = 0; # Anzahl der Argumente
        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 fehler_zuviel;
        }
        funcall_iclosure(*closure_,args_pointer,args_on_stack);
        skipSTACK(1); # discard Closure
        unwind(); # unwind EVAL-Frame
        return; # finished
      }
    }

#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 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 1. Argument
  {
    var object* 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);
        fehler_eval_zuviel(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 Values apply (object fun, uintC args_on_stack, object other_args);
  global Values apply(fun,args_on_stack,other_args)
    var object fun;
    var uintC args_on_stack;
    var object other_args;
    {
      # 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);
      } elif (closurep(fun)) { # Closure ?
        return_Values apply_closure(fun,args_on_stack,other_args);
      } elif (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);
        } elif (closurep(fdef)) { # Closure -> apply
          return_Values apply_closure(fdef,args_on_stack,other_args);
        } elif (orecordp(fdef)) {
          #ifdef DYNAMIC_FFI
          if (ffunctionp(fdef)) { # Foreign-Function ?
            fun = fdef; goto call_ffunction;
          }
          #endif
          switch (Record_type(fdef)) {
            case Rectype_Fsubr:
              fehler_specialform(S(apply),fun);
            case Rectype_Macro:
              fehler_macro(S(apply),fun);
            default: NOTREACHED;
          }
        } else
          # if no SUBR, no Closure, no FSUBR, no Macro:
          # Symbol_function(fun) mus be #<UNBOUND> .
          undef:
          fehler_undefined(S(apply),fun);
      } elif (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);
        } elif (subrp(fdef)) { # SUBR -> apply
          return_Values apply_subr(fdef,args_on_stack,other_args);
        }
        #ifdef DYNAMIC_FFI
        elif (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
      elif (ffunctionp(fun)) { # Foreign-Function ?
        # call (SYS::FOREIGN-CALL-OUT foreign-function . args)
       call_ffunction:
        # Therefore first shift down the arguments in Stack by 1.
        var uintC count;
        var object* 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
      elif (consp(fun) && eq(Car(fun),S(lambda))) { # Cons (LAMBDA ...) ?
        subr_self = L(apply); fehler_lambda_expression(fun);
      } else
        fehler_funname_type(S(apply),fun);
    }

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

# Error because of too many arguments
# > name: name of function
nonreturning_function(local, fehler_apply_zuviel, (object name)) {
  pushSTACK(name);
  fehler(program_error,GETTEXT("APPLY: too many arguments given to ~"));
}

# Error because of too few arguments
# > name: name fo function
nonreturning_function(local, fehler_apply_zuwenig, (object name)) {
  pushSTACK(name);
  fehler(program_error,GETTEXT("APPLY: too few arguments given to ~"));
}

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

# Error because of too few arguments for a SUBR
# > fun: function, a SUBR
nonreturning_function(local, fehler_subr_zuwenig, (object fun));
#define fehler_subr_zuwenig(fun)  fehler_apply_zuwenig(TheSubr(fun)->name)

# 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 Values apply_subr(fun,args_on_stack,args)
    var object fun;
    var uintC args_on_stack;
    var object args;
    {
      #if STACKCHECKS
      var object* args_pointer = args_end_pointer STACKop args_on_stack; # Pointer to the arguments
      #endif
      var object* key_args_pointer; # Pointer to the Keyword-Arguments
      var object* rest_args_pointer; # Pointer to the remaining Arguments
      var uintL argcount; # number of remaining Arguments
      #ifdef DEBUG_EVAL
      if (streamp(Symbol_value(S(funcall_trace_output)))) {
        pushSTACK(fun); trace_call(fun,'A','S'); fun = popSTACK();
      }
      #endif
      # 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--; }                      \
            elif (consp(args)) { pushSTACK(Car(args)); args = Cdr(args); } \
            else goto fehler_zuwenig;                                      \
          }
        # Macro for the n-last optional-Argument:
        #define OPT_ARG(n)  \
          { if (args_on_stack>0) { args_on_stack--; }                      \
            elif (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 fehler_zuviel;
          goto apply_subr_norest;
        case (uintW)subr_argtype_4_1:
          # SUBR with 4 required-Arguments and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_3_1:
          # SUBR with 3 required-Arguments and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_2_1:
          # SUBR with 2 required-Arguments and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_1_1:
          # SUBR with 1 required-Argument and 1 optional-Argument
          REQ_ARG();
        case (uintW)subr_argtype_0_1:
          # SUBR with 1 optional-Argument
          OPT_ARG(1);
          if ((args_on_stack>0) || consp(args)) goto fehler_zuviel;
          goto apply_subr_norest;
        case (uintW)subr_argtype_3_2:
          # SUBR with 3 required-Arguments and 2 optional-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_2_2:
          # SUBR with 2 required-Arguments and 2 optional-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_2:
          # SUBR with 1 required-Argument and 2 optional-Arguments
          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 fehler_zuviel;
          goto apply_subr_norest;
        case (uintW)subr_argtype_2_3:
          # SUBR with 2 required-Arguments and 3 optional-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_3:
          # SUBR with 1 required-Argument and 3 optional-Arguments
          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 fehler_zuviel;
          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 fehler_zuviel;
          goto apply_subr_norest;
        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 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-Arguments and further Arguments
          REQ_ARG();
        case (uintW)subr_argtype_2_0_rest:
          # SUBR with 2 required-Arguments and further Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_0_rest:
          # SUBR with 1 required-Argument and further Arguments
          REQ_ARG();
        case (uintW)subr_argtype_0_0_rest:
          # SUBR with further 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-Arguments and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_3_0_key:
          # SUBR with 3 required-Arguments and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_2_0_key:
          # SUBR with 2 required-Arguments and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_1_0_key:
          # SUBR with 1 required-Argument and Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_0_0_key:
          # SUBR with Keyword-Arguments
          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 Keyword-Arguments
          REQ_ARG();
        case (uintW)subr_argtype_0_1_key:
          # SUBR with 1 optional-Argument and Keyword-Arguments
          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 Keyword-Arguments
          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_anz, { pushSTACK(unbound); } );
          }
          goto apply_subr_norest;
        default: NOTREACHED;
        #undef OPT_ARG
        #undef REQ_ARG
      }
      # Now the general Version:
      {
        var uintC key_anz;
        {
          var uintC req_anz = TheSubr(fun)->req_anz;
          var uintC opt_anz = TheSubr(fun)->opt_anz;
          key_anz = TheSubr(fun)->key_anz;
          if (args_on_stack < req_anz) {
            # fewer Arguments there than demanded
            req_anz = req_anz - args_on_stack; # as many as these must go on STACK
            # reserve space on STACK:
            get_space_on_STACK(sizeof(object) * (uintL)(req_anz + opt_anz + key_anz));
            # store required Parameter in Stack:
            {
              var uintC count;
              dotimespC(count,req_anz, {
                if (atomp(args))
                  goto fehler_zuwenig;
                pushSTACK(Car(args)); # store next Argument
                args = Cdr(args);
              });
            }
            goto optionals_from_list;
          }
          args_on_stack -= req_anz; # remaining number
          if (args_on_stack < opt_anz) {
            # Arguments in Stack don't last for the optional ones
            opt_anz = opt_anz - args_on_stack; # as many as these must go on STACK
            # reserve space on STACK:
            get_space_on_STACK(sizeof(object) * (uintL)(opt_anz + key_anz));
           optionals_from_list:
            # store optional Parameters on Stack:
            {
              var uintC count = opt_anz;
              loop {
                if (atomp(args)) # Argument-list finished?
                  break;
                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_anz, { 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
                fehler_subr_zuviel(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_anz, { pushSTACK(unbound); } );
              }
              rest_args_pointer = args_end_pointer;
              argcount = 0;
              goto key_from_list;
            }
          }
          args_on_stack -= opt_anz; # 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?
                fehler_subr_zuviel(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_anz = TheSubr(fun)->key_anz;
       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(object) * (uintL)key_anz);
        {
          var object* new_args_end_pointer = args_end_pointer STACKop -(uintP)key_anz;
          var object* ptr1 = args_end_pointer;
          var object* 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_anz, { 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 fehler_zuviel;
     apply_subr_rest:
      if (!nullp(args))
        goto fehler_dotted;
      subr_self = fun;
      (*(subr_rest_function_t*)(TheSubr(fun)->function))(argcount,rest_args_pointer);
      goto done;
     apply_subr_norest:
      if (!nullp(args))
        goto fehler_dotted;
      subr_self = fun;
      (*(subr_norest_function_t*)(TheSubr(fun)->function))();
     done:
      #if STACKCHECKS
      if (!(args_pointer == args_end_pointer)) # Stack cleaned up?
        abort(); # no -> go to Debugger
      #endif
      return; # finished
      # gathered error messages:
     fehler_zuwenig: fehler_subr_zuwenig(fun);
     fehler_zuviel: fehler_subr_zuviel(fun);
     fehler_dotted: fehler_apply_dotted(TheSubr(fun)->name,args);
    }

# Error because of too many arguments for a Closure
# > closure: function, a Closure
nonreturning_function(local, fehler_closure_zuviel, (object closure));
#define fehler_closure_zuviel(closure)  fehler_apply_zuviel(closure)

# Error because of too few arguments for a Closure
# > closure: function, a Closure
nonreturning_function(local, fehler_closure_zuwenig, (object closure));
#define fehler_closure_zuwenig(closure)  fehler_apply_zuwenig(closure)

# 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 Values apply_closure(closure,args_on_stack,args)
    var object closure;
    var uintC args_on_stack;
    var object args;
    {
      #ifdef DEBUG_EVAL
      if (streamp(Symbol_value(S(funcall_trace_output)))) {
        pushSTACK(closure); trace_call(closure,'A','C'); closure = popSTACK();
      }
      #endif
      if (simple_bit_vector_p(Atype_8Bit,TheClosure(closure)->clos_codevec)) {
        # closure is a compiled Closure
        #if STACKCHECKC
        var object* args_pointer = args_end_pointer STACKop args_on_stack; # Pointer to the arguments
        #endif
        var object codevec = TheCclosure(closure)->clos_codevec; # Code-Vector
        var object* key_args_pointer; # Pointer to the Keyword-arguments
        var object* 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--; }                      \
              elif (consp(args)) { pushSTACK(Car(args)); args = Cdr(args); } \
              else goto fehler_zuwenig;                                      \
            }
          # Macro for the n-last optional-argument:
          #define OPT_ARG(n)  \
            { if (args_on_stack>0) { args_on_stack--; }                      \
              elif (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 fehler_zuviel;
            if (!nullp(args)) {
              if (consp(args))
                goto fehler_zuviel;
              else
                goto fehler_dotted;
            }
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_4_1:
            # 4 required-Arguments and 1 optional-Argument
            REQ_ARG();
          case (uintB)cclos_argtype_3_1:
            # 3 required-Arguments and 1 optional-Argument
            REQ_ARG();
          case (uintB)cclos_argtype_2_1:
            # 2 required-Arguments and 1 optional-Argument
            REQ_ARG();
          case (uintB)cclos_argtype_1_1:
            # 1 required-Argument and 1 optional-Argument
            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-Arguments and 2 optional-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_2_2:
            # 2 required-Arguments and 2 optional-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_2:
            # 1 required-Argument and 2 optional-Arguments
            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-Arguments and 3 optional-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_3:
            # 1 required-Argument and 3 optional-Arguments
            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-Argument and 4 optional-Arguments
            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 fehler_dotted;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_4_0_rest:
            # 4 required-Arguments, Rest-Parameter
            REQ_ARG();
          case (uintB)cclos_argtype_3_0_rest:
            # 3 required-Arguments, Rest-Parameter
            REQ_ARG();
          case (uintB)cclos_argtype_2_0_rest:
            # 2 required-Arguments, Rest-Parameter
            REQ_ARG();
          case (uintB)cclos_argtype_1_0_rest:
            # 1 required-Argument, Rest-Parameter
            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, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_3_0_key:
            # 3 required-Arguments, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_2_0_key:
            # 2 required-Arguments, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_0_key:
            # 1 required-Argument, Keyword-Arguments
            REQ_ARG();
            noch_0_opt_args_key:
          case (uintB)cclos_argtype_0_0_key:
            # only Keyword-Arguments
            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, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_2_1_key:
            # 2 required-Arguments and 1 optional-Argument, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_1_key:
            # 1 required-Argument and 1 optional-Argument, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_0_1_key:
            # 1 optional-Argument, Keyword-Arguments
            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, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_1_2_key:
            # 1 required-Argument and 2 optional-Arguments, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_0_2_key:
            # 2 optional-Arguments, Keyword-Arguments
            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, Keyword-Arguments
            REQ_ARG();
          case (uintB)cclos_argtype_0_3_key:
            # 3 optional-Arguments, Keyword-Arguments
            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, Keyword-Arguments
            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 fehler_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_anz = TheCodevec(codevec)->ccv_numreq; # number of required Parameters
            var uintC opt_anz = TheCodevec(codevec)->ccv_numopt; # number of optional Parameters
            flags = TheCodevec(codevec)->ccv_flags; # Flags
            if (args_on_stack < req_anz) {
              # fewer Arguments than demanded
              req_anz = req_anz - args_on_stack; # as many as these must on STACK
              # reserve space on STACK:
              get_space_on_STACK(sizeof(object) * (uintL)(req_anz + opt_anz));
              # store required Parameters on Stack:
              {
                var uintC count;
                dotimespC(count,req_anz, {
                  if (atomp(args))
                    goto fehler_zuwenig;
                  pushSTACK(Car(args)); # store next argument
                  args = Cdr(args);
                });
              }
              goto optionals_from_list;
            }
            args_on_stack -= req_anz; # remaining number
            if (args_on_stack < opt_anz) {
              # Argumente in Stack don't last for the optional ones
              opt_anz = opt_anz - args_on_stack; # as many as these must go on STACK
              # reserve space on STACK:
              get_space_on_STACK(sizeof(object) * (uintL)opt_anz);
              optionals_from_list:
              # store optional parameters on Stack:
              {
                var uintC count = opt_anz;
                loop {
                  if (atomp(args)) # argument-list finished?
                    break;
                  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 fehler_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 fehler_zuviel;
              # 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_anz; # remaining number
            if (flags & bit(7)) # Key-Flag?
              goto apply_cclosure_key_withlist_;
            elif (flags & bit(0))
              goto apply_cclosure_rest_nokey;
            else {
              # Closure without REST or KEY
              if ((args_on_stack>0) || consp(args)) # still arguments?
                goto fehler_zuviel;
              goto apply_cclosure_nokey;
            }
          }
         apply_cclosure_key_noargs:
          {
            var uintC key_anz = TheCodevec(codevec)->ccv_numkey; # number of Keyword-parameters
            if (key_anz > 0) {
              get_space_on_STACK(sizeof(object) * (uintL)key_anz);
              var uintC count;
              dotimespC(count,key_anz, { 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_anz = 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_anz;
            if (flags & bit(0))
              shift++; # poss. 1 more for Rest-Parameter
            argcount = args_on_stack;
            get_space_on_STACK(sizeof(object) * shift);
            var object* new_args_end_pointer = args_end_pointer STACKop -(uintP)shift;
            var object* ptr1 = args_end_pointer;
            var object* 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_anz, { 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 object* 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 fehler_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:
        #if STACKCHECKC
        if (!(args_pointer == args_end_pointer)) # Stack cleaned up?
          abort(); # no -> go to Debugger
        #endif
        return; # finished
        # Gathered error-messages:
       fehler_zuwenig: fehler_closure_zuwenig(closure);
       fehler_zuviel: fehler_closure_zuviel(closure);
       fehler_dotted: fehler_apply_dotted(closure,args);
      } else {
        # closure is an interpreted Closure
        # reserve space on STACK:
        get_space_on_STACK(sizeof(object) * 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 fehler_zuviel;
        }
        funcall_iclosure(closure,args_end_pointer STACKop args_on_stack,args_on_stack);
      }
    }


#        ----------------------- 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 Values funcall (object fun, uintC argcount);
  global Values funcall(fun,args_on_stack)
    var object fun;
    var uintC args_on_stack;
    {
      # fun must be a SUBR or a Closure or a Cons (LAMBDA ...) :
      if (subrp(fun)) { # SUBR ?
        return_Values funcall_subr(fun,args_on_stack);
      } elif (closurep(fun)) { # Closure ?
        return_Values funcall_closure(fun,args_on_stack);
      } elif (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);
        } elif (closurep(fdef)) { # Closure -> apply
          return_Values funcall_closure(fdef,args_on_stack);
        } elif (orecordp(fdef)) {
          #ifdef DYNAMIC_FFI
          if (ffunctionp(fdef)) { # Foreign-Function ?
            fun = fdef; goto call_ffunction;
          }
          #endif
          switch (Record_type(fdef)) {
            case Rectype_Fsubr:
              fehler_specialform(S(funcall),fun);
            case Rectype_Macro:
              fehler_macro(S(funcall),fun);
            default: NOTREACHED;
          }
        } else
          # if no SUBR, no Closure, no FSUBR, no Macro:
          # Symbol_function(fun) must be #<UNBOUND> .
          undef:
          fehler_undefined(S(funcall),fun);
      } elif (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 undefed
        var object fdef = Symbol_function(symbol);
        if (closurep(fdef)) { # Closure -> apply
          return_Values funcall_closure(fdef,args_on_stack);
        } elif (subrp(fdef)) { # SUBR -> apply
          return_Values funcall_subr(fdef,args_on_stack);
        }
        #ifdef DYNAMIC_FFI
        elif (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
      elif (ffunctionp(fun)) { # Foreign-Function ?
        # call (SYS::FOREIGN-CALL-OUT foreign-function . args)
       call_ffunction:
        # First shift down the arguments in Stack by 1.
        var uintC count;
        var object* 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
      elif (consp(fun) && eq(Car(fun),S(lambda))) { # Cons (LAMBDA ...) ?
        subr_self = L(funcall); fehler_lambda_expression(fun);
      } else
        fehler_funname_type(S(funcall),fun);
    }

# 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 Values funcall_subr(fun,args_on_stack)
    var object fun;
    var uintC args_on_stack;
    {
      #if STACKCHECKS
      var object* args_pointer = args_end_pointer STACKop args_on_stack; # Pointer to the arguments
      #endif
      var object* key_args_pointer; # Pointer to the Keyword-arguments
      var object* rest_args_pointer; # Pointer to the remaining arguments
      var uintL argcount; # number of remaining arguments
      #ifdef DEBUG_EVAL
      if (streamp(Symbol_value(S(funcall_trace_output)))) {
        pushSTACK(fun); trace_call(fun,'F','S'); fun = popSTACK();
      }
      #endif
      # 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 fehler_zuviel;
          goto apply_subr_norest;
        case (uintW)subr_argtype_1_0:
          # SUBR with 1 required-Argument
          if (!(args_on_stack==1)) goto fehler_anzahl;
          goto apply_subr_norest;
        case (uintW)subr_argtype_2_0:
          # SUBR with 2 required-Arguments
          if (!(args_on_stack==2)) goto fehler_anzahl;
          goto apply_subr_norest;
        case (uintW)subr_argtype_3_0:
          # SUBR with 3 required-Arguments
          if (!(args_on_stack==3)) goto fehler_anzahl;
          goto apply_subr_norest;
        case (uintW)subr_argtype_4_0:
          # SUBR with 4 required-Arguments
          if (!(args_on_stack==4)) goto fehler_anzahl;
          goto apply_subr_norest;
        case (uintW)subr_argtype_5_0:
          # SUBR with 5 required-Arguments
          if (!(args_on_stack==5)) goto fehler_anzahl;
          goto apply_subr_norest;
        case (uintW)subr_argtype_6_0:
          # SUBR with 6 required-Arguments
          if (!(args_on_stack==6)) goto fehler_anzahl;
          goto apply_subr_norest;
        case (uintW)subr_argtype_0_1:
          # SUBR with 1 optional-Argument
          if (args_on_stack==1) goto apply_subr_norest;
          elif (args_on_stack>1) goto fehler_zuviel;
          else { pushSTACK(unbound); goto apply_subr_norest; }
        case (uintW)subr_argtype_1_1:
          # SUBR with 1 required-Argument and 1 optional-Argument
          if (args_on_stack==2) goto apply_subr_norest;
          elif (args_on_stack>2) goto fehler_zuviel;
          elif (args_on_stack==0) goto fehler_zuwenig;
          else { pushSTACK(unbound); goto apply_subr_norest; }
        case (uintW)subr_argtype_2_1:
          # SUBR with 2 required-Arguments and 1 optional-Argument
          if (args_on_stack==3) goto apply_subr_norest;
          elif (args_on_stack>3) goto fehler_zuviel;
          elif (args_on_stack<2) goto fehler_zuwenig;
          else { pushSTACK(unbound); goto apply_subr_norest; }
        case (uintW)subr_argtype_3_1:
          # SUBR with 3 required-Arguments and 1 optional-Argument
          if (args_on_stack==4) goto apply_subr_norest;
          elif (args_on_stack>4) goto fehler_zuviel;
          elif (args_on_stack<3) goto fehler_zuwenig;
          else { pushSTACK(unbound); goto apply_subr_norest; }
        case (uintW)subr_argtype_4_1:
          # SUBR with 4 required-Arguments and 1 optional-Argument
          if (args_on_stack==5) goto apply_subr_norest;
          elif (args_on_stack>5) goto fehler_zuviel;
          elif (args_on_stack<4) goto fehler_zuwenig;
          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 fehler_zuviel;
          }
        case (uintW)subr_argtype_1_2:
          # SUBR with 1 required-Argument and 2 optional-Arguments
          switch (args_on_stack) {
            case 0: goto fehler_zuwenig;
            case 1: pushSTACK(unbound);
            case 2: pushSTACK(unbound);
            case 3: goto apply_subr_norest;
            default: goto fehler_zuviel;
          }
        case (uintW)subr_argtype_2_2:
          # SUBR with 2 required-Arguments and 2 optional-Arguments
          switch (args_on_stack) {
            case 0: goto fehler_zuwenig;
            case 1: goto fehler_zuwenig;
            case 2: pushSTACK(unbound);
            case 3: pushSTACK(unbound);
            case 4: goto apply_subr_norest;
            default: goto fehler_zuviel;
          }
        case (uintW)subr_argtype_3_2:
          # SUBR with 3 required-Arguments and 2 optional-Arguments
          switch (args_on_stack) {
            case 0: goto fehler_zuwenig;
            case 1: goto fehler_zuwenig;
            case 2: goto fehler_zuwenig;
            case 3: pushSTACK(unbound);
            case 4: pushSTACK(unbound);
            case 5: goto apply_subr_norest;
            default: goto fehler_zuviel;
          }
        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 fehler_zuviel;
          }
        case (uintW)subr_argtype_1_3:
          # SUBR with 1 required-Argument and 3 optional-Arguments
          switch (args_on_stack) {
            case 0: goto fehler_zuwenig;
            case 1: pushSTACK(unbound);
            case 2: pushSTACK(unbound);
            case 3: pushSTACK(unbound);
            case 4: goto apply_subr_norest;
            default: goto fehler_zuviel;
          }
        case (uintW)subr_argtype_2_3:
          # SUBR with 2 required-Arguments and 3 optional-Arguments
          switch (args_on_stack) {
            case 0: goto fehler_zuwenig;
            case 1: goto fehler_zuwenig;
            case 2: pushSTACK(unbound);
            case 3: pushSTACK(unbound);
            case 4: pushSTACK(unbound);
            case 5: goto apply_subr_norest;
            default: goto fehler_zuviel;
          }
        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 fehler_zuviel;
          }
        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 fehler_zuviel;
          }
        case (uintW)subr_argtype_0_0_rest:
          # SUBR with further Arguments
          goto apply_subr_rest_ok;
        case (uintW)subr_argtype_1_0_rest:
          # SUBR with 1 required-Argument and further Arguments
          if (args_on_stack==0) goto fehler_zuwenig;
          args_on_stack -= 1;
          goto apply_subr_rest_ok;
        case (uintW)subr_argtype_2_0_rest:
          # SUBR with 2 required-Argumenten and further Arguments
          if (args_on_stack<2) goto fehler_zuwenig;
          args_on_stack -= 2;
          goto apply_subr_rest_ok;
        case (uintW)subr_argtype_3_0_rest:
          # SUBR with 3 required-Argumenten and further Arguments
          if (args_on_stack<3) goto fehler_zuwenig;
          args_on_stack -= 3;
          goto apply_subr_rest_ok;
        case (uintW)subr_argtype_0_0_key:
          # SUBR with Keyword-Arguments
          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-Argument and Keyword-Arguments
          if (args_on_stack==1) goto unbound_optional_key_0;
          elif (args_on_stack<1) goto fehler_zuwenig;
          else { args_on_stack -= 1; goto apply_subr_key; }
        case (uintW)subr_argtype_2_0_key:
          # SUBR with 2 required-Arguments and Keyword-Arguments
          if (args_on_stack==2) goto unbound_optional_key_0;
          elif (args_on_stack<2) goto fehler_zuwenig;
          else { args_on_stack -= 2; goto apply_subr_key; }
        case (uintW)subr_argtype_3_0_key:
          # SUBR with 3 required-Arguments and Keyword-Arguments
          if (args_on_stack==3) goto unbound_optional_key_0;
          elif (args_on_stack<3) goto fehler_zuwenig;
          else { args_on_stack -= 3; goto apply_subr_key; }
        case (uintW)subr_argtype_4_0_key:
          # SUBR with 4 required-Arguments and Keyword-Arguments
          if (args_on_stack==4) goto unbound_optional_key_0;
          elif (args_on_stack<4) goto fehler_zuwenig;
          else { args_on_stack -= 4; goto apply_subr_key; }
        case (uintW)subr_argtype_0_1_key:
          # SUBR with 1 optional-Argument and Keyword-Arguments
          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 Keyword-Arguments
          switch (args_on_stack) {
            case 0: goto fehler_zuwenig;
            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 Keyword-Arguments
          switch (args_on_stack) {
            case 0: goto fehler_zuwenig;
            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_anz, { pushSTACK(unbound); } );
          }
          goto apply_subr_norest;
        default: NOTREACHED;
        #undef OPT_ARG
        #undef REQ_ARG
      }
      # Now the general Version:
      {
        var uintC key_anz;
        {
          var uintC req_anz = TheSubr(fun)->req_anz;
          var uintC opt_anz = TheSubr(fun)->opt_anz;
          key_anz = TheSubr(fun)->key_anz;
          if (args_on_stack < req_anz)
            # fewer Arguments than demanded
            goto fehler_zuwenig;
          args_on_stack -= req_anz; # remaining number
          if (args_on_stack <= opt_anz) {
            # Arguments in Stack don't last for the optional ones
            opt_anz = opt_anz - args_on_stack; # as many as these must go on STACK
            if (opt_anz + key_anz > 0) {
              # reserve space on STACK:
              get_space_on_STACK(sizeof(object) * (uintL)(opt_anz + key_anz));
              # All further count optional parameters receive the "value"
              # #<UNBOUND>, including the Keyword-parameters:
              var uintC count;
              dotimespC(count,opt_anz + key_anz, { 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_anz; # 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 fehler_zuviel; # 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_anz = TheSubr(fun)->key_anz;
       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(object) * (uintL)key_anz);
        {
          var object* new_args_end_pointer = args_end_pointer STACKop -(uintP)key_anz;
          var object* ptr1 = args_end_pointer;
          var object* 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_anz, { 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:
      subr_self = fun;
      (*(subr_rest_function_t*)(TheSubr(fun)->function))(argcount,rest_args_pointer);
      goto done;
     apply_subr_norest:
      subr_self = fun;
      (*(subr_norest_function_t*)(TheSubr(fun)->function))();
     done:
      #if STACKCHECKS
      if (!(args_pointer == args_end_pointer)) # Stack cleaned up?
        abort(); # no -> go to Debugger
      #endif
      return; # finished
      # Gathered error-messages:
     fehler_anzahl:
      if (args_on_stack < TheSubr(fun)->req_anz)
        goto fehler_zuwenig; # too few Arguments
      else
        goto fehler_zuviel; # too many Arguments
     fehler_zuwenig: fehler_subr_zuwenig(fun);
     fehler_zuviel: fehler_subr_zuviel(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 Values funcall_closure(closure,args_on_stack)
    var object closure;
    var uintC args_on_stack;
    {
      #ifdef DEBUG_EVAL
      if (streamp(Symbol_value(S(funcall_trace_output)))) {
        pushSTACK(closure); trace_call(closure,'F','C'); closure = popSTACK();
      }
      #endif
      if (simple_bit_vector_p(Atype_8Bit,TheClosure(closure)->clos_codevec)) {
        # closure is a compiled Closure
        #if STACKCHECKC
        var object* args_pointer = args_end_pointer STACKop args_on_stack; # Pointer to the Arguments
        #endif
        var object codevec = TheCclosure(closure)->clos_codevec; # Code-Vector
        var object* key_args_pointer; # Pointer to the Keyword-Arguments
        var object* 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 fehler_zuviel;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_1_0:
            # 1 required-Argument
            if (!(args_on_stack==1)) goto fehler_anzahl;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_2_0:
            # 2 required-Arguments
            if (!(args_on_stack==2)) goto fehler_anzahl;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_3_0:
            # 3 required-Arguments
            if (!(args_on_stack==3)) goto fehler_anzahl;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_4_0:
            # 4 required-Arguments
            if (!(args_on_stack==4)) goto fehler_anzahl;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_5_0:
            # 5 required-Arguments
            if (!(args_on_stack==5)) goto fehler_anzahl;
            goto apply_cclosure_nokey;
          case (uintB)cclos_argtype_0_1:
            # 1 optional-Argument
            if (args_on_stack==1) goto apply_cclosure_nokey;
            elif (args_on_stack>1) goto fehler_zuviel;
            else { pushSTACK(unbound); goto apply_cclosure_nokey; }
          case (uintB)cclos_argtype_1_1:
            # 1 required-Argument and 1 optional-Argument
            if (args_on_stack==2) goto apply_cclosure_nokey;
            elif (args_on_stack>2) goto fehler_zuviel;
            elif (args_on_stack==0) goto fehler_zuwenig;
            else { pushSTACK(unbound); goto apply_cclosure_nokey; }
          case (uintB)cclos_argtype_2_1:
            # 2 required-Arguments and 1 optional-Argument
            if (args_on_stack==3) goto apply_cclosure_nokey;
            elif (args_on_stack>3) goto fehler_zuviel;
            elif (args_on_stack<2) goto fehler_zuwenig;
            else { pushSTACK(unbound); goto apply_cclosure_nokey; }
          case (uintB)cclos_argtype_3_1:
            # 3 required-Arguments and 1 optional-Argument
            if (args_on_stack==4) goto apply_cclosure_nokey;
            elif (args_on_stack>4) goto fehler_zuviel;
            elif (args_on_stack<3) goto fehler_zuwenig;
            else { pushSTACK(unbound); goto apply_cclosure_nokey; }
          case (uintB)cclos_argtype_4_1:
            # 4 required-Arguments and 1 optional-Argument
            if (args_on_stack==5) goto apply_cclosure_nokey;
            elif (args_on_stack>5) goto fehler_zuviel;
            elif (args_on_stack<4) goto fehler_zuwenig;
            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 fehler_zuviel;
            }
          case (uintB)cclos_argtype_1_2:
            # 1 required-Argument and 2 optional-Arguments
            switch (args_on_stack) {
              case 0: goto fehler_zuwenig;
              case 1: pushSTACK(unbound);
              case 2: pushSTACK(unbound);
              case 3: goto apply_cclosure_nokey;
              default: goto fehler_zuviel;
            }
          case (uintB)cclos_argtype_2_2:
            # 2 required-Arguments and 2 optional-Arguments
            switch (args_on_stack) {
              case 0: case 1: goto fehler_zuwenig;
              case 2: pushSTACK(unbound);
              case 3: pushSTACK(unbound);
              case 4: goto apply_cclosure_nokey;
              default: goto fehler_zuviel;
            }
          case (uintB)cclos_argtype_3_2:
            # 3 required-Arguments and 2 optional-Arguments
            switch (args_on_stack) {
              case 0: case 1: case 2: goto fehler_zuwenig;
              case 3: pushSTACK(unbound);
              case 4: pushSTACK(unbound);
              case 5: goto apply_cclosure_nokey;
              default: goto fehler_zuviel;
            }
          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 fehler_zuviel;
            }
          case (uintB)cclos_argtype_1_3:
            # 1 required-Argument and 3 optional-Arguments
            switch (args_on_stack) {
              case 0: goto fehler_zuwenig;
              case 1: pushSTACK(unbound);
              case 2: pushSTACK(unbound);
              case 3: pushSTACK(unbound);
              case 4: goto apply_cclosure_nokey;
              default: goto fehler_zuviel;
            }
          case (uintB)cclos_argtype_2_3:
            # 2 required-Arguments and 3 optional-Arguments
            switch (args_on_stack) {
              case 0: case 1: goto fehler_zuwenig;
              case 2: pushSTACK(unbound);
              case 3: pushSTACK(unbound);
              case 4: pushSTACK(unbound);
              case 5: goto apply_cclosure_nokey;
              default: goto fehler_zuviel;
            }
          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 fehler_zuviel;
            }
          case (uintB)cclos_argtype_1_4:
            # 1 required-Argument and 4 optional-Arguments
            switch (args_on_stack) {
              case 0: goto fehler_zuwenig;
              case 1: pushSTACK(unbound);
              case 2: pushSTACK(unbound);
              case 3: pushSTACK(unbound);
              case 4: pushSTACK(unbound);
              case 5: goto apply_cclosure_nokey;
              default: goto fehler_zuviel;
            }
          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 fehler_zuviel;
            }
          case (uintB)cclos_argtype_0_0_rest:
            # no Arguments, Rest-Parameter
            goto apply_cclosure_rest_nokey;
          case (uintB)cclos_argtype_1_0_rest:
            # 1 required-Argument, Rest-Parameter
            if (args_on_stack==0) goto fehler_zuwenig;
            args_on_stack -= 1;
            goto apply_cclosure_rest_nokey;
          case (uintB)cclos_argtype_2_0_rest:
            # 2 required-Arguments, Rest-Parameter
            if (args_on_stack<2) goto fehler_zuwenig;
            args_on_stack -= 2;
            goto apply_cclosure_rest_nokey;
          case (uintB)cclos_argtype_3_0_rest:
            # 3 required-Arguments, Rest-Parameter
            if (args_on_stack<3) goto fehler_zuwenig;
            args_on_stack -= 3;
            goto apply_cclosure_rest_nokey;
          case (uintB)cclos_argtype_4_0_rest:
            # 4 required-Arguments, Rest-Parameter
            if (args_on_stack<4) goto fehler_zuwenig;
            args_on_stack -= 4;
            goto apply_cclosure_rest_nokey;
          case (uintB)cclos_argtype_0_0_key:
            # only Keyword-Arguments
            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, Keyword-Arguments
            if (args_on_stack==1) goto unbound_optional_key_0;
            elif (args_on_stack<1) goto fehler_zuwenig;
            else { args_on_stack -= 1; goto apply_cclosure_key_withargs; }
          case (uintB)cclos_argtype_2_0_key:
            # 2 required-Arguments, Keyword-Arguments
            if (args_on_stack==2) goto unbound_optional_key_0;
            elif (args_on_stack<2) goto fehler_zuwenig;
            else { args_on_stack -= 2; goto apply_cclosure_key_withargs; }
          case (uintB)cclos_argtype_3_0_key:
            # 3 required-Arguments, Keyword-Arguments
            if (args_on_stack==3) goto unbound_optional_key_0;
            elif (args_on_stack<3) goto fehler_zuwenig;
            else { args_on_stack -= 3; goto apply_cclosure_key_withargs; }
          case (uintB)cclos_argtype_4_0_key:
            # 4 required-Arguments, Keyword-Arguments
            if (args_on_stack==4) goto unbound_optional_key_0;
            elif (args_on_stack<4) goto fehler_zuwenig;
            else { args_on_stack -= 4; goto apply_cclosure_key_withargs; }
          case (uintB)cclos_argtype_0_1_key:
            # 1 optional-Argument, Keyword-Arguments
            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, Keyword-Arguments
            switch (args_on_stack) {
              case 0: goto fehler_zuwenig;
              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, Keyword-Arguments
            switch (args_on_stack) {
              case 0: case 1: goto fehler_zuwenig;
              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, Keyword-Arguments
            switch (args_on_stack) {
              case 0: case 1: case 2: goto fehler_zuwenig;
              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, Keyword-Arguments
            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, Keyword-Arguments
            switch (args_on_stack) {
              case 0: goto fehler_zuwenig;
              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, Keyword-Arguments
            switch (args_on_stack) {
              case 0: case 1: goto fehler_zuwenig;
              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, Keyword-Arguments
            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, Keyword-Arguments
            switch (args_on_stack) {
              case 0: goto fehler_zuwenig;
              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, Keyword-Arguments
            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 optional Arguments, but args_on_stack=0
            pushSTACK(unbound);
          unbound_optional_key_3: # Still 3 optional Arguments, but args_on_stack=0
            pushSTACK(unbound);
          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
            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_anz = TheCodevec(codevec)->ccv_numreq; # number of required Parameters
            var uintC opt_anz = TheCodevec(codevec)->ccv_numopt; # number of optional Parameters
            flags = TheCodevec(codevec)->ccv_flags; # Flags
            if (args_on_stack < req_anz)
              # fewer Arguments than demanded
              goto fehler_zuwenig;
            args_on_stack -= req_anz; # remaining number
            if (args_on_stack <= opt_anz) {
              # Arguments in Stack don't last for the optional ones
              opt_anz = opt_anz - args_on_stack; # as many as these must go on STACK
              if (opt_anz > 0) {
                # reserve space on STACK:
                get_space_on_STACK(sizeof(object) * (uintL)opt_anz);
                # 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_anz, { 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_anz; # remaining number
            if (flags & bit(7)) # Key-Flag?
              goto apply_cclosure_key_withargs_;
            elif (flags & bit(0))
              goto apply_cclosure_rest_nokey;
            else {
              # Closure without REST or KEY
              if (args_on_stack>0) # still arguments?
                goto fehler_zuviel;
              goto apply_cclosure_nokey;
            }
          }
         apply_cclosure_key_noargs:
          {
            var uintC key_anz = TheCodevec(codevec)->ccv_numkey; # number of Keyword-Parameters
            if (key_anz > 0) {
              get_space_on_STACK(sizeof(object) * (uintL)key_anz);
              var uintC count;
              dotimespC(count,key_anz, { 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_anz = 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_anz;
            if (flags & bit(0))
              shift++; # poss. 1 more for Rest-Parameter
            argcount = args_on_stack;
            get_space_on_STACK(sizeof(object) * shift);
            var object* new_args_end_pointer = args_end_pointer STACKop -(uintP)shift;
            var object* ptr1 = args_end_pointer;
            var object* 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_anz, { 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:
        #if STACKCHECKC
        if (!(args_pointer == args_end_pointer)) # Stack cleaned up?
          abort(); # no -> go to Debugger
        #endif
        return; # finished
        # Gathered error-messages:
       fehler_anzahl:
        if (args_on_stack < TheCodevec(codevec)->ccv_numreq)
          goto fehler_zuwenig; # too few arguments
        else
          goto fehler_zuviel; # too many arguments
       fehler_zuwenig: fehler_closure_zuwenig(closure);
       fehler_zuviel: fehler_closure_zuviel(closure);
      } else {
        # closure is an interpreted Closure
        funcall_iclosure(closure,args_end_pointer STACKop args_on_stack,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 CONVEX
      #define closure_register "a5"
      #define byteptr_register "a4"
    #endif
    #ifdef DECALPHA
      #define byteptr_register  "$14"
    #endif
    #ifdef WIDE_SOFT
      # 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
  local Values interpret_bytecode_(closure_in,codeptr,byteptr_in)
    var object closure_in;
    var Sbvector codeptr;
    var const uintB* byteptr_in;
    {
      # 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 const uintB* byteptr __asm__(byteptr_register);
      byteptr = byteptr_in;
      #endif
      #ifdef DEBUG_EVAL
      if (streamp(Symbol_value(S(funcall_trace_output)))) {
        pushSTACK(closure); trace_call(closure,'B','C'); closure = popSTACK();
      }
      #endif
      # situate closure in STACK, below the arguments:
      var object* 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_zuweisung)  (item_zuweisung *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. Der 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 war gesetzt                                    \
                { 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! In order to
        #  make it GC-invariant, CODEPTR must be subtraced from it.
        #  If one adds to 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 built into a
        # 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:                    # (NIL)
          code_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:                      # (T)
          code_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 object* FRAME = (object*) 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 object* FRAME = (object*) 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 object* FRAME = (object*) 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 object* FRAME = (object*) 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);
          }
        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 object* FRAME = (object*) 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);
              fehler(unbound_variable,GETTEXT("symbol ~ 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);
              fehler(unbound_variable,GETTEXT("symbol ~ 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 (constantp(TheSymbol(symbol))) {
              pushSTACK(symbol);
              fehler(error,
                     GETTEXT("assignment to constant symbol ~ 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 fehler_STACK_putt;
          #endif
          # unwind variable-binding-frame:
          {
            var object* new_STACK = topofframe(STACK_0); # pointer above frame
            var object* frame_end = STACKpointable(new_STACK);
            var object* bindingptr = &STACK_1; # begin of bindings
            # bindingptr loops upwards through the bindings
            until (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 object* FRAME = STACK;
            do {
              #if STACKCHECKC
              if (!(framecode(FRAME_(0)) == DYNBIND_frame_info))
                goto fehler_STACK_putt;
              #endif
              # unwind variable-binding-frame:
              var object* new_FRAME = topofframe(FRAME_(0)); # pointer above frame
              var object* frame_end = STACKpointable(new_FRAME);
              var object* bindingptr = &FRAME_(1); # begin of the bindings
              # bindingptr loops upwards through the bindings
              until (bindingptr == frame_end) {
                # write back old value:
                Symbol_value(*(bindingptr STACKop 0)) = *(bindingptr STACKop 1);
                bindingptr skipSTACKop 2; # next binding
              }
              FRAME = new_FRAME;
            } until (--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
            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 object* newSTACK;
            popSP( newSTACK = (object*) );
            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);       \
            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]);
            if (eq(hashvalue,nullobj))
              goto jmp; # not found -> jump to label
            else # interprete found Fixnum as label:
              byteptr += fixnum_to_L(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]);
            if (eq(hashvalue,nullobj))
              goto jmp; # not found -> jump to label
            else # interprete found Fixnum as label:
              byteptr += fixnum_to_L(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(                                   \
              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 object* ptr1 = STACK STACKop m;
            var object* 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 object* 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 object* 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];                                \
            subr_self = subr_tab_ptr_as_object(fun);                  \
            with_saved_context((*(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];                                \
            subr_self = subr_tab_ptr_as_object(fun);                  \
            with_saved_context((*(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];                                \
            subr_self = subr_tab_ptr_as_object(fun);                  \
            with_saved_context((*(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);
              } until (--n == 0);
            if (atomp(l))
              goto next_byte;
            else
              fehler_apply_zuviel(S(lambda));
           unlist_unbound:
            if (n > m) fehler_apply_zuwenig(S(lambda));
            do { pushSTACK(unbound); } until (--n == 0);
            goto next_byte;
          }
        CASE cod_unliststern:            # (UNLIST* n m)
          {
            var uintC n;
            var uintC m;
            U_operand(n);
            U_operand(m);
            var object l = value1;
            do {
              if (atomp(l)) goto unliststern_unbound;
              pushSTACK(Car(l)); l = Cdr(l);
            } until (--n == 0);
            pushSTACK(l);
            goto next_byte;
           unliststern_unbound:
            if (n > m) fehler_apply_zuwenig(S(lambda));
            do { pushSTACK(unbound); } until (--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 fehler_zuviele_werte;
            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(object));
            # 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];
              loop {
                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 fehler_zuviele_werte; } );
          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 object* FRAME; popSP( FRAME = (object*) ); # 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));
                fehler(program_error,
                       GETTEXT("~: too many arguments given to ~"));
              }
              # 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 object* 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 = (object*) ); popSP(index = );
            closure = *closureptr; # fetch Closure from Stack
            codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
            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 fehler_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))
              fehler_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 object* FRAME = (object*) SP_(k1+jmpbufsize*k2);
            var object block_cons = FRAME_(n);
            if (eq(Cdr(block_cons),disabled))
              fehler_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(object)); # 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 object* 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_L(value1); # Number of Labels
            var uintL index = posfixnum_to_L(STACK_((m-i)+3)); # labeli
            # get closure back, byteptr:=labeli_byteptr :
            closureptr = (object*) SP_(jmpbufsize+0);
            closure = *closureptr; # fetch Closure from Stack
            codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
            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 fehler_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));
              fehler(control_error,
                     GETTEXT("(~ ~): the tagbody of the tags ~ 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 object* FRAME = uTheFramepointer(Cdr(tagbody_cons));
            VALUES1(framecode(FRAME_(0)) == CTAGBODY_frame_info
                   ? fixnum(1+l)
                   : 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 object* FRAME = (object*) 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));
              fehler(control_error,
                     GETTEXT("(~ ~): the tagbody of the tags ~ has already been left"));
            }
            # value passed to Tagbody:
            # For CTAGBODY-Frames 1+l as Fixnum.
            var object* 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 object* 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 = (object*) ); popSP(index = );
            closure = *closureptr; # fetch Closure from Stack
            codeptr = TheSbvector(TheCclosure(closure)->clos_codevec);
            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 fehler_STACK_putt;
          #endif
          FREE_JMPBUF_on_SP();
          #if STACKCHECKC
          if (!(closureptr == (object*)SP_(0))) # that Closureptr must be the current one
            goto fehler_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));
            fehler(control_error,
                   GETTEXT("~: there is no CATCHer for tag ~"));
          }
        # ------------------- (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 object* 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)) {
            fehler(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 = (object*) );
            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);
            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 fehler_STACK_putt;
          if (!(closureptr == (object*)SP_(jmpbufsize+0))) # that Closureptr must be the current one
            goto fehler_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 labe takes place at the end of the Cleanup-Forms.
          {
            var object* oldSTACK; # value of STACK before saveing the values
            popSP( oldSTACK = (object*) );
            var uintL mvcount = # number of saved values on Stack
              STACK_item_count(STACK,oldSTACK);
            if (mvcount >= mv_limit) goto fehler_zuviele_werte;
            STACK_to_mv(mvcount);
          }
          # return to the saved unwind_protect_to_save.fun :
          {
            var restart fun;
            var object* arg;
            popSP( arg = (object*) ); popSP( fun = (restart) );
            # return to uwp_continue or uwp_jmpback or unwind_upto:
            if (!(fun == (restart)NULL)) {
              (*fun)(arg); # return to unwind_upto or similar.
              NOTREACHED;
            }
            if (arg == (object*)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.
              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 fehler_STACK_putt;
          if (!(closureptr == (object*)SP_(jmpbufsize+0))) # that Closureptr must be the current one
            goto fehler_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:
            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 object* top_of_frame = STACK; # Pointer above Frame
            pushSTACK(TheCclosure(closure)->clos_consts[n]);
            pushSTACK(closure);
            pushSTACK(as_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 = posfixnum_to_L(Car(handler_args.spdepth))
                              + jmpbufsize * posfixnum_to_L(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
            } elif (nullp(arg)) {
              # (CAR NIL) = NIL: value1 remains NIL
            } else {
              subr_self = L(car); fehler_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
            } elif (nullp(arg)) {
              pushSTACK(arg); # (CAR NIL) = NIL
            } else {
              subr_self = L(car); fehler_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
            } elif (nullp(arg)) {
              pushSTACK(arg); # (CAR NIL) = NIL
            } else {
              subr_self = L(car); fehler_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
            } elif (nullp(arg)) {
              STACK_(n) = value1 = arg; # (CAR NIL) = NIL
            } else {
              subr_self = L(car); fehler_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
            } elif (nullp(arg)) {
              # (CDR NIL) = NIL: value1 remains NIL
            } else {
              subr_self = L(cdr); fehler_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
            } elif (nullp(arg)) {
              pushSTACK(arg); # (CDR NIL) = NIL
            } else {
              subr_self = L(cdr); fehler_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
            } elif (nullp(arg)) {
              pushSTACK(arg); # (CDR NIL) = NIL
            } else {
              subr_self = L(cdr); fehler_list(arg);
            }
          }
          goto next_byte;
        CASE cod_load_cdr_store:         # (LOAD&CDR&STORE n)
          {
            var uintL n;
            U_operand(n);
            var object* arg_ = &STACK_(n);
            var object arg = *arg_;
            if (consp(arg)) {
              *arg_ = value1 = Cdr(arg); # CDR of a Cons
            } elif (nullp(arg)) {
              value1 = arg; # (CDR NIL) = NIL
            } else {
              subr_self = L(cdr); fehler_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 object* arg_ = &STACK_(n);
            Cdr(new_cons) = *arg_;
            VALUES1(*arg_ = new_cons);
          }
          goto next_byte;
        {var object symbol;
        CASE cod_symbol_function:        # (SYMBOL-FUNCTION)
          symbol = value1;
          if (!symbolp(symbol)) goto csf_kein_symbol;
          if (!boundp(Symbol_function(symbol))) goto csf_unbound;
          VALUES1(Symbol_function(symbol));
          goto next_byte;
        CASE cod_const_symbol_function:  # (CONST&SYMBOL-FUNCTION n)
          {
            var uintL n;
            U_operand(n);
            symbol = TheCclosure(closure)->clos_consts[n];
          }
          if (!symbolp(symbol)) goto csf_kein_symbol;
          if (!boundp(Symbol_function(symbol))) goto csf_unbound;
          VALUES1(Symbol_function(symbol));
          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];
          }
          if (!symbolp(symbol)) goto csf_kein_symbol;
          if (!boundp(Symbol_function(symbol))) goto csf_unbound;
          pushSTACK(Symbol_function(symbol));
          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];
          }
          if (!symbolp(symbol)) goto csf_kein_symbol;
          if (!boundp(Symbol_function(symbol))) goto csf_unbound;
          {
            var uintL k;
            U_operand(k);
            STACK_(k) = value1 = Symbol_function(symbol); mv_count=1;
          }
          goto next_byte;
        csf_kein_symbol:
          fehler_kein_symbol(S(symbol_function),symbol);
        csf_unbound:
          # (symbol poss. not the actual function-name, for
          # e.g. (FUNCTION FOO) is converted to (SYMBOL-FUNCTION '#:|(SETF FOO)|),
          # but that should be enough for the error message.)
          fehler_undefined(S(symbol_function),symbol);
        }
        {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_kein_svector;
          vec = popSTACK(); # Simple-Vector
          index = value1;
          # and the Index must be Fixnum >= 0, < length(vec) :
          {
            var uintL i;
            if (!(posfixnump(index) &&
                  ((i = posfixnum_to_L(index)) < Svector_length(vec))))
              goto svref_kein_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_kein_svector;
          vec = popSTACK(); # Simple-Vector
          index = value1;
          # and the Index must be a Fixnum >=0, <Length(vec) :
          {
            var uintL i;
            if (!(posfixnump(index) &&
                  ((i = posfixnum_to_L(index)) < Svector_length(vec))))
              goto svref_kein_index;
            value1 = TheSvector(vec)->data[i] = popSTACK(); # put in new element
            mv_count = 1;
          }
          goto next_byte;
        svref_kein_svector: # Non-Simple-Vector in STACK_0
          fehler_kein_svector(S(svref),STACK_0);
        svref_kein_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));
          fehler(type_error,GETTEXT("~: ~ is not a correct index into ~"));
        }
        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( { pushSTACK(listof(n)); } );
          }
          goto next_byte;
        CASE cod_liststern:              # (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_liststern_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(bitm(oint_data_len)-1)))                 \
              { arg = fixnum_inc(arg,1); statement; }                      \
              else                                                         \
              { with_saved_context(                                        \
                  { pushSTACK(arg); subr_self = L(einsplus); C_einsplus(); } # funcall(L(einsplus),1); \
                  );                                                       \
                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(                                  \
                  { pushSTACK(arg); subr_self = L(einsminus); C_einsminus(); } # funcall(L(einsminus),1); \
                  );                                                 \
                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 object* 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 object* 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
              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)
            # foil -fomit-frame-pointer, herewith allow utilization of
            # %sp resp. %esp  as private_SP :
            alloca(1);
          #endif
          pushSTACK(fixnum(byteptr-&codeptr->data[0]-1)); # erroneous byte-number
          pushSTACK(closure); # Closure
          fehler(serious_condition,
                 GETTEXT("undefined bytecode in ~ at byte ~"));
        #undef L_operand
        #undef S_operand
        #undef U_operand
        #undef B_operand
        #undef CASE
      }
     fehler_zuviele_werte:
      fehler(error,GETTEXT("too many return values"));
     #if STACKCHECKC
     fehler_STACK_putt:
      pushSTACK(fixnum(byteptr-&codeptr->data[0])); # PC
      pushSTACK(closure); # FUNC
      fehler(serious_condition,GETTEXT("Corrupted STACK in ~ at byte ~"));
     #endif
     finished:
      #undef FREE_JMPBUF_on_SP
      #undef JMPBUF_on_SP
      #ifndef FAST_SP
      FREE_DYNAMIC_ARRAY(private_SP_space);
      #endif
      return;
    }


# 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??

