/*
 * (SPVW = Speicherverwaltung): Memory Management for CLISP
 * Bruno Haible 1990-2004
 * Sam Steingold 1998-2004
 * German comments translated into English: Stefan Kain 2002-03-24
 */

/* Content:
 module management
 debug utilities
 memory size
 object size determination
 Page Fault and Protection handling
 Garbage Collection
 memory provision functions
 cycle test
 memory walk
 elementary string functions
 other global auxiliary functions
 initialization
 loading and storing MEM-files
 dynamic loading of modules
 version */
#include "lispbibl.c"

#include <string.h> /* declares strchr() and possibly memset() */
#ifdef MULTITHREAD
  #define bzero(ptr,len)  memset(ptr,0,len)
  #define bcopy(source,dest,len)  memcpy(dest,source,len)
#endif

# in this file, the table macros have a different utilization:
  #undef LISPSPECFORM
  #undef LISPFUN
  #undef LISPSYM
  #undef LISPOBJ

# table of all SUBRs: out-sourced to SPVWTABF
# size of this table:
#define subr_anz  (sizeof(subr_tab)/sizeof(subr_t))

# table of all FSUBRs: moved to CONTROL
# size of this table:
#define fsubr_anz  (sizeof(fsubr_tab)/sizeof(fsubr_t))

# tables of all relocatable pointers: moved to STREAM
# size of these tables:
#define pseudocode_anz  (sizeof(pseudocode_tab)/sizeof(Pseudofun))
#if defined(MICROSOFT) && !defined(UNICODE)
  #define pseudodata_anz 0
#else
  #define pseudodata_anz  (sizeof(pseudodata_tab)/sizeof(Pseudofun))
#endif
# total table:
#define pseudofun_anz  (pseudocode_anz+pseudodata_anz)
local struct pseudofun_tab_ { object pointer[pseudofun_anz]; } pseudofun_tab;

# table of all fixed symbols: moved to SPVWTABS
# size of these tables:
#define symbol_anz  (sizeof(symbol_tab)/sizeof(symbol_))

# table of all other fixed objects: moved to SPVWTABO
# size of these tables:
#define object_anz  (sizeof(object_tab)/sizeof(gcv_object_t))

# looping over subr_tab:
# (NB: subr_tab_ptr_as_object(ptr) turns a traversing pointer
# into a genuine lisp-object.)
#ifdef MAP_MEMORY_TABLES
  local uintC total_subr_anz;
  #define for_all_subrs(statement)                                      \
    do { var subr_t* ptr = (subr_t*)&subr_tab; /* traverse subr_tab */  \
         var uintC count;                                               \
         dotimesC(count,total_subr_anz, { statement; ptr++; } );        \
    } while(0)
#else
  #define for_all_subrs(statement)                      \
    do { var module_t* module; /* traverse modules */   \
         for_modules(all_modules,{                      \
           if (module->initialized)                     \
             if (*module->stab_size > 0) {              \
               var subr_t* ptr = module->stab;          \
               var uintC count;                         \
               dotimespC(count,*module->stab_size,      \
                         { statement; ptr++; } );       \
         }});                                           \
    } while(0)
#endif

# On traversal of symbol_tab:
# turns a traversing pointer into a genuine lisp-object.
#ifdef MAP_MEMORY_TABLES
  #define symbol_tab_ptr_as_object(ptr)  as_object((oint)(ptr))
#else
  #ifdef TYPECODES
    #define symbol_tab_ptr_as_object(ptr) type_pointer_object(symbol_type,ptr)
  #else
    #ifdef WIDE_AUXI
      #define symbol_tab_ptr_as_object(ptr) as_object_with_auxi((aint)(ptr)+varobject_bias)
    #else
      #define symbol_tab_ptr_as_object(ptr) as_object((oint)(ptr)+varobject_bias)
    #endif
  #endif
#endif
# traversal of symbol_tab:
#define for_all_constsyms(statement)                                       \
  do { var symbol_* ptr = (symbol_*)&symbol_tab; # pass through symbol_tab \
       var uintC count;                                                    \
       dotimesC(count,symbol_anz, { statement; ptr++; } );                 \
  } while(0)

# Traverse object_tab:
#define for_all_constobjs(statement)                                         \
  do { var module_t* module; # loop over modules                             \
       for_modules(all_modules,{                                             \
         if (module->initialized)                                            \
           if (*module->otab_size > 0) {                                     \
             var gcv_object_t* objptr = module->otab; # loop over object_tab \
             var uintC count;                                                \
             dotimespC(count,*module->otab_size,                             \
                       { statement; objptr++; } );                           \
       }});                                                                  \
  } while(0)

# Semaphores: decide, if a break is effectless (/=0) or
# effectual (all = 0) .
# Are set with set_break_sem_x and deleted with clr_break_sem_x again.
global break_sems_ break_sems;
  # break_sem_0 == break_sems.einzeln[0]
  #   set, as long as a page-fault-handling is in progress
  # break_sem_1 == break_sems.einzeln[1]
  #   set, as long as the memory management forbids a break
  #   (so that empty memory cannot be traversed by the GC)
  # break_sem_2 == break_sems.einzeln[2]
  #   for package-management on lower level and hashtable-management
  # break_sem_3 == break_sems.einzeln[3]
  #   for package-management on higher level
  # break_sem_4 == break_sems.einzeln[4]
  #   set, as long as external functions are being called.
  # break_sem_5 == break_sems.einzeln[5]
  #   set, as long as (UNIX) a signal-handler is being called.

# -----------------------------------------------------------------------------
#                          module management

#include "spvw_module.c"

# -----------------------------------------------------------------------------
#                            debug-helper

#include "spvw_debug.c"

# -----------------------------------------------------------------------------
#                          our own alloca()

#include "spvw_alloca.c"

# -----------------------------------------------------------------------------
#                         fast program-exit

# jmp_buf for return to the original-value of SP on program start:
local jmp_buf original_context;

# leave LISP immediately:
# quit_sofort(exitcode);
# > exitcode: 0 for normal, 1 for abnormal end of program
  # we must set the SP to the original value.
  # (On some operating systems, the memory occupied by the program is
  # returned with free() , before control is withdrawn from it.
  # For this short span the SP has to be set reasonably.)
local int exitcode;
#define quit_sofort(xcode)  exitcode = xcode; longjmp(original_context,1)

# -----------------------------------------------------------------------------
#                         memory management, common part

# method of the memory management:
#if defined(SPVW_BLOCKS) && defined(SPVW_MIXED) # e.g. ATARI
  #define SPVW_MIXED_BLOCKS
  #if !defined(TRIVIALMAP_MEMORY)
    # Blocks grow like this:         |******-->     <--****|
    #define SPVW_MIXED_BLOCKS_OPPOSITE
  #else # defined(TRIVIALMAP_MEMORY)
    #if !defined(WIDE_SOFT) && !defined(SELFMADE_MMAP)
      # Blocks grow like this:       |******-->     <--****|
      #define SPVW_MIXED_BLOCKS_OPPOSITE
    #else
      # Blocks grow like this:       |******-->      |***-->
      #define SPVW_MIXED_BLOCKS_STAGGERED
    #endif
  #endif
#endif
#if defined(SPVW_BLOCKS) && defined(SPVW_PURE) # e.g. UNIX_LINUX, Linux 0.99.7
  #define SPVW_PURE_BLOCKS
#endif
#if defined(SPVW_PAGES) && defined(SPVW_MIXED) # e.g. SUN3, HP9000_800
  #define SPVW_MIXED_PAGES
#endif
#if defined(SPVW_PAGES) && defined(SPVW_PURE) # e.g. SUN4, SUN386
  #define SPVW_PURE_PAGES
#endif

# canonical addresses:
# With MULTIMAP_MEMORY, the same spot in memory can be accessed with different
# pointers-types. The management of the heaps needs a "canonical"
# pointer. Via this pointer access takes place, and comparisons occur
# via >=, <=. heap_start and heap_end are canonical addresses.
#ifdef MULTIMAP_MEMORY
  #define canonaddr(obj)  upointer(obj)
  #define canon(address)  ((address) & oint_addr_mask)
#else
  #define canonaddr(obj)  (aint)ThePointer(obj)
  #define canon(address)  (address)
#endif
# canonaddr(obj) == canon((aint)ThePointer(obj)).

# -----------------------------------------------------------------------------
#                          Page-Allocation

#if defined(SINGLEMAP_MEMORY) || defined(TRIVIALMAP_MEMORY) || defined(MULTITHREAD)

#include "spvw_mmap.c"

#endif # SINGLEMAP_MEMORY || TRIVIALMAP_MEMORY || MULTITHREAD

#ifdef MULTIMAP_MEMORY

#include "spvw_multimap.c"

#if defined(MAP_MEMORY_TABLES)
  # symbol_tab is multi-mapped, always at the same address.
  # This speeds up loadmem() a little.
  #define MULTIMAP_MEMORY_SYMBOL_TAB
#endif

#endif # MULTIMAP_MEMORY

#if defined(SINGLEMAP_MEMORY) || defined(TRIVIALMAP_MEMORY)

#include "spvw_singlemap.c"

#if defined(SINGLEMAP_MEMORY) && defined(HAVE_WIN32_VM)
  /* Despite SINGLEMAP_MEMORY, a relocation may be necessary
   at loadmem() time. */
  #define SINGLEMAP_MEMORY_RELOCATE
#endif

#endif # SINGLEMAP_MEMORY || TRIVIALMAP_MEMORY

# -----------------------------------------------------------------------------
#                           Multithreading

#ifndef MULTITHREAD

  # Global variables.

  # the STACK:
  #if !defined(STACK_register)
    global gcv_object_t* STACK;
  #endif
  #ifdef HAVE_SAVED_STACK
    global gcv_object_t* saved_STACK;
  #endif

  # MULTIPLE-VALUE-SPACE:
  #if !defined(mv_count_register)
    global uintC mv_count;
  #endif
  #ifdef NEED_temp_mv_count
    global uintC temp_mv_count;
  #endif
  #ifdef HAVE_SAVED_mv_count
    global uintC saved_mv_count;
  #endif
  global object mv_space [mv_limit-1];
  #ifdef NEED_temp_value1
    global object temp_value1;
  #endif
  #ifdef HAVE_SAVED_value1
    global object saved_value1;
  #endif

  # During the execution of a SUBR, FSUBR: the current SUBR resp. FSUBR
  #if !defined(back_trace_register)
    global p_backtrace_t back_trace = NULL;
  #endif
  #ifdef HAVE_SAVED_back_trace
    global p_backtrace_t saved_back_trace;
  #endif

  # during callbacks, the saved registers:
  #if defined(HAVE_SAVED_REGISTERS)
    global struct registers * callback_saved_registers = NULL;
  #endif

  # stack-limits:
  #ifndef NO_SP_CHECK
    global void* SP_bound;  # SP-growth-limit
  #endif
  global void* STACK_bound; # STACK-growth-limit

  # the lexical environment:
  global gcv_environment_t aktenv;

  global unwind_protect_caller_t unwind_protect_to_save;

  # variables for passing of information to the top of the handler:
  global handler_args_t handler_args;

  # As only whole regions of handlers are deactivated and activated again,
  # we treat the handlers on deactivation apartly, but we maintain
  # a list of the STACK-regions, in which the handlers are deactivated.
  global stack_range_t* inactive_handlers = NULL;
  # A handler counts as inactiv if and only if:
  # low_limit <= handler < high_limit
  # is true for one of the regions listed in inactive_handlers:

  #define for_all_threadobjs(statement)                                  \
    do { var gcv_object_t* objptr = (gcv_object_t*)&aktenv;              \
         var uintC count;                                                \
         dotimespC(count,sizeof(gcv_environment_t)/sizeof(gcv_object_t), \
           { statement; objptr++; });                                    \
    } while(0)

  #define for_all_STACKs(statement)           \
    do { var gcv_object_t* objptr = &STACK_0; \
         { statement; }                       \
    } while(0)

  #define for_all_back_traces(statement)    \
    do { var p_backtrace_t bt = back_trace; \
      { statement;  }                       \
    } while(0)

#else

  # Mutex protecting the set of threads.
  local xmutex_t allthreads_lock;

  # Set of threads.
  #define MAXNTHREADS  128
  local uintC nthreads = 0;
  local thread_t* allthreads[MAXNTHREADS];

  # Number of symbol values currently in use in every thread.
  local uintL num_symvalues = 0;
  # Maximum number of symbol values in every thread before new thread-local
  # storage must be added.
  # = floor(round_up(thread_size(num_symvalues),mmap_pagesize)
  #         -offsetofa(thread_t,_symvalues),sizeof(gcv_object_t))
  local uintL maxnum_symvalues;

  # Initialization.
local void init_multithread (void) {
  xthread_init();
  xmutex_init(&allthreads_lock);
  maxnum_symvalues = floor(((thread_size(0)+mmap_pagesize-1)&-mmap_pagesize)
                           -offsetofa(thread_t,_symvalues),sizeof(gcv_object_t));
}

  # Create a new thread.
local thread_t* create_thread (void* sp) {
  var thread_t* thread;
  xmutex_lock(&allthreads_lock);
  if (nthreads >= MAXNTHREADS) { thread = NULL; goto done; }
  thread = sp_to_thread(sp);
  if (mmap_zeromap(thread,(thread_size(num_symvalues)+mmap_pagesize-1)&-mmap_pagesize) < 0)
    { thread = NULL; goto done; }
  thread->_index = nthreads;
  {
    var gcv_object_t* objptr =
      (gcv_object_t*)((uintP)thread+thread_objects_offset(num_symvalues));
    var uintC count;
    dotimespC(count,thread_objects_anz(num_symvalues),
      { *objptr++ = NIL; objptr++; });
  }
  allthreads[nthreads] = thread;
  nthreads++;
 done:
  xmutex_unlock(&allthreads_lock);
  return thread;
}

  # Delete a thread.
local void delete_thread (thread_t* thread) {
  xmutex_lock(&allthreads_lock);
  ASSERT(thread->_index < nthreads);
  ASSERT(allthreads[thread->_index] == thread);
  allthreads[thread->_index] = allthreads[nthreads-1];
  nthreads--;
  xmutex_unlock(&allthreads_lock);
}

  #define for_all_threads(statement)                            \
    do { var thread_t** _pthread = &allthreads[nthreads];        \
         while (_pthread != &allthreads[0])                     \
           { var thread_t* thread = *--_pthread; statement; }    \
    } while(0)

  # Add a new symbol value.
  # > value: the default value in all threads
  # < returns: the index in the every thread's _symvalues[] array
local uintL make_symvalue_perthread (object value) {
  var uintL symbol_index;
  xmutex_lock(&allthreads_lock);
  if (num_symvalues == maxnum_symvalues) {
    for_all_threads({
      if (mmap_zeromap((void*)((uintP)thread+((thread_size(num_symvalues)+mmap_pagesize-1)&-mmap_pagesize)),mmap_pagesize) < 0)
        goto failed;
    });
    maxnum_symvalues += mmap_pagesize/sizeof(gcv_object_t);
  }
  symbol_index = num_symvalues++;
  for_all_threads({ thread->_symvalues[symbol_index] = value; });
  xmutex_unlock(&allthreads_lock);
  return symbol_index;
 failed:
  xmutex_unlock(&allthreads_lock);
  fehler(error,GETTEXT("could not make symbol value per-thread"));
}

  #define for_all_threadobjs(statement)  \
    for_all_threads({                                    \
      var gcv_object_t* objptr = (gcv_object_t*)((uintP)thread+thread_objects_offset(num_symvalues)); \
      var uintC count;                                   \
      dotimespC(count,thread_objects_anz(num_symvalues), \
        { statement; objptr++; });                       \
    })

  #define for_all_STACKs(statement)  \
    for_all_threads({                                            \
      var gcv_object_t* objptr = STACKpointable(thread->_STACK); \
      { statement; }                                             \
    })

  #define for_all_back_traces(statement)   \
    for_all_threads({ var p_backtrace_t bt = thread->_back_trace; \
      { statement; }                                                  \
    })

#endif

# -----------------------------------------------------------------------------
#                           Page-Management

#include "spvw_page.c"
#include "spvw_heap.c"
#include "spvw_global.c"

#ifdef SPVW_PAGES

# A dummy-page for lastused:
  local NODE dummy_NODE;
  #define dummy_lastused  (&dummy_NODE)

#endif

#ifdef SPVW_BLOCKS

#ifdef SELFMADE_MMAP
# Pages from the memfile are read in when they are first used.
# We manage this ourselves by trapping page faults.
# Works only with SPVW_PURE_BLOCKS or SPVW_MIXED_BLOCKS_STAGGERED.
#endif

#endif

# -----------------------------------------------------------------------------

#if defined(NOCOST_SP_CHECK) && !defined(WIN32_NATIVE)
# Check for near stack overflow.
global bool near_SP_overflow (void) {
  # Force a stack overflow if there is not a minimum of room available.
  var uintB dummy[0x1001];
  dummy[0] = 0; dummy[0x800] = 0; dummy[0x1000] = 0;
 #ifdef GNU
  alloca(1); # Makes this function non-inlinable.
 #endif
  return false;
}
#endif

# At overflow of one of the stacks:
nonreturning_function(global, SP_ueber, (void)) {
  var bool interactive_p = interactive_stream_p(Symbol_value(S(debug_io)));
  begin_system_call();
  fputs(GETTEXTL("\n*** - " "Program stack overflow. RESET"),stderr);
  if (!interactive_p) fputs("\n",stderr);
  fflush(stderr);
  end_system_call();
  if (interactive_p) reset(1);
  /* non-interactive session: quit */
  else { final_exitcode=1; quit(); }
}
nonreturning_function(global, STACK_ueber, (void)) {
  var bool interactive_p = interactive_stream_p(Symbol_value(S(debug_io)));
  begin_system_call();
  fputs(GETTEXTL("\n*** - " "Lisp stack overflow. RESET"),stderr);
  if (!interactive_p) fputs("\n",stderr);
  fflush(stderr);
  end_system_call();
  if (interactive_p) reset(1);
  /* non-interactive session: quit */
  else { final_exitcode=1; quit(); }
}

# ----------------------------------------------------------------------------
#                       GC-Statistics

#include "spvw_gcstat.c"

# -----------------------------------------------------------------------------
#                       Memory-Size

#include "spvw_space.c"

# -----------------------------------------------------------------------------
#                       Marks

#include "spvw_mark.c"

# -----------------------------------------------------------------------------
#                   object size determination

#include "spvw_objsize.c"

# -----------------------------------------------------------------------------
#                    Memory Update

#include "spvw_update.c"

# -----------------------------------------------------------------------------
#                      Page Fault and Protection Handling

#if defined(SELFMADE_MMAP) || defined(GENERATIONAL_GC)

#include "spvw_fault.c"

#endif # SELFMADE_MMAP || GENERATIONAL_GC

# -----------------------------------------------------------------------------
#                      Signal handlers

#include "spvw_sigsegv.c"
#include "spvw_sigcld.c"
#include "spvw_sigpipe.c"
#include "spvw_sigint.c"
#include "spvw_sigwinch.c"

# -----------------------------------------------------------------------------
#                       Garbage-Collector

#include "spvw_garcol.c"

# -----------------------------------------------------------------------------
#                 Memory Allocation Functions

#include "spvw_allocate.c"
#include "spvw_typealloc.c"

# -----------------------------------------------------------------------------
#                   Circularity Test

#include "spvw_circ.c"

# -----------------------------------------------------------------------------
#                     Memory Walk

#include "spvw_walk.c"

# -----------------------------------------------------------------------------
#                  Elementary String Functions

#ifndef asciz_length
# UP: Returns the length of an ASCIZ-string.
# asciz_length(asciz)
# > char* asciz: ASCIZ-string
#       (address of a character sequence terminated by a nullbyte)
# < result: length of the character sequence (without nullbyte)
global uintL asciz_length (const char * asciz) {
  var const char* ptr = asciz;
  var uintL len = 0;
  # search nullbyte and increment length:
  while (*ptr++ != 0) { len++; }
  return len;
}
#endif

# UP: compares two ASCIZ-strings.
# asciz_equal(asciz1,asciz2)
# > char* asciz1: first ASCIZ-string
# > char* asciz2: second ASCIZ-string
# < result: true if both sequences are equal
global bool asciz_equal (const char * asciz1, const char * asciz2) {
  # compare bytes until the first nullbyte:
  loop {
    var char ch1 = *asciz1++;
    if (ch1 != *asciz2++) goto no;
    if (ch1 == '\0') goto yes;
  }
 yes: return true;
 no: return false;
}

# -----------------------------------------------------------------------------
#                  Other Global Helper Functions

/* malloc() with error check. */
global void* my_malloc (size_t size)
{
  begin_system_call();
  var void* ptr = malloc(size);
  end_system_call();
  if (ptr)
    return ptr;
  pushSTACK(TheSubr(subr_self)->name);
  fehler(storage_condition,GETTEXT("~: malloc() failed"));
}

#if (int_bitsize < long_bitsize)
# passing value from longjmpl() to setjmpl()  :
  global long jmpl_value;
#endif

#ifndef SP
# determine (an approximation) of the SP-stackpointer.
global void* SP (void) {
  var long dummy;
  return &dummy;
}
#endif

# error-message when a location of the program is reached that is (should be)
# unreachable. Does not return.
# fehler_notreached(file,line);
# > file: filename (with quotation marks) as constant ASCIZ-string
# > line: line number
nonreturning_function(global, fehler_notreached,
                      (const char* file, uintL line)) {
  end_system_call(); # just in case
  pushSTACK(fixnum(line));
  pushSTACK(ascii_to_string(file));
  fehler(serious_condition,
         GETTEXT("Internal error: statement in file ~, line ~ has been reached!!\n"
                 "Please send the authors of the program a description how you produced this error!"));
}

#include "spvw_ctype.c"

#include "spvw_language.c"

# -----------------------------------------------------------------------------
#                        Initialization

# name of the program (for error reporting)
local char* program_name;

# flag, if SYS::READ-FORM should behave ILISP-compatible:
global bool ilisp_mode = false;

local fsubr_argtype_t fsubr_argtype (uintW req_anz, uintW opt_anz,
                                     fsubr_body_t body_flag)
{ /* conversion of the argument types of a FSUBR into a code: */
  switch (body_flag) {
    case fsubr_nobody:
      switch (opt_anz) {
        case 0:
          switch (req_anz) {
            case 1: return(fsubr_argtype_1_0_nobody);
            case 2: return(fsubr_argtype_2_0_nobody);
            default: goto illegal;
          }
        case 1:
          switch (req_anz) {
            case 1: return(fsubr_argtype_1_1_nobody);
            case 2: return(fsubr_argtype_2_1_nobody);
            default: goto illegal;
          }
        default: goto illegal;
      }
    case fsubr_body:
      switch (opt_anz) {
        case 0:
          switch (req_anz) {
            case 0: return(fsubr_argtype_0_body);
            case 1: return(fsubr_argtype_1_body);
            case 2: return(fsubr_argtype_2_body);
            default: goto illegal;
          }
        default: goto illegal;
      }
    default: goto illegal;
  }
 illegal:
  fprintf(stderr,GETTEXTL("Unknown FSUBR signature: %d %d %d\n"),
          req_anz,opt_anz,body_flag);
  quit_sofort(1);
}

local subr_argtype_t subr_argtype (uintW req_anz, uintW opt_anz,
                                   subr_rest_t rest_flag, subr_key_t key_flag,
                                   const subr_initdata_t *sid)
{ /* conversion of the argument types of a FSUBR into a code: */
  switch (key_flag) {
    case subr_nokey:
      switch (rest_flag) {
        case subr_norest:
          switch (opt_anz) {
            case 0:
              switch (req_anz) {
                case 0: return(subr_argtype_0_0);
                case 1: return(subr_argtype_1_0);
                case 2: return(subr_argtype_2_0);
                case 3: return(subr_argtype_3_0);
                case 4: return(subr_argtype_4_0);
                case 5: return(subr_argtype_5_0);
                case 6: return(subr_argtype_6_0);
                default: goto illegal;
              }
            case 1:
              switch (req_anz) {
                case 0: return(subr_argtype_0_1);
                case 1: return(subr_argtype_1_1);
                case 2: return(subr_argtype_2_1);
                case 3: return(subr_argtype_3_1);
                case 4: return(subr_argtype_4_1);
                default: goto illegal;
              }
            case 2:
              switch (req_anz) {
                case 0: return(subr_argtype_0_2);
                case 1: return(subr_argtype_1_2);
                case 2: return(subr_argtype_2_2);
                case 3: return(subr_argtype_3_2);
                default: goto illegal;
              }
            case 3:
              switch (req_anz) {
                case 0: return(subr_argtype_0_3);
                case 1: return(subr_argtype_1_3);
                case 2: return(subr_argtype_2_3);
                default: goto illegal;
              }
            case 4:
              switch (req_anz) {
                case 0: return(subr_argtype_0_4);
                default: goto illegal;
              }
            case 5:
              switch (req_anz) {
                case 0: return(subr_argtype_0_5);
                default: goto illegal;
              }
            default: goto illegal;
          }
        case subr_rest:
          switch (opt_anz) {
            case 0:
              switch (req_anz) {
                case 0: return(subr_argtype_0_0_rest);
                case 1: return(subr_argtype_1_0_rest);
                case 2: return(subr_argtype_2_0_rest);
                case 3: return(subr_argtype_3_0_rest);
                default: goto illegal;
              }
            default: goto illegal;
          }
        default: goto illegal;
      }
    case subr_key:
      switch (rest_flag) {
        case subr_norest:
          switch (opt_anz) {
            case 0:
              switch (req_anz) {
                case 0: return(subr_argtype_0_0_key);
                case 1: return(subr_argtype_1_0_key);
                case 2: return(subr_argtype_2_0_key);
                case 3: return(subr_argtype_3_0_key);
                case 4: return(subr_argtype_4_0_key);
                default: goto illegal;
              }
            case 1:
              switch (req_anz) {
                case 0: return(subr_argtype_0_1_key);
                case 1: return(subr_argtype_1_1_key);
                default: goto illegal;
              }
            case 2:
              switch (req_anz) {
                case 1: return(subr_argtype_1_2_key);
                default: goto illegal;
              }
            default: goto illegal;
          }
        case subr_rest:
        default: goto illegal;
      }
    case subr_key_allow: goto illegal;
    default: goto illegal;
  }
 illegal:
  fprintf(stderr,GETTEXTL("Unknown SUBR signature: %d %d %d %d"),
          req_anz,opt_anz,rest_flag,key_flag);
  if (sid)
    fprintf(stderr," (%s::%s)\n",sid->packname,sid->symname);
  else fputs("\n",stderr);
  quit_sofort(1);
}
# set the argtype of a subr_t *ptr
#define SUBR_SET_ARGTYPE(ptr,sid)                                       \
  ptr->argtype = (uintW)subr_argtype(ptr->req_anz,ptr->opt_anz,         \
                                     (subr_rest_t)(ptr->rest_flag),     \
                                     (subr_key_t)(ptr->key_flag),sid)

local inline void module_set_argtypes (module_t *module)
{ /* set artype for all SUBRs in the module */
  var subr_t* stab_ptr = module->stab; /* traverse subr_tab */
  var const subr_initdata_t *stab_init_ptr = module->stab_initdata;
  var uintC count = *module->stab_size;
  do { SUBR_SET_ARGTYPE(stab_ptr,stab_init_ptr);
    stab_ptr++; stab_init_ptr++;
  } while (--count);
}

# Verify that a code address has the C_CODE_ALIGNMENT.
# This is important for calling make_machine_code, but it's easiest verified
# on Fsubrs and Subrs.
#ifdef TYPECODES
  #define verify_code_alignment(ptr,symbol)  # not needed
#else
  #define verify_code_alignment(ptr,symbol)  \
    if ((uintP)(void*)(ptr) & (C_CODE_ALIGNMENT-1))     \
      fehler_code_alignment((uintP)(void*)(ptr),symbol)
nonreturning_function(local, fehler_code_alignment,
                      (uintP address, object symbol)) {
  fprintf(stderr,"C_CODE_ALIGNMENT is wrong. &%s = 0x%x.\n",
          TheAsciz(string_to_asciz(Symbol_name(symbol),O(terminal_encoding))),
          address);
 #if (__GNUC__ >= 3)
  fprintf(stderr,"Add -falign-functions=%d to CFLAGS in the Makefile.\n",
          C_CODE_ALIGNMENT);
 #endif
  abort();
}
#endif

# Initialization-routines for the tables
# during the first part of the initialization phase:
# initialize subr_tab:
local void init_subr_tab_1 (void) {
 #if defined(NO_TYPECODES)
  # lispbibl.d normally takes care of this, using a gcc __attribute__.
  # But __attribute__((aligned(4))) is ignored for some GCC targets,
  # so we check it here for safety.
  if (alignof(subr_t) < 4) {
    fprintf(stderr,"Alignment of SUBRs is %d. NO_TYPECODES requires it to be at least 4.\nRecompile CLISP with -DNO_TYPECODES.\n",alignof(subr_t));
    abort();
  }
 #endif
 #if defined(INIT_SUBR_TAB)
  #ifdef MAP_MEMORY_TABLES
  # copy table into the designated region:
  subr_tab = subr_tab_data;
  #endif
  #if !NIL_IS_CONSTANT
  { # initialize the name-slot first:
    var subr_t* ptr = (subr_t*)&subr_tab; # traverse subr_tab
     #define LISPFUN  LISPFUN_E
       #include "subr.c"
     #undef LISPFUN
  }
  { # and initialize the keywords-slot temporarily:
    var subr_t* ptr = (subr_t*)&subr_tab; # traverse subr_tab
    var uintC count = subr_anz;
    dotimesC(count,subr_anz, { ptr->keywords = NIL; ptr++; });
  }
  #endif
  # Because of SPVWTABF all slots except keywords and argtype
  # are already initialized.
  { # now initialize the argtype-slot:
    var subr_t* ptr = (subr_t*)&subr_tab; # traverse subr_tab
    var uintC count;
    dotimesC(count,subr_anz,{ SUBR_SET_ARGTYPE(ptr,NULL); ptr++; });
  }
 #else
  { # initialize all slots except keywords:
    var subr_t* ptr = (subr_t*)&subr_tab; # traverse subr_tab
    #define LISPFUN  LISPFUN_D
      #include "subr.c"
    #undef LISPFUN
  }
 #endif
  {
    var module_t* module;
    for_modules(all_other_modules,{
      if (*module->stab_size > 0) module_set_argtypes(module);
    });
  }
 #ifdef MAP_MEMORY_TABLES
  { # ditto, copy other tables tino the mapped region:
    var subr_t* newptr = (subr_t*)&subr_tab;
    var module_t* module;
    main_module.stab = newptr; newptr += subr_anz;
    for_modules(all_other_modules,{
      if (*module->stab_size > 0) {
        var subr_t* oldptr = module->stab;
        var uintC count;
        module->stab = newptr;
        dotimespC(count,*module->stab_size, { *newptr++ = *oldptr++; } );
      }
    });
    ASSERT(newptr == (subr_t*)&subr_tab + total_subr_anz);
  }
 #endif
}
# initialize symbol_tab:
local void init_symbol_tab_1 (void) {
 #if defined(INIT_SYMBOL_TAB) && NIL_IS_CONSTANT
  #ifdef MAP_MEMORY_TABLES
  # copy table into the designated region:
  symbol_tab = symbol_tab_data;
  #endif
 #else
  {
    var symbol_* ptr = (symbol_*)&symbol_tab; # traverse symbol_tab
    var uintC count;
    for (count = symbol_anz; count > 0; count--) {
      ptr->GCself = symbol_tab_ptr_as_object(ptr);
     #ifndef TYPECODES
      ptr->tfl = xrecord_tfl(Rectype_Symbol,0,5,0);
     #endif
      ptr->symvalue = unbound;
      ptr->symfunction = unbound;
      ptr->proplist = NIL;
      ptr->pname = NIL;
      ptr->homepackage = NIL;
      ptr++;
    }
  }
 #endif
}
# initialize object_tab:
local void init_object_tab_1 (void) {
  var module_t* module;
 #if defined(INIT_OBJECT_TAB) && NIL_IS_CONSTANT # object_tab already pre-initialized?
  for_modules(all_other_modules,{
    if (*module->otab_size > 0) {
      var gcv_object_t* ptr = module->otab; # traverse object_tab
      var uintC count;
      dotimespC(count,*module->otab_size, { *ptr++ = NIL; });
    }
  });
 #else
  for_modules(all_modules,{
    if (*module->otab_size > 0) {
      var gcv_object_t* ptr = module->otab; # traverse object_tab
      var uintC count;
      dotimespC(count,*module->otab_size, { *ptr++ = NIL; });
    }
  });
 #endif
  O(all_weakpointers) = Fixnum_0;
  O(all_weakkvtables) = Fixnum_0;
  O(all_finalizers) = Fixnum_0; O(pending_finalizers) = Fixnum_0;
}
# initialize other modules coarsely:
local void init_other_modules_1 (void) {
  var module_t* module;
  for_modules(all_other_modules, {
    # fill pointer in the subr-table with NIL, for GC to become possible:
    if (*module->stab_size > 0) {
      var subr_t* ptr = module->stab;
      var uintC count;
      dotimespC(count,*module->stab_size,
      { ptr->name = NIL; ptr->keywords = NIL; ptr++; });
    }
    # the pointers in the object-table have already been inizialized
    # by init_object_tab_1().
  });
}

# Initialization-routines for the tables
# during the second part of the initialization phase:
# finish initialization of subr_tab: enter keyword-vectors.
local void init_subr_tab_2 (void) {
#if 0
  # I would love to have a simple solution here, but
  # TURBO-C doesn't get enough memory for compilation!
  # traverse subr_tab
  var object vec;
  var gcv_object_t* vecptr;
 #define LISPFUN  LISPFUN_H
  #define kw(name)  *vecptr++ = S(K##name)
  #include "subr.c"
  #undef LISPFUN
 #undef kw
#else
  # create keyword-vectors individually:
  var object vec;
  var gcv_object_t* vecptr;
  # fills another single keyword into the vector:
  #define kw(name)  *vecptr++ = S(K##name)
  # creates vector with given keywords:
  #define v(key_anz,keywords)                   \
     vec = allocate_vector(key_anz);            \
     vecptr = &TheSvector(vec)->data[0];        \
     keywords;
  # sets the vector as keyword-vector for SUBR name:
  #define s(name)  subr_tab.D_##name.keywords = vec;
  #include "subrkw.c"
  #undef s
  #undef v
  #undef kw
#endif
}
# finish initialization of symbol_tab: enter printnames and home-package.
local void init_symbol_tab_2 (void) {
  # table of printnames:
  local const char * const pname_table[symbol_anz] = {
    #define LISPSYM  LISPSYM_C
    #include "constsym.c"
    #undef LISPSYM
  };
  # table of packages:
  enum { # the values in this enum are 0,1,2,...
    enum_lisp_index,
    enum_user_index,
    enum_system_index,
    enum_keyword_index,
    enum_charset_index,
    #define LISPPACK  LISPPACK_A
    #include "constpack.c"
    #undef LISPPACK
    enum_dummy_index
  };
  #define package_anz  ((uintL)enum_dummy_index)
  local const uintB package_index_table[symbol_anz] = {
    #define LISPSYM  LISPSYM_D
    #include "constsym.c"
    #undef LISPSYM
  };
  {
    var object list = O(all_packages); # list of packages
    # shortly after the initialization:
    # (#<PACKAGE LISP> #<PACKAGE SYSTEM> #<PACKAGE KEYWORD> #<PACKAGE CHARSET> ...)
    var uintC count;
    dotimespC(count,package_anz, { pushSTACK(Car(list)); list = Cdr(list); });
  }
  {
    var symbol_* ptr = (symbol_*)&symbol_tab; # traverse symbol_tab
    var const char * const * pname_ptr = &pname_table[0]; # traverse pname_table
    var const uintB* index_ptr = &package_index_table[0]; # traverse package_index_table
    var uintC count = symbol_anz;
    do {
      ptr->pname =
        coerce_imm_ss(' ' == **pname_ptr # non-ASCII
                      ? asciz_to_string(*pname_ptr+1, # skip ' '
                                        Symbol_value(S(utf_8)))
                      : ascii_to_string(*pname_ptr));
      pname_ptr++;
      var uintB this_index = *index_ptr++;
      var gcv_object_t* package_ = /* pointer to the package */
        &STACK_(package_anz-1) STACKop -(uintP)this_index;
      pushSTACK(symbol_tab_ptr_as_object(ptr)); /* Symbol */
      import(&STACK_0,package_);                /* import normally */
      switch (this_index) {
        case enum_lisp_index:    /* in #<PACKAGE LISP>? */
        case enum_charset_index: /* in #<PACKAGE CHARSET>? */
        case enum_socket_index:
        case enum_custom_index:
          export(&STACK_0,package_); /* also export */
      }
      Symbol_package(popSTACK()) = *package_; /* set the home-package */
      ptr++;
    } while (--count != 0);
    skipSTACK(package_anz);
  }
}
# enter FSUBRs/SUBRs into their symbols:
local void init_symbol_functions (void) {
  { # enter FSUBRs:
    typedef struct {
      #if defined(INIT_SUBR_TAB) && NIL_IS_CONSTANT
        #define LISPSPECFORM LISPSPECFORM_F
        object name;
        #define fsubr_name(p)  (p)->name
      #else
        #define LISPSPECFORM LISPSPECFORM_E
        uintL name_offset;
        #define fsubr_name(p)  symbol_tab_ptr_as_object((char*)&symbol_tab+(p)->name_offset)
      #endif
      uintW req_anz;
      uintW opt_anz;
      uintW body_flag;
    } fsubr_data_t;
    local const fsubr_data_t fsubr_data_tab[] = {
      #include "fsubr.c"
    };
    #undef LISPSPECFORM
    var const fsubr_t* ptr1 = (const fsubr_t *)&fsubr_tab; # traverse fsubr_tab
    var const fsubr_data_t * ptr2 = &fsubr_data_tab[0]; # traverse fsubr_data_tab
    var uintC count;
    dotimesC(count,fsubr_anz,{
      var object sym = fsubr_name(ptr2);
      var object obj = allocate_fsubr();
      TheFsubr(obj)->name = sym;
      TheFsubr(obj)->argtype =
        fixnum((uintW)fsubr_argtype(ptr2->req_anz,ptr2->opt_anz,
                                    (fsubr_body_t)(ptr2->body_flag)));
      TheFsubr(obj)->function = (void*)(*ptr1);
      Symbol_function(sym) = obj;
      verify_code_alignment(*ptr1,sym);
      ptr1++; ptr2++;
    });
  }
  { # enter SUBRs:
    var subr_t* ptr = (subr_t*)&subr_tab; # traverse subr_tab
    var uintC count;
    dotimesC(count,subr_anz,{
      Symbol_function(ptr->name) = subr_tab_ptr_as_object(ptr);
      verify_code_alignment(ptr->function,ptr->name);
      ptr++;
    });
  }
}
# assign values to constants/variables:
local void init_symbol_values (void) {
  # helper macro: constant := value+1
  #define define_constant_UL1(symbol,value)                     \
    do { var object x = # value+1 as integer                    \
           ( ((uintL)(value) < (uintL)(bitm(oint_data_len)-1))  \
                ? fixnum(value+1)                               \
                : I_1_plus_I(UL_to_I(value))                    \
            );                                                  \
          define_constant(symbol,x);                            \
    } while(0)
  # common:
  define_constant(S(nil),S(nil));                 # NIL := NIL
  define_constant(S(t),S(t));                     # T := T
  define_variable(S(gc_statistics_stern),Fixnum_minus1); # SYS::*GC-STATISTICS* := -1
  # for EVAL/CONTROL:
  define_constant_UL1(S(lambda_parameters_limit),lp_limit_1); # LAMBDA-PARAMETERS-LIMIT := lp_limit_1 + 1
  define_constant_UL1(S(call_arguments_limit),ca_limit_1); # CALL-ARGUMENTS-LIMIT := ca_limit_1 + 1
  define_constant(S(multiple_values_limit),fixnum(mv_limit)); # MULTIPLE-VALUES-LIMIT := mv_limit
  define_constant(S(jmpbuf_size),fixnum(jmpbufsize)); # SYS::*JMPBUF-SIZE* := size of a jmp_buf
  define_constant(S(big_endian),(BIG_ENDIAN_P ? T : NIL)); # SYS::*BIG-ENDIAN* := NIL resp. T
  define_variable(S(macroexpand_hook),L(funcall)); # *MACROEXPAND-HOOK* := #'FUNCALL
  define_variable(S(evalhookstern),NIL);          # *EVALHOOK*
  define_variable(S(applyhookstern),NIL);         # *APPLYHOOK*
  # for PACKAGE:
  define_variable(S(packagestern),Car(O(all_packages))); # *PACKAGE* := '#<PACKAGE LISP>
  # for SYMBOL:
  define_variable(S(gensym_counter),Fixnum_1);    # *GENSYM-COUNTER* := 1
  # for PATHNAME:
  define_variable(S(merge_pathnames_ansi),NIL); # *MERGE-PATHNAMES-ANSI*
  # for LISPARIT:
  init_arith(); # defines the following:
  # define_variable(S(pi),);                      # PI
  # define_constant(S(most_positive_fixnum),);    # MOST-POSITIVE-FIXNUM
  # define_constant(S(most_negative_fixnum),);    # MOST-NEGATIVE-FIXNUM
  # define_constant(S(most_positive_short_float),); # MOST-POSITIVE-SHORT-FLOAT
  # define_constant(S(least_positive_short_float),); # LEAST-POSITIVE-SHORT-FLOAT
  # define_constant(S(least_negative_short_float),); # LEAST-NEGATIVE-SHORT-FLOAT
  # define_constant(S(most_negative_short_float),); # MOST-NEGATIVE-SHORT-FLOAT
  # define_constant(S(most_positive_single_float),); # MOST-POSITIVE-SINGLE-FLOAT
  # define_constant(S(least_positive_single_float),); # LEAST-POSITIVE-SINGLE-FLOAT
  # define_constant(S(least_negative_single_float),); # LEAST-NEGATIVE-SINGLE-FLOAT
  # define_constant(S(most_negative_single_float),); # MOST-NEGATIVE-SINGLE-FLOAT
  # define_constant(S(most_positive_double_float),); # MOST-POSITIVE-DOUBLE-FLOAT
  # define_constant(S(least_positive_double_float),); # LEAST-POSITIVE-DOUBLE-FLOAT
  # define_constant(S(least_negative_double_float),); # LEAST-NEGATIVE-DOUBLE-FLOAT
  # define_constant(S(most_negative_double_float),); # MOST-NEGATIVE-DOUBLE-FLOAT
  # define_variable(S(most_positive_long_float),); # MOST-POSITIVE-LONG-FLOAT
  # define_variable(S(least_positive_long_float),); # LEAST-POSITIVE-LONG-FLOAT
  # define_variable(S(least_negative_long_float),); # LEAST-NEGATIVE-LONG-FLOAT
  # define_variable(S(most_negative_long_float),); # MOST-NEGATIVE-LONG-FLOAT
  # define_variable(S(least_positive_normalized_long_float),); # LEAST-POSITIVE-NORMALIZED-LONG-FLOAT
  # define_variable(S(least_negative_normalized_long_float),); # LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT
  # define_constant(S(short_float_epsilon),);     # SHORT-FLOAT-EPSILON
  # define_constant(S(single_float_epsilon),);    # SINGLE-FLOAT-EPSILON
  # define_constant(S(double_float_epsilon),);    # DOUBLE-FLOAT-EPSILON
  # define_variable(S(long_float_epsilon),);      # LONG-FLOAT-EPSILON
  # define_constant(S(short_float_negative_epsilon),); # SHORT-FLOAT-NEGATIVE-EPSILON
  # define_constant(S(single_float_negative_epsilon),); # SINGLE-FLOAT-NEGATIVE-EPSILON
  # define_constant(S(double_float_negative_epsilon),); # DOUBLE-FLOAT-NEGATIVE-EPSILON
  # define_variable(S(long_float_negative_epsilon),); # LONG-FLOAT-NEGATIVE-EPSILON
  # define_variable(S(read_default_float_format),); # *READ-DEFAULT-FLOAT-FORMAT*
  # define_variable(S(random_state),);            # *RANDOM-STATE*
  # for ARRAY:
  define_constant_UL1(S(array_total_size_limit),arraysize_limit_1); # ARRAY-TOTAL-SIZE-LIMIT := arraysize_limit_1 + 1
  define_constant_UL1(S(array_dimension_limit),arraysize_limit_1); # ARRAY-DIMENSION-LIMIT := arraysize_limit_1 + 1
  define_constant_UL1(S(array_rank_limit),arrayrank_limit_1); # ARRAY-RANK-LIMIT := arrayrank_limit_1 + 1
  # for CHARSTRG:
  define_constant(S(char_cod_limit),fixnum(char_code_limit)); # CHAR-CODE-LIMIT
  define_constant(S(base_char_cod_limit),fixnum(base_char_code_limit)); # BASE-CHAR-CODE-LIMIT
  define_variable(S(coerce_fixnum_char_ansi),NIL); # LISP:*COERCE-FIXNUM-CHAR-ANSI*
  # for SEQUENCE:
  define_variable(S(sequence_count_ansi),NIL); # LISP:*SEQUENCE-COUNT-ANSI*
  # for DEBUG:
  define_variable(S(plus),NIL);                   # +
  define_variable(S(plus2),NIL);                  # ++
  define_variable(S(plus3),NIL);                  # +++
  define_variable(S(minus),NIL);                  # -
  define_variable(S(mal),NIL);                    # *
  define_variable(S(mal2),NIL);                   # **
  define_variable(S(mal3),NIL);                   # ***
  define_variable(S(durch),NIL);                  # /
  define_variable(S(durch2),NIL);                 # //
  define_variable(S(durch3),NIL);                 # ///
  define_variable(S(driverstern),NIL);            # *DRIVER* := NIL
  define_variable(S(break_driver),NIL);           # *BREAK-DRIVER* := NIL
  define_variable(S(break_count),Fixnum_0);       # SYS::*BREAK-COUNT* := 0
  define_variable(S(recurse_count_standard_output),Fixnum_0); # SYS::*RECURSE-COUNT-STANDARD-OUTPUT* := 0
  define_variable(S(recurse_count_debug_io),Fixnum_0); # SYS::*RECURSE-COUNT-DEBUG-IO* := 0
  # for STREAM:
  # later: init_streamvars(); # defines the following:
  # define_variable(S(standard_input),);          # *STANDARD-INPUT*
  # define_variable(S(standard_output),);         # *STANDARD-OUTPUT*
  # define_variable(S(error_output),);            # *ERROR-OUTPUT*
  # define_variable(S(query_io),);                # *QUERY-IO*
  # define_variable(S(debug_io),);                # *DEBUG-IO*
  # define_variable(S(terminal_io),);             # *TERMINAL-IO*
  # define_variable(S(trace_output),);            # *TRACE-OUTPUT*
  # define_variable(S(keyboard_input),);          # *KEYBOARD-INPUT*
  define_variable(S(default_pathname_defaults),unbound); # *DEFAULT-PATHNAME-DEFAULTS*
  # for IO:
  init_reader(); # defines the following:
  # define_variable(S(read_base),);               # *READ-BASE* := 10
  # define_variable(S(read_suppress),);           # *READ-SUPPRESS* := NIL
  # define_variable(S(read_eval),);               # *READ-EVAL* := T
  # define_variable(S(readtablestern),);          # *READTABLE*
  define_variable(S(read_preserve_whitespace),unbound); # SYS::*READ-PRESERVE-WHITESPACE*
  define_variable(S(read_recursive_p),unbound);   # SYS::*READ-RECURSIVE-P*
  define_variable(S(read_reference_table),unbound); # SYS::*READ-REFERENCE-TABLE*
  define_variable(S(backquote_level),unbound);    # SYS::*BACKQUOTE-LEVEL*
  define_variable(S(compiling),NIL);              # SYS::*COMPILING* ;= NIL
  define_variable(S(print_case),S(Kupcase));      # *PRINT-CASE* := :UPCASE
  define_variable(S(print_level),NIL);            # *PRINT-LEVEL* := NIL
  define_variable(S(print_length),NIL);           # *PRINT-LENGTH* := NIL
  define_variable(S(print_gensym),T);             # *PRINT-GENSYM* := T
  define_variable(S(print_escape),T);             # *PRINT-ESCAPE* := T
  define_variable(S(print_radix),NIL);            # *PRINT-RADIX* := NIL
  define_variable(S(print_base),fixnum(10));      # *PRINT-BASE* := 10
  define_variable(S(print_array),T);              # *PRINT-ARRAY* := T
  define_variable(S(print_circle),NIL);           # *PRINT-CIRCLE* := NIL
  define_variable(S(print_pretty),NIL);           # *PRINT-PRETTY* := NIL
  define_variable(S(print_closure),NIL);          # *PRINT-CLOSURE* := NIL
  define_variable(S(print_readably),NIL);         # *PRINT-READABLY* := NIL
  define_variable(S(print_lines),NIL);            # *PRINT-LINES* := NIL
  define_variable(S(print_miser_width),NIL);      # *PRINT-MISER-WIDTH* := NIL
  define_variable(S(prin_line_prefix),unbound);   # *PRIN-LINE-PREFIX*
  define_variable(S(prin_miserp),unbound);        # *PRIN-MISERP*
  define_variable(S(prin_pprinter),unbound);      # *PRIN-PPRINTER*
  define_variable(S(prin_indentation),unbound);   # *PRIN-INDENTATION*
  define_variable(S(print_pprint_dispatch),NIL);  # *PRINT-PPRINT-DISPATCH* := NIL
  define_variable(S(print_right_margin),NIL);     # *PRINT-RIGHT-MARGIN* := NIL
  define_variable(S(print_rpars),NIL);            # *PRINT-RPARS* := NIL
  define_variable(S(print_indent_lists),fixnum(1)); # *PRINT-INDENT-LISTS* := 1
  define_variable(S(print_pretty_fill),NIL);      # *PRINT-PRETTY-FILL* := NIL
  define_variable(S(print_circle_table),unbound); # SYS::*PRINT-CIRCLE-TABLE*
  define_variable(S(prin_level),unbound);         # SYS::*PRIN-LEVEL*
  define_variable(S(prin_lines),unbound);         # SYS::*PRIN-LINES*
  define_variable(S(prin_stream),unbound);        # SYS::*PRIN-STREAM*
  define_variable(S(prin_linelength),fixnum(79)); # SYS::*PRIN-LINELENGTH* := 79 (preliminarily)
  define_variable(S(prin_l1),unbound);            # SYS::*PRIN-L1*
  define_variable(S(prin_lm),unbound);            # SYS::*PRIN-LM*
  define_variable(S(prin_rpar),unbound);          # SYS::*PRIN-RPAR*
  define_variable(S(prin_traillength),unbound);   # SYS::*PRIN-TRAILLENGTH*
  define_variable(S(prin_prev_traillength),unbound); # SYS::*PRIN-PREV-TRAILLENGTH*
  define_variable(S(prin_jblocks),unbound);       # SYS::*PRIN-JBLOCKS*
  define_variable(S(prin_jbstrings),unbound);     # SYS::*PRIN-JBSTRINGS*
  define_variable(S(prin_jbmodus),unbound);       # SYS::*PRIN-JBMODUS*
  define_variable(S(prin_jblpos),unbound);        # SYS::*PRIN-JBLPOS*
  define_variable(S(load_forms),NIL); /* SYS::*LOAD-FORMS* */
  define_variable(S(terminal_read_open_object),unbound); # SYS::*TERMINAL-READ-OPEN-OBJECT*
  define_variable(S(terminal_read_stream),unbound); # SYS::*TERMINAL-READ-STREAM*
  define_variable(S(pprint_first_newline),T);     # CUSTOM:*PPRINT-FIRST-NEWLINE*
  define_variable(S(print_symbols_long),NIL);     # CUSTOM:*PRINT-SYMBOLS-LONG*
  define_variable(S(print_pathnames_ansi),NIL);   # CUSTOM:*PRINT-PATHNAMES-ANSI*
  define_variable(S(parse_namestring_ansi),NIL);  # CUSTOM:*PARSE-NAMESTRING-ANSI*
 #ifdef PATHNAME_NOEXT
  define_variable(S(parse_namestring_dot_file),S(Ktype)); # CUSTOM:*PARSE-NAMESTRING-DOT-FILE*
 #endif
  define_variable(S(deftype_depth_limit),NIL);    # CUSTOM:*DEFTYPE-DEPTH-LIMIT*
 #if defined(WIN32_NATIVE) || defined(UNIX_CYGWIN32)
  define_variable(S(device_prefix),NIL); # CUSTOM:*DEVICE-PREFIX*
 #endif
  # for EVAL:
  define_variable(S(evalhookstern),NIL);          # *EVALHOOK* := NIL
  define_variable(S(applyhookstern),NIL);         # *APPLYHOOK* := NIL
  # for MISC:
  define_constant(S(internal_time_units_per_second),  # INTERNAL-TIME-UNITS-PER-SECOND
                  fixnum(ticks_per_second) ); # := 200 resp. 1000000
  # for PREDTYPE:
  define_variable(S(recurse_count_gc_statistics),Fixnum_0); # SYS::*RECURSE-COUNT-GC-STATISTICS* := 0
  # for ERROR:
  define_variable(S(use_clcs),NIL);               # SYS::*USE-CLCS* := NIL
  define_variable(S(recursive_error_count),Fixnum_0); # SYS::*RECURSIVE-ERROR-COUNT* := 0
  define_variable(S(error_handler),NIL);          # *ERROR-HANDLER* := NIL
  # for SPVW:
  define_variable(S(init_hooks),NIL);             # SYS::*INIT-HOOKS* := NIL
  define_variable(S(quiet),NIL);                  # SYS::*QUIET* := NIL
  define_variable(S(args),NIL);                   # EXT:*ARGS* := NIL
  define_variable(S(load_compiling),NIL); /* *LOAD-COMPILING* := NIL */
  define_variable(S(load_verbose),T); /* *LOAD-VERBOSE* := T */
  define_variable(S(load_print),NIL); /* *LOAD-PRINT* := NIL */
  define_variable(S(compile_print),NIL); /* *COMPILE-PRINT* := NIL */
  define_variable(S(compile_verbose),T); /* *COMPILE-VERBOSE* := T */
  # for FOREIGN:
 #ifdef DYNAMIC_FFI
  define_constant(S(fv_flag_readonly),fixnum(fv_readonly));  # FFI::FV-FLAG-READONLY
  define_constant(S(fv_flag_malloc_free),fixnum(fv_malloc)); # FFI::FV-FLAG-MALLOC-FREE
  define_constant(S(ff_flag_alloca),fixnum(ff_alloca));      # FFI::FF-FLAG-ALLOCA
  define_constant(S(ff_flag_malloc_free),fixnum(ff_malloc)); # FFI::FF-FLAG-MALLOC-FREE
  define_constant(S(ff_flag_out),fixnum(ff_out));            # FFI::FF-FLAG-OUT
  define_constant(S(ff_flag_in_out),fixnum(ff_inout));       # FFI::FF-FLAG-IN-OUT
  define_constant(S(ff_language_asm),fixnum(ff_lang_asm));       # FFI::FF-LANGUAGE-ASM
  define_constant(S(ff_language_c),fixnum(ff_lang_c));           # FFI::FF-LANGUAGE-C
  define_constant(S(ff_language_ansi_c),fixnum(ff_lang_ansi_c)); # FFI::FF-LANGUAGE-ANSI-C
  define_constant(S(ff_language_stdcall),fixnum(ff_lang_stdcall)); # FFI::FF-LANGUAGE-STDCALL
 #endif
  # for PATHNAME:
 #ifdef LOGICAL_PATHNAMES
  { # SYS::*LOGICAL-PATHNAME-TRANSLATIONS* := (MAKE-HASH-TABLE :TEST #'EQUALP)
    pushSTACK(S(Ktest)); pushSTACK(L(equalp)); funcall(L(make_hash_table),2);
    define_variable(S(logpathname_translations),value1);
  }
  O(empty_logical_pathname) = allocate_logpathname();
 #endif
  # initialize *DEFAULT-PATHNAME-DEFAULTS* preliminarily:
  define_variable(S(default_pathname_defaults),allocate_pathname());
 #undef define_constant_UL1
}
# create other objects and fill object table:
local void init_object_tab (void) {
  # table with initialization strings:
  local var const char * const object_initstring_tab [] = {
    #define LISPOBJ LISPOBJ_C
    #include "constobj.c"
    #undef LISPOBJ
  };
  { # initialize *FEATURES* :
    var const char * features_initstring =
      "(:CLISP :ANSI-CL :COMMON-LISP :LISP=CL :INTERPRETER"
     #ifdef DEBUG_SPVW
      " :CLISP-DEBUG"
     #endif
     #ifdef MULTITHREAD
      " :MT"
     #endif
     #ifdef SOCKET_STREAMS
      " :SOCKETS"
     #endif
     #ifdef GENERIC_STREAMS
      " :GENERIC-STREAMS"
     #endif
     #ifdef LOGICAL_PATHNAMES
      " :LOGICAL-PATHNAMES"
     #endif
     #ifdef SCREEN
      " :SCREEN"
     #endif
     #ifdef DYNAMIC_FFI
      " :FFI"
     #endif
     #ifdef GNU_GETTEXT
      " :GETTEXT"
     #endif
     #ifdef UNICODE
      " :UNICODE"
     #endif
     #if (base_char_code_limit == char_code_limit)
      " :BASE-CHAR=CHARACTER"
     #endif
     #ifdef PC386
      " :PC386"
     #endif
     #ifdef UNIX
      " :UNIX"
     #endif
     #ifdef UNIX_CYGWIN32
      " :CYGWIN"
     #endif
     #ifdef UNIX_BEOS
      " :BEOS"
     #endif
     #ifdef WIN32
      " :WIN32"
     #endif
      ")";
    pushSTACK(ascii_to_string(features_initstring));
    var object list = (funcall(L(read_from_string),1), value1);
    define_variable(S(features),list);             # *FEATURES*
  }
  { # read objects from the strings:
    var gcv_object_t* objptr = (gcv_object_t*)&object_tab; # traverse object_tab
    var const char * const * stringptr = &object_initstring_tab[0]; # traverse string table
    var uintC count;
    dotimesC(count,object_anz,{
      var const char * string = *stringptr++;
      if (*string == '@') {
        # no READ-FROM-STRING for LISPOBJ_L && GNU_GETTEXT
        *objptr = asciz_to_string(&string[1],O(internal_encoding));
      } else {
        pushSTACK(asciz_to_string(string,O(internal_encoding))); # string
        funcall(L(make_string_input_stream),1); # pack into stream
        pushSTACK(value1);
        var object obj = stream_read(&STACK_0,NIL,NIL); # read object
        skipSTACK(1);
        if (!eq(obj,dot_value)) { *objptr = obj; } # and store (except ".")
      }
      objptr++;
    });
  }
  # build toplevel-declaration-environment
  Car(O(top_decl_env)) = O(declaration_types);
}
# manual initialization of all LISP-data:
local void initmem (void) {
  init_symbol_tab_1(); # initialize symbol_tab
  init_object_tab_1(); # initialize object_tab
  init_other_modules_1(); # initialize other modules coarsely
  {
    aktenv.var_env = NIL; aktenv.fun_env = NIL; aktenv.block_env = NIL;
    aktenv.go_env = NIL; aktenv.decl_env = NIL;
  }
  # Now the tables are coarsely initialized,
  # nothing can happen at GC.
  # finish initialization of subr_tab:
  init_subr_tab_2();
  # initialize packages:
  init_packages();
  init_encodings_1(); # init some encodings (utf_8 for init_symbol_tab_2)
  # finish initialization of symbol_tab:
  init_symbol_tab_2();
  init_encodings_2(); # init the rest of encodings
  # enter SUBRs/FSUBRs into their symbols:
  init_symbol_functions();
  # constants/variables: enter value into the symbols:
  init_symbol_values();
  # create other objects:
  init_object_tab();
}
# loading of MEM-file:
local void loadmem (const char* filename); # see below
# initialization of the other, not yet initialized modules:
local void init_other_modules_2 (void);
local void init_module_2 (module_t* module) {
  # pre-initialize subr_tab, object_tab, so that GC becomes possible:
  if (*module->stab_size > 0) {
    var subr_t* ptr = module->stab; # traverse subr_tab
    var uintC count;
    dotimespC(count,*module->stab_size,
    { ptr->name = NIL; ptr->keywords = NIL; ptr++; });
  }
  if (*module->otab_size > 0) {
    var gcv_object_t* ptr = module->otab; # traverse object_tab
    var uintC count;
    dotimespC(count,*module->otab_size, { *ptr++ = NIL; });
  }
  # now, GC my see this subr_tab, object_tab:
  module->initialized = true;
  # enter Subr-symbols:
  if (*module->stab_size > 0) {
    var subr_t* subr_ptr = module->stab;
    var const subr_initdata_t* init_ptr = module->stab_initdata;
    var uintC count;
    dotimespC(count,*module->stab_size,{
      var const char* packname = init_ptr->packname;
      var object symname = asciz_to_string(init_ptr->symname,O(internal_encoding));
      var object symbol;
      if (packname==NULL) {
        symbol = make_symbol(symname);
      } else {
        var object pack =
          find_package(asciz_to_string(packname,O(internal_encoding)));
        if (nullp(pack)) { # package not found?
          fprintf(stderr,GETTEXTL("module `%s' requires package %s.\n"),
                  module->name, packname);
          quit_sofort(1);
        }
        intern(symname,pack,&symbol);
      }
      subr_ptr->name = symbol; # complete Subr
      Symbol_function(symbol) = subr_tab_ptr_as_object(subr_ptr); # define function
      init_ptr++; subr_ptr++;
    });
  }
  # enter objects:
  if (*module->otab_size > 0) {
    var gcv_object_t* object_ptr = module->otab;
    var const object_initdata_t* init_ptr = module->otab_initdata;
    var uintC count;
    dotimespC(count,*module->otab_size, {
      pushSTACK(asciz_to_string(init_ptr->initstring,O(internal_encoding))); # string
      funcall(L(make_string_input_stream),1); # pack into stream
      pushSTACK(value1);
      *object_ptr = stream_read(&STACK_0,NIL,NIL); # read object
      skipSTACK(1);
      object_ptr++; init_ptr++;
    });
  }
  # call initialization function:
  (*module->initfunction1)(module);
}
local void init_other_modules_2 (void) {
  var module_t* module; # traverse modules
  for_modules(all_other_modules,{
    if (!module->initialized)
      init_module_2(module);
  });
}

# print usage and exit
nonreturning_function (local, usage, (int exit_code)) {
  printf(PACKAGE_NAME " (" PACKAGE_BUGREPORT ") ");
  printf(GETTEXTL("is an ANSI Common Lisp.\nUsage:  "));
  printf(program_name);
  printf(GETTEXTL(" [options] [lispfile [argument ...]]\n"
                  " When `lispfile' is given, it is loaded and `*ARGS*' is set\n"
                  " to the list of argument strings. Otherwise, an interactive\n"
                  " read-eval-print loop is entered.\n"));
  printf(GETTEXTL("Informative output:\n"));
  printf(GETTEXTL(" -h, --help    - print this help and exit\n"));
  printf(GETTEXTL(" --version     - print the version information\n"));
  printf(GETTEXTL(" --license     - print the licensing information\n"));
  printf(GETTEXTL("Memory image selection:\n"));
  printf(GETTEXTL(" -B lisplibdir - set the installation directory\n"));
 #if defined(UNIX) || defined(WIN32_NATIVE)
  printf(GETTEXTL(" -K linkingset - use this executable and memory image\n"));
 #endif
  printf(GETTEXTL(" -M memfile    - use this memory image\n"));
  printf(GETTEXTL(" -m size       - memory size (size = xxxxxxxB or xxxxKB or xMB)\n"));
  #ifndef NO_SP_MALLOC
  printf(GETTEXTL(" -s size       - stack size (size = xxxxxxxB or xxxxKB or xMB)\n"));
  #endif
  #ifdef MULTIMAP_MEMORY_VIA_FILE
  printf(GETTEXTL(" -t tmpdir     - temporary directory for memmap\n"));
  #endif
  printf(GETTEXTL("Internationalization:\n"));
  printf(GETTEXTL(" -L language   - set user language\n"));
  printf(GETTEXTL(" -N nlsdir     - NLS catalog directory\n"));
  printf(GETTEXTL(" -Edomain encoding - set encoding\n"));
  printf(GETTEXTL("Interoperability:\n"));
  printf(GETTEXTL(" -q, --quiet, --silent, -v, --verbose - verbosity level:\n"
                  "     affects banner, *LOAD-VERBOSE*/*COMPILE-VERBOSE*,\n"
                  "     and *LOAD-PRINT*/*COMPILE-PRINT*\n"));
  printf(GETTEXTL(" -w            - wait for a keypress after program termination\n"));
  printf(GETTEXTL(" -I            - be ILISP-friendly\n"));
  printf(GETTEXTL("Startup actions:\n"));
  printf(GETTEXTL(" -ansi         - more ANSI CL compliance\n"));
  printf(GETTEXTL(" -traditional  - traditional (undoes -ansi)\n"));
  printf(GETTEXTL(" -p package    - start in the package\n"));
  printf(GETTEXTL(" -C            - set *LOAD-COMPILING* to T\n"));
  printf(GETTEXTL(" -norc         - do not load the user ~/.clisprc file\n"));
  printf(GETTEXTL(" -i file       - load initfile (can be repeated)\n"));
  printf(GETTEXTL("Actions:\n"));
  printf(GETTEXTL(" -c [-l] lispfile [-o outputfile] - compile LISPFILE\n"));
  printf(GETTEXTL(" -x expressions - execute the expressions, then exit\n"));
  printf(GETTEXTL(" lispfile [argument ...] - load lispfile, then exit\n"));
  printf(GETTEXTL("These actions put CLISP into a batch mode, which is overridden by\n"));
  printf(GETTEXTL(" -interactive-debug - allow interaction for failed ASSERT and friends\n"));
  printf(GETTEXTL(" -repl              - enter the interactive read-eval-print loop when done\n"));
  printf(GETTEXTL("Default action is an interactive read-eval-print loop.\n"));
  quit_sofort (exit_code); # abnormal end of program
}

# print license and exit
nonreturning_function (local, print_license, (void)) {
  local const char * const license [] = {
    PACKAGE_NAME " is free software; you can redistribute and/or modify it\n",
    "under the terms of the GNU General Public License as published by\n",
    "the Free Software Foundation; either version 2, or (at your option)\n",
    "any later version.\n",
    "\n",
    PACKAGE_NAME " is distributed in the hope that it will be useful,\n",
    "but WITHOUT ANY WARRANTY; without even the implied warranty of\n",
    "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n",
    "See the GNU General Public License for more details.\n",
    "\n",
    "You should have received a copy of the GNU General Public License\n",
    "along with " PACKAGE_NAME ", see file GNU-GPL.\n",
    "If not, write to the Free Software Foundation, Inc.,\n",
    "59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.\n",
    "\n",
    "Distribution of Lisp programs meant to run in " PACKAGE_NAME "\n",
    "without sources is possible under certain conditions.\n",
    "See file COPYRIGHT that came with " PACKAGE_NAME " for details.\n",
    "\n",
  };
  var const char * const * ptr = license;
  var uintC count = sizeof(license)/sizeof(license[0]);
  pushSTACK(var_stream(S(standard_output),strmflags_wr_ch_B));
  while (count--)
    write_sstring(&STACK_0,asciz_to_string(*ptr++,O(internal_encoding)));
  skipSTACK(1);
  quit_sofort (0);
}

#include "spvw_calendar.c"

# print the banner
local void print_banner ()
{ const char * const banner0[] = { # some lines above 66 characters
  #  |Column 0           |Column 20                                    |Col 66
  # "012345678901234567890123456789012345678901234567890123456789012345678901"
    "  i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo\n",
    "  I I I I I I I      8     8   8           8     8     o  8    8\n",
   "  I  \\ `+' /  I      8         8           8     8        8    8\n",
   "   \\  `-+-'  /       8         8           8      ooooo   8oooo\n",
    "    `-__|__-'        8         8           8           8  8\n",
    "        |            8     o   8           8     o     8  8\n",
    "  ------+------       ooooo    8oooooo  ooo8ooo   ooooo   8\n",
   };
  const char * banner0_hanukka[] = { # some lines above 66 characters
 #  |Column 0           |Column 20                                    |Col 66
 # "012345678901234567890123456789012345678901234567890123456789012345678901"
   "        .\n",
   ". . . . I . . . .     ooooo    o        ooooooo   ooooo   ooooo\n",
   "I I I I I I I I I    8     8   8           8     8     o  8    8\n",
  "I I  \\ `+' /  I I    8         8           8     8        8    8\n",
  "I  \\  `-+-'  /  I    8         8           8      ooooo   8oooo\n",
  " \\  `-__|__-'  /     8         8           8           8  8\n",
   "  `--___|___--'      8     o   8           8     o     8  8\n",
   "        |             ooooo    8oooooo  ooo8ooo   ooooo   8\n",
   "--------+--------\n",
  };
  char banner0_line0[100];
  char banner0_line1[100];
  const char * const banner1[] = {
   "\n",
   "Copyright (c) Bruno Haible, Michael Stoll 1992, 1993\n",
   "Copyright (c) Bruno Haible, Marcus Daniels 1994-1997\n",
   "Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998\n",
   "Copyright (c) Bruno Haible, Sam Steingold 1999-2000\n",
   "Copyright (c) Sam Steingold, Bruno Haible 2001-2004\n",
  };
  var const char * banner2 = "\n";
  var int candles = 0;
  var uintL offset = (posfixnum_to_L(Symbol_value(S(prin_linelength))) >= 65 ? 0 : 20);
  if (offset == 0) {
    begin_system_call();
    strcpy(banner0_line0,banner0_hanukka[0]);
    strcpy(banner0_line1,banner0_hanukka[1]);
    var time_t now = time(NULL);
    var struct tm now_local;
    var struct tm now_gm;
    now_local = *(localtime(&now));
    now_gm = *(gmtime(&now));
    end_system_call();
    var sintL dayswest = /* Tage-Differenz, kann als 0,1,-1 angenommen werden */
      (now_gm.tm_year < now_local.tm_year ? -1 :
       now_gm.tm_year > now_local.tm_year ? 1 :
       (now_gm.tm_mon < now_local.tm_mon ? -1 :
        now_gm.tm_mon > now_local.tm_mon ? 1 :
        (now_gm.tm_mday < now_local.tm_mday ? -1 :
         now_gm.tm_mday > now_local.tm_mday ? 1 :
         0)));
    var sintL hourswest = 24*dayswest
      + (sintL)(now_gm.tm_hour - now_local.tm_hour);
    var uintL hours_since_1900 = ((unsigned long)now / 3600) - hourswest + 613608;
    /* Add 6 because Hebrew days begin in the evening. */
    var uintL days_since_1900 = (hours_since_1900 + 6) / 24;
    candles = hebrew_calendar_hanukka_candles(days_since_1900);
    if (candles > 0) {
      banner0_line0[8] = 'i';
      if (candles >= 1) {
        banner0_line1[16] = 'i';
        if (candles >= 2) {
          banner0_line1[14] = 'i';
          if (candles >= 3) {
            banner0_line1[12] = 'i';
            if (candles >= 4) {
              banner0_line1[10] = 'i';
              if (candles >= 5) {
                banner0_line1[6] = 'i';
                if (candles >= 6) {
                  banner0_line1[4] = 'i';
                  if (candles >= 7) {
                    banner0_line1[2] = 'i';
                    if (candles >= 8) {
                      banner0_line1[0] = 'i';
                    }
                  }
                }
              }
            }
          }
        }
      }
    }
    banner0_hanukka[0] = banner0_line0;
    banner0_hanukka[1] = banner0_line1;
  }
  var const char * const * ptr;
  var uintC count;
  pushSTACK(var_stream(S(standard_output),strmflags_wr_ch_B)); # to *STANDARD-OUTPUT*
  if (candles > 0) {
    ptr = banner0_hanukka; count = sizeof(banner0_hanukka)/sizeof(banner0_hanukka[0]);
  } else {
    ptr = banner0; count = sizeof(banner0)/sizeof(banner0[0]);
  }
  while (count--)
    write_sstring(&STACK_0,asciz_to_string((*ptr++)+offset,O(internal_encoding)));
  ptr = banner1; count = sizeof(banner1)/sizeof(banner1[0]);
  while (count--)
    write_sstring(&STACK_0,asciz_to_string(*ptr++,O(internal_encoding)));
  write_sstring(&STACK_0,asciz_to_string(banner2,O(internal_encoding)));
  skipSTACK(1);
}

/* can trigger GC */
local object appease_form (bool interactive_debug, object form)
{ /* return `(BATCHMODE-ERRORS ,form) */
  if (interactive_debug) pushSTACK(S(appease_cerrors));
  else pushSTACK(S(batchmode_errors));
  pushSTACK(form);
  return listof(2);
}

# main program stores the name 'main'.
#ifdef NEXTAPP
  # main() already exists in Lisp_main.m
  #define main  clisp_main
#endif
#ifndef argc_t
  #define argc_t int  # Type of argc is mostly 'int'.
#endif
global const char* locale_encoding = NULL; # GNU canonical name of locale encoding
global const char* argv_encoding_misc = NULL; # override for *misc-encoding*
global const char* argv_encoding_file = NULL; # ... for *default-file-encoding*
global const char* argv_encoding_pathname = NULL; # ... for *pathname-encoding*
global const char* argv_encoding_terminal = NULL; # ... for *terminal-encoding*
global const char* argv_encoding_foreign = NULL; # ... for *foreign-encoding*
local int argv_verbose = 2;    /* verbosity level */
local bool argv_wait_keypress = false;
local bool argv_license = false;
global int main (argc_t argc, char* argv[]) {
  # initialization of memory management.
  # overall procedure:
  # process command-line-options.
  # determine memory partitioning.
  # look at command string and either load LISP-data from .MEM-file
  # or create manually and initialize static LISP-data.
  # build up interrupt-handler.
  # print banner.
  # jump into the driver.
 #ifdef WIN32_NATIVE
  init_win32();
 #endif
 #ifdef UNIX
  begin_system_call();
  find_executable(argv[0]);
  end_system_call();
 #endif
  var uintL argv_memneed = 0;
 #ifndef NO_SP_MALLOC
  var uintL argv_stackneed = 0;
 #endif
 #ifdef MULTIMAP_MEMORY_VIA_FILE
  var local char* argv_tmpdir = NULL;
 #endif
  var local char* argv_lisplibdir;
  var local bool argv_developer = false;
  var local char* argv_memfile = NULL;
  var local bool argv_load_compiling = false;
  var local uintL argv_init_filecount = 0;
  var local bool argv_compile = false;
  var local bool argv_compile_listing = false;
  var local bool argv_norc = false;
  var local bool argv_interactive_debug = false;
  var local uintL argv_compile_filecount = 0;
  typedef struct { char* input_file; char* output_file; } argv_compile_file_t;
  var local argv_compile_file_t* argv_compile_files;
  var local char* argv_package = NULL;
  var local int argv_ansi = 0; # 0: default; 1: ANSI; 2: traditional
  var local bool argv_repl = false;
  var local uintL argv_expr_count = 0;
  var local char* argv_execute_file = NULL;
  var local char** argv_execute_args = NULL;
  var local uintL argv_execute_arg_count;
  var local char* argv_language = NULL;
  var local char* argv_localedir = NULL;
  {var DYNAMIC_ARRAY(argv_selection_array,char*,(uintL)argc); # max argc -x/-i
  var DYNAMIC_ARRAY(argv_compile_files_array,argv_compile_file_t,(uintL)argc); # maximal argc file-arguments
  argv_compile_files = argv_compile_files_array;
  if (!(setjmp(original_context) == 0)) goto end_of_main;
  /* process arguments argv[0..argc-1] :
     -h              Help
     -m size         Memory size (size = xxxxxxxB oder xxxxKB oder xMB)
     -s size         Stack size (size = xxxxxxxB oder xxxxKB oder xMB)
     -t directory    temporary directory
     -B directory    set lisplibdir
     -K linkingset   specify executable and mem file
     -M file         load MEM-file
     -L language     set the user language
     -N directory    NLS catalog directory
     -Edomain encoding  set encoding
     -q/-v           verbosity level:
        3:   banner, VERBOSE=T, PRINT=T
      * 2:   banner, VERBOSE=T, PRINT=NIL  ======= default
        1:   no banner, VERBOSE=T, PRINT=NIL
        0:   no banner, VERBOSE=NIL, PRINT=NIL
     -norc           do not load the user ~/.clisprc file
     -I              ILISP-friendly
     -C              set *LOAD-COMPILING* to T
     -i file ...     load LISP-file for initialization
     -c file ...     compile LISP-files, then leave LISP
     -l              At compilation: create listings
     -p package      set *PACKAGE*
     -ansi           more ANSI CL Compliance
     -traditional    traditional (undoes -ansi)
     -x expr         execute LISP-expressions, then leave LISP
     -interactive-debug  override batch-mode for -c, -x and file
     -repl           enter REPL after -c, -x and file
     -w              wait for keypress after termination
     --help          print usage and exit (should be the only option)
     --version       print version and exit (should be the only option)
     file [arg ...]  load LISP-file in batch-mode and execute, then leave LISP
   -d -- developer mode -- undocumented, unsupported &c
      - unlock all packages.

   Newly added options have to be listed:
   - in the above table,
   - in the usage-message here,
   - in the options parser,
   - in the options parser in _clisp.c,
   - in the manual-pages _clisp.1 and _clisp.html. */

  program_name = argv[0]; # argv[0] is the program name
  {
    var char** argptr = &argv[1];
    var char** argptr_limit = &argv[argc];
    var enum { for_exec, for_init, for_compile, for_expr } argv_for = for_exec;
    # loop and process options, replace processed options with NULL:
    while (argptr < argptr_limit) {
      var char* arg = *argptr++; # next argument
      if ((arg[0] == '-') && !(arg[1] == '\0')) {
        switch (arg[1]) {
          case 'h': # help
            usage ((arg[2] != 0));
            # returns after a one-character token the rest of the
            # option in arg. poss. space is skipped.
            #define OPTION_ARG                                             \
              if (arg[2] == '\0') {                                        \
                if (argptr < argptr_limit) arg = *argptr++; else usage (1);\
              } else { arg = &arg[2]; }
            # parses the rest of an option, that specifies a byte-size.
            # also checks, if certain boundaries are obeyed.
            #define SIZE_ARG(docstring,sizevar,limit_low,limit_high)       \
               # arg should consist of a few decimal places, then          \
               # maybe K or M, then maybe B or W.                          \
              do { # arg: [0-9]+[KM]?[BW]?                                 \
                var uintL val = 0;                                         \
                while ((*arg >= '0') && (*arg <= '9'))                     \
                  val = 10*val + (uintL)(*arg++ - '0');                    \
                switch (*arg) {                                            \
                  case 'k': case 'K': # in kilobytes                       \
                    val = val * 1024; arg++; break;                        \
                  case 'm': case 'M': # in megabytes                       \
                    val = val * 1024*1024; arg++; break;                   \
                }                                                          \
                switch (*arg) {                                            \
                  case 'w': case 'W': # in words                           \
                    val = val * sizeof(gcv_object_t);                      \
                  case 'b': case 'B': # in bytes                           \
                    arg++; break;                                          \
                }                                                          \
                if (*arg != '\0') { # argument finished?                   \
                  fprintf(stderr,GETTEXTL("Syntax for %s: nnnnnnn or nnnnKB or nMB\n"), docstring); \
                  usage (1);                                               \
                }                                                          \
                if (!((val >= limit_low) && (val <= limit_high))) {        \
                  fprintf(stderr,GETTEXTL("%s out of range\n"),  \
                          docstring);                                   \
                  usage (1);                                               \
                }                                                          \
                # For multiple -m resp. -s arguments, only the last counts.\
                sizevar = val;                                             \
              } while(0)
          case 'm': # memory size
           #ifdef WIN32_NATIVE
            if (arg[2]=='m' && arg[3]=='\0') # "-mm" -> print a memory map
              { DumpProcessMemoryMap(); quit_sofort(1); }
           #endif
            OPTION_ARG;
            SIZE_ARG(GETTEXTL("memory size"),argv_memneed,100000,
                     # memory size limited by:
                     (oint_addr_len+addr_shift < intLsize-1
                      # address space in oint_addr_len+addr_shift bits
                      ? bitm(oint_addr_len+addr_shift)
                      # (resp. big dummy-limit)
                      : (uintL)bit(intLsize-1)-1));
            break;
         #ifndef NO_SP_MALLOC
          case 's': # stack size
            OPTION_ARG;
            SIZE_ARG(GETTEXTL("stack size"),argv_stackneed,40000,8*1024*1024);
            break;
         #endif
          case 't': # traditional, temporary directory
            if (asciz_equal(arg,"-traditional"))
              argv_ansi = 2; # traditional
            else {
             #ifdef MULTIMAP_MEMORY_VIA_FILE
              OPTION_ARG;
              if (!(argv_tmpdir == NULL)) usage (1);
              argv_tmpdir = arg;
             #else
              usage (1);
             #endif
            }
            break;
          case 'd': /* developer mode */
            argv_developer = true;
            if (arg[2] != '\0') usage (1);
            break;
          case 'B': # lisplibdir
            OPTION_ARG;
            if (!(argv_lisplibdir == NULL)) usage (1);
            argv_lisplibdir = arg;
            break;
          case 'n':
            if (asciz_equal(arg,"-norc"))
              argv_norc = true;
            else
              usage (1);
            break;
         #if defined(UNIX) || defined(WIN32_NATIVE)
          case 'K': # linKing set
            OPTION_ARG;
            # This option has already been digested by clisp.c.
            # We can ignore it.
            break;
         #endif
          case 'M': # MEM-file: when repeated, only the last one counts.
            OPTION_ARG;
            argv_memfile = arg;
            break;
          case 'L': # Language: when repeated, only the last one counts.
            OPTION_ARG;
            argv_language = arg;
            break;
          case 'N': # NLS-directory: when repeated, only the last one counts.
            OPTION_ARG;
            argv_localedir = arg;
            break;
          case 'E': # encoding
            if (!(argptr < argptr_limit)) usage(1);
            if (asciz_equal(&arg[2],"file"))
              argv_encoding_file = *argptr++;
            else if (asciz_equal(&arg[2],"pathname"))
              argv_encoding_pathname = *argptr++;
            else if (asciz_equal(&arg[2],"terminal"))
              argv_encoding_terminal = *argptr++;
            else if (asciz_equal(&arg[2],"foreign"))
              argv_encoding_foreign = *argptr++;
            else if (asciz_equal(&arg[2],"misc"))
              argv_encoding_misc = *argptr++;
            else if (arg[2] == '\0') # unspecified => all
              argv_encoding_file = argv_encoding_pathname =
                argv_encoding_terminal = argv_encoding_foreign =
                argv_encoding_misc = *argptr++;
            else
              usage(1);
            break;
          case 'q':             /* verbosity level */
            argv_verbose--;
            if (arg[2] != '\0') usage (1);
            break;
          case 'v':             /* verbosity level */
            argv_verbose++;
            if (arg[2] != '\0') usage (1);
            break;
          case 'I': # ILISP-friendly
            ilisp_mode = true;
            if (arg[2] != '\0') usage (1);
            break;
          case 'C': # set *LOAD-COMPILING*
            argv_load_compiling = true;
            if (arg[2] != '\0') usage (1);
            break;
          case 'r': /* -repl */
            if (asciz_equal(&arg[1],"repl"))
              argv_repl = true;
            break;
          case 'i': # initialization files
            if (arg[2] == '\0') argv_for = for_init;
            else if (asciz_equal(&arg[1],"interactive-debug"))
              argv_interactive_debug = true;
            else usage (1);
            break;
          case 'c': # files to be compiled
            argv_compile = true;
            argv_for = for_compile;
            if (arg[2] == 'l') {
              argv_compile_listing = true;
              if (arg[3] != '\0') usage (1);
            } else {
              if (arg[2] != '\0') usage (1);
            }
            break;
          case 'l': # compilation listings
            argv_compile_listing = true;
            if (arg[2] != '\0') usage (1);
            break;
          case 'o': # target for files to be compiled
            if (arg[2] != '\0') usage (1);
            OPTION_ARG;
            if (!((argv_compile_filecount > 0)
                  && (argv_compile_files[argv_compile_filecount-1].output_file==NULL)))
              usage (1);
            argv_compile_files[argv_compile_filecount-1].output_file = arg;
            break;
          case 'p': # package: when repeated, only the last one counts.
            OPTION_ARG;
            argv_package = arg;
            break;
          case 'a': # ANSI CL Compliance
            if (asciz_equal(arg,"-ansi"))
              argv_ansi = 1; # ANSI
            else if (arg[2] != '\0') usage (1);
            else {
              fprintf(stderr,GETTEXTL("CLISP: -a is deprecated, use -ansi\n"));
              argv_ansi = 1; # ANSI
            }
            break;
          case 'x': # execute LISP-expression
            if (arg[2] != '\0') usage (1);
            argv_for = for_expr;
            break;
          case 'w': # wait for keypress after termination
            argv_wait_keypress = true;
            if (arg[2] != '\0') usage (1);
            break;
          case '-': # -- GNU-style long options
            if (arg[2] == 0) /* "--" ==> end of options */
              goto done_with_argv;
            else if (asciz_equal(&arg[2],"help"))
              usage (0);
            else if (asciz_equal(&arg[2],"version")) {
              argv_expr_count = 0;  /* discard previous -x */
              argv_verbose = 1;
              argv_norc = true;
              argv_repl = false;
              /* force processing this argument again,
                 but this time as if it came after an '-x' */
              argv_for = for_expr;
              *--argptr = "(PROGN (PRINC \"" PACKAGE_NAME " \")"
                "(PRINC (LISP-IMPLEMENTATION-VERSION)) (TERPRI)"
                "(PRINC \"Software: \") (PRINC (SOFTWARE-VERSION))"
                "(PRINC \" \") (PRINC (SOFTWARE-TYPE)) (TERPRI)"
                "(PRINC \"Features"
               #ifdef DEBUG_SPVW
                " [SAFETY=" STRINGIFY(SAFETY)
                #ifdef TYPECODES
                " TYPECODES"
                #endif
                #ifdef WIDE
                " WIDE"
                #endif
                #ifdef GENERATIONAL_GC
                " GENERATIONAL_GC"
                #endif
                "]"
               #endif
                ": \") (PRINC *FEATURES*) (TERPRI)"
                "(PRINC \"Installation directory: \")"
                "(PRINC (SYS::LIB-DIRECTORY)) (TERPRI)"
                "(PRINC \"User language: \")"
                "(PRINC (SYS::CURRENT-LANGUAGE)) (TERPRI)"
                "(PRINC \"Machine: \") (PRINC (MACHINE-TYPE))"
                "(PRINC \" (\") (PRINC (MACHINE-VERSION))"
                "(PRINC \") \") (PRINC (MACHINE-INSTANCE)) (TERPRI)"
                /*"(PRINC \"Arguments: \") (PRIN1 (EXT::ARGV)) (TERPRI)"*/
                "(SYS::%EXIT))";
              break;
            } else if (asciz_equal(&arg[2],"quiet")
                       || asciz_equal(&arg[2],"silent")) {
              argv_verbose--; break;
            } else if (asciz_equal(&arg[2],"verbose")) {
              argv_verbose++; break;
            } else if (asciz_equal(&arg[2],"license")) {
              argv_license = true; break;
            } else
              usage (1); # unknown option
            break;
          default: # unknown option
            usage (1);
        }
      } else if (arg[0] == 0) {  /* done with the arguments */
       done_with_argv:
        argv_execute_args = argptr;
        argv_execute_arg_count = argptr_limit - argptr;
        argptr = argptr_limit; /* abort loop */
      } else {
        # no option is interpreted as file to be loaded / compiled / executed
        switch (argv_for) {
          case for_init:
            argv_selection_array[argv_init_filecount++] = arg; break;
          case for_compile:
            argv_compile_files[argv_compile_filecount].input_file = arg;
            argv_compile_files[argv_compile_filecount].output_file = NULL;
            argv_compile_filecount++;
            break;
          case for_exec:
            argv_execute_file = arg;
            # All further arguments are arguments for argv_execute_file.
            argv_execute_args = argptr;
            argv_execute_arg_count = argptr_limit - argptr;
            # Simulate -norc. Batch scripts should be executed in an
            # environment which does not depend on files in $HOME, for
            # maximum portability.
            argv_norc = true;
            argptr = argptr_limit; # abort loop
            break;
          case for_expr:
            argv_selection_array[argc-1- argv_expr_count++] = arg; break;
          default: NOTREACHED;
        }
      }
    }
    # check options semantically and store defaults:
    if (argv_memneed == 0) {
     #if defined(SPVW_MIXED_BLOCKS_OPPOSITE) && defined(GENERATIONAL_GC)
      # Because of GENERATIONAL_GC the memory region is hardly exhausted.
      argv_memneed = 3584*1024*sizeof(gcv_object_t); # 3584 KW = 14 MB Default
     #else
      # normal
      argv_memneed = 512*1024*sizeof(gcv_object_t); # 512 KW = 2 MB Default
     #endif
    }
   #ifdef MULTIMAP_MEMORY_VIA_FILE
    if (argv_tmpdir == NULL) {
      argv_tmpdir = getenv("TMPDIR"); # try environment-variable
      if (argv_tmpdir == NULL) { argv_tmpdir = "/tmp"; }
    }
   #endif
    if (argv_memfile == NULL)
      # If no memfile is given, LOAD cannot be called with 3 arguments.
      # So disable the loading of ~/.clisprc.
      argv_norc = true;
    if (!argv_compile) {
      # Some options are useful only together with '-c' :
      if (argv_compile_listing) usage (1);
    } else {
      # Other options are useful only without '-c' :
      if (argv_expr_count) usage (1);
    }
    if (argv_expr_count && argv_execute_file) usage (1);
    # The argv_* variables now have their final values.
    # Analyze the environment variables determining the locale.
    # Deal with LC_CTYPE.
    init_ctype();
    # Deal with LC_MESSAGE.
    # (This must come last, because it may unset environment variable LC_ALL)
   #ifndef LANGUAGE_STATIC
    init_language(argv_language,argv_localedir);
   #endif
  } # option processing is over
  { # Initialize the table of relocatable pointers:
    var object* ptr2 = &pseudofun_tab.pointer[0];
    { var const Pseudofun* ptr1 = (const Pseudofun*)&pseudocode_tab;
      var uintC count;
      dotimesC(count,pseudocode_anz,
        { *ptr2++ = make_machine_code(*ptr1); ptr1++; });
    }
    { var const Pseudofun* ptr1 = (const Pseudofun*)&pseudodata_tab;
      var uintC count;
      dotimesC(count,pseudodata_anz,
        { *ptr2++ = make_machine(*ptr1); ptr1++; });
    }
  }
  # fetch memory:
  begin_system_call();
 #if (defined(SINGLEMAP_MEMORY) || defined(TRIVIALMAP_MEMORY) || defined(MULTITHREAD)) && (defined(HAVE_MMAP_ANON) || defined(HAVE_MMAP_DEVZERO) || defined(HAVE_MACH_VM) || defined(HAVE_WIN32_VM))
  mmap_init_pagesize();
 #endif
 #if defined(MULTIMAP_MEMORY) || defined(SINGLEMAP_MEMORY) || defined(TRIVIALMAP_MEMORY)
  init_map_pagesize();
 #endif
 #ifdef SPVW_PURE
  init_mem_heaptypes();
  init_objsize_table();
 #endif
 #if defined(SPVW_MIXED_BLOCKS) && defined(TYPECODES) && defined(GENERATIONAL_GC)
  init_mem_heapnr_from_type();
 #endif
  init_modules_0(); # assemble the list of modules
 #ifdef MULTITHREAD
  init_multithread();
  create_thread((void*)roughly_SP());
 #endif
  end_system_call();
 #ifdef MAP_MEMORY_TABLES
  { # calculate total_subr_anz:
    var uintC total = 0;
    var module_t* module;
    for_modules(all_modules, { total += *module->stab_size; } );
    total_subr_anz = total;
  }
 #endif
  { # partitioning of the total memory:
    #define teile             16  # 16/16
    #ifdef NO_SP_MALLOC # is SP provided by the OS?
      #define teile_SP         0
    #else
      #define teile_SP         2  # 2/16 (1/16 often is not enough)
    #endif
    #define teile_STACK      2  # 2/16
    #define teile_stacks     (teile_SP + teile_STACK)
    #ifdef SPVW_MIXED_BLOCKS
      #define teile_objects    (teile - teile_stacks)  # rest
    #else
      #define teile_objects    0
    #endif
    var uintL pagesize = # size of a page
     #if defined(MULTIMAP_MEMORY)
      map_pagesize
     #elif defined(SELFMADE_MMAP) || defined(GENERATIONAL_GC)
      mmap_pagesize
     #else # if the system-pagesize does not play a role
      teile*varobject_alignment
     #endif
      ;
    var uintL memneed = argv_memneed; # needed memory
    var aint memblock; # lower address of the provided memory block
   #if !(defined(SPVW_MIXED_BLOCKS_OPPOSITE) && !defined(TRIVIALMAP_MEMORY))
    memneed = teile_stacks*floor(memneed,teile); # do not yet calculate memory for objects
    #undef teile
    #define teile  teile_stacks
   #endif
   #ifndef NO_SP_MALLOC
    if (!(argv_stackneed==0)) {
      memneed = memneed*(teile-teile_SP)/teile;
      # the SP-size specified with option -s is not yet included in memneed.
      memneed = memneed + argv_stackneed;
    }
   #endif
   #if defined(TRIVIALMAP_MEMORY) && defined(WIN32_NATIVE)
    # Somehow the RESERVE_FOR_MALLOC limit for mallocs after prepare_zeromap()
    # seems also to encompass the mallocs before prepare_zeromap().
    # Do not know why.
    if (memneed > RESERVE_FOR_MALLOC*3/4) { memneed = RESERVE_FOR_MALLOC*3/4; }
   #endif
   #if defined(MULTIMAP_MEMORY_VIA_SHM) && (defined(UNIX_SUNOS4) || defined(UNIX_SUNOS5))
    # SunOS 4 refuses to shmat() into a previously malloc-ed region,
    # even if there is a munmap() inbetween:
    # errno = EINVAL. Also the reverse, first to shmat() and then to
    # merge the occupied region with sbrk() or brk()  into the
    # data segment, fails with errno = ENOMEM.
    # The only way out is to fetch the necessary memory from far,
    # if possible, out of reach of malloc() .
    {
      var uintL memhave = round_down(bit(oint_addr_len)-(aint)sbrk(0),SHMLBA);
      if (memhave < memneed) { memneed = memhave; }
      memblock = round_down(bit(oint_addr_len) - memneed,SHMLBA);
    }
   #else
    loop {
      memblock = (aint)mymalloc(memneed); # try to allocate memory
      if (!((void*)memblock == NULL)) break; # successful -> OK
      memneed = floor(memneed,8)*7; # else try again with 7/8 thereof
      if (memneed == 0) break;
    }
    if (memneed == 0) {
      begin_system_call();
      memblock = (aint)malloc(1);
      end_system_call();
      fprintf(stderr,GETTEXTL("Return value of malloc() = %x is not compatible with type code distribution.\n"),
              memblock);
      goto no_mem;
    }
    if (memneed < MINIMUM_SPACE+RESERVE) { # but with less than MINIMUM_SPACE
      # we will not be satisfied:
      fprintf(stderr,GETTEXTL("Only %d bytes available.\n"),memneed);
      goto no_mem;
    }
   #endif
   #ifdef MULTIMAP_MEMORY
    # Though we only need this address space and not its content, we must
    # not free it, as it must stay under our control.
   #endif
    { # round to the next lower page boundary:
      var uintL unaligned = (uintL)(-memblock) % pagesize;
      memblock += unaligned; memneed -= unaligned;
    }
    { # round off to the last page boundary:
      var uintL unaligned = memneed % pagesize;
      memneed -= unaligned;
    }
    # the memory region [memblock,memblock+memneed-1] is now free,
    # and its boundaries are located on page boundaries.
   #ifdef MULTIMAP_MEMORY
    #ifdef MULTIMAP_MEMORY_VIA_FILE
    if ( initmap(argv_tmpdir) <0) goto no_mem;
    #else
    if ( initmap() <0) goto no_mem;
    #endif
    multimap(case_machine: MM_TYPECASES, memblock, memneed, false);
    #ifdef MAP_MEMORY_TABLES
    { # set symbol_tab to address 0:
      var uintL memneed = round_up(sizeof(symbol_tab),pagesize); # round up length
      multimap(case_symbolflagged: , 0, memneed, false);
    }
    # set subr_tab to address 0:
    if (zeromap(&subr_tab,round_up(total_subr_anz*sizeof(subr_t),pagesize)) <0)
      goto no_mem;
    #else
    # multimap symbol_tab and subr_tab:
    # symbol_tab and subr_tab keep their address. The region, they
    # are located in (in the data segment of the program!!), becomes
    # Shared Memory resp. shared-mmap-attach . What a hack!
    # This is irreconcilable with the existence of external modules
    # (DYNAMIC_MODULES) ! ??
    {
      var aint symbol_tab_start = round_down((aint)&symbol_tab,pagesize);
      var aint symbol_tab_end = round_up((aint)&symbol_tab+sizeof(symbol_tab),pagesize);
      var aint subr_tab_start = round_down((aint)&subr_tab,pagesize);
      var aint subr_tab_end = round_up((aint)&subr_tab+sizeof(subr_tab),pagesize);
      if ((symbol_tab_end <= subr_tab_start)
          || (subr_tab_end <= symbol_tab_start)) {
        # two distinct intervals
        multimap(case_machine: case_symbolflagged: , symbol_tab_start, symbol_tab_end-symbol_tab_start, true);
        multimap(case_machine: case_subr: , subr_tab_start, subr_tab_end-subr_tab_start, true);
      } else { # the tables have overlap!
        var aint tab_start = (symbol_tab_start < subr_tab_start ? symbol_tab_start : subr_tab_start);
        var aint tab_end = (symbol_tab_end > subr_tab_end ? symbol_tab_end : subr_tab_end);
        multimap(case_machine: case_symbolflagged: case_subr: , tab_start, tab_end-tab_start, true);
      }
    }
    #endif # MAP_MEMORY_TABLES
   #endif # MULTIMAP_MEMORY
   #if defined(SINGLEMAP_MEMORY) || defined(TRIVIALMAP_MEMORY) # <==> SPVW_PURE_BLOCKS || TRIVIALMAP_MEMORY
    if ( initmap() <0) goto no_mem;
    #ifdef SINGLEMAP_MEMORY
    { # pre-initialize all heaps:
      var uintL heapnr;
      for (heapnr=0; heapnr<heapcount; heapnr++) {
        var Heap* heapptr = &mem.heaps[heapnr];
        heapptr->heap_limit = (aint)type_zero_oint(heapnr);
        heapptr->heap_hardlimit = (aint)type_zero_oint(heapnr+1);
        if ((mem.heaptype[heapnr] >= -1)
            && prepare_zeromap(&heapptr->heap_limit,
                               &heapptr->heap_hardlimit,true) <0)
          goto no_mem;
      }
    }
    # set symbol_tab, subr_tab to address 0:
    # (for this purpose case_symbolflagged must be equivalent to case_symbol!)
    #define map_tab(tab,size)                                                \
      do { var uintL map_len = round_up(size,map_pagesize);                  \
           if ( zeromap(&tab,map_len) <0) goto no_mem;                       \
           mem.heaps[typecode(as_object((oint)&tab))].heap_limit += map_len; \
      } while(0)
    map_tab(symbol_tab,sizeof(symbol_tab));
    map_tab(subr_tab,total_subr_anz*sizeof(subr_t));
    #endif
    #ifdef TRIVIALMAP_MEMORY
    # initialize all heaps as empty.
    # Partition the whole available space with a ratio
    # 1:1 , if it is scarce. Otherwise, appoint the two heaps at
    # 1/5 resp. 2/5 of the address range. (An "awry" denominator,
    # in order to avoid diverse Shared-Library-regions.)
    {
      var void* malloc_addr = malloc(1);
      var aint start = round_up((aint)malloc_addr+RESERVE_FOR_MALLOC,map_pagesize); # reserve for malloc()
     #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
      #if defined(SUN4_29)
      var aint end = bitm(oint_addr_len+addr_shift < 29 ? oint_addr_len+addr_shift : 29);
      mem.heaps[0].heap_limit = start + round_down(floor(end-start,5),map_pagesize);
      mem.heaps[1].heap_limit = round_down(end,map_pagesize);
      #elif defined(UNIX_LINUX) && defined(WIDE_SOFT) && !defined(SPARC)
      mem.heaps[0].heap_limit = 0x2E000000; # room until at least 0x40000000
      mem.heaps[1].heap_limit = 0x7F000000; # room until at least 0x64000000
      #else
       #ifdef TYPECODES
      var aint end = bitm(oint_addr_len+addr_shift);
       #else
      var aint end = bitm(oint_addr_len-1); # keep garcol_bit zero
       #endif
      var aint part = floor(end - (start & (end-1)),5);
      #if defined(AMD64) && defined(UNIX_LINUX)
      # Don't use more than 36 address bits, otherwise mmap() fails.
      part &= 0x0000000FFFFFFFFFUL;
      #endif
      mem.heaps[0].heap_limit = start + round_down(1*part,map_pagesize);
      mem.heaps[1].heap_limit = start + round_down(4*part,map_pagesize);
      #endif
      if ( prepare_zeromap(&mem.heaps[0].heap_limit,&mem.heaps[1].heap_limit,true) <0) goto no_mem;
     #else # SPVW_MIXED_BLOCKS_STAGGERED
      #if defined(SUN4_29)
      var aint end = bitm(oint_addr_len+addr_shift < 29 ? oint_addr_len+addr_shift : 29);
      mem.heaps[0].heap_limit = start + round_down(floor(end-start,5),map_pagesize);
      mem.heaps[0].heap_hardlimit =
        mem.heaps[1].heap_limit = start + round_down(floor((end-start)*3,5),map_pagesize);
      mem.heaps[1].heap_hardlimit = end;
      #elif defined(UNIX_LINUX) && defined(WIDE_SOFT) && !defined(SPARC)
      mem.heaps[0].heap_limit = 0x2E000000; # room until at least 0x40000000
      mem.heaps[0].heap_hardlimit = 0x40000000;
      mem.heaps[1].heap_limit = 0x64000000; # room until at least 0x7F000000
      mem.heaps[1].heap_hardlimit = 0x7F000000;
      #else
       #ifdef TYPECODES
      var aint end = bitm(oint_addr_len+addr_shift);
       #else
      var aint end = (start | (bitm(garcol_bit_o)-1)) + 1; # keep garcol_bit zero
       #endif
      var aint part = floor(end - (start & (end-1)),5);
      #if defined(AMD64) && defined(UNIX_LINUX)
      # Don't use more than 36 address bits, otherwise mmap() fails.
      part &= 0x0000000FFFFFFFFFUL;
      #endif
      mem.heaps[0].heap_limit = start + round_down(1*part,map_pagesize);
      mem.heaps[0].heap_hardlimit =
        mem.heaps[1].heap_limit = start + round_down(2*part,map_pagesize);
      mem.heaps[1].heap_hardlimit = start + round_down(3*part,map_pagesize);
      #endif
      if ( prepare_zeromap(&mem.heaps[0].heap_limit,&mem.heaps[1].heap_hardlimit,true) <0) goto no_mem;
     #endif
      free(malloc_addr);
    }
   #endif # TRIVIALMAP_MEMORY
    { # initialize all heaps as empty:
      var uintL heapnr;
      for (heapnr=0; heapnr<heapcount; heapnr++) {
        var Heap* heapptr = &mem.heaps[heapnr];
        heapptr->heap_start = heapptr->heap_end = heapptr->heap_limit;
       #ifdef SELFMADE_MMAP
        heapptr->memfile_numpages = 0;
        # heapptr->memfile_pages = NULL; # irrelevant
        # heapptr->memfile_offset = 0; # irrelevant
       #endif
       #ifdef GENERATIONAL_GC
        heapptr->heap_gen0_start = heapptr->heap_gen0_end =
          heapptr->heap_gen1_start = heapptr->heap_limit;
        heapptr->physpages = NULL;
       #endif
      }
    }
   #ifdef SINGLEMAP_MEMORY_STACK
    { # initialize STACK:
      var uintL map_len = round_up(memneed * teile_STACK/teile, map_pagesize);
      # The stack occupies the interval between 0 and map_len
      # for typecode = system_type:
      var aint low = (aint)type_zero_oint(system_type);
      var aint high = low + map_len;
      if ( prepare_zeromap(&low,&high,true) <0) goto no_mem;
      if ( zeromap((void*)low,map_len) <0) goto no_mem;
     #ifdef STACK_DOWN
      STACK_bound = (gcv_object_t*)low + 0x40; # 64 pointers additionally safety margin
      setSTACK(STACK = (gcv_object_t*)high); # initialize STACK
     #endif
     #ifdef STACK_UP
      setSTACK(STACK = (gcv_object_t*)low); # initialize STACK
      STACK_bound = (gcv_object_t*)high - 0x40; # 64 pointers additionally safety margin
      #endif
    }
    #undef teile_STACK
    #define teile_STACK 0  # need no more room for the STACK
    #if (teile==0)
     #undef teile
     #define teile 1  # avoid division by 0
    #endif
   #endif # SINGLEMAP_MEMORY_STACK
   #endif # SINGLEMAP_MEMORY || TRIVIALMAP_MEMORY
   #if defined(SELFMADE_MMAP) || defined(GENERATIONAL_GC)
    init_physpagesize();
   #endif
    { # divide memory block:
      var uintL free_reserved; # number of reserved bytes
     #ifndef NO_SP_MALLOC
      var void* initial_SP; # initial value for SP-stackpointer
      var uintL for_SP = 0; # number of bytes for SP-stack
      #define min_for_SP  40000 # minimal SP-stack-size
     #endif
      var uintL for_STACK; # number of bytes for Lisp-stack
      var uintL for_objects; # number of bytes for Lisp-objects
      # the STACK needs alignment, because for frame-pointers
      # the last Bit must be =0:
      #define STACK_alignment  bit(addr_shift+1)
      #define alignment  (varobject_alignment>STACK_alignment ? varobject_alignment : STACK_alignment)
      free_reserved = memneed;
      #ifndef NO_SP_MALLOC
      if (argv_stackneed != 0 && 2*argv_stackneed <= free_reserved) {
        # do not reserve to much for the SP-stack
        for_SP = round_down(argv_stackneed,varobject_alignment);
        free_reserved -= argv_stackneed;
      }
      #endif
      # make divisible by teile*alignment, so that each 1/16 is aligned:
      free_reserved = round_down(free_reserved,teile*alignment);
      free_reserved = free_reserved - RESERVE;
      {
        var uintL teil = free_reserved/teile; # a sub block, a 1/16 of the room
        var aint ptr = memblock;
        mem.MEMBOT = ptr;
        #ifdef NO_SP_MALLOC
          #ifdef UNIX_NEXTSTEP
            # Set the stack size limit to 8 MB if possible to prevent
            # crashes from machine stack overflow.
            # (If the stack is large enough, the Lisp STACK will overflow
            # first, and the error will be handled in a reasonable way.)
            { var struct rlimit rl;
              var long need = 0x800000; # 8 Megabyte
              getrlimit(RLIMIT_STACK,&rl);
              if (rl.rlim_max < need) { need = rl.rlim_max; }
              if (rl.rlim_cur < need)
                { rl.rlim_cur = need; setrlimit(RLIMIT_STACK,&rl); }
            }
          #endif
          #if defined(WIN32_NATIVE) && !defined(NO_SP_CHECK)
            # Even if the NOCOST_SP_CHECK stack overflow detection (using a
            # guard page) works, we set SP_bound.
            # Normally, the stack's `AllocationBase' is = 0x30000, the guard
            # page is 0x32000-0x32FFF, hence we can set SP_bound = 0x34000.
            { var MEMORY_BASIC_INFORMATION info;
              if (!(VirtualQuery((void*)SP(),&info,sizeof(info)) == sizeof(info))) {
                fprintf(stderr,GETTEXTL("Could not determine the end of the SP stack!\n"));
                SP_bound = 0;
              } else { # 0x4000 might be enough, but 0x8000 will be better.
                SP_bound = (void*)((aint)info.AllocationBase + 0x8000);
              }
            }
          #endif
        #else
          # allocate SP:
          if (for_SP==0) { # 2/16 for program stack
            for_SP = teile_SP*teil;
          } else { # room for SP is already removed.
            # teile := teile-teile_SP; # is not possible anymore, instead:
            teil = round_down(free_reserved/(teile-teile_SP),alignment);
          }
          if (for_SP < min_for_SP) { for_SP = round_up(min_for_SP,alignment); } # but not too little
          #ifdef SP_DOWN
            SP_bound = (void*)(ptr + 0x800); # 512 pointer safety margin
            ptr += for_SP;
            initial_SP = (void*)ptr;
          #endif
          #ifdef SP_UP
            initial_SP = (void*)ptr;
            ptr += for_SP;
            SP_bound = (void*)(ptr - 0x800); # 512 pointer safety margin
          #endif
        #endif
        # allocate STACK:
        #ifdef SINGLEMAP_MEMORY_STACK
        for_STACK = 0; # STACK is already allocated elsewhere.
        #else
        #ifdef STACK_DOWN
          STACK_bound = (gcv_object_t*)ptr + 0x40; # 64 pointer safety margin
          ptr += for_STACK = teile_STACK*teil; # 2/16 for Lisp-stack
          setSTACK(STACK = (gcv_object_t*)ptr); # initialize STACK
        #endif
        #ifdef STACK_UP
          setSTACK(STACK = (gcv_object_t*)ptr); # initialize STACK
          ptr += for_STACK = teile_STACK*teil; # 2/16 for Lisp-stack
          STACK_bound = (gcv_object_t*)ptr - 0x40; # 64 pointer safety margin
        #endif
        #endif
        #if defined(SPVW_MIXED_BLOCKS_OPPOSITE) && !defined(TRIVIALMAP_MEMORY)
        # now, the lisp-objects start:
        #ifdef GENERATIONAL_GC
        mem.varobjects.heap_gen0_start = mem.varobjects.heap_gen0_end =
          mem.varobjects.heap_gen1_start = mem.varobjects.heap_start =
          (ptr + (physpagesize-1)) & -physpagesize;
        #else
        mem.varobjects.heap_start = ptr;
        #endif
        mem.varobjects.heap_end = mem.varobjects.heap_start; # there are no objects of variable length, yet
        # rest (14/16 or a little less) for lisp-objects:
        for_objects = memblock+free_reserved - ptr; # about = teile_objects*teil
        ptr += for_objects;
        #ifdef GENERATIONAL_GC
        mem.conses.heap_gen0_start = mem.conses.heap_gen0_end =
          mem.conses.heap_gen1_end = mem.conses.heap_end =
          ptr & -physpagesize;
        #else
        mem.conses.heap_end = ptr;
        #endif
        mem.conses.heap_start = mem.conses.heap_end; # there are no conses yet
        # ptr = memblock+free_reserved, because 2/16 + 14/16 = 1
        # allocate memory reserve:
        ptr += RESERVE;
        # upper memory limit reached.
        mem.MEMTOP = ptr;
        # above (far away) the machine stack.
        #endif
        #if defined(SPVW_PURE_BLOCKS) || defined(TRIVIALMAP_MEMORY) || defined(GENERATIONAL_GC)
        mem.total_room = 0;
        #ifdef GENERATIONAL_GC
        mem.last_gcend_space0 = 0;
        mem.last_gcend_space1 = 0;
        #endif
        #endif
        #ifdef SPVW_PAGES
        for_each_heap(heap, { heap->inuse = EMPTY; } );
        for_each_cons_heap(heap, { heap->lastused = dummy_lastused; } );
        dummy_lastused->page_room = 0;
        mem.free_pages = NULL;
        mem.total_space = 0;
        mem.used_space = 0;
        mem.last_gcend_space = 0;
        mem.gctrigger_space = 0;
        #endif
        # initialize stacks:
        #ifndef NO_SP_MALLOC
          #ifdef GNU
            # a little dummy-action, that prevents a delayed clean up of SP
            # at a later date:
            if (mem.MEMBOT) { printf(""); }
          #endif
          setSP(initial_SP); # set SP! All local variables get lost!
        #endif
        #ifdef NOCOST_SP_CHECK
          install_stackoverflow_handler(0x4000); # 16 KB reserve should be enough
        #endif
        pushSTACK(nullobj); pushSTACK(nullobj); # two nullpointer as STACK end marker
      }
    }
  }
 #ifdef DEBUG_SPVW
  { /* STACK & SP are settled - check that we have enough STACK */
    var uintL stack_depth =
      STACK_item_count((gcv_object_t*)STACK_bound,STACK)/sizeof(*STACK);
    fprintf(stderr,"STACK depth: %d\n",stack_depth);
   #ifndef NO_SP_CHECK
    fprintf(stderr,"SP depth: %d\n",
            STACK_item_count((SPint*)SP_bound,(SPint*)SP())/sizeof(SPint));
   #endif
    if (stack_depth < ca_limit_1) {
      fprintf(stderr,"STACK depth is less than CALL-ARGUMENTS-LIMIT (%d)\n",
              ca_limit_1);
      abort();
    }
  }
 #endif
  init_subr_tab_1(); # initialize subr_tab
  if (argv_memfile==NULL) # manual initialization:
    initmem();
  else # load memory file:
    loadmem(argv_memfile);
  # init O(current_language)
  O(current_language) = current_language_o(language);
  # set current evaluator-environments to the toplevel-value:
  aktenv.var_env   = NIL;
  aktenv.fun_env   = NIL;
  aktenv.block_env = NIL;
  aktenv.go_env    = NIL;
  aktenv.decl_env  = O(top_decl_env);
  { /* init ARGV */
    uintL count;
    O(argv) = allocate_vector(argc);
    for (count=0; count<argc; count++)
      TheSvector(O(argv))->data[count] =
        asciz_to_string(argv[count],O(misc_encoding));
  }
  # everything completely initialized.
 {var struct backtrace_t bt;
  bt.bt_next = NULL;
  bt.bt_caller = L(driver);
  bt.bt_stack = STACK;
  bt.bt_num_arg = -1;
  back_trace = &bt;
  clear_break_sems(); set_break_sem_1();
  begin_system_call();
  # establish interrupt-handler:
 #if defined(HAVE_SIGNALS) && defined(SIGWINCH) && !defined(NO_ASYNC_INTERRUPTS)
  install_sigwinch_handler();
 #endif
  # query the size of the terminal-window also now on program start:
 #if defined(HAVE_SIGNALS)
  update_linelength();
 #endif
 #if defined(WIN32_NATIVE)
 # cannot do it in init_win32 - too early
 if (isatty(stdout_handle)) {
   var HANDLE handle = GetStdHandle(STD_OUTPUT_HANDLE);
   if (handle!=INVALID_HANDLE_VALUE) {
     var CONSOLE_SCREEN_BUFFER_INFO info;
     if (GetConsoleScreenBufferInfo(handle,&info))
       Symbol_value(S(prin_linelength)) = fixnum(info.dwSize.X - 1);
   }
 }
 #endif
 #if (defined(HAVE_SIGNALS) && defined(UNIX)) || defined(WIN32_NATIVE)
  # install Ctrl-C-Handler:
  install_sigint_handler();
 #endif
 #if defined(SELFMADE_MMAP) || defined(GENERATIONAL_GC)
  # insatll Page-Fault-Handler:
  install_segv_handler();
 #endif
 #ifdef HAVE_SIGNALS
  install_sigcld_handler();
 #endif
 #if defined(HAVE_SIGNALS) && defined(SIGPIPE)
  install_sigpipe_handler();
 #endif
  # initialize time variables:
  init_time();
  # Initialize locale dependent encodings:
  init_dependent_encodings();
  # initialize stream-variables:
  init_streamvars(argv_execute_file && !argv_repl);
 #ifdef NEXTAPP
  # make nxterminal-stream functional:
  if (nxterminal_init()) { final_exitcode = 17; quit(); }
 #endif
  # make break possible:
  end_system_call();
  clr_break_sem_1();
  # initialize pathnames:
  init_pathnames();
 #ifdef DYNAMIC_FFI
  # initialize FFI:
  init_ffi();
 #endif
  init_other_modules_2(); # initialize modules yet uninitialized
  { # final module initializations:
    var module_t* module; # loop over modules
    for_modules(all_other_modules,{
      if (module->initfunction2)
        # call initialization function:
        (*module->initfunction2)(module);
    });
  }
  { # other initializations:
    pushSTACK(Symbol_value(S(init_hooks))); # SYS::*INIT-HOOKS*
    while (mconsp(STACK_0)) { # process
      var object obj = STACK_0;
      STACK_0 = Cdr(obj); funcall(Car(obj),0);
    }
    skipSTACK(1);
  }
  /* print greeting: */
  if (!nullpSv(quiet))           /* SYS::*QUIET* /= NIL ? */
    { argv_verbose = 1; }        /* prevents the greeting */
  if (argv_execute_file != NULL) /* batch-mode ? */
    { argv_verbose = 1; }        /* prevents the greeting */
  if (argv_verbose>=2 || argv_license) print_banner();
  if (argv_license) print_license();
  if (argv_execute_arg_count > 0) {
    var uintL count = argv_execute_arg_count;
    do { pushSTACK(asciz_to_string(*argv_execute_args++,O(misc_encoding))); }
    while (--count);
    Symbol_value(S(args)) = listof(argv_execute_arg_count);
  }
  if ((argv_memfile == NULL) && (argv_expr_count == 0)) {
    # warning for beginners
    pushSTACK(var_stream(S(standard_output),strmflags_wr_ch_B)); # auf *STANDARD-OUTPUT*
    write_sstring(&STACK_0,CLSTEXT("\nWARNING: No initialization file specified.\n"));
    write_sstring(&STACK_0,CLSTEXT("Please try: "));
    write_string(&STACK_0,asciz_to_string(program_name,O(pathname_encoding)));
    write_string(&STACK_0,ascii_to_string(" -M lispinit.mem\n"));
    skipSTACK(1);
  }
  if (argv_lisplibdir == NULL) {
    if (nullp(O(lib_dir))) {
      # warning for beginners and careless developers
      pushSTACK(var_stream(S(standard_output),strmflags_wr_ch_B)); # on *STANDARD-OUTPUT*
      write_sstring(&STACK_0,CLSTEXT("\nWARNING: No installation directory specified.\n"));
      write_sstring(&STACK_0,CLSTEXT("Please try: "));
      write_string(&STACK_0,asciz_to_string(program_name,O(pathname_encoding)));
      write_string(&STACK_0,ascii_to_string(" -B /usr/local/lib/clisp\n"));
      skipSTACK(1);
    }
  } else { # set it
    pushSTACK(asciz_to_string(argv_lisplibdir,O(pathname_encoding)));
    funcall(L(set_lib_directory),1);
  }
  if ((argv_compile || argv_expr_count || argv_execute_file != NULL)
      && !argv_interactive_debug && !argv_repl) {
    # '-c' or '-x' or file specified -> LISP runs in batch-mode:
    # (setq *debug-io*
    #   (make-two-way-stream (make-string-input-stream "") *query-io*)
    # )
    funcall(L(make_concatenated_stream),0); # (MAKE-CONCATENATED-STREAM)
    pushSTACK(value1); # empty input-stream
    var object stream = var_stream(S(query_io),strmflags_wr_ch_B);
    Symbol_value(S(debug_io)) = make_twoway_stream(popSTACK(),stream);
  }
  switch (argv_ansi) {
    case 1: # Maximum ANSI CL compliance
      pushSTACK(T); funcall(L(set_ansi),1); break;
    case 2: # The traditional CLISP behavior
      pushSTACK(NIL); funcall(L(set_ansi),1); break;
    default: # use the settings from the memory image
      break;
  }
  if (argv_load_compiling) # (SETQ *LOAD-COMPILING* T) :
    { Symbol_value(S(load_compiling)) = T; }
  if (argv_verbose < 1) /* (setq *load-verbose* nil *compile-verbose* nil) */
    Symbol_value(S(load_verbose)) = Symbol_value(S(compile_verbose)) = NIL;
  if (argv_verbose > 2) /* (setq *load-print* t *compile-print* t) */
    Symbol_value(S(load_print)) = Symbol_value(S(compile_print)) = T;
  if (argv_developer) { /* developer mode */
    /* unlock all packages */
    var object packlist = O(all_packages);
    while (consp(packlist)) {
      mark_pack_unlocked(Car(packlist));
      packlist = Cdr(packlist);
    }
  }
  # load RC file ~/.clisprc
  if (!argv_norc) {
    # (LOAD (MAKE-PATHNAME :NAME ".clisprc"
    #                      :DEFAULTS (USER-HOMEDIR-PATHNAME))
    #       :IF-DOES-NOT-EXIST NIL
    # )
    pushSTACK(S(Kname));
   #ifdef PATHNAME_UNIX
    pushSTACK(ascii_to_string(".clisprc"));
   #endif
   #ifdef PATHNAME_WIN32
    pushSTACK(ascii_to_string("_clisprc"));
   #endif
    pushSTACK(S(Kdefaults));
    funcall(S(user_homedir_pathname),0);
    pushSTACK(value1);
    funcall(L(make_pathname),4);
    pushSTACK(value1);
    pushSTACK(S(Kif_does_not_exist));
    pushSTACK(S(nil));
    funcall(S(load),3);
  }
  # execute (LOAD initfile) for each initfile:
  if (argv_init_filecount > 0) {
    var char** fileptr = &argv_selection_array[0];
    var uintL count = argv_init_filecount;
    if (interactive_stream_p(Symbol_value(S(debug_io))))
      do { pushSTACK(asciz_to_string(*fileptr++,O(misc_encoding)));
        funcall(S(load),1);
      } while (--count);
    else { /* non-interactive - guard with SYS::BATCHMODE-ERRORS */
      pushSTACK(S(batchmode_errors));
      do { pushSTACK(S(load));
        pushSTACK(asciz_to_string(*fileptr++,O(misc_encoding)));
        { object tmp = listof(2); pushSTACK(tmp); }
      } while (--count);
      eval_noenv(listof(argv_init_filecount+1));
    }
  }
  if (argv_compile) {
    # execute
    #   (EXIT-ON-ERROR
    #     (APPEASE-CERRORS
    #       (COMPILE-FILE (setq file (MERGE-PATHNAMES file (MERGE-PATHNAMES '#".lisp" (CD))))
    #                     [:OUTPUT-FILE (setq output-file (MERGE-PATHNAMES (MERGE-PATHNAMES output-file (MERGE-PATHNAMES '#".fas" (CD))) file))]
    #                     [:LISTING (MERGE-PATHNAMES '#".lis" (or output-file file))]
    #   ) ) )
    # for each file:
    if (argv_compile_filecount > 0) {
      var argv_compile_file_t* fileptr = &argv_compile_files[0];
      var uintL count;
      dotimespL(count,argv_compile_filecount,{
        var uintC argcount = 1;
        var object filename = asciz_to_string(fileptr->input_file,O(misc_encoding));
        pushSTACK(S(compile_file));
        pushSTACK(filename);
        pushSTACK(O(source_file_type)); # #".lisp"
        funcall(L(cd),0); pushSTACK(value1); # (CD)
        funcall(L(merge_pathnames),2); # (MERGE-PATHNAMES '#".lisp" (CD))
        pushSTACK(value1);
        funcall(L(merge_pathnames),2); # (MERGE-PATHNAMES file ...)
        pushSTACK(value1);
        if (fileptr->output_file) {
          filename = asciz_to_string(fileptr->output_file,O(misc_encoding));
          pushSTACK(S(Koutput_file));
          pushSTACK(filename);
          pushSTACK(O(compiled_file_type)); # #".fas"
          funcall(L(cd),0); pushSTACK(value1); # (CD)
          funcall(L(merge_pathnames),2); # (MERGE-PATHNAMES '#".fas" (CD))
          pushSTACK(value1);
          funcall(L(merge_pathnames),2); # (MERGE-PATHNAMES output-file ...)
          pushSTACK(value1);
          pushSTACK(STACK_2); # file
          funcall(L(merge_pathnames),2); # (MERGE-PATHNAMES ... file)
          pushSTACK(value1);
          argcount += 2;
        }
        if (argv_compile_listing) {
          pushSTACK(S(Klisting));
          pushSTACK(O(listing_file_type)); # #".lis"
          pushSTACK(STACK_2); # (or output-file file)
          funcall(L(merge_pathnames),2); # (MERGE-PATHNAMES '#".lis" ...)
          pushSTACK(value1);
          argcount += 2;
        }
        # quote all arguments:
        if (argcount > 0) {
          var gcv_object_t* ptr = args_end_pointer;
          var uintC c;
          dotimespC(c,argcount,{
            pushSTACK(S(quote)); pushSTACK(Before(ptr));
            BEFORE(ptr) = listof(2);
          });
        }
        var object form = listof(1+argcount); # `(COMPILE-FILE ',...)
        if (!argv_repl) form = appease_form(argv_interactive_debug,form);
        eval_noenv(form); # execute
        fileptr++;
      });
    }
    if (!argv_repl) quit();
  }
  if (argv_package != NULL) { # (IN-PACKAGE packagename)
    var object packname = asciz_to_string(argv_package,O(misc_encoding));
    var object package = find_package(packname);
    if (!nullp(package)) {
      Symbol_value(S(packagestern)) = package;
    } else {
      pushSTACK(var_stream(S(standard_output),strmflags_wr_ch_B));
      write_sstring(&STACK_0,CLSTEXT("\nWARNING: no such package: "));
      write_sstring(&STACK_0,packname);
      terpri(&STACK_0);
      skipSTACK(1);
    }
  }
  if (argv_execute_file != NULL) {
    #  execute:
    # (PROGN
    #   #+UNIX (SET-DISPATCH-MACRO-CHARACTER #\# #\!
    #           (FUNCTION SYS::UNIX-EXECUTABLE-READER))
    #   (SETQ *LOAD-VERBOSE* NIL)
    #   (EXIT-ON-ERROR
    #    (APPEASE-CERRORS
    #     (LOAD argv_execute_file :EXTRA-FILE-TYPES ...)))
    #   (UNLESS argv_repl (EXIT)))
   #if defined(UNIX) || defined(WIN32_NATIVE)
    # Make clisp ignore the leading #! line.
    pushSTACK(ascii_char('#')); pushSTACK(ascii_char('!'));
    pushSTACK(L(unix_executable_reader));
    funcall(L(set_dispatch_macro_character),3);
   #endif
    Symbol_value(S(load_verbose)) = NIL;
    var object form;
    pushSTACK(S(load));
    if (asciz_equal(argv_execute_file,"-")) {
      pushSTACK(S(standard_input)); # *STANDARD-INPUT*
    } else {
      pushSTACK(asciz_to_string(argv_execute_file,O(misc_encoding)));
    }
    pushSTACK(S(Kextra_file_types));
   #ifdef WIN32_NATIVE
    pushSTACK(S(quote));
    pushSTACK(O(load_extra_file_types));
    form = listof(2); # (QUOTE (".BAT"))
    pushSTACK(form);
   #else
    pushSTACK(NIL);
   #endif
    form = listof(4);
    if (!argv_repl) form = appease_form(argv_interactive_debug,form);
    eval_noenv(form); # execute
    if (!argv_repl) quit();
  }
  if (argv_expr_count) {
    # set *STANDARD-INPUT* to a stream, that produces argv_exprs:
    var char** exprs = &argv_selection_array[argc-1];
    if (argv_expr_count > 1) {
      var uintL count = argv_expr_count;
      do { pushSTACK(asciz_to_string(*exprs--,O(misc_encoding))); }
      while (--count);
      var object total = string_concat(argv_expr_count);
      pushSTACK(total);
    } else pushSTACK(asciz_to_string(*exprs--,O(misc_encoding)));
    funcall(L(make_string_input_stream),1);
    # During bootstrapping, *DRIVER* has no value and SYS::BATCHMODE-ERRORS
    # is undefined. Do not set an error handler in that case.
    if (!nullpSv(driverstern)) {
      dynamic_bind(S(standard_input),value1);
      # (PROGN
      #   (EXIT-ON-ERROR (APPEASE-CERRORS (FUNCALL *DRIVER*)))
      #   ; Normally this will exit by itself once the string has reached EOF,
      #   ; but to be sure:
      #   (UNLESS argv_repl (EXIT)))
      var object form;
      pushSTACK(S(funcall)); pushSTACK(S(driverstern)); form = listof(2);
      if (!argv_repl) form = appease_form(argv_interactive_debug,form);
      eval_noenv(form);
      if (!argv_repl) quit();
      else dynamic_unbind(S(standard_input));
    } else /* no *DRIVER* => bootstrap, no -repl */
      Symbol_value(S(standard_input)) = value1;
  }
  # call read-eval-print-loop:
  driver();
  quit();
  /*NOTREACHED*/
 } # end var bt
  # if the memory does not suffice:
  no_mem:
  fprintf(stderr,GETTEXTL("%s: Not enough memory for Lisp.\n"),program_name);
  quit_sofort(1);
  /*NOTREACHED*/
  # termination of program via quit_sofort() (engl. quit_instantly() ):
  end_of_main:
 #ifdef MULTIMAP_MEMORY
  exitmap();
 #endif
  FREE_DYNAMIC_ARRAY(argv_compile_files_array);
  FREE_DYNAMIC_ARRAY(argv_selection_array); }
 #ifdef WIN32_NATIVE
  done_win32();
 #endif
 #if defined(UNIX) && !defined(NEXTAPP)
  terminal_sane(); # switch terminal again in normal mode
 #endif
 #ifdef UNIX
  exit(exitcode); # Calling exit(), not _exit(), allows profiling to work.
 #endif
 #ifdef WIN32_NATIVE
  _exit(exitcode);
 #endif
  # if that did not help:
  return exitcode;
}

# leave LISP-interpreter
# quit();
# > final_exitcode: 0 on normal exit, 1 on abort
global int final_exitcode = 0;
local int quit_retry = 0;
nonreturning_function(global, quit, (void)) {
  # first "unwind" the STACK downto STACK-end:
  VALUES0; /* do not save values for UNWIND-PROTECT-frames */
  unwind_protect_to_save.fun = (restartf_t)&quit;
  while (!(eq(STACK_0,nullobj) && eq(STACK_1,nullobj)))
    if (framecode(STACK_0) & bit(frame_bit_t))
      # At STACK_0 a frame starts
      { unwind(); } # unwind frame
    else
      # STACK_0 contains a normal LISP-object
      { skipSTACK(1); }
  # Then, a farewell message:
  if (quit_retry==0) {
    quit_retry++; # If this fails, do not retry it. For robustness.
    funcall(L(fresh_line),0); # (FRESH-LINE [*standard-output*])
    if (argv_verbose >= 2) {
      pushSTACK(CLSTEXT("Bye.")); funcall(L(write_line),1);
    }
    pushSTACK(var_stream(S(error_output),strmflags_wr_ch_B)); # Stream *ERROR-OUTPUT*
    funcall(L(fresh_line),1); # (FRESH-LINE *error-output*)
  }
  # Then wait for a keypress:
  if (argv_wait_keypress) {
    argv_wait_keypress = false; # If this fails, do not retry it (robustness)
    pushSTACK(CLSTEXT("Press a key to terminate..."));
    funcall(L(write_line),1);
    funcall(S(wait_keypress),0); # (SYS::WAIT-KEYPRESS)
  }
  close_all_files(); # close all files
 #ifdef DYNAMIC_FFI
  exit_ffi(); # close FFI
 #endif
 #ifdef WIN32_NATIVE
  done_win32();
 #endif
 #ifdef NEXTAPP
  nxterminal_exit(); # cloase terminal-stream-communication
 #endif
  quit_sofort(final_exitcode); # leave program
}

# -----------------------------------------------------------------------------
#                  Saving and Loading of MEM-Files

#include "spvw_memfile.c"

# -----------------------------------------------------------------------------
#                       Dynamic Loading of Modules

#ifdef DYNAMIC_MODULES

# Attaches a shared library to this process' memory, and attempts to load
# a number of clisp modules from it.
nonreturning_function(local, fehler_dlerror,
                      (const char* func, const char* symbol,
                       const char* errstring)) {
  end_system_call();
  if (errstring == NULL) { errstring = "Unknown error"; }
  pushSTACK(asciz_to_string(errstring,O(misc_encoding)));
  if (symbol != NULL)
    { pushSTACK(asciz_to_string(symbol,O(internal_encoding))); }
  pushSTACK(asciz_to_string(func,O(internal_encoding)));
  pushSTACK(TheSubr(subr_self)->name);
  fehler(error, (symbol == NULL ? "~: ~ -> ~" : "~: ~(~) -> ~"));
}
global void dynload_modules (const char * library, uintC modcount,
                             const char * const * modnames) {
  var void* libhandle;
  begin_system_call();
  # Open the library.
  libhandle = dlopen(library,RTLD_NOW);
  if (libhandle == NULL) fehler_dlerror("dlopen",NULL,dlerror());
  end_system_call();
  if (modcount > 0) {
    # What's the longest module name? What's their total size?
    var uintL max_modname_length = 0;
    var uintL total_modname_length = 0;
    begin_system_call();
    {
      var const char * const * modnameptr = modnames;
      var uintC count;
      dotimespC(count,modcount,{
        var uintL len = asciz_length(*modnameptr);
        if (len > max_modname_length) { max_modname_length = len; }
        total_modname_length += len+1;
        modnameptr++;
      });
    }
    { # Make room for the module descriptors.
      var module_t* modules = (module_t*) malloc(modcount*sizeof(module_t)+total_modname_length);
      if (modules==NULL) fehler_dlerror("malloc",NULL,"out of memory");
      {
        var char* modnamebuf = (char*)(&modules[modcount]);
        var DYNAMIC_ARRAY(symbolbuf,char,8+max_modname_length+21+1);
        var const char * const * modnameptr = modnames;
        var module_t* module = modules;
        var uintC count;
        dotimespC(count,modcount,{
          var const char * modname = *modnameptr;
          var uintL len = asciz_length(modname);
          var const char * err;
          # Copy modname into modnamebuf:
          module->name = modnamebuf;
          {
            var const char * ptr = modname;
            until ((*modnamebuf++ = *ptr++) == '\0') {}
          }
          { # Find the addresses of some C data in the shared library:
            sprintf(symbolbuf,"module__%s__subr_tab",modname);
            module->stab = (subr_t*) dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          {
            sprintf(symbolbuf,"module__%s__subr_tab_size",modname);
            module->stab_size = (const uintC*) dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          {
            sprintf(symbolbuf,"module__%s__object_tab",modname);
            module->otab = (gcv_object_t*) dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          {
            sprintf(symbolbuf,"module__%s__object_tab_size",modname);
            module->otab_size = (const uintC*) dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          module->initialized = false;
          {
            sprintf(symbolbuf,"module__%s__subr_tab_initdata",modname);
            module->stab_initdata = (const subr_initdata_t*)
              dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          {
            sprintf(symbolbuf,"module__%s__object_tab_initdata",modname);
            module->otab_initdata = (const object_initdata_t*)
              dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          { # Find the addresses of some C functions in the shared library:
            sprintf(symbolbuf,"module__%s__init_function_1",modname);
            module->initfunction1 = (void (*) (module_t*))
              dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          {
            sprintf(symbolbuf,"module__%s__init_function_2",modname);
            module->initfunction2 = (void (*) (module_t*))
              dlsym(libhandle,symbolbuf);
            err = dlerror();
            if (err) fehler_dlerror("dlsym",symbolbuf,err);
          }
          module->next = NULL;
          modnameptr++; module++;
        });
        FREE_DYNAMIC_ARRAY(symbolbuf);
      }
      end_system_call();
      { # We found all the necessary symbols. Now register the modules.
        var module_t* module = modules;
        var uintC mcount = modcount;
        while (mcount-- > 0) {
          add_module(module);
          # pre-initialization, cf. init_subr_tab_1.
          if (*module->stab_size > 0) module_set_argtypes(module);
         #if (defined(MULTIMAP_MEMORY) || defined(SINGLEMAP_MEMORY)) && defined(MAP_MEMORY_TABLES)
          {
            var subr_t* newptr = (subr_t*)&subr_tab + total_subr_anz;
            var uintC count = *module->stab_size;
            if (count > 0) {
              {
                var uintL old_map_len = round_up(total_subr_anz*sizeof(subr_t),map_pagesize);
                var uintL new_map_len = round_up((total_subr_anz+count)*sizeof(subr_t),map_pagesize);
                if (old_map_len < new_map_len) {
                  if (zeromap((void*)((aint)&subr_tab+old_map_len),new_map_len-old_map_len) <0)
                    fehler_dlerror("zeromap",NULL,"out of memory for subr_tab");
                }
              }
              {
                var subr_t* oldptr = module->stab;
                module->stab = newptr;
                dotimespC(count,count, {
                  *newptr = *oldptr++;
                  newptr->name = NIL; newptr->keywords = NIL; # GC stays possible with it
                  newptr++;
                });
              }
              total_subr_anz += *module->stab_size;
            }
          }
         #elif defined(MULTIMAP_MEMORY)
          if (*module->stab_size > 0) {
            # multimap the subr_tab of the loaded module .
            # the pages to be mapped belong to the data segment of the
            # newly loaded Shared-Library, so are surely not yet
            # multi-mapped.
            var aint subr_tab_start = round_down((aint)module->stab,pagesize);
            var aint subr_tab_end = round_up((aint)module->stab+(*module->stab_size)*sizeof(subr_t),pagesize);
            multimap(case_machine: case_subr: , subr_tab_start, subr_tab_end-subr_tab_start, true);
            if (false)
              no_mem:
            fehler_dlerror("multimap",NULL,"out of memory for subr_tab");
          }
         #endif
          # main initialization.
          init_module_2(module);
          module++;
        }
      }
      { # Now start the modules' life.
        var module_t* module = modules;
        var uintC count;
        dotimespC(count,modcount,{
          if (module->initfunction2)
            # call initialization function:
            (*module->initfunction2)(module);
          module++;
        });
      }
    }
  }
}

#endif

# -----------------------------------------------------------------------------

