home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / D / CLISP / CLISPSRC.TAR / clisp-1995-01-01 / src / lispbibl.d < prev    next >
Encoding:
Text File  |  1994-12-30  |  397.0 KB  |  10,115 lines
  1. # Haupt-Include-File fⁿr CLISP
  2. # Bruno Haible 30.12.1994
  3. # Marcus Daniels 11.11.1994
  4.  
  5.  
  6. # Implementation ist auf folgende Rechner, Betriebssysteme und C-Compiler
  7. # vorbereitet:
  8. # Maschine     Hersteller         Betriebssystem                C-Compiler    erkennbar an
  9. # ATARI ST     Atari              GEMDOS                        TURBO         __TOS__, __TURBOC__
  10. # ATARI ST     Atari              GEMDOS                        GNU           __GNUC__, evtl. __ATARIST__ und __GEM__
  11. # ATARI TT     Atari              GEMDOS                        TURBO         __TOS__, __TURBOC__, ??
  12. # ATARI TT     Atari              GEMDOS                        GNU           __GNUC__, ??
  13. # AMIGA        Commodore          AMIGA-OS (AMIGADOS)           GNU           amiga oder AMIGA, __GNUC__, evtl. MC68000 oder AMIGA3000
  14. # beliebig     beliebig           UNIX                          GNU           unix, __GNUC__, ...
  15. # beliebig     beliebig           UNIX                          CC            unix, ...
  16. # Amiga 3000   Commodore          Amiga UNIX 2.1 SVR4.0         GNU           unix, __unix__, AMIX, __AMIX__, __svr4__, m68k, __m68k__, __motorola__, __GNUC__
  17. # SUN-3        Sun                SUN-OS3 (UNIX BSD 4.2)        GNU           sun, unix, mc68020, __GNUC__
  18. # SUN-3        Sun                SUN-OS4 (UNIX SUNOS 4.1)      GNU           sun, unix, mc68020, __GNUC__
  19. # SUN-386      Sun                SUN-OS4 (UNIX SUNOS 4.0)      GNU           sun, unix, sun386, i386, __GNUC__
  20. # SUN-386      Sun                SUN-OS4 (UNIX SUNOS 4.0)      CC            sun, unix, sun386, i386
  21. # SUN-4        Sun                SUN-OS4 (UNIX SUNOS 4.1)      GNU           sun, unix, sparc, __GNUC__
  22. # SUN-4        Sun                SUN-OS4 (UNIX SUNOS 4.1)      CC            sun, unix, sparc
  23. # SUN-4        Sun                SUN-OS5 (UNIX Solaris)        GCC           sun, unix, sparc, __GNUC__
  24. # HP9000-300   Hewlett-Packard    NetBSD 0.9 (UNIX BSD 4.3)     GNU           unix, __NetBSD__, mc68000, __GNUC__
  25. # HP9000-300   Hewlett-Packard    HP-UX 8.0 (UNIX SYS V)        GNU           [__]hpux, [__]unix, [__]hp9000s300, mc68000, __GNUC__
  26. # HP9000-800   Hewlett-Packard    HP-UX 8.0 (UNIX SYS V)        GNU           [__]hpux, [__]unix, [__]hp9000s800
  27. # IRIS         Silicon Graphics   IRIX (UNIX SYS V 3.2)         GNU           unix, SVR3, mips, sgi, __GNUC__
  28. # IRIS         Silicon Graphics   IRIX (UNIX SYS V)             cc -ansi      [__]unix, [__]SVR3, [__]mips, [__]sgi
  29. # IRIS         Silicon Graphics   IRIX 5 (UNIX SYS V 4)         GNU           [__]unix, [__]SYSTYPE_SVR4, [__]mips, [__]host_mips, [__]MIPSEB, [__]sgi, __DSO__, [__]_MODERN_C, __GNUC__
  30. # DECstation 5000                 RISC/OS (Ultrix V4.2A)        GNU           unix, [__]mips, [__]ultrix
  31. # DG-UX 88k    Data General       DG/UX                         GNU           unix, m88000, DGUX
  32. # DEC Alpha    DEC                OSF/1 1.3                     cc            [unix,] __unix__, __osf__, __alpha
  33. # DEC Alpha    DEC                OSF/1 1.3                     GNU           unix, __unix__, __osf__, __alpha, __alpha__, _LONGLONG
  34. # Apple MacII  Apple              A/UX (UNIX SYS V 2)           GNU           [__]unix, [__]AUX, [__]macII, [__]m68k, mc68020, mc68881, __GNUC__
  35. # NeXT         NeXT               NeXTstep 3.1 (UNIX)           cc            NeXT, m68k
  36. # Sequent      Sequent            PTX 3.2.0 V2.1.0 i386 (SYS V) GNU           unix, i386, _SEQUENT_, __GNUC__
  37. # Convex C2    Convex             ConvexOS 10.1                 GNU           __convex__, __GNUC__
  38. # IBM RS/6000  IBM                AIX 3.2                       GNU           _AIX, _AIX32, _IBMR2, __CHAR_UNSIGNED__, __GNUC__
  39. # IBM-PC/386   beliebig           LINUX (freies UNIX)           GNU           unix, linux, i386, __GNUC__
  40. # IBM-PC/386   beliebig           386BSD 0.1 (UNIX BSD 4.2)     GNU           unix, __386BSD__, i386, __GNUC__
  41. # IBM-PC/386   beliebig           NetBSD 0.9 (UNIX BSD 4.3)     GNU           unix, __NetBSD__, i386, __GNUC__
  42. # IBM-PC/386   beliebig           COHERENT 386 4.0.1            cc, gcc-cccp  unix, COHERENT, _I386; unix mu▀ man selbst definieren!
  43. # IBM-PC/386   beliebig           COHERENT 386 4.0.1            GNU           unix, COHERENT, _I386, __GNUC__
  44. # IBM-PC/386   beliebig           DJUNIX (UNIXlike auf MSDOS)   GNU           unix, i386, [__MSDOS__,] __GNUC__, __GO32__; __GO32__ mu▀ man evtl. selbst definieren!
  45. # IBM-PC/386   beliebig           EMX (UNIXlike auf MSDOS)      GNU           [unix,] i386, __GNUC__, __EMX__
  46. # IBM-PC/386   beliebig           EMX (UNIXlike auf OS/2)       GNU           [unix,] i386, __GNUC__, __EMX__, OS2; OS2 mu▀ man selbst definieren!
  47. # IBM-PC/386   beliebig           MSDOS + MS Windows 3.1 + RSX  GNU           [unix,] i386, __GNUC__, __EMX__, WINDOWS; WINDOWS mu▀ man selbst definieren!
  48. # IBM-PC/386   beliebig           MSDOS                         WATCOM        MSDOS, __386__, M_I386, __WATCOMC__, __FLAT__
  49. # IBM-PC/386   beliebig           MSDOS + MS Windows 3.1        WATCOM        __WINDOWS_386__, __386__, M_I386, __WATCOMC__, __FLAT__
  50. # RM400        Siemens-Nixdorf    SINIX-N 5.42                  c89           unix, mips, MIPSEB, host_mips, sinix, SNI, _XPG_IV
  51. # Acorn        Risc PC            RISC OS 3.x                   GNU           [__]arm, [__]riscos, __GNUC__
  52. # Acorn        Risc PC            RISC OS 3.x                   Norcroft      [__]arm, [__]riscos
  53. # APPLE IIGS   Apple              ??                            ??
  54. # Fⁿr ANSI-C-Compiler: verwende PrΣprozessoren comment5, ansidecl.
  55. # Fⁿr traditionelle C-Compiler: verwende PrΣprozessoren comment5, traddecl
  56. #   und evtl. gcc-cpp, ccpaux, deelif, deerror und mergestrings.
  57.  
  58.  
  59. # diese Maschine: ATARI oder AMIGA oder DOSPC oder ACORN oder GENERIC_UNIX
  60. #if defined(__unix) && !defined(unix)
  61.   #define unix
  62. #endif
  63. #if (defined(amiga) || defined(AMIGA))
  64.   #undef AMIGA
  65.   #define AMIGA
  66. #endif
  67. #if (defined(arm) || defined(__arm)) && (defined(riscos) || defined(__riscos))
  68.   #define ACORN
  69. #endif
  70. #if (defined(__TOS__) || (defined(__GNUC__) && !defined(unix) && !defined(i386) && !defined(AMIGA) && !defined(ACORN)))
  71.   #define ATARI
  72. #endif
  73. #if (defined(i386) && defined(__EMX__)) || defined(__GO32__) || (defined(__386__) && defined(__WATCOMC__) && (defined(MSDOS) || defined(__WINDOWS_386__)))
  74.   #define DOSPC
  75. #endif
  76. #if !(defined(ATARI) || defined(AMIGA) || defined(DOSPC) || defined(ACORN))
  77.   #if defined(unix)
  78.     #define GENERIC_UNIX
  79.   #else
  80.     #error "Unknown machine type -- Maschine neu einstellen!"
  81.   #endif
  82. #endif
  83. # ZusΣtzliche Spezifikation der Maschine:
  84. #ifdef DOSPC
  85.   #define PC386 # IBMPC-Kompatibler mit 80386/80486-Prozessor
  86. #endif
  87. #ifdef GENERIC_UNIX
  88.   #if (defined(sun) && defined(unix) && defined(sun386))
  89.     #define SUN386
  90.   #endif
  91.   #if (defined(unix) && defined(linux) && defined(i386))
  92.     #define PC386
  93.   #endif
  94.   #if (defined(sun) && defined(unix) && defined(mc68020))
  95.     #define SUN3
  96.   #endif
  97.   #if (defined(sun) && defined(unix) && defined(sparc))
  98.     #define SUN4
  99.     # evtl. SUN4_29 falls nur Adressen <2^29 unterstⁿtzt werden.
  100.   #endif
  101.   #if defined(hp9000s800) || defined(__hp9000s800)
  102.     #define HP8XX
  103.   #endif
  104. #endif
  105.  
  106. # Auswahl des Prozessors:
  107. # MC680X0 == alle Prozessoren der Motorola-68000-Serie
  108. # MC680Y0 == alle Prozessoren der Motorola-68000-Serie ab MC68020
  109. # SPARC == der Sun-SPARC-Prozessor
  110. # HPPA == alle Prozessoren der HP-Precision-Architecture
  111. # MIPS == der Mips-Prozessor
  112. # M88000 == alle Prozessoren der Motorola-88000-Serie
  113. # RS6000 == der IBM-RS/6000-Prozessor
  114. # I80X86 == alle Prozessoren der Intel-8086-Serie
  115. # I80Y86 == alle Prozessoren der Intel-8086-Serie ab 80286
  116. # I80Z86 == alle Prozessoren der Intel-8086-Serie ab 80386
  117. # VAX == der VAX-Prozessor
  118. # CONVEX == der Convex-Prozessor
  119. # ARM == der ARM-Prozessor
  120. # DECALPHA == der DEC-Alpha-Chip
  121. #ifdef ATARI
  122.   #define MC680X0
  123.   #ifdef ATARITT
  124.     #define MC680Y0
  125.   #else
  126.     #define MC68000
  127.   #endif
  128. #endif
  129. #ifdef AMIGA
  130.   #define MC680X0
  131.   #if defined(AMIGA3000) && !defined(MC680Y0)
  132.     #define MC680Y0
  133.   #endif
  134. #endif
  135. #ifdef DOSPC
  136.   #define I80X86
  137.   #define I80Y86
  138.   #define I80Z86
  139. #endif
  140. #if 0
  141.   #define VAX
  142. #endif
  143. #if defined(arm) || defined(__arm)
  144.   #define ARM
  145. #endif
  146. #ifdef GENERIC_UNIX
  147.   #if defined(m68k) || defined(mc68000)
  148.     #define MC680X0
  149.   #endif
  150.   #if defined(mc68020) || (defined(m68k) && defined(NeXT))
  151.     #define MC680X0
  152.     #define MC680Y0
  153.   #endif
  154.   #if defined(i386) || defined(__i386) || defined(_I386)
  155.     #define I80X86
  156.     #define I80Y86
  157.     #define I80Z86
  158.   #endif
  159.   #ifdef sparc
  160.     #define SPARC
  161.   #endif
  162.   #if defined(mips) || defined(__mips)
  163.     #define MIPS
  164.   #endif
  165.   #if defined(HP8XX) || defined(hppa) || defined(__hppa)
  166.     #define HPPA
  167.   #endif
  168.   #ifdef m88000
  169.     #define M88000
  170.   #endif
  171.   #ifdef _IBMR2
  172.     #define RS6000
  173.   #endif
  174.   #ifdef __convex__
  175.     #define CONVEX
  176.   #endif
  177.   #ifdef __alpha
  178.     #define DECALPHA
  179.   #endif
  180. #endif
  181.  
  182.  
  183. # Auswahl des Betriebssystems:
  184. #ifdef ATARI
  185.   #define GEMDOS
  186. #endif
  187. #ifdef AMIGA
  188.   #define AMIGAOS
  189. #endif
  190. #if (defined(riscos) || defined(__riscos)) && !defined(unix)
  191.   #define RISCOS  # Acorn RISC OS
  192.   #ifndef __GNUC__
  193.     #define RISCOS_CCBUG  # Bug in Norcrofts C-Compiler umgehen
  194.   #endif
  195. #endif
  196. #ifdef GENERIC_UNIX
  197.   #define UNIX
  198.   #ifdef linux
  199.     #define UNIX_LINUX  # Linux (Linus Torvalds Unix)
  200.   #endif
  201.   #if defined(hpux) || defined(__hpux)
  202.     #define UNIX_HPUX  # HP-UX
  203.   #endif
  204.   #if defined(SVR3) || defined(__SVR3) || defined(SVR4) || defined(__SVR4) || defined(SYSTYPE_SVR4) || defined(__SYSTYPE_SVR4) || defined(__svr4__) || defined(USG) || defined(UNIX_HPUX) # ??
  205.     #define UNIX_SYSV  # UNIX System V
  206.   #endif
  207.   #if defined(UNIX_SYSV) && (defined(sgi) || defined(__sgi))
  208.     #define UNIX_IRIX  # Irix
  209.     #if defined(SYSTYPE_SVR4) || defined(__SYSTYPE_SVR4)
  210.       #define UNIX_IRIX5  # Irix 5
  211.     #endif
  212.   #endif
  213.   #if defined(MIPS) && (defined(ultrix) || defined(__ultrix))
  214.     #define UNIX_DEC_ULTRIX  # DEC's (oder IBM's ?) RISC/OS Ultrix auf DEC MIPS
  215.     #ifdef __GNUC__
  216.       #define UNIX_DEC_ULTRIX_GCCBUG  # GCC 2.3.3 Bug umgehen
  217.     #endif
  218.   #endif
  219.   #if defined(USL) # defined(__svr4__) && defined(i386) && ??
  220.     # Eine Reihe von 386er Unixen (alle unter verschiedenem Namen) stammen
  221.     # von USL SysV R 4 ab:
  222.     #   386 UHC UNIX System V release 4
  223.     #   Consensys System V 4.2
  224.     #   Onsite System V 4.2
  225.     #   SINIX-Z
  226.     #define UNIX_SYSV_USL  # Unix System V R 4 von der AT&T-Tochter USL
  227.     #define UNIX_SYSV_UHC_1 # Behandlung analog HPPA && UNIX_HPUX
  228.     # define UNIX_SYSV_UHC_2 # Behandlung analog AMIGA3000 - langsamer
  229.     #ifdef SNI
  230.       #define UNIX_SINIX # Siemens is nix
  231.     #endif
  232.   #endif
  233.   #ifdef _SEQUENT_
  234.     #define UNIX_SYSV_PTX
  235.   #endif
  236.   #ifdef _AIX
  237.     #define UNIX_AIX  # IBM AIX
  238.   #endif
  239.   #ifdef DGUX
  240.     #define UNIX_DGUX  # Data General DG/UX
  241.   #endif
  242.   #ifdef __osf__
  243.     #define UNIX_OSF  # OSF/1
  244.   #endif
  245.   #ifdef AUX
  246.     #define UNIX_AUX  # Apple A/UX, ein aufgepΣppeltes SVR2
  247.   #endif
  248.   #ifdef NeXT
  249.     #define UNIX_NEXTSTEP  # NeXTstep
  250.   #endif
  251.   #ifdef AMIX
  252.     #define UNIX_AMIX  # Amiga UNIX
  253.   #endif
  254.   #ifdef __convex__
  255.     #define UNIX_CONVEX  # ConvexOS
  256.   #endif
  257.   #ifdef COHERENT
  258.     #define UNIX_COHERENT # Mark Williams Coherent, unvergleichlich altertⁿmlich
  259.     #ifdef __GNUC__
  260.       #if (__GNUC_MAJOR__ < 2)
  261.         #define UNIX_COHERENT_GCCBUG  # gcc 1.40 PrΣprozessor Bug umgehen
  262.       #endif
  263.     #endif
  264.   #endif
  265.   #ifdef __MINT__
  266.     #define UNIX_MINT  # MiNT (UNIXlike auf Atari)
  267.   #endif
  268. #endif
  269. #ifdef DOSPC
  270.   #undef MSDOS  # wg. WATCOM
  271.   #define MSDOS
  272.   #ifdef __EMX__
  273.     #define EMUNIX  # UNIX-Emulation auf MSDOS/OS2-Basis von Eberhard Mattes
  274.     #ifdef OS2
  275.       #define EMUNIX_PORTABEL # ob wir eine zwischen MSDOS und OS2 portable Version machen
  276.     #endif
  277.     # EMUNIX_OLD_8d steht fⁿr emx <= 0.8d, EMUNIX_NEW_8e steht fⁿr emx >= 0.8e
  278.     # EMUNIX_OLD_8e steht fⁿr emx <= 0.8e, EMUNIX_NEW_8f steht fⁿr emx >= 0.8f
  279.     # EMUNIX_OLD_8f steht fⁿr emx <= 0.8f, EMUNIX_NEW_8g steht fⁿr emx >= 0.8g
  280.     # EMUNIX_OLD_8g steht fⁿr emx <= 0.8g, EMUNIX_NEW_8h steht fⁿr emx >= 0.8h
  281.     # EMUNIX_OLD_8h steht fⁿr emx <= 0.8h, EMUNIX_NEW_9a steht fⁿr emx >= 0.9a
  282.   #endif
  283.   #ifdef __GO32__
  284.     #define DJUNIX  # UNIX-Emulation auf MSDOS-Basis von D.J. Delorie
  285.   #endif
  286.   #ifdef __WATCOMC__
  287.     #define WATCOM  # Bibliotheksfunktionen von WATCOM C
  288.     #ifdef __WINDOWS_386__
  289.       #define WINDOWS
  290.     #endif
  291.   #endif
  292.   # WINDOWS ist definiert, wenn wir fⁿr MS Windows 3.1 compilieren
  293. #endif
  294.  
  295.  
  296. # Eigenschaften von Compiler und Umgebung abfragen:
  297. #if defined(UNIX)
  298.   #include "unixconf.h"  # von configure erzeugte Konfiguration
  299.   #include "machine.h"   # von machine erzeugte Integertyp-Charakteristika
  300. #elif defined(ATARI) || defined(AMIGA) || defined(DOSPC) || defined(ACORN)
  301.   #define char_bitsize 8
  302.   #define short_bitsize 16
  303.   #if defined(DOSPC) || defined(ACORN)
  304.     #define int_bitsize 32
  305.   #else
  306.     #define int_bitsize 0 # wird nicht ben÷tigt
  307.   #endif
  308.   #define long_bitsize 32
  309.   #ifdef __GNUC__
  310.     #if (__GNUC__ >= 2) # GCC 2 hat inzwischen funktionierenden `long long' Typ
  311.       #define long_long_bitsize 64
  312.     #endif
  313.   #endif
  314.   #define pointer_bitsize 32
  315.   #ifdef MC680X0
  316.     #define short_big_endian
  317.     #define long_big_endian
  318.   #endif
  319.   #if defined(I80X86) || defined(VAX) || defined(ARM)
  320.     #define short_little_endian
  321.     #define long_little_endian
  322.   #endif
  323.   #define stack_grows_down
  324. #endif
  325.  
  326.  
  327. # Genauere Klassifikation des Betriebssystems:
  328.   #if defined(UNIX) && defined(SIGNALBLOCK_BSD) && !defined(SIGNALBLOCK_SYSV)
  329.     #define UNIX_BSD  # BSD Unix
  330.   #endif
  331.   #if (defined(SUN3) || defined(SUN386) || defined(SUN4)) && defined(HAVE_MMAP) && defined(HAVE_VADVISE)
  332.     #define UNIX_SUNOS4  # Sun OS Version 4
  333.   #endif
  334.   #if defined(SUN4) && !defined(HAVE_VADVISE) # && !defined(HAVE_GETPAGESIZE)
  335.     #define UNIX_SUNOS5  # Sun OS Version 5.1/5.2/5.3 (Solaris 2)
  336.   #endif
  337.  
  338.  
  339. # Auswahl des Zeichensatzes:
  340. #ifdef ATARI
  341.   #define ATARI_CHS  # Atari-Zeichensatz
  342. #endif
  343. #if (defined(SUN3) && defined(UNIX_SUNOS4)) || defined(SUN4) || defined(AMIGA) || defined(ACORN) || defined(UNIX_LINUX) || defined(UNIX_AIX)
  344.   #define ISOLATIN_CHS  # ISO 8859-1, siehe isolatin.chs
  345. #endif
  346. #ifdef HP8XX
  347.   #define HPROMAN8_CHS  # HP-Roman8, siehe hproman8.chs
  348.   # unter X-Term aber: #define ISOLATIN_CHS ??
  349. #endif
  350. #ifdef UNIX_NEXTSTEP
  351.   #define NEXTSTEP_CHS  # NeXTstep, siehe nextstep.chs
  352. #endif
  353. #if defined(DOSPC) || defined(UNIX_COHERENT)
  354.   #define IBMPC_CHS  # IBM PC, siehe ibmpc.chs
  355. #endif
  356. #if !(defined(ATARI_CHS) || defined(ISOLATIN_CHS) || defined(HPROMAN8_CHS) || defined(NEXTSTEP_CHS) || defined(IBMPC_CHS))
  357.   #define ASCII_CHS  # Default: Nur Ascii-Zeichensatz ohne Sonderzeichen
  358. #endif
  359.  
  360.  
  361. # Auswahl des Compilers:
  362. #if defined(__GNUC__)
  363.   #define GNU
  364. #endif
  365. #if defined(__STDC__)
  366.   #define ANSI
  367. #endif
  368.  
  369.  
  370. # Auswahl der Floating-Point-FΣhigkeiten:
  371. # FAST_DOUBLE sollte definiert werden, wenn ein Floating-Point-Coprozessor
  372. # vorhanden ist, dessen 'double'-Typ IEEE-Floating-Points mit 64 Bits sind.
  373. # FAST_FLOAT sollte definiert werden, wenn ein Floating-Point-Coprozessor
  374. # vorhanden ist, dessen 'float'-Typ IEEE-Floating-Points mit 32 Bits sind,
  375. # und der C-Compiler auch 'float'- und nicht 'double'-Operationen generiert.
  376. #ifdef SUN4
  377.   #define FAST_DOUBLE
  378.   #define FAST_FLOAT
  379. #endif
  380. #ifdef HPPA
  381.   #define FAST_DOUBLE
  382.   #define FAST_FLOAT
  383. #endif
  384. #ifdef M88000
  385.   #define FAST_DOUBLE
  386.   #define FAST_FLOAT
  387. #endif
  388. #ifdef RS6000
  389.   #define FAST_DOUBLE
  390.   #define FAST_FLOAT
  391. #endif
  392. #if defined(I80Z86) && defined(UNIX_LINUX)
  393.   # Linux hat einen funktionierenden Floating-Point-Coprozessor-Emulator.
  394.   # Aber auf Intel-Pentium-Prozessoren ist die FPU fehlerhaft.
  395.   #define FAST_DOUBLE
  396.   #define FAST_FLOAT
  397. #endif
  398. #ifdef ARM
  399.   # Bei Integers ist der Prozessor Little-Endian, bei Double-Floats Big-Endian!
  400.   #undef FAST_DOUBLE
  401. #endif
  402. #ifdef GNU
  403.   # Erst gcc-2.6 kann auch bei -traditional mit 'float's konversionslos rechnen.
  404.   #if !defined(ANSI) && !((__GNUC__ == 2) && (__GNUC_MINOR__ >= 6))
  405.     #undef FAST_FLOAT
  406.   #endif
  407. #endif
  408.  
  409.  
  410. # Auswahl der Sprache:
  411.   #ifdef ENGLISH
  412.     #undef ENGLISH
  413.     #define ENGLISH 1
  414.   #else
  415.     #define ENGLISH 0
  416.   #endif
  417.   #ifdef DEUTSCH
  418.     #undef DEUTSCH
  419.     #define DEUTSCH 1
  420.   #else
  421.     #define DEUTSCH 0
  422.   #endif
  423.   #ifdef FRANCAIS
  424.     #undef FRANCAIS
  425.     #define FRANCAIS 1
  426.   #else
  427.     #define FRANCAIS 0
  428.   #endif
  429.   #if (DEUTSCH+ENGLISH+FRANCAIS > 1)
  430.     #error "Ambiguous choice of language -- Sprache nicht eindeutig!!"
  431.   #endif
  432.   #if (DEUTSCH+ENGLISH+FRANCAIS > 0)
  433.     #define LANGUAGE_STATIC
  434.   #else # noch keine Sprache ausgewΣhlt
  435.     # Sprache wird zur Laufzeit von der Variablen language bestimmt.
  436.     #undef ENGLISH
  437.     #undef DEUTSCH
  438.     #undef FRANCAIS
  439.     #define ENGLISH  (language==language_english)
  440.     #define DEUTSCH  (language==language_deutsch)
  441.     #define FRANCAIS  (language==language_francais)
  442.   #endif
  443.  
  444.  
  445. # Auswahl der Sicherheitsstufe:
  446. # SAFETY=0 : alle Optimierungen eingeschaltet
  447. # SAFETY=1 : alle Optimierungen, aber noch STACKCHECKs
  448. # SAFETY=2 : nur einfache Assembler-Unterstⁿtzung
  449. # SAFETY=3 : keine Optimierungen
  450.   #ifndef SAFETY
  451.     #define SAFETY 0
  452.   #endif
  453.   #if SAFETY >= 3
  454.     #define NO_ASM
  455.   #endif
  456.  
  457.  
  458. # Name des Compilers: siehe constobj.d: software_version_string
  459.  
  460.  
  461. # Es gibt doch tatsΣchlich Compiler, deren PrΣprozessor in den constant-
  462. # expressions nach '#if' keine Macros mit Argumenten expandiert.
  463. # (Z.B. der cc von HP-UX 8.0.)
  464. # Solche Compiler unterstⁿtzen wir definitiv nicht.
  465.  
  466. # Der Acorn ANSI-C Compiler fⁿr ARM unter RISCOS hat "char" == "unsigned char".
  467.   #if defined(ARM) && defined(RISCOS) && !defined(GNU)
  468.     #define __CHAR_UNSIGNED__
  469.   #endif
  470.  
  471. # Eine Eigenschaft des Prozessors:
  472. # Die Reihenfolge, in der Worte/Langworte in Bytes abgelegt werden.
  473.   #if defined(short_little_endian) || defined(int_little_endian) || defined(long_little_endian)
  474.     # Z80, VAX, I80X86, DECALPHA, MIPSEB, ...:
  475.     # Low Byte zuunterst, High Byte an h÷herer Adresse
  476.     #if defined(BIG_ENDIAN_P)
  477.       #error "Bogus BIG_ENDIAN_P -- BIG_ENDIAN_P neu einstellen!"
  478.     #endif
  479.     #define BIG_ENDIAN_P  0
  480.   #endif
  481.   #if defined(short_big_endian) || defined(int_big_endian) || defined(long_big_endian)
  482.     # MC680X0, SPARC, HPPA, MIPSEL, M88000, ...:
  483.     # High Byte zuunterst, Low Byte an h÷herer Adresse (leichter zu lesen)
  484.     #if defined(BIG_ENDIAN_P)
  485.       #error "Bogus BIG_ENDIAN_P -- BIG_ENDIAN_P neu einstellen!"
  486.     #endif
  487.     #define BIG_ENDIAN_P  1
  488.   #endif
  489.   #if !defined(BIG_ENDIAN_P)
  490.     #error "Bogus BIG_ENDIAN_P -- BIG_ENDIAN_P neu einstellen!"
  491.   #endif
  492.  
  493. # Globale Registerdeklarationen mⁿssen schon jetzt kommen, wenn die
  494. # System-Include-Files Inline-Funktions-Definitionen enthalten.
  495.   #if defined(GNU) && (SAFETY < 2)
  496.     #if defined(M88000) && defined(UNIX_DGUX)
  497.       # CFLAGS = -ffixed-r14 -ffixed-r15 -ffixed-r16  simulieren:
  498.       register void* *       STACK    __asm__("%r14"); # s.u.
  499.       register unsigned long mv_count __asm__("%r15"); # s.u.
  500.       register void*         value1   __asm__("%r16"); # s.u.
  501.     #endif
  502.   #endif
  503.  
  504.  
  505. # ###################### Macros zu C ##################### #
  506.  
  507. # Definitionen fⁿr non-ANSI-C-Compiler:
  508. #if !defined(ANSI) && !defined(UNIXCONF)
  509.   #define const       # 'const' streichen
  510. #endif
  511. #if !defined(ANSI)
  512.   # 'volatile' (in der Bedeutung als Variablen-Attribut) streichen:
  513.     #define volatile
  514.   # Hiervon nicht betroffen sind:
  515.   # * 'volatile' als Attribut fⁿr die Deklaration (nicht Definition!) von
  516.   #   Funktionen, hei▀t bei uns 'nonreturning'.
  517.   # * '__volatile__' als Attribut fⁿr GCC-__asm__-Anweisungen.
  518. #endif
  519. #if !defined(ANSI) && !defined(__CHAR_UNSIGNED__)
  520.   #define signed      # 'signed int' --> 'int'
  521. #endif
  522. #if !defined(ANSI) && !defined(UNIXCONF)
  523.   #define void  char  # Ergebnistyp 'void', Typ 'void*'
  524. #endif
  525. #if !defined(UNIXCONF)
  526.   # Um einen Typ vom Wert void weiterzureichen: return_void(...);
  527.   #ifdef GNU
  528.     #define return_void  return # 'return void;' ist zulΣssig
  529.   #else
  530.     # TURBO-C auf dem Atari hat einen Bug: mag 'return void;' nicht.
  531.     # Manche andere alte C-Compiler unterstⁿtzen 'void' ebenso nur halbherzig.
  532.     #define return_void  # Kein 'return' fⁿr Expressions vom Typ 'void' verwenden.
  533.   #endif
  534. #endif
  535. #if !defined(GNU)
  536.   #define inline      # inline foo() {...} --> foo() {...}
  537. #endif
  538. #if !defined(UNIXCONF)
  539.   #define nowarn
  540. #else
  541.   # Um GCC-Warnungen selektiv auszuschalten:
  542.   #define nowarn  __nowarn__
  543. #endif
  544.  
  545. # Definitionen fⁿr C++-Compiler:
  546. #ifdef __cplusplus
  547.   #define BEGIN_DECLS  extern "C" {
  548.   #define END_DECLS    }
  549. #else
  550.   #define BEGIN_DECLS
  551.   #define END_DECLS
  552. #endif
  553. # C++ st÷rt sich noch an goto's, die in den Scope von Variablen hineinspringen.
  554.  
  555. # Leere Macro-Argumente:
  556. # Manche Compiler (z.B. der cc von HP-UX) interpretieren einen Macro-Aufruf
  557. # foo(arg1,...,argn,) offenbar als Σquivalent zu foo(arg1,...,argn), was einen
  558. # Fehler ergibt. _EMA_ steht fⁿr "empty macro argument". Es wird durch
  559. # CC_NEED_DEEMA eingefⁿgt, jeweils zwischen Komma und schlie▀ende Klammer.
  560. # Au▀erdem ist es beim Durchreichen m÷glicherweise leerer Argumente an andere
  561. # Macros n÷tig.
  562.   #define _EMA_
  563.  
  564. # ZusammenhΣngen zweier macroexpandierter Tokens:
  565. # Beispiel:
  566. #   #undef x
  567. #   #define y 16
  568. #   CONCAT(x,y)        ==>  'x16' (nicht 'xy' !)
  569.   #define CONCAT_(xxx,yyy)  xxx##yyy
  570.   #define CONCAT3_(aaa,bbb,ccc)  aaa##bbb##ccc
  571.   #define CONCAT4_(aaa,bbb,ccc,ddd)  aaa##bbb##ccc##ddd
  572.   #define CONCAT5_(aaa,bbb,ccc,ddd,eee)  aaa##bbb##ccc##ddd##eee
  573.   #define CONCAT6_(aaa,bbb,ccc,ddd,eee,fff)  aaa##bbb##ccc##ddd##eee##fff
  574.   #define CONCAT7_(aaa,bbb,ccc,ddd,eee,fff,ggg)  aaa##bbb##ccc##ddd##eee##fff##ggg
  575.   #define CONCAT(xxx,yyy)  CONCAT_(xxx,yyy)
  576.   #define CONCAT3(aaa,bbb,ccc)  CONCAT3_(aaa,bbb,ccc)
  577.   #define CONCAT4(aaa,bbb,ccc,ddd)  CONCAT4_(aaa,bbb,ccc,ddd)
  578.   #define CONCAT5(aaa,bbb,ccc,ddd,eee)  CONCAT5_(aaa,bbb,ccc,ddd,eee)
  579.   #define CONCAT6(aaa,bbb,ccc,ddd,eee,fff)  CONCAT6_(aaa,bbb,ccc,ddd,eee,fff)
  580.   #define CONCAT7(aaa,bbb,ccc,ddd,eee,fff,ggg)  CONCAT7_(aaa,bbb,ccc,ddd,eee,fff,ggg)
  581.  
  582. # Generierung von Sprungzielen (goto-Marken) in Macros:
  583. # GENTAG(end)  ==>  end116
  584. # Damit kann ein Macro, der Marken definiert, mehr als einmal pro Funktion,
  585. # aber immer noch nur einmal pro Source-Zeile benutzt werden.
  586. # Die Marken mⁿssen in einem umschlie▀enden Block mit
  587. # DECLTAG(end);
  588. # deklariert werden.
  589. # Ab GCC-2.6.1 mu▀ dieser umschlie▀ende Block eine Expression sein:
  590. # BEGIN_DECLTAG { DECLTAG(end); ... } END_DECLTAG  expandiert dann zu
  591. # ( { DECLTAG(end); ... } );
  592.   #ifdef ANSI # mit traditionellem PrΣprozessor ist dieser Macro wertlos
  593.     #define GENTAG(xxx)  CONCAT(xxx,__LINE__)
  594.     #define DECLTAG(xxx)
  595.     #define BEGIN_DECLTAG
  596.     #define END_DECLTAG
  597.   #elif defined(GNU)
  598.     #if (__GNUC__ >= 2)
  599.       #define GENTAG(xxx)  xxx
  600.       #define DECLTAG(xxx)  __label__ xxx
  601.       #define BEGIN_DECLTAG  (
  602.       #define END_DECLTAG  );
  603.     #endif
  604.   #endif
  605.  
  606. # Umwandlung von Tokens in Strings:
  607. # STRING(token)  ==>  "token"
  608. #ifdef ANSI
  609.   #define STRING(token) #token
  610. #else
  611.   #define STRING(token) "token"
  612. #endif
  613. #define STRINGIFY(token) STRING(token)
  614.  
  615. # Storage-Class-Specifier in Top-Level-Deklarationen:
  616. # fⁿr Variablen:
  617. #   global           ⁿberall sichtbare Variable
  618. #   local            nur im File (lokal) sichtbare Variable
  619. #   extern           Verweis auf woanders definierte Variable
  620. # fⁿr Funktionen:
  621. #   global           ⁿberall sichtbare Funktion
  622. #   local            nur im File (lokal) sichtbare Funktion
  623. #   extern           Verweis auf woanders definierte Funktion
  624. #   local_function   Verweis auf spΣter im File definierte Funktion
  625. #   nonreturning     Funktion, die nie zurⁿckkommt
  626. #   cdecl            Funktion, die bei ATARI_TURBO (ausnahmsweise) ihre
  627. #                      Parameter auf dem Stack ⁿbergeben bekommt
  628.   #define global
  629.   #define local  static
  630. # #define extern extern
  631.   #if defined(ANSI) || defined(GNU)
  632.     #define local_function  local
  633.   #else
  634.     # Es gibt Compiler, die sich ⁿber
  635.     #    typedef int handler(); local handler my_handler;
  636.     # aufregen!
  637.     #define local_function  extern
  638.   #endif
  639.   #ifdef GNU
  640.     #define nonreturning  __volatile__
  641.   #else
  642.     #define nonreturning
  643.   #endif
  644.  
  645. # Deklaration einer Funktion (nur die FΣlle, die von ansidecl.d nicht erkannt
  646. # werden):
  647.   #ifdef ANSI
  648.     #define _ARGS(x) x
  649.   #else
  650.     #define _ARGS(x) ()
  651.   #endif
  652.   #ifdef ANSI
  653.     #define PARM0()  (void)
  654.     #define PARM1(arg1,decl1)  (decl1)
  655.     #define PARM2(arg1,arg2,decl1,decl2)  (decl1,decl2)
  656.     #define PARM3(arg1,arg2,arg3,decl1,decl2,decl3)  (decl1,decl2,decl3)
  657.     #define PARM4(arg1,arg2,arg3,arg4,decl1,decl2,decl3,decl4)  (decl1,decl2,decl3,decl4)
  658.     #define PARM5(arg1,arg2,arg3,arg4,arg5,decl1,decl2,decl3,decl4,decl5)  (decl1,decl2,decl3,decl4,decl5)
  659.   #else
  660.     #define PARM0()  ()
  661.     #define PARM1(arg1,decl1)  (arg1) decl1;
  662.     #define PARM2(arg1,arg2,decl1,decl2)  (arg1,arg2) decl1; decl2;
  663.     #define PARM3(arg1,arg2,arg3,decl1,decl2,decl3)  (arg1,arg2,arg3) decl1; decl2; decl3;
  664.     #define PARM4(arg1,arg2,arg3,arg4,decl1,decl2,decl3,decl4)  (arg1,arg2,arg3,arg4) decl1; decl2; decl3; decl4;
  665.     #define PARM5(arg1,arg2,arg3,arg4,arg5,decl1,decl2,decl3,decl4,decl5)  (arg1,arg2,arg3,arg4,arg5) decl1; decl2; decl3; decl4; decl5;
  666.   #endif
  667.  
  668. # Deklaration einer Funktion, die nie zurⁿckkommt:
  669. # nonreturning_function(extern,exit,(void)); == extern void abort (void);
  670.   #ifdef GNU
  671.     #ifdef ANSI
  672.       #define nonreturning_function(storclass,funname,arguments)  \
  673.         typedef void CONCAT3(funname,_function_,__LINE__) arguments; \
  674.         storclass nonreturning CONCAT3(funname,_function_,__LINE__) funname
  675.     #else
  676.       typedef void void_function ();
  677.       #define nonreturning_function(storclass,funname,arguments)  \
  678.         storclass nonreturning void_function funname
  679.     #endif
  680.   #else
  681.     #ifdef ANSI
  682.       #define nonreturning_function(storclass,funname,arguments)  \
  683.         storclass void funname arguments
  684.     #else
  685.       #define nonreturning_function(storclass,funname,arguments)  \
  686.         storclass void funname()
  687.     #endif
  688.   #endif
  689.  
  690. # Storage-Class-Specifier in Deklarationen an BlockanfΣngen:
  691. # var                       leitet Variablendeklarationen ein
  692. # reg1, reg2, ..., reg10    spezifiziert, da▀ eine Variable in einem Register
  693. #                           sitzen soll, und die (geschΣtzte) PrioritΣt
  694. #                           davon.
  695. #      (reg1 = wichtigst, z.B. ZΣhler der innersten Schleife)
  696.   #define var
  697. # regvarcount ist eine SchΣtzung, wieviele (Integer-)Variablen der Compiler
  698. # ⁿblicherweise gleichzeitig in die Register legen kann. Die Anzahl der Nullen
  699. # bei Integer-Registern im Macro CALL_USED_REGISTERS der gcc2-Maschinen-
  700. # beschreibung ist ein guter SchΣtzwert.
  701. #ifdef MC680X0            # gcc2: 6+5
  702.   #define regvarcount  6  # kann mindestens 6 Variablen in die Register nehmen
  703. #endif
  704. #ifdef SPARC              # gcc2: 14
  705.   #define regvarcount  8  # kann mindestens 8 Variablen in die Register nehmen
  706. #endif
  707. #ifdef HPPA               # gcc2: 16
  708.   #define regvarcount 16  # kann sehr viele Variablen in die Register nehmen
  709. #endif
  710. #ifdef MIPS               # gcc2: 9
  711.   #define regvarcount 10  # kann viele Variablen in die Register nehmen
  712. #endif
  713. #ifdef M88000             # gcc2: 12
  714.   #define regvarcount 12  # kann viele Variablen in die Register nehmen
  715. #endif
  716. #ifdef RS6000             # gcc2: 19
  717.   #define regvarcount 16  # kann sehr viele Variablen in die Register nehmen
  718. #endif
  719. #ifdef I80X86             # gcc2: 4
  720.   #define regvarcount  4  # kann mindestens 4 Variablen in die Register nehmen
  721. #endif
  722. #ifdef VAX
  723.   #define regvarcount  6  # gcc2: 6
  724. #endif
  725. #ifdef CONVEX
  726.   #define regvarcount  6  # gcc2: 0
  727. #endif
  728. #ifdef ARM
  729.   #define regvarcount  6  # gcc2: 6
  730. #endif
  731. #ifdef DECALPHA           # gcc2: 8, dafⁿr aber 20 call-used-Register
  732.   #define regvarcount 10  # kann viele Variablen in die Register nehmen
  733. #endif
  734. #if (regvarcount>=1)
  735.   #define reg1  register
  736. #else
  737.   #define reg1  # auto
  738. #endif
  739. #if (regvarcount>=2)
  740.   #define reg2  register
  741. #else
  742.   #define reg2  # auto
  743. #endif
  744. #if (regvarcount>=3)
  745.   #define reg3  register
  746. #else
  747.   #define reg3  # auto
  748. #endif
  749. #if (regvarcount>=4)
  750.   #define reg4  register
  751. #else
  752.   #define reg4  # auto
  753. #endif
  754. #if (regvarcount>=5)
  755.   #define reg5  register
  756. #else
  757.   #define reg5  # auto
  758. #endif
  759. #if (regvarcount>=6)
  760.   #define reg6  register
  761. #else
  762.   #define reg6  # auto
  763. #endif
  764. #if (regvarcount>=7)
  765.   #define reg7  register
  766. #else
  767.   #define reg7  # auto
  768. #endif
  769. #if (regvarcount>=8)
  770.   #define reg8  register
  771. #else
  772.   #define reg8  # auto
  773. #endif
  774. #if (regvarcount>=9)
  775.   #define reg9  register
  776. #else
  777.   #define reg9  # auto
  778. #endif
  779. #if (regvarcount>=10)
  780.   #define reg10  register
  781. #else
  782.   #define reg10  # auto
  783. #endif
  784.  
  785. # Adresse des ersten Elements eines Arrays: &!array
  786. # (Wenn klar werden soll, da▀ man die Adresse des ganzen Arrays ⁿbergibt.
  787. # Wenn man &array schreibt, ist das genau genommen ein Typfehler.)
  788.  
  789. # Verallgemeinerte if-Anweisung:
  790. # if (cond1) ... {elif (condi) ...} [else ...]
  791.   #define elif  else if
  792.  
  793. # Endlosschleife, nur mit  break;  oder  return...;  zu verlassen:
  794.   #define loop  while (1)
  795.  
  796. # Umgekehrte Abbruchbedingung in Schleifen:
  797. # Erlaubt   until (expression) statement
  798. # und       do statement until (expression);
  799.   #define until(expression)  while(!(expression))
  800.  
  801. # Fallunterscheidung ⁿber einen Wert >=0
  802. # switchu (expression) ...
  803.   #ifdef GNU # wird so besser optimiert
  804.     #define switchu(expression)  switch ((unsigned int)(expression))
  805.   #else
  806.     #define switchu  switch
  807.   #endif
  808.  
  809. # Vertauschen zweier Variableninhalte:  swap(register int, x1, x2);
  810.   #define swap(swap_type,swap_var1,swap_var2)  \
  811.     { var swap_type swap_temp;                                             \
  812.       swap_temp = swap_var1; swap_var1 = swap_var2; swap_var2 = swap_temp; \
  813.     }
  814.  
  815. # Kennzeichnung einer unerreichten Programmstelle: NOTREACHED
  816.   #define NOTREACHED  fehler_notreached(__FILE__,__LINE__);
  817.  
  818. # ▄berprⁿfung eines arithmetischen Ausdrucks: ASSERT(expr)
  819.   #define ASSERT(expr)  { if (!(expr)) { NOTREACHED } }
  820.  
  821. # alloca()
  822.   #if defined(GNU) && !defined(RISCOS) && !defined(CONVEX)
  823.     #define alloca  __builtin_alloca
  824.   #elif defined(HAVE_ALLOCA_H) || defined(RISCOS)
  825.     #include <alloca.h>
  826.     #ifndef alloca # Manche definieren 'alloca' als Macro...
  827.       #ifdef UNIX_OSF
  828.         extern char* alloca (int size);
  829.       #else
  830.         extern void* alloca (int size); # siehe MALLOC(3V)
  831.       #endif
  832.     #endif
  833.   #elif defined(_AIX)
  834.     #pragma alloca /* AIX requires this to be the first thing in the file. */
  835.   #elif defined(WATCOM)
  836.     #include <malloc.h> # definiert 'alloca' als Macro
  837.   #elif !defined(NO_ALLOCA)
  838.     extern void* alloca (int size); # siehe MALLOC(3V)
  839.   #endif
  840.  
  841. # Synonym fⁿr Byte, Word, Longword:
  842. # BYTE    = signed 8 bit integer
  843. # UBYTE   = unsigned 8 bit int
  844. # WORD    = signed 16 bit int
  845. # UWORD   = unsigned 16 bit int
  846. # LONG    = signed 32 bit int
  847. # ULONG   = unsigned 32 bit int
  848. # Hingegen wird "char" nur in der Bedeutung eines Elements eines Strings
  849. # verwendet. Nie wird mit einem "char" wirklich gerechnet; das k÷nnte von
  850. # __CHAR_UNSIGNED__ abhΣngen!
  851.   #if (char_bitsize==8)
  852.     #ifdef __CHAR_UNSIGNED__
  853.       typedef signed char  BYTE;
  854.     #else
  855.       typedef char         BYTE;
  856.     #endif
  857.     typedef unsigned char  UBYTE;
  858.   #else
  859.     #error "No 8 bit integer type? -- Welcher Integer-Typ hat 8 Bit?"
  860.   #endif
  861.   #if (short_bitsize==16)
  862.     typedef short          WORD;
  863.     typedef unsigned short UWORD;
  864.   #else
  865.     #error "No 16 bit integer type? -- Welcher Integer-Typ hat 16 Bit?"
  866.   #endif
  867.   #if (long_bitsize==32)
  868.     typedef long           LONG;
  869.     typedef unsigned long  ULONG;
  870.   #elif (int_bitsize==32)
  871.     typedef int            LONG;
  872.     typedef unsigned int   ULONG;
  873.   #else
  874.     #error "No 32 bit integer type? -- Welcher Integer-Typ hat 32 Bit?"
  875.   #endif
  876.   #if (long_bitsize==64)
  877.     typedef long           LONGLONG;
  878.     typedef unsigned long  ULONGLONG;
  879.     #undef HAVE_LONGLONG
  880.     #define HAVE_LONGLONG
  881.   #elif defined(HAVE_LONGLONG)
  882.    #if defined(long_long_bitsize) && (long_long_bitsize==64)
  883.     typedef long long           LONGLONG;
  884.     typedef unsigned long long  ULONGLONG;
  885.    #else # unbrauchbarer Typ
  886.     #undef HAVE_LONGLONG
  887.    #endif
  888.   #endif
  889.   #if defined(WIDE) && !defined(HAVE_LONGLONG)
  890.     #error "No 64 bit integer type? -- Welcher Integer-Typ hat 64 Bit?"
  891.   #endif
  892.  
  893. # Wahrheitswerte:
  894.   #define TRUE   1
  895.   #define FALSE  0
  896.   typedef unsigned int  boolean;
  897.  
  898. # Typ fⁿr Vorzeichenwerte, Vergleichsergebnisse, dreiwertige enum's
  899. # mit Werten +1, 0, -1
  900.   typedef signed int  signean;
  901.   #define signean_plus    1 # +1
  902.   #define signean_null    0 #  0
  903.   #define signean_minus  -1 # -1
  904.  
  905. # Nullpointer
  906.   #undef NULL  # wg. WATCOM
  907.   #define NULL  ((void*) 0L)
  908.  
  909. # Den Offset einer Komponente 'ident' in einem Struct vom Typ 'type' bestimmen:
  910. # 0 als Pointer auf 'type' auffassen, dorthin ein Struct 'type' legen und
  911. # von dessen Komponente 'ident' die Adresse bestimmen und als Zahl liefern:
  912.   #undef offsetof
  913.   #define offsetof(type,ident)  ((ULONG)&(((type*)0)->ident))
  914. # Den Offset eines Arrays 'ident' in einem Struct vom Typ 'type' bestimmen:
  915.   #define offsetofa(type,ident)  offsetof(type,ident[0])
  916.  
  917. # Unspezifizierte LΣnge von Arrays in Structures:
  918. # struct { ...; ...; type x[unspecified]; }
  919. # Statt sizeof(..) mu▀ man dann aber immer offsetof(..,x) schreiben.
  920.   #if defined(GNU) # GNU-C kann Arrays der LΣnge 0
  921.     #define unspecified 0
  922.   #elif 0
  923.     # ▄blicherweise lΣ▀t man die Arraygrenze weg:
  924.     #define unspecified
  925.   #else
  926.     # Jedoch die HP-UX- und IRIX-Compiler lassen sich nur damit befriedigen:
  927.     #define unspecified 1
  928.   #endif
  929.  
  930. # Pointer-Arithmetik: einen gegebenen Offset (gemessen in Bytes)
  931. # zu einem Pointer addieren.
  932.   #if !(defined(GNU) || (pointer_bitsize > 32))
  933.     # Billige Methode:
  934.     #define pointerplus(pointer,offset)  ((void*)((ULONG)(pointer)+(offset)))
  935.   #else
  936.     # Fⁿr GNU-C beim Initialisieren von static-Variablen unerlΣ▀lich
  937.     # (mu▀ ein Bug in 'c-typeck.c' in 'initializer_constant_valid_p' sein):
  938.     # Das einzig Richtige, falls sizeof(ULONG) < sizeof(void*):
  939.     #define pointerplus(pointer,offset)  ((UBYTE*)(pointer)+(offset))
  940.   #endif
  941.  
  942. # Bit Nummer n (0<=n<32)
  943.   #define bit(n)  (1L<<(n))
  944. # Bit Nummer n (0<n<=32) mod 2^32
  945.   #define bitm(n)  (2L<<((n)-1))
  946. # Bit-Test von Bit n in x, n konstant, x ein oint:
  947.   #if !defined(SPARC)
  948.     #define bit_test(x,n)  ((x) & bit(n))
  949.   #else
  950.     # Auf SPARC-Prozessoren sind lange Konstanten langsamer als Shifts.
  951.     #if !defined(GNU)
  952.       #define bit_test(x,n)  \
  953.         ((n)<12 ? ((x) & bit(n)) : ((sint32)((uint32)(x) << (31-(n))) < 0))
  954.     #else # der GNU-Compiler optimiert boolean-Expressions so besser:
  955.       #define bit_test(x,n)  \
  956.         (   ( ((n)<12) && ((x) & bit(n)) )                           \
  957.          || ( ((n)>=12) && ((sint32)((uint32)(x) << (31-(n))) < 0) ) \
  958.         )
  959.     #endif
  960.   #endif
  961. # Minus Bit Nummer n (0<=n<32)
  962.   #define minus_bit(n)  (-1L<<(n))
  963. # Minus Bit Nummer n (0<n<=32) mod 2^32
  964.   #define minus_bitm(n)  (-2L<<((n)-1))
  965.  
  966. # floor(a,b) liefert fⁿr a>=0, b>0  floor(a/b).
  967. # b sollte eine 'constant expression' sein.
  968.   #define floor(a_from_floor,b_from_floor)  ((a_from_floor) / (b_from_floor))
  969.  
  970. # ceiling(a,b) liefert fⁿr a>=0, b>0  ceiling(a/b) = floor((a+b-1)/b).
  971. # b sollte eine 'constant expression' sein.
  972.   #define ceiling(a_from_ceiling,b_from_ceiling)  \
  973.     (((a_from_ceiling) + (b_from_ceiling) - 1) / (b_from_ceiling))
  974.  
  975. # round_down(a,b) rundet a>=0 so ab, da▀ es durch b>0 teilbar ist.
  976. # b sollte eine 'constant expression' sein.
  977.   #define round_down(a_from_round,b_from_round)  \
  978.     (floor(a_from_round,b_from_round)*(b_from_round))
  979.  
  980. # round_up(a,b) rundet a>=0 so auf, da▀ es durch b>0 teilbar ist.
  981. # b sollte eine 'constant expression' sein.
  982.   #define round_up(a_from_round,b_from_round)  \
  983.     (ceiling(a_from_round,b_from_round)*(b_from_round))
  984.  
  985. # nicht-lokale AusgΣnge
  986.   #if !(defined(ATARI) && defined(GNU))
  987.     #include <setjmp.h>
  988.   #else
  989.     # GNU auf dem Atari definiert auch throw, was wir nicht brauchen k÷nnen.
  990.     #define throw  GNU_throw
  991.     #include <setjmp.h>
  992.     #undef throw
  993.   #endif
  994.   #if defined(UNIX) && defined(HAVE__JMP) && !defined(UNIX_LINUX)
  995.     # Folgende Routinen sind effizienter (hantieren nicht mit Signal-Masken):
  996.     #undef setjmp
  997.     #undef longjmp
  998.     #define setjmp  _setjmp
  999.     #define longjmp  _longjmp
  1000.     #ifdef LONGJMP_RETURNS
  1001.       # _longjmp(jmpbuf,value) kann zurⁿckkehren, wenn jmpbuf ungⁿltig ist.
  1002.       #undef longjmp
  1003.       #define longjmp(x,y)  _longjmp(x,y), NOTREACHED
  1004.     #endif
  1005.   #endif
  1006. # Mit longjmp() kann man nur ein `int' ⁿbergeben.
  1007. # Wenn wir nun ein `long' ⁿbergeben wollen und sizeof(int) < sizeof(long) ist,
  1008. # brauchen wir eine globale Variable:
  1009.   #if (int_bitsize == long_bitsize)
  1010.     #define setjmpl(x)  setjmp(x)
  1011.     #define longjmpl(x,y)  longjmp(x,y)
  1012.   #else # (int_bitsize < long_bitsize)
  1013.     extern long jmpl_value;
  1014.     #define setjmpl(x)  (setjmp(x) ? jmpl_value : 0)
  1015.     #define longjmpl(x,y)  jmpl_value = (y), longjmp(x,1)
  1016.   #endif
  1017.  
  1018. # Dynamisch allozierte Arrays mit dynamic extent:
  1019. # Beispiel:
  1020. #     { var DYNAMIC_ARRAY(reg7,my_array,uintL,n);
  1021. #       ...
  1022. #       FREE_DYNAMIC_ARRAY(my_array);
  1023. #     }
  1024. # Vorsicht: Je nach Implementierung ist my_array entweder der Array selbst
  1025. # oder ein Pointer auf den Array! Immer nur my_array als Expression verwenden!
  1026.   #if defined(GNU)
  1027.     # verkraftet dynamisch allozierte Arrays im Maschinenstack
  1028.     # { var reg7 uintL my_array[n]; ... }
  1029.     #define DYNAMIC_ARRAY(regdecl,arrayvar,arrayeltype,arraysize)  \
  1030.       arrayeltype arrayvar[arraysize]
  1031.     #define FREE_DYNAMIC_ARRAY(arrayvar)
  1032.     #ifdef DECALPHA # GCC 2.5.5 Bug umgehen
  1033.       #undef DYNAMIC_ARRAY
  1034.       #define DYNAMIC_ARRAY(regdecl,arrayvar,arrayeltype,arraysize)  \
  1035.         arrayeltype arrayvar[(arraysize)+1]
  1036.     #endif
  1037.   #elif (defined(UNIX) && (defined(HAVE_ALLOCA_H) || defined(_AIX) || !defined(NO_ALLOCA))) || defined(WATCOM) || defined(RISCOS)
  1038.     # Platz im Maschinenstack reservieren.
  1039.     # { var reg7 uintL* my_array = (uintL*)alloca(n*sizeof(uintL)); ... }
  1040.     #define DYNAMIC_ARRAY(regdecl,arrayvar,arrayeltype,arraysize)  \
  1041.       regdecl arrayeltype* arrayvar = (arrayeltype*)alloca((arraysize)*sizeof(arrayeltype))
  1042.     #define FREE_DYNAMIC_ARRAY(arrayvar)
  1043.     # kein Errorcheck??
  1044.   #else
  1045.     # Platz woanders reservieren und dann wieder freigeben.
  1046.     # { var reg7 uintL* my_array = (uintL*)malloc(n*sizeof(uintL)); ... free(my_array); }
  1047.     #ifdef HAVE_STDLIB_H
  1048.       #include <stdlib.h>
  1049.     #else
  1050.       #include <sys/types.h>
  1051.     #endif
  1052.     #ifndef malloc
  1053.       extern void* malloc (size_t size); # siehe MALLOC(3V)
  1054.     #endif
  1055.     #ifndef free
  1056.       extern void free (void* ptr); # siehe MALLOC(3V)
  1057.     #endif
  1058.     #define NEED_MALLOCA
  1059.     extern void* malloca (size_t size); # siehe SPVW.D
  1060.     extern void freea (void* ptr); # siehe SPVW.D
  1061.     #define DYNAMIC_ARRAY(regdecl,arrayvar,arrayeltype,arraysize)  \
  1062.       regdecl arrayeltype* arrayvar = (arrayeltype*)malloca((arraysize)*sizeof(arrayeltype))
  1063.     #define FREE_DYNAMIC_ARRAY(arrayvar)  freea(arrayvar)
  1064.   #endif
  1065.  
  1066. # Signed/Unsigned-Integer-Typen mit vorgegebener Mindestgr÷▀e:
  1067.   typedef UBYTE   uint1;   # unsigned 1 bit Integer
  1068.   typedef BYTE    sint1;   # signed 1 bit Integer
  1069.   typedef UBYTE   uint2;   # unsigned 2 bit Integer
  1070.   typedef BYTE    sint2;   # signed 2 bit Integer
  1071.   typedef UBYTE   uint3;   # unsigned 3 bit Integer
  1072.   typedef BYTE    sint3;   # signed 3 bit Integer
  1073.   typedef UBYTE   uint4;   # unsigned 4 bit Integer
  1074.   typedef BYTE    sint4;   # signed 4 bit Integer
  1075.   typedef UBYTE   uint5;   # unsigned 5 bit Integer
  1076.   typedef BYTE    sint5;   # signed 5 bit Integer
  1077.   typedef UBYTE   uint6;   # unsigned 6 bit Integer
  1078.   typedef BYTE    sint6;   # signed 6 bit Integer
  1079.   typedef UBYTE   uint7;   # unsigned 7 bit Integer
  1080.   typedef BYTE    sint7;   # signed 7 bit Integer
  1081.   typedef UBYTE   uint8;   # unsigned 8 bit Integer
  1082.   typedef BYTE    sint8;   # signed 8 bit Integer
  1083.   typedef UWORD   uint9;   # unsigned 9 bit Integer
  1084.   typedef WORD    sint9;   # signed 9 bit Integer
  1085.   typedef UWORD   uint10;  # unsigned 10 bit Integer
  1086.   typedef WORD    sint10;  # signed 10 bit Integer
  1087.   typedef UWORD   uint11;  # unsigned 11 bit Integer
  1088.   typedef WORD    sint11;  # signed 11 bit Integer
  1089.   typedef UWORD   uint12;  # unsigned 12 bit Integer
  1090.   typedef WORD    sint12;  # signed 12 bit Integer
  1091.   typedef UWORD   uint13;  # unsigned 13 bit Integer
  1092.   typedef WORD    sint13;  # signed 13 bit Integer
  1093.   typedef UWORD   uint14;  # unsigned 14 bit Integer
  1094.   typedef WORD    sint14;  # signed 14 bit Integer
  1095.   typedef UWORD   uint15;  # unsigned 15 bit Integer
  1096.   typedef WORD    sint15;  # signed 15 bit Integer
  1097.   typedef UWORD   uint16;  # unsigned 16 bit Integer
  1098.   typedef WORD    sint16;  # signed 16 bit Integer
  1099.   typedef ULONG   uint17;  # unsigned 17 bit Integer
  1100.   typedef LONG    sint17;  # signed 17 bit Integer
  1101.   typedef ULONG   uint18;  # unsigned 18 bit Integer
  1102.   typedef LONG    sint18;  # signed 18 bit Integer
  1103.   typedef ULONG   uint19;  # unsigned 19 bit Integer
  1104.   typedef LONG    sint19;  # signed 19 bit Integer
  1105.   typedef ULONG   uint20;  # unsigned 20 bit Integer
  1106.   typedef LONG    sint20;  # signed 20 bit Integer
  1107.   typedef ULONG   uint21;  # unsigned 21 bit Integer
  1108.   typedef LONG    sint21;  # signed 21 bit Integer
  1109.   typedef ULONG   uint22;  # unsigned 22 bit Integer
  1110.   typedef LONG    sint22;  # signed 22 bit Integer
  1111.   typedef ULONG   uint23;  # unsigned 23 bit Integer
  1112.   typedef LONG    sint23;  # signed 23 bit Integer
  1113.   typedef ULONG   uint24;  # unsigned 24 bit Integer
  1114.   typedef LONG    sint24;  # signed 24 bit Integer
  1115.   typedef ULONG   uint25;  # unsigned 25 bit Integer
  1116.   typedef LONG    sint25;  # signed 25 bit Integer
  1117.   typedef ULONG   uint26;  # unsigned 26 bit Integer
  1118.   typedef LONG    sint26;  # signed 26 bit Integer
  1119.   typedef ULONG   uint27;  # unsigned 27 bit Integer
  1120.   typedef LONG    sint27;  # signed 27 bit Integer
  1121.   typedef ULONG   uint28;  # unsigned 28 bit Integer
  1122.   typedef LONG    sint28;  # signed 28 bit Integer
  1123.   typedef ULONG   uint29;  # unsigned 29 bit Integer
  1124.   typedef LONG    sint29;  # signed 29 bit Integer
  1125.   typedef ULONG   uint30;  # unsigned 30 bit Integer
  1126.   typedef LONG    sint30;  # signed 30 bit Integer
  1127.   typedef ULONG   uint31;  # unsigned 31 bit Integer
  1128.   typedef LONG    sint31;  # signed 31 bit Integer
  1129.   typedef ULONG   uint32;  # unsigned 32 bit Integer
  1130.   typedef LONG    sint32;  # signed 32 bit Integer
  1131.   #ifdef HAVE_LONGLONG
  1132.   typedef ULONGLONG  uint33;  # unsigned 33 bit Integer
  1133.   typedef LONGLONG   sint33;  # signed 33 bit Integer
  1134.   typedef ULONGLONG  uint48;  # unsigned 48 bit Integer
  1135.   typedef LONGLONG   sint48;  # signed 48 bit Integer
  1136.   typedef ULONGLONG  uint64;  # unsigned 64 bit Integer
  1137.   typedef LONGLONG   sint64;  # signed 64 bit Integer
  1138.   #endif
  1139.   #define exact_uint_size_p(n) (((n)==char_bitsize)||((n)==short_bitsize)||((n)==int_bitsize)||((n)==long_bitsize))
  1140.   #ifdef ANSI # mit traditionellem PrΣprozessor sind diese Macros wertlos
  1141.     #define signed_int_with_n_bits(n) CONCAT(sint,n)
  1142.     #define unsigned_int_with_n_bits(n) CONCAT(uint,n)
  1143.   #endif
  1144. # Verwende 'uintn' und 'sintn' fⁿr Integers mit genau vorgegebener Breite.
  1145. # exact_uint_size_p(n) gibt an, ob der uint mit n Bits auch wirklich
  1146. # nur n Bits hat.
  1147.  
  1148. # Ab hier bedeuten 'uintX' und 'sintX' unsigned bzw. signed integer -
  1149. # Typen der Wortbreite X (X=B,W,L,Q).
  1150.   #define intBsize 8
  1151.   #ifdef ANSI
  1152.     typedef signed_int_with_n_bits(intBsize)    sintB;
  1153.     typedef unsigned_int_with_n_bits(intBsize)  uintB;
  1154.   #else
  1155.     typedef sint/**/intBsize  sintB;
  1156.     typedef uint/**/intBsize  uintB;
  1157.   #endif
  1158.   #define intWsize 16
  1159.   #ifdef ANSI
  1160.     typedef signed_int_with_n_bits(intWsize)    sintW;
  1161.     typedef unsigned_int_with_n_bits(intWsize)  uintW;
  1162.   #else
  1163.     typedef sint/**/intWsize  sintW;
  1164.     typedef uint/**/intWsize  uintW;
  1165.   #endif
  1166.   #define intLsize 32
  1167.   #ifdef ANSI
  1168.     typedef signed_int_with_n_bits(intLsize)    sintL;
  1169.     typedef unsigned_int_with_n_bits(intLsize)  uintL;
  1170.   #else
  1171.     typedef sint/**/intLsize  sintL;
  1172.     typedef uint/**/intLsize  uintL;
  1173.   #endif
  1174.   #if defined(DECALPHA)
  1175.     # Maschine hat echte 64-Bit-Zahlen in Hardware.
  1176.     #define intQsize 64
  1177.     #ifdef ANSI
  1178.       typedef signed_int_with_n_bits(intQsize)    sintQ;
  1179.       typedef unsigned_int_with_n_bits(intQsize)  uintQ;
  1180.     #else
  1181.       typedef sint/**/intQsize  sintQ;
  1182.       typedef uint/**/intQsize  uintQ;
  1183.     #endif
  1184.     typedef sintQ  sintL2;
  1185.     typedef uintQ  uintL2;
  1186.   #else
  1187.     # Emuliere 64-Bit-Zahlen mit Hilfe von zwei 32-Bit-Zahlen.
  1188.     typedef struct { sintL hi; uintL lo; } sintL2; # signed integer mit 64 Bit
  1189.     typedef struct { uintL hi; uintL lo; } uintL2; # unsigned integer mit 64 Bit
  1190.   #endif
  1191. # Verwende 'uintX' und 'sintX' fⁿr Integers mit ungefΣhr vorgegebener Breite
  1192. # und m÷glichst geringem Speicherplatz.
  1193.  
  1194. # Ab hier bedeuten 'uintP' und 'sintP' unsigned bzw. signed integer - Typen,
  1195. # die so breit sind wie ein void* - Pointer.
  1196.   #ifdef ANSI
  1197.     typedef signed_int_with_n_bits(pointer_bitsize)    sintP;
  1198.     typedef unsigned_int_with_n_bits(pointer_bitsize)  uintP;
  1199.   #else
  1200.     typedef sint/**/pointer_bitsize  sintP;
  1201.     typedef uint/**/pointer_bitsize  uintP;
  1202.   #endif
  1203.  
  1204. # Ab hier bedeuten 'uintXY' und 'sintXY' unsigned bzw. signed integer -
  1205. # Typen der Wortbreite X oder Y (X,Y=B,W,L).
  1206.   #if (defined(MC680X0) && !defined(HPUX_ASSEMBLER)) || defined(VAX)
  1207.     # Der 68000 hat gute uintB-, uintW-, uintL-Verarbeitung, insbesondere
  1208.     # DBRA-Befehle fⁿr uintW.
  1209.     #define intBWsize intBsize
  1210.     #define intWLsize intWsize
  1211.     #define intBWLsize intBsize
  1212.   #elif (defined(MC680X0) && defined(HPUX_ASSEMBLER)) || defined(SPARC) || defined(HPPA) || defined(MIPS) || defined(M88000) || defined(RS6000) || defined(CONVEX)
  1213.     # Der Sparc-Prozessor kann mit uintB und uintW schlecht rechnen.
  1214.     # Anderen 32-Bit-Prozessoren geht es genauso.
  1215.     #define intBWsize intWsize
  1216.     #define intWLsize intLsize
  1217.     #define intBWLsize intLsize
  1218.   #elif defined(I80Z86)
  1219.     # Wird auf einem 80386 mit uintB und uintW gerechnet, so gibt das viele
  1220.     # Zero-Extends, die - da es zu wenig Register gibt - andere Variablen
  1221.     # unn÷tigerweise in den Speicher schieben.
  1222.     #define intBWsize intWsize
  1223.     #define intWLsize intLsize
  1224.     #define intBWLsize intLsize
  1225.   #elif defined(ARM)
  1226.     # Der ARM kann mit uintW sehr schlecht rechnen.
  1227.     #define intBWsize intBsize
  1228.     #define intWLsize intLsize
  1229.     #define intBWLsize intBsize
  1230.   #elif defined(DECALPHA)
  1231.     # Auch 64-Bit-Prozessoren k÷nnen mit uintB und uintW schlecht rechnen.
  1232.     #define intBWsize intWsize
  1233.     #define intWLsize intLsize
  1234.     #define intBWLsize intLsize
  1235.   #else
  1236.     #error "Preferred integer sizes depend on CPU -- Gr÷▀en intBWsize, intWLsize, intBWLsize neu einstellen!"
  1237.   #endif
  1238.   #ifdef ANSI
  1239.     typedef signed_int_with_n_bits(intBWsize)    sintBW;
  1240.     typedef unsigned_int_with_n_bits(intBWsize)  uintBW;
  1241.     typedef signed_int_with_n_bits(intWLsize)    sintWL;
  1242.     typedef unsigned_int_with_n_bits(intWLsize)  uintWL;
  1243.     typedef signed_int_with_n_bits(intBWLsize)    sintBWL;
  1244.     typedef unsigned_int_with_n_bits(intBWLsize)  uintBWL;
  1245.   #else
  1246.     typedef sint/**/intBWsize  sintBW;
  1247.     typedef uint/**/intBWsize  uintBW;
  1248.     typedef sint/**/intWLsize  sintWL;
  1249.     typedef uint/**/intWLsize  uintWL;
  1250.     typedef sint/**/intBWLsize  sintBWL;
  1251.     typedef uint/**/intBWLsize  uintBWL;
  1252.   #endif
  1253. # Verwende 'uintXY' und 'sintXY' fⁿr Integers mit vorgegebener Mindestbreite,
  1254. # mit denen sich leicht rechnen lΣ▀t.
  1255.  
  1256. # Schleife, die ein Statement eine gewisse Anzahl mal ausfⁿhrt:
  1257. # dotimesW(countvar,count,statement);  falls count in ein uintW pa▀t,
  1258. # dotimesL(countvar,count,statement);  falls count nur in ein uintL pa▀t,
  1259. # dotimespW(countvar,count,statement);  falls count in ein uintW pa▀t und >0 ist,
  1260. # dotimespL(countvar,count,statement);  falls count nur in ein uintL pa▀t und >0 ist.
  1261. # Die Variable countvar mu▀ bereits deklariert sein, vom Typ uintW bzw. uintL
  1262. # und wird durch diese Anweisung verΣndert!
  1263. # Sie darf in statement nicht verwendet werden!
  1264. # Die Expression count wird nur einmal (zu Beginn) ausgewertet.
  1265.   #if defined(GNU) && defined(MC680X0) && !defined(HPUX_ASSEMBLER)
  1266.     # GNU-C auf einem 680X0 lΣ▀t sich dazu ⁿberreden, den DBRA-Befehl zu verwenden:
  1267.     #define fast_dotimesW
  1268.     # Um zu entscheiden, wie man GNU-C am besten dazu ⁿberredet, betrachte man
  1269.     # den Code, der fⁿr spvw.d:gc_markphase() produziert wird.
  1270.     # Oder ein kleines Testprogramm (dbratest.c), das mit
  1271.     # "gcc -O6 -da -S dbratest.c" compiliert wird, und betrachte dbratest.s
  1272.     # und dbratest.c.flow sowie dbratest.c.combine.
  1273.     #if (__GNUC__<2) # GNU C Version 1
  1274.       #define dotimesW_(countvar_from_dotimesW,count_from_dotimesW,statement_from_dotimesW)  \
  1275.         { countvar_from_dotimesW = (count_from_dotimesW);     \
  1276.           if (!(countvar_from_dotimesW==0))                   \
  1277.             { countvar_from_dotimesW--;                       \
  1278.               do {statement_from_dotimesW}                    \
  1279.                  until ((sintW)--countvar_from_dotimesW==-1); \
  1280.         }   }
  1281.       #define dotimespW_(countvar_from_dotimespW,count_from_dotimespW,statement_from_dotimespW)  \
  1282.         { countvar_from_dotimespW = (count_from_dotimespW)-1;                         \
  1283.           do {statement_from_dotimespW} until ((sintW)--countvar_from_dotimespW==-1); \
  1284.         }
  1285.     #else
  1286.       #define dotimesW_(countvar_from_dotimesW,count_from_dotimesW,statement_from_dotimesW)  \
  1287.         { countvar_from_dotimesW = (count_from_dotimesW);        \
  1288.           if (!(countvar_from_dotimesW==0))                      \
  1289.             { countvar_from_dotimesW--;                          \
  1290.               do {statement_from_dotimesW}                       \
  1291.                  until ((sintW)(--countvar_from_dotimesW)+1==0); \
  1292.         }   }
  1293.       #define dotimespW_(countvar_from_dotimespW,count_from_dotimespW,statement_from_dotimespW)  \
  1294.         { countvar_from_dotimespW = (count_from_dotimespW)-1;                            \
  1295.           do {statement_from_dotimespW} until ((sintW)(--countvar_from_dotimespW)+1==0); \
  1296.         }
  1297.     #endif
  1298.   #else
  1299.     #define dotimesW_(countvar_from_dotimesW,count_from_dotimesW,statement_from_dotimesW)  \
  1300.       { countvar_from_dotimesW = (count_from_dotimesW);         \
  1301.         until (countvar_from_dotimesW==0)                       \
  1302.           {statement_from_dotimesW; countvar_from_dotimesW--; } \
  1303.       }
  1304.     #define dotimespW_(countvar_from_dotimespW,count_from_dotimespW,statement_from_dotimespW)  \
  1305.       { countvar_from_dotimespW = (count_from_dotimespW);                   \
  1306.         do {statement_from_dotimespW} until (--countvar_from_dotimespW==0); \
  1307.       }
  1308.   #endif
  1309.   #if defined(GNU) && defined(MC680X0) && !defined(HPUX_ASSEMBLER)
  1310.     # GNU-C auf einem 680X0 lΣ▀t sich dazu ⁿberreden, den DBRA-Befehl
  1311.     # auf intelligente Weise zu verwenden:
  1312.     #define fast_dotimesL
  1313.     #define dotimesL_(countvar_from_dotimesL,count_from_dotimesL,statement_from_dotimesL)  \
  1314.       { countvar_from_dotimesL = (count_from_dotimesL);           \
  1315.         if (!(countvar_from_dotimesL==0))                         \
  1316.           { countvar_from_dotimesL--;                             \
  1317.             do {statement_from_dotimesL}                          \
  1318.                until ((sintL)(--countvar_from_dotimesL) == -1);   \
  1319.       }   }
  1320.     #define dotimespL_(countvar_from_dotimespL,count_from_dotimespL,statement_from_dotimespL)  \
  1321.       { countvar_from_dotimespL = (count_from_dotimespL)-1;                             \
  1322.         do {statement_from_dotimespL} until ((sintL)(--countvar_from_dotimespL) == -1); \
  1323.       }
  1324.   #endif
  1325.   #ifndef dotimesL_
  1326.     #define dotimesL_(countvar_from_dotimesL,count_from_dotimesL,statement_from_dotimesL)  \
  1327.       { countvar_from_dotimesL = (count_from_dotimesL);         \
  1328.         until (countvar_from_dotimesL==0)                       \
  1329.           {statement_from_dotimesL; countvar_from_dotimesL--; } \
  1330.       }
  1331.     #define dotimespL_(countvar_from_dotimespL,count_from_dotimespL,statement_from_dotimespL)  \
  1332.       { countvar_from_dotimespL = (count_from_dotimespL);                   \
  1333.         do {statement_from_dotimespL} until (--countvar_from_dotimespL==0); \
  1334.       }
  1335.   #endif
  1336.   #if defined(GNU) && defined(__OPTIMIZE__)
  1337.     # Es ist mir nun schon zweimal passiert, da▀ ich dotimesL auf eine
  1338.     # Variable vom Typ uintC angewandt habe. Damit J÷rg und Marcus nicht
  1339.     # mehr suchen mⁿssen, ⁿberprⁿfe ich das jetzt.
  1340.     # Der Dummy-Aufruf wird, wenn's gut geht, von gcc wegoptimiert.
  1341.     # Ansonsten bekommt man einen Fehler beim Linken.
  1342.     #define dotimes_check_sizeof(countvar,type)  \
  1343.       if (!(sizeof(countvar)==sizeof(type))) { dotimes_called_with_count_of_wrong_size(); }
  1344.     extern void dotimes_called_with_count_of_wrong_size (void); # nicht existente Funktion
  1345.   #else
  1346.     #define dotimes_check_sizeof(countvar,type)
  1347.   #endif
  1348.   #define dotimesW(countvar_from_dotimesW,count_from_dotimesW,statement_from_dotimesW) \
  1349.     { dotimes_check_sizeof(countvar_from_dotimesW,uintW); \
  1350.       dotimesW_(countvar_from_dotimesW,count_from_dotimesW,statement_from_dotimesW); \
  1351.     }
  1352.   #define dotimespW(countvar_from_dotimespW,count_from_dotimespW,statement_from_dotimespW) \
  1353.     { dotimes_check_sizeof(countvar_from_dotimespW,uintW); \
  1354.       dotimespW_(countvar_from_dotimespW,count_from_dotimespW,statement_from_dotimespW); \
  1355.     }
  1356.   #define dotimesL(countvar_from_dotimesL,count_from_dotimesL,statement_from_dotimesL) \
  1357.     { dotimes_check_sizeof(countvar_from_dotimesL,uintL); \
  1358.       dotimesL_(countvar_from_dotimesL,count_from_dotimesL,statement_from_dotimesL); \
  1359.     }
  1360.   #define dotimespL(countvar_from_dotimespL,count_from_dotimespL,statement_from_dotimespL) \
  1361.     { dotimes_check_sizeof(countvar_from_dotimespL,uintL); \
  1362.       dotimespL_(countvar_from_dotimespL,count_from_dotimespL,statement_from_dotimespL); \
  1363.     }
  1364. # doconsttimes(count,statement);
  1365. # fⁿhrt statement count mal aus (count mal der Code!),
  1366. # wobei count eine constant-expression >=0, <=8 ist.
  1367.   #define doconsttimes(count_from_doconsttimes,statement_from_doconsttimes)  \
  1368.     { if (0 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1369.       if (1 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1370.       if (2 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1371.       if (3 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1372.       if (4 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1373.       if (5 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1374.       if (6 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1375.       if (7 < (count_from_doconsttimes)) { statement_from_doconsttimes; } \
  1376.     }
  1377. # DOCONSTTIMES(count,macroname);
  1378. # ruft count mal den Macro macroname auf (count mal der Code!),
  1379. # wobei count eine constant-expression >=0, <=8 ist.
  1380. # Dabei bekommt macroname der Reihe nach die Werte 0,...,count-1 ⁿbergeben.
  1381.   #define DOCONSTTIMES(count_from_DOCONSTTIMES,macroname_from_DOCONSTTIMES)  \
  1382.     { if (0 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((0 < (count_from_DOCONSTTIMES) ? 0 : 0)); } \
  1383.       if (1 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((1 < (count_from_DOCONSTTIMES) ? 1 : 0)); } \
  1384.       if (2 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((2 < (count_from_DOCONSTTIMES) ? 2 : 0)); } \
  1385.       if (3 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((3 < (count_from_DOCONSTTIMES) ? 3 : 0)); } \
  1386.       if (4 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((4 < (count_from_DOCONSTTIMES) ? 4 : 0)); } \
  1387.       if (5 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((5 < (count_from_DOCONSTTIMES) ? 5 : 0)); } \
  1388.       if (6 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((6 < (count_from_DOCONSTTIMES) ? 6 : 0)); } \
  1389.       if (7 < (count_from_DOCONSTTIMES)) { macroname_from_DOCONSTTIMES((7 < (count_from_DOCONSTTIMES) ? 7 : 0)); } \
  1390.     }
  1391.  
  1392. # Ab hier bedeutet uintC einen unsigned-Integer-Typ, mit dem sich besonders
  1393. # leicht zΣhlen lΣ▀t. Teilmengenrelation: uintW <= uintC <= uintL.
  1394. # uintCoverflow(x) stellt fest, ob nach Ausfⁿhren eines x++ ein Overflow
  1395. # eingetreten ist.
  1396.   #define intCsize intWLsize
  1397.   #define uintC uintWL
  1398.   #define sintC sintWL
  1399.   #if (intCsize==intWsize)
  1400.     #define dotimesC dotimesW
  1401.     #define dotimespC dotimespW
  1402.   #endif
  1403.   #if (intCsize==intLsize)
  1404.     #define dotimesC dotimesL
  1405.     #define dotimespC dotimespL
  1406.   #endif
  1407.   #define uintCoverflow(x)  ((intCsize<intLsize) && ((x)==0))
  1408. # Verwende 'uintC' fⁿr ZΣhler, die meist klein sind.
  1409.  
  1410. # Die Arithmetik benutzt "Digit Sequences" aus "Digits".
  1411. # Das sind unsigned ints mit intDsize Bits (sollte =8 oder =16 oder =32 sein).
  1412. # Falls HAVE_DD: "Doppel-Digits" sind unsigned ints mit 2*intDsize<=32 Bits.
  1413.   #if defined(MC680X0) && !defined(MC680Y0)
  1414.     #define intDsize 16
  1415.     #define intDDsize 32  # = 2*intDsize
  1416.     #define log2_intDsize  4  # = log2(intDsize)
  1417.   #elif defined(MC680Y0) || defined(I80Z86) || defined(SPARC) || defined(HPPA) || defined(MIPS) || defined(M88000) || defined(RS6000) || defined(VAX) || defined(CONVEX) || defined(ARM) || defined(DECALPHA)
  1418.     #define intDsize 32
  1419.     #define intDDsize 64  # = 2*intDsize
  1420.     #define log2_intDsize  5  # = log2(intDsize)
  1421.   #else
  1422.     #error "Preferred digit size depends on CPU -- Gr÷▀e intDsize neu einstellen!"
  1423.   #endif
  1424.   #ifdef ANSI
  1425.     typedef unsigned_int_with_n_bits(intDsize)  uintD;
  1426.     typedef signed_int_with_n_bits(intDsize)    sintD;
  1427.   #else
  1428.     typedef uint/**/intDsize  uintD;
  1429.     typedef sint/**/intDsize  sintD;
  1430.   #endif
  1431.   #if (intDDsize<=32)
  1432.     #define HAVE_DD 1
  1433.     #ifdef ANSI
  1434.       typedef unsigned_int_with_n_bits(intDDsize)  uintDD;
  1435.       typedef signed_int_with_n_bits(intDDsize)    sintDD;
  1436.     #else
  1437.       typedef uint/**/intDDsize  uintDD;
  1438.       typedef sint/**/intDDsize  sintDD;
  1439.     #endif
  1440.   #else
  1441.     #define HAVE_DD 0
  1442.   #endif
  1443.  
  1444. # Auch einige andere Kⁿrzel wie 'oint', 'tint', 'aint', 'cint' werden noch
  1445. # fⁿr entsprechende Integer-Typen verwendet werden:
  1446. #   Integertyp     enthΣlt Information Σquivalent zu
  1447. #      oint           LISP-Objekt
  1448. #      tint           Typcode eines LISP-Objekts
  1449. #      aint           Adresse eines LISP-Objekts
  1450. #      cint           LISP-Character
  1451.  
  1452. # ▄blicherweise ist sizeof(oint) = sizeof(aint) = sizeof(uintL) = 32 Bit.
  1453. # Bei Modell WIDE ist sizeof(oint) > sizeof(uintL).
  1454. # Modell WIDE_HARD steht fⁿr sizeof(aint) > sizeof(uintL).
  1455. #   Dieses Modell mu▀ dann gewΣhlt werden, wenn
  1456. #   sizeof(void*) > sizeof(uintL) = 32 Bit ist. Es setzt
  1457. #   sizeof(long) = sizeof(void*) = 64 Bit voraus, denn einige 64-Bit-Zahlen
  1458. #   tauchen als PrΣprozessor-Konstanten auf.
  1459. # Modell WIDE_SOFT steht fⁿr sizeof(oint) = 64 Bit und sizeof(aint) = 32 Bit.
  1460. #   Dieses Modell kann auf jeder 32-Bit-Maschine gewΣhlt werden, wenn der
  1461. #   Compiler (soft- oder hardwaremΣ▀ige) 64-Bit-Zahlen hat. Es mu▀ dann
  1462. #   gewΣhlt werden, wenn ansonsten nicht genug Platz fⁿr die Typbits in einem
  1463. #   32-Bit-Pointer wΣre.
  1464.  
  1465. #ifdef DECALPHA
  1466.   #define WIDE_HARD
  1467. #endif
  1468.  
  1469. #if defined(WIDE) && !(defined(WIDE_HARD) || defined(WIDE_SOFT))
  1470.   #define WIDE_SOFT
  1471. #endif
  1472. #if (defined(WIDE_HARD) || defined(WIDE_SOFT)) && !defined(WIDE)
  1473.   #define WIDE
  1474. #endif
  1475. # Nun ist defined(WIDE) == defined(WIDE_HARD) || defined(WIDE_SOFT)
  1476.  
  1477. #ifdef WIDE_SOFT
  1478.   #ifdef GNU
  1479.     # Benutze die GNU-C-Erweiterungen, um die breiten oints als structs aufzufassen.
  1480.     #define WIDE_STRUCT
  1481.   #endif
  1482.   # Bestimmt die Anordnung der Teile eines oints:
  1483.   #define WIDE_ENDIANNESS TRUE
  1484. #endif
  1485.  
  1486.  
  1487. # ###################### Betriebssystem-Routinen ##################### #
  1488.  
  1489. # allgemein standardisierte Konstanten fⁿr Steuerzeichen:
  1490.   #define BS    8  #  #\Backspace     Backspace
  1491.   #define TAB   9  #  #\Tab           Tabulator
  1492.   #define LF   10  #  #\Linefeed      Zeilenvorschub
  1493.   #define CR   13  #  #\Return        Carriage return, zum Zeilenanfang
  1494.   #define PG   12  #  #\Page          Form Feed, neue Seite
  1495.  
  1496. #ifdef ATARI
  1497.  
  1498. #include "atari.c"
  1499.  
  1500. # statement ausfⁿhren, falls beide Maustasten gedrⁿckt sind:
  1501. # interruptp(statement);
  1502.   #define interruptp(statement)                                                                  \
  1503.     { if (((~LineA_MouseButtons()) & 0x03) ==0) # beide Bits 0 (links) und 1 (rechts) gesetzt?   \
  1504.         { set_break_sem_1(); # Interrupt sperren                                                 \
  1505.           while (((~LineA_MouseButtons()) & 0x03) ==0) ; # solange beide Tasten gedrⁿckt, warten \
  1506.           LineA_MouseButtons() &= 0x03; # dann beide Tasten fⁿr nicht gedrⁿckt erklΣren          \
  1507.           clr_break_sem_1(); # Interrupt wieder zulassen                                         \
  1508.           statement;                                                                             \
  1509.     }   }
  1510. # wird verwendet von EVAL, IO, SPVW, STREAM
  1511.  
  1512. #endif # ATARI
  1513.  
  1514. #ifdef AMIGAOS
  1515.  
  1516. #ifdef GNU
  1517.   # Expandiere alle Betriebssystem-Aufrufe inline, mit Markus Wild inlines.h
  1518.   #define GNU_INLINES
  1519. #endif
  1520.  
  1521. #include "amiga.c"
  1522.  
  1523. # statement im Unterbrechungsfalle (Ctrl-C gedrⁿckt) ausfⁿhren:
  1524. # interruptp(statement);
  1525.   #define interruptp(statement) \
  1526.     { # Ctrl-C-Signal abfragen und l÷schen:                             \
  1527.       if (SetSignal(0L,(ULONG)(SIGBREAKF_CTRL_C)) & (SIGBREAKF_CTRL_C)) \
  1528.         { statement }                                                   \
  1529.     }
  1530.   # vgl. AMIGA.D und exec.library/SetSignal
  1531. # wird verwendet von EVAL, IO, SPVW, STREAM
  1532.  
  1533. #endif # AMIGAOS
  1534.  
  1535. #ifdef RISCOS
  1536.  
  1537. #include "acorn.c"
  1538.  
  1539. # Unterbrechungen noch nicht implementiert.
  1540.   #define interruptp(statement)
  1541.  
  1542. # Verdecken der Funktion read:
  1543.   #define read LISPread
  1544.  
  1545. #endif # RISCOS
  1546.  
  1547. #if defined(UNIX) || defined(DJUNIX) || defined(EMUNIX) || defined(WATCOM)
  1548.  
  1549. #ifdef UNIX
  1550. #include "unix.c"
  1551. #endif
  1552. #ifdef MSDOS
  1553. #include "msdos.c"
  1554. #endif
  1555.  
  1556. # statement im Unterbrechungsfalle ausfⁿhren:
  1557. # interruptp(statement);
  1558.  #if defined(UNIX) || (defined(EMUNIX) && !defined(WINDOWS))
  1559.   # Eine Tastatur-Unterbrechung (Signal SIGINT, erzeugt durch Ctrl-C)
  1560.   # wird eine Sekunde lang aufgehoben. In dieser Zeit kann sie mittels
  1561.   # 'interruptp' auf fortsetzbare Art behandelt werden. Nach Ablauf dieser
  1562.   # Zeit wird das Programm nichtfortsetzbar unterbrochen.
  1563.   #define PENDING_INTERRUPTS
  1564.   extern uintB interrupt_pending;
  1565.   #define interruptp(statement)  if (interrupt_pending) { statement; }
  1566.  #endif
  1567.  #if defined(DJUNIX)
  1568.   # DJUNIX kennt keine Signale, nicht mal Ctrl-C.
  1569.   # Hat auch kein alarm() oder ualarm().
  1570.   #define interruptp(statement)  if (_go32_was_ctrl_break_hit()) { statement; }
  1571.  #endif
  1572.  #if defined(WATCOM) && !defined(WINDOWS)
  1573.   # WATCOM hat kein alarm() oder ualarm().
  1574.   #define interruptp(statement)  FALSE
  1575.  #endif
  1576.  #if defined(WINDOWS)
  1577.   # Eine Unterbrechung (erzeugt durch einen Windows-Event) wird aufgehoben.
  1578.   # Sie kann mittels 'interruptp' auf fortsetzbare Art behandelt werden.
  1579.   #define PENDING_INTERRUPTS
  1580.   extern uintB interrupt_pending;
  1581.   #define interruptp(statement)  if (interrupt_pending) { statement; }
  1582.  #endif
  1583. # wird verwendet von EVAL, IO, SPVW, STREAM
  1584.  
  1585. # Verdecken der Systemfunktion read:
  1586.   #define read LISPread
  1587. # Consensys macht "#define DS 3". Grr...
  1588.   #undef DS
  1589. # 386BSD macht "#define CBLOCK 64". Grr...
  1590.   #undef CBLOCK
  1591. # BSDI 1.1 macht "#define IMMUTABLE". Grr...
  1592.   #ifdef __bsdi__
  1593.     #undef IMMUTABLE
  1594.   #endif
  1595.  
  1596. #endif # UNIX || DJUNIX || EMUNIX || WATCOM
  1597.  
  1598. # ##################### Weitere System-AbhΣngigkeiten ##################### #
  1599.  
  1600. # Erst solche, die bis auf die Lisp-Ebene hin sichtbar sind:
  1601.  
  1602. # Einstellung der Tabelle von Zeichennamen:
  1603.   #ifdef ATARI
  1604.     #define ATARI_CHARNAMES
  1605.   #endif
  1606.   #ifdef AMIGA
  1607.     #define AMIGA_CHARNAMES
  1608.   #endif
  1609.   #ifdef MSDOS
  1610.     #define MSDOS_CHARNAMES
  1611.   #endif
  1612.   #if defined(UNIX) || defined(RISCOS)
  1613.     #define UNIX_CHARNAMES
  1614.   #endif
  1615. # Bei Erweiterung: CONSTOBJ, CHARSTRG, FORMAT.LSP erweitern.
  1616.  
  1617. # Ob ein Stream *KEYBOARD-INPUT* gebildet wird,
  1618. # und ob er fⁿr den Stream *TERMINAL-IO* verwendet wird:
  1619.   #if defined(ATARI) || defined(MSDOS) || defined(UNIX) || defined(RISCOS)
  1620.     #define KEYBOARD
  1621.     #if defined(ATARI) # || defined(WINDOWS) ??
  1622.       #define TERMINAL_USES_KEYBOARD
  1623.     #endif
  1624.   #endif
  1625. # Bei Erweiterung: STREAM, USER1.LSP erweitern.
  1626.  
  1627. # Ob wir die GNU Readline-Library fⁿr *TERMINAL-IO* benutzen:
  1628.   #if ((defined(UNIX) && !defined(UNIX_COHERENT)) || (defined(MSDOS) && !defined(WATCOM) && !defined(WINDOWS))) && !defined(NO_READLINE)
  1629.     # Unter Coherent verhindert readline() die Erkennung des Signals Ctrl-C.
  1630.     # Auf WATCOM ist die Readline-Library noch nicht portiert.
  1631.     # Unter Windows haben wir Besseres vor.
  1632.     #define GNU_READLINE
  1633.   #endif
  1634. # Bei Erweiterung: READLINE erweitern.
  1635.  
  1636. # Ob es Window-Streams und eine Package SCREEN gibt:
  1637.   #if defined(ATARI) || defined(MSDOS) || defined(UNIX)
  1638.     #define SCREEN
  1639.   #endif
  1640. # Bei Erweiterung: STREAM erweitern (viel Arbeit!).
  1641.  
  1642. # Ob es File-Handle-Streams gibt:
  1643.   #if defined(UNIX) || defined(MSDOS) || defined(AMIGAOS) # || defined(RISCOS)
  1644.     #define HANDLES
  1645.   #endif
  1646. # Bei Erweiterung: STREAM erweitern.
  1647.  
  1648. # Ob es Pipe-Streams gibt:
  1649.   #if defined(UNIX) || defined(EMUNIX_PORTABEL)
  1650.     #define PIPES
  1651.     #if defined(UNIX) || defined(EMUNIX_PORTABEL)
  1652.       #define PIPES2  # bidirektionale Pipes
  1653.     #endif
  1654.   #endif
  1655. # Bei Erweiterung: STREAM und USER2.LSP erweitern.
  1656.  
  1657. # Ob es Socket-Streams gibt:
  1658.   #if defined(UNIX) && defined(HAVE_GETHOSTBYNAME)
  1659.     # Damit Socket-Streams sinnvoll sind, mu▀ socket.d compilierbar sein.
  1660.     # Dazu mu▀ netdb.h oder sun/netdb.h existieren, was zufΣllig auch der
  1661.     # Existenz von gethostbyname() entspricht.
  1662.     #define SOCKETS
  1663.   #endif
  1664. # Bei Erweiterung: STREAM erweitern.
  1665.  
  1666. # Whether there are generic streams:
  1667.   #if 1
  1668.     #define GENERIC_STREAMS
  1669.   #endif
  1670. # Bei Erweiterung: Nichts weiter zu tun.
  1671.  
  1672. # Ob die fⁿr die Funktionen MACHINE-TYPE, MACHINE-VERSION, MACHINE-INSTANCE
  1673. # ben÷tigte Information vom Betriebssystem geholt werden kann:
  1674.   #ifdef UNIX
  1675.     #define MACHINE_KNOWN
  1676.   #endif
  1677. # Bei Erweiterung: MISC erweitern.
  1678.  
  1679. # Ob es LOGICAL-PATHNAMEs gibt:
  1680.   #if 1
  1681.     #define LOGICAL_PATHNAMES
  1682.   #endif
  1683. # Bei Erweiterung: Nichts weiter zu tun.
  1684.  
  1685. # Ob die Funktion USER-HOMEDIR-PATHNAME existiert:
  1686.   #if defined(UNIX) || defined(RISCOS)
  1687.     #define USER_HOMEDIR
  1688.   #endif
  1689. # Bei Erweiterung: PATHNAME erweitern.
  1690.  
  1691. # Ob ein Stream *PRINTER-OUTPUT* bzw. eine Funktion MAKE-PRINTER-STREAM
  1692. # zur Verfⁿgung gestellt werden:
  1693.   #ifdef ATARI
  1694.     #define PRINTER_ATARI
  1695.   #endif
  1696.   #ifdef AMIGAOS
  1697.     #define PRINTER_AMIGAOS
  1698.   #endif
  1699. # Ob es Printer-Streams gibt:
  1700.   #if defined(PRINTER_ATARI) || defined(PRINTER_AMIGAOS)
  1701.     #define PRINTER
  1702.   #endif
  1703. # Bei Erweiterung: STREAM erweitern.
  1704.  
  1705. # Ob externe Kommunikation via Rexx unterstⁿtzt wird.
  1706.   #ifdef AMIGAOS
  1707.     #define REXX
  1708.     # define REXX_SERVER  # noch nicht ?JCH?
  1709.   #endif
  1710. # Bei Erweiterung: REXX erweitern.
  1711.  
  1712. # Ob Graphik-Operationen unterstⁿtzt werden.
  1713.   #if (defined(EMUNIX) && !defined(WINDOWS)) || defined(UNIX_LINUX)
  1714.     #define GRAPHICS
  1715.     #define GRAPHICS_SWITCH  # Umschalten zwischen Text-Modus und Grafik-Modus
  1716.   #endif
  1717. # Bei Erweiterung: GRAPH erweitern.
  1718.  
  1719. # Ob das Betriebssystem ein Environment verwaltet, das Strings zu Strings
  1720. # assoziiert:
  1721.   #if defined(UNIX) || defined(MSDOS) || defined(ATARI) || defined(RISCOS)
  1722.     #define HAVE_ENVIRONMENT
  1723.   #endif
  1724. # Bei Erweiterung: Nichts weiter zu tun.
  1725.  
  1726. # Ob das Betriebssystem einen bevorzugten Kommando-Interpreter hat:
  1727.   #if defined(UNIX) || defined(MSDOS) || defined(ATARI) || defined(AMIGAOS) || defined(RISCOS)
  1728.     #define HAVE_SHELL
  1729.   #endif
  1730. # Bei Erweiterung: PATHNAME erweitern.
  1731.  
  1732. # Ob ein Foreign Function Interface zur Verfⁿgung gestellt wird:
  1733.   #if defined(UNIX) && !defined(UNIX_BINARY_DISTRIB)
  1734.     #define HAVE_FFI
  1735.   #endif
  1736. # Bei Erweiterung: ??
  1737.  
  1738. # Dann die, die nur intern bedeutsam sind:
  1739.  
  1740. # Ob die GC nicht mehr referenzierte Files schlie▀t:
  1741.   #if defined(UNIX) || defined(WINDOWS) || defined(AMIGAOS) || defined(RISCOS)
  1742.     #define GC_CLOSES_FILES
  1743.   #endif
  1744. # Bei Erweiterung: nichts zu tun.
  1745.  
  1746. # Wie die Zeitmessungen durchgefⁿhrt werden:
  1747.   #ifdef ATARI
  1748.     #define TIME_ATARI
  1749.   #endif
  1750.   #ifdef MSDOS
  1751.     #define TIME_MSDOS
  1752.   #endif
  1753.   #ifdef AMIGAOS
  1754.     #define TIME_AMIGAOS
  1755.   #endif
  1756.   #ifdef RISCOS
  1757.     #define TIME_RISCOS
  1758.   #endif
  1759.   #ifdef UNIX
  1760.     #if defined(HAVE_GETTIMEOFDAY) || defined(HAVE_FTIME)
  1761.       #define TIME_UNIX
  1762.     #elif defined(HAVE_TIMES_CLOCK)
  1763.       #define TIME_UNIX_TIMES
  1764.     #endif
  1765.   #endif
  1766.   #if defined(TIME_ATARI) || defined(TIME_MSDOS) || defined(TIME_AMIGAOS) || defined(TIME_UNIX_TIMES) || defined(TIME_RISCOS)
  1767.     # Die Zeitaufl÷sung ist nur mittel, so da▀ man fⁿr Zeitdifferenz-Messungen
  1768.     # ohne weiteres eine 32-Bit-Zahl nehmen kann.
  1769.     #define TIME_1
  1770.     # Wir holen die Uhrzeit einmal beim System-Start. Alle weiteren
  1771.     # Uhrzeiten werden relativ zu dieser genommen.
  1772.     #define TIME_RELATIVE
  1773.   #endif
  1774.   #if defined(TIME_UNIX)
  1775.     # Die Zeitaufl÷sung ist so hoch, da▀ man fⁿr Zeitdifferenz-Messungen gleich
  1776.     # zwei 32-Bit-Zahlen braucht: Sekunden und Sekundenbruchteile.
  1777.     #define TIME_2
  1778.     # In diesem Fall k÷nnen wir auch gleich immer mit absoluten und genauen
  1779.     # Uhrzeiten rechnen.
  1780.     #define TIME_ABSOLUTE
  1781.   #endif
  1782. # Bei Erweiterung: MISC, SPVW erweitern.
  1783.  
  1784. # Ob die Funktion SYS::%SLEEP ein oder zwei Argumente ⁿbergeben bekommt:
  1785.   #if defined(TIME_ATARI) || defined(TIME_MSDOS) || defined(TIME_AMIGAOS) || defined(TIME_RISCOS)
  1786.     #define SLEEP_1
  1787.   #endif
  1788.   #if defined(TIME_UNIX) || defined(TIME_UNIX_TIMES)
  1789.     #define SLEEP_2
  1790.   #endif
  1791. # Bei Erweiterung: MISC, DEFS1.LSP erweitern.
  1792.  
  1793. # Ob das Betriebssystem uns die Run-Time liefern kann, oder ob wir sie
  1794. # selber akkumulieren mⁿssen (was bei Multitasking-Betriebssystemen ein wenig
  1795. # verfΣlschend ist: AMIGAOS??, RISCOS??):
  1796.   #ifdef UNIX
  1797.     #define HAVE_RUN_TIME
  1798.   #endif
  1799. # Bei Erweiterung: SPVW erweitern.
  1800.  
  1801. # Ob das Betriebssystem Virtual Memory zur Verfⁿgung stellt.
  1802.   #if defined(UNIX) || defined(EMUNIX) || defined(DJUNIX) || defined(WINDOWS)
  1803.     #define VIRTUAL_MEMORY
  1804.   #endif
  1805. # Bei Erweiterung: nichts zu tun.
  1806.  
  1807. # Ob das Betriebssystem Unterbrechungen (Ctrl-C o.Σ.) als Signal auszuliefern
  1808. # in der Lage ist:
  1809.   #if defined(UNIX) || ((defined(EMUNIX) || defined(WATCOM)) && !defined(WINDOWS)) || defined(RISCOS)
  1810.     #define HAVE_SIGNALS
  1811.   #endif
  1812. # Ob wir auf asynchrone Signale auch reagieren k÷nnen:
  1813. # (Bei WIDE_SOFT ist das Schreiben eines Pointers i.a. keine Elementar-Operation mehr!)
  1814.   #if defined(WIDE_SOFT) && !(defined(GNU) && defined(SPARC))
  1815.     #define NO_ASYNC_INTERRUPTS
  1816.   #endif
  1817. # Bei Erweiterung: SPVW erweitern, interruptp() schreiben.
  1818.  
  1819. # Arten der Pathname-Verwaltung:
  1820.   #ifdef ATARI
  1821.     #define PATHNAME_ATARI
  1822.   #endif
  1823.   #ifdef AMIGAOS
  1824.     #define PATHNAME_AMIGAOS
  1825.   #endif
  1826.   #ifdef MSDOS
  1827.    #ifdef OS2
  1828.     #define PATHNAME_OS2
  1829.    #else
  1830.     #define PATHNAME_MSDOS
  1831.    #endif
  1832.   #endif
  1833.   #ifdef RISCOS
  1834.     #define PATHNAME_RISCOS
  1835.   #endif
  1836.   #ifdef UNIX
  1837.     #define PATHNAME_UNIX
  1838.   #endif
  1839. # Die Komponenten von Pathnames:
  1840.   #if defined(PATHNAME_ATARI) || defined(PATHNAME_AMIGAOS) || defined(PATHNAME_MSDOS) || defined(PATHNAME_OS2)
  1841.     #define HAS_HOST      0
  1842.     #define HAS_DEVICE    1
  1843.     #define HAS_VERSION   0
  1844.   #endif
  1845.   #ifdef PATHNAME_UNIX
  1846.     #define HAS_HOST      0
  1847.     #define HAS_DEVICE    0
  1848.     #define HAS_VERSION   0
  1849.   #endif
  1850.   #ifdef PATHNAME_RISCOS
  1851.     #define HAS_HOST      1
  1852.     #define HAS_DEVICE    1
  1853.     #define HAS_VERSION   0
  1854.     #define FLIP_NAME_TYPE # Name und Type zum Betriebssystem hin vertauschen
  1855.   #endif
  1856.   #ifdef PATHNAME_ATARI
  1857.     #define HAS_SERNR     1
  1858.   #else
  1859.     #define HAS_SERNR     0
  1860.   #endif
  1861. # Handhabung der File "Extension" (pathname-type):
  1862.   #if defined(PATHNAME_ATARI) || defined(PATHNAME_MSDOS)
  1863.     #define PATHNAME_EXT83  # Name und Type getrennt, Abschneiden nach 8 bzw. 3 Zeichen
  1864.   #endif
  1865.   #if defined(PATHNAME_RISCOS)
  1866.     #define PATHNAME_EXT  # Name und Type getrennt, aber keine LΣngenbegrenzung
  1867.   #endif
  1868.   #if defined(PATHNAME_UNIX) || defined(PATHNAME_AMIGAOS) || defined(PATHNAME_OS2)
  1869.     #define PATHNAME_NOEXT  # Keine explizite Extension.
  1870.   #endif
  1871. # Bei Erweiterung: PATHNAME erweitern.
  1872.  
  1873. # Ob Simple-Strings am Stⁿck an Streams durchgereicht werden:
  1874.   #if defined(UNIX) || defined(AMIGAOS) || defined(OS2) || defined(RISCOS)
  1875.     #define STRM_WR_SS
  1876.   #endif
  1877. # Bei VerΣnderung: Nichts weiter zu tun.
  1878.  
  1879. # Ob an diversen Schlⁿsselstellen der STACK ⁿberprⁿft wird:
  1880.   #define STACKCHECKS  (SAFETY >= 1) # beim Aufruf von SUBRs und FSUBRs
  1881.   #define STACKCHECKC  (SAFETY >= 1) # beim Abinterpretieren compilierter Closures
  1882.   #define STACKCHECKR  (SAFETY >= 1) # im Reader
  1883.   #define STACKCHECKP  (SAFETY >= 1) # im Printer
  1884. # Bei VerΣnderung: Nichts weiter zu tun.
  1885.  
  1886. # Ob subr_tab statisch zu initialisieren versucht wird.
  1887.   #if (1 || defined(ANSI) || defined(GNU)) && !(defined(WIDE_SOFT) && !defined(WIDE_STRUCT)) && !defined(WATCOM)
  1888.     #define INIT_SUBR_TAB
  1889.   #endif
  1890. # Bei VerΣnderung: Nichts weiter zu tun.
  1891.  
  1892. # Ob symbol_tab statisch zu initialisieren versucht wird.
  1893. # (Es macht die Initialisierung einfacher, aber bei GNU-C auf einem Amiga
  1894. # oder unter Coherent reicht der Platz zum Compilieren von SPVWTABS nicht.
  1895. # WATCOM stⁿrzt ab mit "Abnormal program termination: Page fault".
  1896. # Und Nicht-ANSI-Compiler verweigern das Initialisieren von Unions.)
  1897.   #if (defined(ANSI) || defined(GNU)) && !(defined(WIDE_SOFT) && !defined(WIDE_STRUCT)) && !(defined(AMIGA) || defined(WATCOM) || (defined(UNIX_COHERENT) && defined(GNU)))
  1898.     #define INIT_SYMBOL_TAB
  1899.   #endif
  1900. # Bei VerΣnderung: Nichts weiter zu tun.
  1901.  
  1902. # Ob object_tab statisch zu initialisieren versucht wird.
  1903.   #if (1 || defined(ANSI) || defined(GNU)) && !(defined(WIDE_SOFT) && !defined(WIDE_STRUCT)) && !defined(WATCOM)
  1904.     #define INIT_OBJECT_TAB
  1905.   #endif
  1906. # Bei VerΣnderung: Nichts weiter zu tun.
  1907.  
  1908.  
  1909. # ############### Liste von implementierten CLtL2-Features ################ #
  1910.  
  1911. #undef  X3J13_003
  1912. #define X3J13_005  # 18.5.1993
  1913. #define X3J13_149  # 22.7.1993
  1914. #define X3J13_161  # 20.5.1993
  1915. #define X3J13_175  # 25.7.1993
  1916.  
  1917.  
  1918. # ##################### Speicherstruktur von Objekten ##################### #
  1919.  
  1920. /*
  1921.  
  1922. FESTLEGUNG DER BEDEUTUNG DES TYP-INFOBYTES UND DER SPEICHERFORMATE DER
  1923. ======================================================================
  1924.                        VERSCHIEDENEN DATENTYPEN
  1925.                        ========================
  1926.  
  1927. 1. Typ-Infobyte
  1928. ---------------
  1929.  
  1930. Das Typ-Infobyte besteht aus den h÷chstwertigen 8 Bits (Bits 24-31)
  1931. des Langworts, das ein Datum reprΣsentiert. Au▀er in einigen speziellen
  1932. FΣllen ("kleine Daten" wie Zeichen, Fixnums u.Σ.) enthalten die ⁿbrigen
  1933. 24 Bits die Speicheradresse des Objekts (wie Cons, Symbol, Vektor...).
  1934. Bit 7 des Infobytes (Bit 31 des Langworts) dient als Markierungsbit
  1935. fⁿr den Garbage Collector und ist au▀erhalb desselben stets gel÷scht
  1936. (einzige Ausnahme: Hilfsroutine fⁿr PRINT-CIRCLE). Bit 6 (Bit 30) ist
  1937. genau dann gesetzt, wenn es sich um ein Cons handelt (CONS_BIT), Bit 5
  1938. (Bit 29) genau dann, wenn es sich um ein Symbol handelt (SYMBOL_BIT).
  1939. Bit 4 (Bit 28) ist nur bei Zahlen gesetzt (NUMBER_BIT). Die ⁿbrigen
  1940. 4 Bits dienen der nΣheren Unterscheidung. Die Bedeutungen im einzelnen:
  1941.  
  1942. Bits 76543210       Bedeutung (Typ)
  1943.  
  1944.      00000000       Maschinenpointer  (*)
  1945.      00000???       array
  1946.      000000??       einfacher vector (d.h. eindimensionaler Array
  1947.                                       ohne zusΣtzl. Features)
  1948.      00000001       simple-bit-vector
  1949.      00000010       simple-string
  1950.      00000011       simple-vector
  1951.      000001??       ⁿbrige Arrays
  1952.      00000100       sonstige Arrays (Rang /= 1 oder andere Elementtypen)
  1953.      00000101       bit-vector oder byte-vector, kein simple-bit-vector
  1954.      00000110       string, kein simple-string
  1955.      00000111       (vector t), kein simple-vector
  1956.      00001...       Records:
  1957.      00001000        closure
  1958.      00001001        structure
  1959.      00001010        stream
  1960.      00001011        sonstige (package, readtable, hash-table ...)
  1961.      00001100        instance
  1962.      00001101       character         (*)
  1963.      00001110       subr              (*)
  1964.      00001111....0  frame-pointer     (*) [STACK mu▀ Alignment 2 haben!]
  1965.      000011110...1  read-label        (*)
  1966.      000011111...1  system            (*) (UNBOUND, SPECDECL u.Σ.)
  1967.      0001???V       number (V = Vorzeichen bei reellen Zahlen)
  1968.      0001000V       fixnum            (*)
  1969.      0001001V       short-float       (*)
  1970.      0001010V       bignum
  1971.      0001011V       single-float
  1972.      0001100V       ratio
  1973.      0001101V       double-float
  1974.      00011100       complex
  1975.      0001111V       long-float
  1976.      0010????       symbol
  1977.      0100????       cons
  1978.  
  1979. (Objekte der mit (*) gekennzeichneten Typen sind nicht im Speicher
  1980. verschiebbar und brauchen daher bei der GC nicht berⁿcksichtigt zu
  1981. werden.)
  1982.  
  1983. 2. Speicherformate
  1984. ------------------
  1985.  
  1986. 2.0. Maschinenpointer
  1987.  
  1988. Ein Maschinenpointer ist eine fⁿrs LISP-System bedeutungslose Adresse.
  1989. (Beispielsweise Pointer in den SP oder in den STACK, die keine Typinfo
  1990. tragen. K÷nnen z.B. vorⁿbergehend im Stack liegen.)
  1991. Maschinenpointer, die nicht in 24 Bit passen, mⁿssen als Foreign-Pointer
  1992. in einen Simple-Bit-Vector verpackt werden.
  1993.  
  1994. 2.1. CONS
  1995.  
  1996. Ein Cons umfa▀t 8 Byte, aufgeteilt in 2 Langworte. Das erste enthΣlt
  1997. den CDR, das zweite den CAR.
  1998.  
  1999.      +-+-----+       +-------+-------+
  2000.      |T| ADR |  ADR: |  CDR  |  CAR  |
  2001.      +-+-----+       +-------+-------+
  2002.  
  2003. ADR: Adresse des Records fⁿr CAR und CDR
  2004. T: Typ-Info fⁿr CONS #b0100????
  2005. Conses befinden sich im Speicherbereich fⁿr Zwei-Pointer-Objekte.
  2006.  
  2007. 2.2. SYMBOL
  2008.  
  2009. Ein Symbol umfa▀t 24 Byte (6 Langworte). Das zweite enthΣlt den aktuellen
  2010. dynamischen Wert, das dritte die globale Funktionsdefinition (wenn nicht
  2011. vorhanden, steht in beiden FΣllen dort der Wert #UNBOUND). Das vierte
  2012. Langwort enthΣlt die Property-Liste (zunΣchst NIL), das fⁿnfte den Namen
  2013. des Symbols (ein [einfacher] String). Im sechsten Langwort befindet sich
  2014. die Home-Package, und das erste ist frei fⁿr die GC, bis auf einige
  2015. Flags (KEYWORD, CONSTANT, SPECIAL).
  2016.  
  2017.      +-+-----+       +-------+-------+-------+-------+-------+-------+
  2018.      |T| ADR |  ADR: |F      | VALUE | FUNCT.| PLIST | NAME  | PACK. |
  2019.      +-+-----+       +-------+-------+-------+-------+-------+-------+
  2020.  
  2021. ADR: Adresse der Recordstruktur
  2022. T: Typ-Info fⁿr SYMBOL #b0010????
  2023. F: Bits 2..0 sind die Flags
  2024. Symbole befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2025.  
  2026. 2.3. CHARACTER
  2027.  
  2028. Code, Bit- und Font-Attribute befinden sich direkt im darstellenden
  2029. Langwort: Bits 0-7 geben den (ASCII-)Code des Zeichens, Bits 8-11 sind
  2030. die Control-Bits (control: Bit 8, meta: Bit 9, super: Bit 10, hyper:
  2031. Bit 11) und Bits 12-15 die Fontnummer (0 bis 15); die Bits 16-23 sind
  2032. stets 0, nur Bit 16 wird bei den Streams als Markierung benutzt.
  2033.  
  2034.      +-+-+--+-+
  2035.      |T|0|FB|C|
  2036.      +-+-+--+-+
  2037.  
  2038. T = #b00001100 Typ-Info fⁿr CHARACTER
  2039. 0 = #b00000000
  2040. F = 4 Bits fⁿr Fontnummer (obere 4 Bits)
  2041. B = 4 Control-Bits (untere 4 Bits)
  2042. C = 8 Bits fⁿr Code
  2043.  
  2044. 2.4. SUBR, FSUBR
  2045.  
  2046. Die unteren 24 Bits enthalten die Startadresse des Maschinenunter-
  2047. programms, das die betreffende Funktion ausfⁿhrt (zum Format des
  2048. Codes siehe unten).
  2049.  
  2050.      +-+-----+
  2051.      |T| ADR |
  2052.      +-+-----+
  2053.  
  2054. T = #b00001101 oder #b00001110 Typ-Info fⁿr SUBR oder FSUBR
  2055.  
  2056. 2.5. FRAME-POINTER
  2057.  
  2058. Die unteren 24 Bits enthalten die Adresse des Frame-Anfangs (im LISP-
  2059. Stack), "Anfang" hei▀t Adresse des Langworts mit dem Frame-Infobyte.
  2060.  
  2061.      +-+-----+
  2062.      |T| ADR |
  2063.      +-+-----+
  2064.  
  2065. T = #b00001111 Typ-Info fⁿr FRAME-POINTER
  2066. Zum Aufbau der Frames siehe EVALBIBL.
  2067.  
  2068. 2.6. READ-LABEL
  2069.  
  2070. Die unteren 22 Bits (Bit 23 ist gesetzt, Bit 22 gel÷scht) enthalten
  2071. die Nummer n des Labels #n= .
  2072.  
  2073.      +-+-----+
  2074.      |T| VAL |
  2075.      +-+-----+
  2076.  
  2077. T = #b00001111 Typ-Info fⁿr SYSTEM, VAL = #b10??????????????????????
  2078.  
  2079. 2.7. SYSTEM
  2080.  
  2081. Die unteren 22 Bits (Bits 22,23 sind gesetzt) enthalten irgendeine
  2082. spezielle Markierung (z.B. #b1111111111111111111111 fⁿr #UNBOUND).
  2083.  
  2084.      +-+-----+
  2085.      |T|FLAG |
  2086.      +-+-----+
  2087.  
  2088. T = #b00001111 Typ-Info fⁿr SYSTEM, FLAG = #b11??????????????????????
  2089.  
  2090. 2.8. FIXNUM
  2091.  
  2092. Bit 24 enthΣlt das Vorzeichen (1 fⁿr negativ, 0 fⁿr >= 0), die unteren
  2093. 24 Bits enthalten den Wert in Zweierkomplementdarstellung (der Werte-
  2094. bereich geht also von -2^24 bis +2^24-1).
  2095.  
  2096.      +-+-----+
  2097.      |T|WERT |
  2098.      +-+-----+
  2099.  
  2100. T = #b0001000V Typ-Info fⁿr FIXNUM
  2101.  
  2102. 2.9. BIGNUM
  2103.  
  2104. Bignums werden in Zweierkomplementdarstellung variabler LΣnge abge-
  2105. speichert. Das h÷chstwertige Bit gibt das Vorzeichen an.
  2106. Die Zahl ist durch einen Vektor von Bits gegeben:
  2107.  
  2108.       +-+-----+        +-------+---+--------------------+
  2109.       |T| ADR |   ADR: |       |LEN|  ...   DATA   ...  |
  2110.       +-+-----+        +-------+---+--------------------+
  2111.  
  2112. ADR: Adresse des Zahlvektors
  2113. T = #b0001010V Typ-Info fⁿr BIGNUM (V = Vorzeichen)
  2114. LEN = LΣnge der Zahl (in Digits), ( >= 2 )
  2115. DATA = Zahl in Zweierkomplementdarstellung
  2116. Bignums befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2117.  
  2118. 2.10. SHORT-FLOAT
  2119.  
  2120. Bit 24 = Vorzeichen, Rest = Wert (Bits 16-23 fⁿr Exponent, Bits 0-15
  2121. fⁿr Mantisse)
  2122.  
  2123.      +-+-----+
  2124.      |T|WERT |
  2125.      +-+-----+
  2126.  
  2127. T = #b0001001V Typ-Info fⁿr SHORT-FLOAT
  2128.  
  2129. 2.11. SINGLE-FLOAT
  2130.  
  2131. Wird im Bereich fⁿr Objekte variabler LΣnge abgespeichert:
  2132.  
  2133.       +-+-----+         +-------+-------+
  2134.       |T| ADR |    ADR: |       | WERT  |
  2135.       +-+-----+         +-------+-------+
  2136.  
  2137. ADR: Adresse des Zahl-"Vektors"
  2138. T: Typ-Info fⁿr SINGLE-FLOAT #b0001011V (V = Vorzeichen)
  2139. WERT: Zahlwert (1 Bit Vorz., 8 Bit Exponent, 23 Bit Mantisse)
  2140. Single-Floats befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2141.  
  2142. 2.12. DOUBLE-FLOAT
  2143.  
  2144. Wird im Bereich fⁿr Objekte variabler LΣnge abgespeichert:
  2145.  
  2146.       +-+-----+         +-------+---------------+
  2147.       |T| ADR |    ADR: |       |     WERT      |
  2148.       +-+-----+         +-------+---------------+
  2149.  
  2150. ADR: Adresse des Zahl-"Vektors"
  2151. T: Typ-Info fⁿr DOUBLE-FLOAT #b0001101V (V = Vorzeichen)
  2152. WERT: Zahlwert (1 Bit Vorz., 11 Bit Exponent, 52 Bit Mantisse)
  2153. Double-Floats befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2154.  
  2155. 2.13. LONG-FLOAT
  2156.  
  2157. Long-floats sind Realzahlen variabler Genauigkeit (precision). Sie
  2158. werden als Vektoren abgespeichert (Σhnlich wie BIGNUMs).
  2159.  
  2160.       +-+-----+       +-------+---+-------+------------------+
  2161.       |T| ADR |  ADR: |       |LEN| EXPO  | ... MANTISSE ... |
  2162.       +-+-----+       +-------+---+-------+------------------+
  2163.  
  2164. ADR: Adresse des Zahlvektors
  2165. T = #b0001111V Typ-Info fⁿr LONG-FLOAT (V = Vorzeichen)
  2166. LEN = LΣnge der Mantisse in Digits
  2167. EXPO = Exponent (in Zweierkomplementdarstellung)
  2168. MANTISSE = Mantisse (16*LEN Bits)
  2169. Long-Floats befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2170.  
  2171. 2.14. RATIO
  2172.  
  2173. Brⁿche werden wie CONSes abgespeichert:
  2174.  
  2175.      +-+-----+       +-------+-------+
  2176.      |T| ADR |  ADR: |  NUM  | DENOM |
  2177.      +-+-----+       +-------+-------+
  2178.  
  2179. ADR: Adresse des Records fⁿr ZΣhler und Nenner
  2180. T: Typ-Info fⁿr RATIO #b0001100V (V = Vorzeichen)
  2181. NUM: ZΣhler (FIXNUM oder BIGNUM /= 0 mit Vorzeichen V)
  2182. DENOM: Nenner (FIXNUM oder BIGNUM, positiv, > 1)
  2183. ZΣhler und Nenner sind teilerfremde ganze Zahlen.
  2184. Ratios befinden sich im Speicherbereich fⁿr Zwei-Pointer-Objekte.
  2185.  
  2186. 2.15. COMPLEX
  2187.  
  2188. Komplexe Zahlen werden wie CONSes abgespeichert:
  2189.  
  2190.      +-+-----+       +-------+-------+
  2191.      |T| ADR |  ADR: | REAL  | IMAG  |
  2192.      +-+-----+       +-------+-------+
  2193.  
  2194. ADR2 Adresse des Records fⁿr Real-  und ImaginΣrteil
  2195. T: Typ-Info fⁿr COMPLEX #b00011100
  2196. REAL: Realteil (NUMBER)
  2197. IMAG: ImaginΣrteil (NUMBER, /= INTEGER 0)
  2198. Complexs befinden sich im Speicherbereich fⁿr Zwei-Pointer-Objekte.
  2199.  
  2200. 2.16. SIMPLE-VECTOR
  2201.  
  2202. Simple-Vectors sind Records von LISP-Objekten:
  2203.  
  2204.       +-+-----+      +-------+-------+-------+-----+-------+
  2205.       |T| ADR | ADR: |       |  LEN  | OBJ1  | ... | OBJn  |
  2206.       +-+-----+      +-------+-------+-------+-----+-------+
  2207.  
  2208. ADR: Adresse des Records
  2209. T: Typ-Info fⁿr SIMPLE-VECTOR #b00000011
  2210. LEN: Anzahl n der Objekte im Vektor
  2211. OBJi: LISP-Objekte (die Vektor-Elemente)
  2212. Simple-Vectors befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2213.  
  2214. 2.17. SIMPLE-BIT-VECTOR
  2215.  
  2216.       +-+-----+      +-------+-------+------------------+
  2217.       |T| ADR | ADR: |       |  LEN  |  ...  BITS  ...  |
  2218.       +-+-----+      +-------+-------+------------------+
  2219.  
  2220. ADR: Adresse des Bit-Vektors
  2221. T: Typ-Info fⁿr SIMPLE-BIT-VECTOR #b00000001
  2222. LEN: LΣnge des Vektors (Anzahl Bits)
  2223. BITS: Die Bits des Vektors, aufgefⁿllt auf durch 16 teilbare Anzahl
  2224.       (Bit Nummer x ist Bit (7-(x mod 8)) im Byte (ADR+DATA_+(x div 8)).)
  2225. Simple-Bit-Vectors befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2226.  
  2227. 2.18. SIMPLE-STRING
  2228.  
  2229.       +-+-----+      +-------+-------+-------------------+
  2230.       |T| ADR | ADR: |       |  LEN  |  ...  CHARS  ...  |
  2231.       +-+-----+      +-------+-------+-------------------+
  2232.  
  2233. ADR: Adresse des Zeichen-Vektors
  2234. T: Typ-Info fⁿr SIMPLE-STRING #b00000010
  2235. LEN: Anzahl Zeichen im String
  2236. CHARS: Die Zeichen (im Atari-ASCII-Code, aufgefⁿllt auf gerade Anzahl)
  2237. Simple-Strings befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2238.  
  2239. 2.19. ARRAY
  2240.  
  2241.       +-+-----+
  2242.       |T| ADR |
  2243.       +-+-----+
  2244.  
  2245.       +-------+-+-+---+-------+-------+-------+-------+-----+-------+-------+
  2246. ADR:  |       |F| |RK | DATA  | TSIZE +[D.OFF]| DIM1  | ... | DIMn  |[FILLP]|
  2247.       +-------+-+-+---+-------+-------+-------+-------+-----+-------+-------+
  2248.  
  2249. ADR: Adresse des Datenrecords fⁿr den Array
  2250. T: #b000001?? Typ-Info fⁿr Array
  2251. F: nΣhere Information (8 Bits):
  2252.      Bit 7: 1 = adjustable
  2253.      Bit 6: 1 = Fill-Pointer ist vorhanden (nur bei n = 1 m÷glich)
  2254.      Bit 5: 1 = displaced
  2255.      Bit 4: 1 = Platz fⁿr Displaced-Offset ist vorhanden
  2256.               (<==> Array adjustable oder displaced)
  2257.      Bits 0-3: Element-Typ, im Fall T = #b00000111
  2258.           n÷tig: T, BIT, STRING-CHAR
  2259.           wⁿnschenswert: SINGLE-FLOAT, LONG-FLOAT, evtl. FIXNUM
  2260.              (dann mⁿssen aber die Macros VECTORP und ARRAY1P in
  2261.               BIBTYPE geΣndert werden!)
  2262.            Bit 3210       Bedeutung (Element-Typ)
  2263.                1000          BIT
  2264.                0001          2BIT
  2265.                0010          4BIT
  2266.                0011          8BIT
  2267.                0100          16BIT
  2268.                0101          32BIT
  2269.                1110          T
  2270.                1111          STRING-CHAR
  2271.          Der Element-Typ ist auch der Element-Typ des Datenvektors. (Ausnahme:
  2272.          Byte-Vektoren. Deren letzter Datenvektor ist ein Simple-Bit-Vektor.)
  2273. RK: Rang n (von 0 bis 65535)
  2274. DATA: Vektor mit Arrayelementen (in lexikographischer Ordung gemΣ▀ den
  2275.       Indices) oder (falls displaced) Array, auf den displaced wurde.
  2276. TSIZE: Total-Size (als vorzeichenlose 32-Bit-Zahl)
  2277. D.OFF: Falls F,Bit 4 = 1: Falls F,Bit 5 = 1: displaced-offset, sonst
  2278.        beliebig (nur Platzhalter fⁿr den Fall, da▀ bei ADJUST-ARRAY
  2279.        die :DISPLACED-TO-Option angegeben wird).
  2280. DIMi: i-te Dimension (als vorzeichenlose 32-Bit-Zahl)
  2281. FILLP: Falls F,Bit 6 = 1: Fill-Pointer (als vorzeichenlose 32-Bit-Zahl)
  2282.  
  2283. (Die Gesamtgr÷▀e des Arrays (d.h. TSIZE = DIM1*...*DIMn) ist gleich der LΣnge
  2284. des Datenvektors, falls nicht displaced, abgesehen von obiger Ausnahme.)
  2285.  
  2286. Arrays befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2287.  
  2288. 2.20. Records (CLOSURE, STRUCTURE, INSTANCE, STREAM etc.)
  2289.  
  2290.       +-+-----+      +-------+-+-+---+-------+-----+-------+
  2291.       |T| ADR | ADR: |       |F|t| L | DAT1  | ... | DATn  |
  2292.       +-+-----+      +-------+-+-+---+-------+-----+-------+
  2293.  
  2294. ADR: Adresse des Records
  2295. T: #b000010?? Typ-Info fⁿr Records
  2296. F: 8 Flag-Bits fⁿr zusΣtzliche lokale Information
  2297.      (z.B. bei Hash-Tables fⁿr Test (EQ, EQL, EQUAL) und ob
  2298.       Rehash nach GC n÷tig ist)
  2299. t: 8 Bits nΣhere Typinformation bei T = #b00001011:
  2300.      #b11111111 = Hash-Table
  2301.      #b00000000 = Package
  2302.      #b00000001 = Readtable
  2303.      #b00000010 = Pathname
  2304.      #b00000011 = Random-State
  2305.      #b00000100 = Byte
  2306.      #b00000101 = Load-time-Eval
  2307.      #b00000110 = Symbol-Macro
  2308. L: LΣnge des Records (in Pointern) (ein Wort)
  2309. DATi: Elemente des Records
  2310. Records befinden sich im Speicherbereich fⁿr Objekte variabler LΣnge.
  2311.  
  2312. 2.21. Records im Einzelnen
  2313.  
  2314. 2.21.1. Closures
  2315.  
  2316. Interpretierte Closures:
  2317.   F=t=0, L=21, die Daten sind:
  2318.   NAME            Name der Funktion (:LAMBDA als Default)
  2319.   FORM            gesamter Lambdabody (lambda-list {decl|doc} {form}) oder NIL
  2320.   DOCSTRING       Docstring oder NIL
  2321.   BODY            Liste der auszufⁿhrenden Formen
  2322.   VAR_ENV         Variablen-Environment             | Environments,
  2323.   FUN_ENV         Funktionsdefinitions-Environment  | die beim Aufruf
  2324.   BLOCK_ENV       Block-Environment                 | der Closure zu
  2325.   GO_ENV          Tagbody-Environment               | aktivieren sind
  2326.   DECL_ENV        Deklarations-Environment          |
  2327.   VARS            Vektor mit allen Variablen in der richtigen Reihenfolge
  2328.   VARFLAGS        parallel dazu: Byte-Vektor, in dem jeweils evtl.
  2329.                     DYNAM_BIT und SVAR_BIT gesetzt sind (DYNAM_BIT,
  2330.                     wenn die Variable dynamisch gebunden werden mu▀,
  2331.                     SVAR_BIT, wenn eine supplied-p-Variable folgt)
  2332.   SPEC_ANZ        Anzahl der dynamischen Referenzen
  2333.   REQ_ANZ         Anzahl der required-Parameter
  2334.   OPT_ANZ         Anzahl der optional-Parameter
  2335.   OPT_INITS       Liste der Initialisierungsformen der optional-Parameter
  2336.   KEY_ANZ         Anzahl der Keyword-Parameter
  2337.   KEYWORDS        Liste der zugeh÷rigen Keywords (oder 0, falls ⁿberhaupt
  2338.                     keine Keywords zugelassen sind)
  2339.   KEY_INITS       Liste der Initialisierungsformen der Keyword-Parameter
  2340.   ALLOW_FLAG      Flag fⁿr &ALLOW-OTHER-KEYS (NIL oder T)
  2341.   REST_FLAG       Flag fⁿr &REST-Parameter (NIL oder T)
  2342.   AUX_ANZ         Anzahl der &AUX-Variablen
  2343.   AUX_INITS       Liste der Initialisierungsformen der &AUX-Variablen
  2344.  
  2345. Compilierte Closures:
  2346. F=t=0, die Daten sind:
  2347.   Name            Name der Funktion
  2348.   CODEVEC         Bytecode-Vektor
  2349.   [VenvConst]
  2350.   {BlockConst}*
  2351.   {TagbodyConst}*
  2352.   {Keyword}*
  2353.   {sonstige Const}*
  2354. VenvConst, BlockConst, TagbodyConst : diese LISP-Objekte werden innerhalb der
  2355. Funktion als Konstanten betrachtet. Sie werden beim Aufbau der Funktion zur
  2356. Laufzeit mitgegeben. Sollten diese drei Teile fehlen (d.h. diese Funktion ist
  2357. von der Inkarnation unabhΣngig, weil sie auf keine lexikalischen Variablen,
  2358. Blocks oder Tags zugreift, die im compilierten Code au▀erhalb von ihr definiert
  2359. werden), so hei▀t die Funktion autonom.
  2360. Keyword : die Keywords in der richtigen Reihenfolge. Werden vom Interpreter bei
  2361. der Parameterⁿbergabe gebraucht.
  2362. sonstige Const: sonstige Konstanten, auf die vom Innern der Funktion aus Bezug
  2363. genommen wird. Sie sind untereinander und zu allen Keywords paarweise nicht EQL.
  2364. CODEVEC = Code-Vektor, ein SIMPLE-BIT-VECTOR,
  2365.    2 Bytes : Anzahl der required parameter
  2366.    2 Bytes : Anzahl der optionalen Parameter
  2367.    1 Byte : Flags. Bit 0: ob &REST - Parameter angegeben
  2368.                    Bit 7: ob Keyword-Parameter angegeben
  2369.                    Bit 6: &ALLOW-OTHER-KEYS-Flag
  2370.    1 Byte : Kⁿrzel fⁿr den Argumenttyp, fⁿr schnelleres FUNCALL
  2371.    Falls Keyword-Parameter angegeben:
  2372.      4 Bytes : 2 Bytes : Anzahl der Keyword-Parameter
  2373.                2 Bytes : Offset in FUNC der Keywords
  2374.    dann
  2375.    eine Folge von Byte-Instruktionen.
  2376.  
  2377. 2.21.2. Structures
  2378.  
  2379. t=0, L>0, erstes Element ist das LIST* aller Structure-Typen, der die
  2380. Structure angeh÷rt (alles Symbole): (name_1 ... name_i-1 name_i)
  2381. Siehe RECORD.D
  2382.  
  2383. 2.21.3. Instanzen
  2384.  
  2385. t=0, L>0, erstes Element ist die Klasse, von der das Objekt eine direkte
  2386. Instanz ist. (Oberklassen werden nicht direkt aufgefⁿhrt.) Dann die Slots,
  2387. die instanz-alloziert sind.
  2388.  
  2389. 2.21.4. Streams
  2390.  
  2391. t codiert den Typ des Streams:
  2392.   Bit 0-7 genauerer Typ
  2393. F codiert den Zustand des Streams:
  2394.   Bit 0-3 =0
  2395.   Bit 4 gesetzt, falls READ-BYTE m÷glich ist
  2396.   Bit 5 gesetzt, falls WRITE-BYTE m÷glich ist
  2397.   Bit 6 gesetzt, falls READ-CHAR m÷glich ist
  2398.   Bit 7 gesetzt, falls WRITE-CHAR m÷glich ist
  2399. L >=6, die festen Daten sind:
  2400. RD_BY          Pseudofunktion zum Lesen eines Bytes
  2401. WR_BY          Pseudofunktion zum Schreiben eines Bytes
  2402. RD_CH          Pseudofunktion zum Lesen eines Characters
  2403. WR_CH          Pseudofunktion zum Schreiben eines Characters
  2404. RD_CH_LAST     letztes gelesenes Zeichen und Flag
  2405. WR_CH_LPOS     Position in der Zeile
  2406.  
  2407. 2.21.5. Packages
  2408.  
  2409. F=0, L=7, die Daten sind:
  2410. EXTERNAL_SYMBOLS     Symboltabelle der extern prΣsenten Symbole
  2411. INTERNAL_SYMBOLS     Symboltabelle der intern prΣsenten Symbole
  2412. SHADOWING_SYMBOLS    Liste der Shadowing-Symbole
  2413. USE_LIST             Use-List
  2414. USED_BY_LIST         Used-By-List
  2415. NAME                 Package-Name
  2416. NICKNAMES            Liste der Nicknames der Package
  2417. Siehe PACKAGE.D
  2418.  
  2419. 2.21.6. Hash-Tables
  2420.  
  2421. t=-1.
  2422. F codiert den Typ und den Zustand der Hashtabelle:
  2423.   Bit 0 gesetzt, wenn EQ-Hashtabelle
  2424.   Bit 1 gesetzt, wenn EQL-Hashtabelle
  2425.   Bit 2 gesetzt, wenn EQUAL-Hashtabelle
  2426.   Bit 3-6 =0
  2427.   Bit 7 gesetzt, wenn Tabelle nach GC reorganisiert werden mu▀
  2428. L=10, die Daten sind:
  2429. SIZE                Fixnum>0 = LΣnge der ITABLE
  2430. MAXCOUNT            Fixnum>0 = LΣnge der NTABLE
  2431. ITABLE              Index-Vektor der LΣnge SIZE, enthΣlt Indizes
  2432. NTABLE              Next-Vektor der LΣnge MAXCOUNT, enthΣlt Indizes
  2433. KVTABLE             Key-Value-Vektor, Vektor der LΣnge 2*MAXCOUNT
  2434. FREELIST            Start-Index der Freiliste im Next-Vektor
  2435. COUNT               Anzahl der EintrΣge in der Table, Fixnum >=0, <=MAXCOUNT
  2436. REHASH_SIZE         Wachstumsrate bei Reorganisation. Float >1.1
  2437. MINCOUNT_THRESHOLD  VerhΣltnis MINCOUNT/MAXCOUNT = 1/rehash-size^2
  2438. MINCOUNT            Fixnum>=0, untere Grenze fⁿr COUNT
  2439. Siehe HASHTABL.D
  2440.  
  2441. 2.21.7. Readtables
  2442.  
  2443. F=0, L=3, die Daten sind:
  2444. SYNTAX_TABLE           Syntaxcodes, ein Bitvektor mit 256 Bytes
  2445. MACRO_TABLE            Read-Macros, ein Vektor mit 256 Funktionen/Vektoren/NILs
  2446. CASE                   Case, ein Fixnum in {0,1,2}
  2447. Siehe IO.D
  2448.  
  2449. 2.21.8. Pathnames
  2450.  
  2451. F=0, L<=6, die Daten sind:
  2452. evtl. HOST             Host
  2453. evtl. DEVICE           Drive
  2454.       DIRECTORY        Disknummer und Subdirectory-Path
  2455.       NAME             Name
  2456.       TYPE             Extension
  2457. evtl. VERSION          Version
  2458.  
  2459. 2.21.9. Random-states
  2460.  
  2461. F=0, L=1, die Daten sind:
  2462. SEED                   letzte Zahl, ein Simple-Bit-Vector mit 64 Bits
  2463.  
  2464. 2.21.10. Bytes
  2465.  
  2466. F=0, L=2, die Daten sind:
  2467. SIZE            Gr÷▀e des spezifizierten Bytes, ein Fixnum
  2468. POSITION        Position des spezifizierten Bytes, ein Fixnum
  2469. Siehe ARIDECL.TXT
  2470.  
  2471. 2.21.11. Load-time-Evals
  2472.  
  2473. F=0, L=1, die Daten sind:
  2474. FORM            Form, die erst zur Zeit des Ladens evaluiert werden soll
  2475.  
  2476. 2.21.12. Symbol-Macros
  2477.  
  2478. F=0, L=1, die Daten sind:
  2479. EXPANSION       Expansion des Symbols, eine Form.
  2480.  
  2481.  
  2482. 3. Code-Aufbau
  2483. --------------
  2484.  
  2485. Der Code ist compiliert. Fⁿr Fehlermeldungen ist der Name n÷tig. Da man in C
  2486. nicht Daten in unmittelbarer NΣhe von Funktionen unterbringen kann, mu▀ man
  2487. Name und Funktionsadresse in einer Tabelle aller SUBRs bzw. FSUBRs unter-
  2488. bringen. Ein SUBR ist ein Pointer in die SUBR-Tabelle, ein FSUBR ist ein
  2489. Pointer in die FSUBR-Tabelle. Um sowohl schnellen FUNCALL als auch
  2490. Argumente-ⁿberprⁿfenden APPLY zu erm÷glichen, stehen noch weitere
  2491. Informationen in der Tabelle (Argumentanzahlen etc.):
  2492.  
  2493. FSUBR-Tabellen-Eintrag:
  2494.   .L   Adresse der C-Funktion (ohne Argumente, ohne Wert)
  2495.   .L   Adresse des Namens des FSUBR (LISP-Objekt)
  2496.   .W   Kⁿrzel fⁿr den Argumente-Typ des FSUBR
  2497.   .W   REQ_ANZ : Anzahl required Parameter
  2498.   .W   OPT_ANZ : Anzahl optionaler Parameter
  2499.   .W   BODY_FLAG : Body-Flag
  2500.  
  2501. SUBR-Tabellen-Eintrag:
  2502.   .L   Adresse der C-Funktion (ohne Argumente, ohne Wert)
  2503.   .L   Adresse des Namens des SUBR (LISP-Objekt)
  2504.   .L   Adresse des Vektors mit den Keywords oder NIL (LISP-Objekt)
  2505.   .W   Kⁿrzel fⁿr den Argumente-Typ des SUBR
  2506.   .W   REQ_ANZ : Anzahl required Parameter
  2507.   .W   OPT_ANZ : Anzahl optionaler Parameter
  2508.   .B   REST_FLAG : Flag fⁿr beliebig viele Argumente
  2509.   .B   KEY_FLAG : Flag fⁿr Keywords
  2510.   .W   KEY_ANZ : Anzahl Keywordparameter
  2511.  
  2512. */
  2513.  
  2514. # ######################## LISP-Objekte allgemein ######################### #
  2515.  
  2516. #if !defined(WIDE)
  2517.  
  2518. # Ein Objektpointer ist erst einmal ein leerer Pointer (damit man in C nichts
  2519. # Unbeabsichtigtes mit ihm machen kann):
  2520.   typedef  void *  object;
  2521. # Aber in der ReprΣsentation steckt eine Adresse und Typbits.
  2522.  
  2523. # Ein (unsigned) Integer von der Gr÷▀e eines Objekts:
  2524.   typedef  uintL  oint;
  2525.   typedef  sintL  soint;
  2526.  
  2527. #else # defined(WIDE)
  2528.  
  2529. # Ein Objekt besteht aus getrennten 32 Bit Adresse und 32 Bit Typinfo.
  2530.   typedef  uint64  oint;
  2531.   typedef  sint64  soint;
  2532.   #ifdef WIDE_STRUCT
  2533.     #if BIG_ENDIAN_P==WIDE_ENDIANNESS
  2534.       #define TYPEDEF_OBJECT  \
  2535.         typedef  union { struct { /* tint */ uintL type; /* aint */ uintL addr; } both; \
  2536.                          oint one _attribute_aligned_object_;                           \
  2537.                        }                                                                \
  2538.                  object;
  2539.     #else
  2540.       #define TYPEDEF_OBJECT  \
  2541.         typedef  union { struct { /* aint */ uintL addr; /* tint */ uintL type; } both; \
  2542.                          oint one _attribute_aligned_object_;                           \
  2543.                        }                                                                \
  2544.                  object;
  2545.     #endif
  2546.   #else
  2547.     typedef  oint  object;
  2548.   #endif
  2549.  
  2550. #endif
  2551.  
  2552. # Es mu▀ sizeof(object) = sizeof(oint) gelten!
  2553.  
  2554. # Umwandlungen zwischen object und oint:
  2555. # as_oint(expr)   object --> oint
  2556. # as_object(x)    oint --> object
  2557.   #ifdef WIDE_STRUCT
  2558.     #define as_oint(expr)  ((expr).one)
  2559.     #if 1
  2560.       #define as_object(o)  ((object){one:(o)})
  2561.     #else
  2562.       extern __inline__ object as_object (register oint o)
  2563.         { register object obj; obj.one = o; return obj; }
  2564.     #endif
  2565.   #else
  2566.     #define as_oint(expr)  (oint)(expr)
  2567.     #define as_object(o)  (object)(o)
  2568.   #endif
  2569.  
  2570. # Was von einer Adresse auch wirklich auf den Adre▀bus geschickt wird:
  2571. #if defined(MC68000)
  2572.   #define addressbus_mask  0x00FFFFFFUL  # 68000 wirft 8 Bits weg
  2573. #elif defined(SUN3) && !defined(UNIX_SUNOS4)
  2574.   #define addressbus_mask  0x0FFFFFFFUL  # SUN3 unter SunOS 3.5 wirft 4 Bits weg
  2575. #elif 1
  2576.   #define addressbus_mask  ~0UL  # Default: nichts wird weggeworfen
  2577. #else
  2578.   #error "Unknown address bus mask -- Gr÷▀e addressbus_mask neu einstellen!"
  2579. #endif
  2580.  
  2581. # Aufteilung eines oint in Typbits und Adresse:
  2582. # Stets ist  oint_type_mask  subset  (2^oint_type_len-1)<<oint_type_shift
  2583. # und        oint_addr_mask superset (2^oint_addr_len-1)<<oint_addr_shift .
  2584. #if defined(WIDE_HARD)
  2585.   #if defined(DECALPHA) && defined(UNIX_OSF)
  2586.     #if defined(NO_SINGLEMAP)
  2587.       # Wenn MAP_MEMORY nicht gefordert ist, ist das das sicherste.
  2588.       # Bits 63..48 = Typcode, Bits 47..0 = Adresse
  2589.       #define oint_type_shift 48
  2590.       #define oint_type_len 16
  2591.       #define oint_type_mask 0xFFFF000000000000UL
  2592.       #define oint_addr_shift 0
  2593.       #define oint_addr_len 48
  2594.       #define oint_addr_mask 0x0000FFFFFFFFFFFFUL
  2595.       #define oint_data_shift 0
  2596.       #define oint_data_len 32
  2597.       #define oint_data_mask 0x00000000FFFFFFFFUL
  2598.     #else
  2599.       # Gew÷hnliche Pointer liegen im Bereich 1*2^32..2*2^32.
  2600.       # Bits 63..33 = Typcode, Bits 32..0 = Adresse
  2601.       #if 1 # Was ist besser??
  2602.         #define oint_type_shift 32
  2603.         #define oint_type_len 32
  2604.       #else
  2605.         #define oint_type_shift 33
  2606.         #define oint_type_len 31
  2607.       #endif
  2608.       #define oint_type_mask 0xFFFFFFFE00000000UL
  2609.       #define oint_addr_shift 0
  2610.       #define oint_addr_len 33
  2611.       #define oint_addr_mask 0x00000001FFFFFFFFUL
  2612.       #define oint_data_shift 0
  2613.       #define oint_data_len 32
  2614.       #define oint_data_mask 0x00000000FFFFFFFFUL
  2615.     #endif
  2616.   #endif
  2617. #elif defined(WIDE_SOFT)
  2618.   # Getrennte 32-Bit-W÷rter fⁿr Typcode und Adresse.
  2619.   #if WIDE_ENDIANNESS
  2620.     # Bits 63..32 = Typcode, Bits 31..0 = Adresse
  2621.     #define oint_type_shift 32
  2622.     #define oint_type_len 32
  2623.     #define oint_type_mask 0xFFFFFFFF00000000ULL
  2624.     #define oint_addr_shift 0
  2625.     #define oint_addr_len 32
  2626.     #define oint_addr_mask 0x00000000FFFFFFFFULL
  2627.   #else # umgekehrt ist es etwas langsamer:
  2628.     # Bits 63..32 = Adresse, Bits 31..0 = Typcode
  2629.     #define oint_type_shift 0
  2630.     #define oint_type_len 32
  2631.     #define oint_type_mask 0x00000000FFFFFFFFULL
  2632.     #define oint_addr_shift 32
  2633.     #define oint_addr_len 32
  2634.     #define oint_addr_mask 0xFFFFFFFF00000000ULL
  2635.   #endif
  2636. #elif (defined(MC680X0) && !defined(ATARITT) && !defined(AMIGA3000) && !defined(UNIX_AMIX) && !defined(UNIX_NEXTSTEP)) || (defined(I80Z86) && !defined(WATCOM_BLAKE) && !defined(UNIX_SYSV_UHC_2) && !defined(UNIX_SYSV_UHC_1) && !defined(UNIX_NEXTSTEP) && !defined(UNIX_SYSV_PTX)) || defined(SPARC) || (defined(MIPS) && !defined(UNIX_IRIX) && !defined(UNIX_DEC_ULTRIX)) || defined(M88000) || (defined(RS6000) && !defined(UNIX_AIX)) || defined(VAX) || (defined(CONVEX) && !defined(UNIX_CONVEX)) || defined(ACORN_1)
  2637.   # Bits 31..24 = Typcode, Bits 23..0 = Adresse
  2638.   #define oint_type_shift 24
  2639.   #define oint_type_len 8
  2640.   #define oint_type_mask 0xFF000000UL
  2641.   #define oint_addr_shift 0
  2642.   #define oint_addr_len 24
  2643.   #define oint_addr_mask 0x00FFFFFFUL
  2644. #elif defined(ACORN_2)
  2645.   # Bits 31..8 = Adresse, Bits 7..0 = Typcode
  2646.   #define oint_type_shift 0
  2647.   #define oint_type_len 8
  2648.   #define oint_type_mask 0x000000FFUL
  2649.   #define oint_addr_shift 8
  2650.   #define oint_addr_len 24
  2651.   #define oint_addr_mask 0xFFFFFF00UL
  2652. #elif defined(ATARITT) || defined(ACORN_3)
  2653.   # Bits 31..26 = Typcode, Bits 25..0 = Adresse
  2654.   #define oint_type_shift 26
  2655.   #define oint_type_len 6
  2656.   #define oint_type_mask 0xFC000000UL
  2657.   #define oint_addr_shift 0
  2658.   #define oint_addr_len 26
  2659.   #define oint_addr_mask 0x03FFFFFFUL
  2660. #elif defined(ACORN_4)
  2661.   # Bits 31..6 = Adresse, Bits 5..0 = Typcode
  2662.   #define oint_type_shift 0
  2663.   #define oint_type_len 6
  2664.   #define oint_type_mask 0x0000003FUL
  2665.   #define oint_addr_shift 6
  2666.   #define oint_addr_len 26
  2667.   #define oint_addr_mask 0xFFFFFFC0UL
  2668. #elif defined(AMIGA3000)
  2669.   # Bits 31..6 = Adresse/2, Bits 5..0 = Typcode
  2670.   #define oint_type_shift 0
  2671.   #define oint_type_len 6
  2672.   #define oint_type_mask 0x0000003FUL
  2673.   #define oint_addr_shift 6
  2674.   #define oint_addr_len 26
  2675.   #define oint_addr_mask 0xFFFFFFC0UL
  2676.   #define addr_shift 1
  2677. #elif defined(UNIX_SYSV_UHC_2)
  2678.   # Bits 31..6 = Adresse/4, Bits 5..0 = Typcode
  2679.   #define oint_type_shift 0
  2680.   #define oint_type_len 6
  2681.   #define oint_type_mask 0x0000003FUL
  2682.   #define oint_addr_shift 6
  2683.   #define oint_addr_len 26
  2684.   #define oint_addr_mask 0xFFFFFFC0UL
  2685.   #define addr_shift 2  # funktioniert nicht wegen STACK_alignment ??
  2686. #elif (defined(HPPA) && defined(UNIX_HPUX)) || (defined(MC680X0) && defined(UNIX_AMIX))
  2687.   # Bits 29..24 = Typcode, Bits 31..30,23..0 = Adresse
  2688.   #define oint_type_shift 24
  2689.   #define oint_type_len 6
  2690.   #define oint_type_mask 0x3F000000UL
  2691.   #define oint_addr_shift 0
  2692.   #define oint_addr_len 24 # vernⁿnftig nutzbar sind nur die unteren 24 Bit
  2693.   #define oint_addr_mask 0xC0FFFFFFUL
  2694.   # Beachte: unten wird aint = uint24 = uint32 sein.
  2695. #elif defined(UNIX_SYSV_UHC_1)
  2696.   # Bits 31..28,26..24 = Typcode, Bits 23..0 = Adresse
  2697.   #define oint_type_shift 24
  2698.   #define oint_type_len 8
  2699.   #define oint_type_mask 0xF7000000UL
  2700.   #define oint_addr_shift 0
  2701.   #define oint_addr_len 24
  2702.   #define oint_addr_mask 0x08FFFFFFUL
  2703. #elif defined(MIPS) && (defined(UNIX_IRIX) || defined(UNIX_DEC_ULTRIX))
  2704.   # Bits 31..29,27..24 = Typcode, Bits 23..0 = Adresse
  2705.   #define oint_type_shift 24
  2706.   #define oint_type_len 8
  2707.   #define oint_type_mask 0xEF000000UL
  2708.   #define oint_addr_shift 0
  2709.   #define oint_addr_len 24
  2710.   #define oint_addr_mask 0x10FFFFFFUL
  2711. #elif defined(RS6000) && defined(UNIX_AIX)
  2712.   # Bits 31..30,28..24 = Typcode, Bits 23..0 = Adresse
  2713.   #define oint_type_shift 24
  2714.   #define oint_type_len 8
  2715.   #define oint_type_mask 0xDF000000UL
  2716.   #define oint_addr_shift 0
  2717.   #define oint_addr_len 24
  2718.   #define oint_addr_mask 0x20FFFFFFUL
  2719. #elif defined(WATCOM_BLAKE)
  2720.   # Bits 30..25 = Typcode, Bits 31,24..0 = Adresse
  2721.   #define oint_type_shift 25
  2722.   #define oint_type_len 6
  2723.   #define oint_type_mask 0x7E000000UL
  2724.   #define oint_addr_shift 0
  2725.   #define oint_addr_len 25
  2726.   #define oint_addr_mask 0x81FFFFFFUL
  2727. #elif defined(UNIX_NEXTSTEP)
  2728.   # Bits 31..24 = Typcode, Bits 23..0 = Adresse
  2729.   #define oint_type_shift 24
  2730.   #define oint_type_len 8
  2731.   #define oint_type_mask 0xFF000000UL
  2732.   #define oint_addr_shift 0
  2733.   #define oint_addr_len 24
  2734.   #define oint_addr_mask 0x00FFFFFFUL
  2735.   # UNIX_NEXTSTEP has shared libraries at 0x05000000, related storage at
  2736.   # 0x04000000, a stack from 0x03F80000..0x04000000. We avoid this address
  2737.   # range of VM addresses by not using bits 26 and 24 in our typecode
  2738.   # bit encoding scheme.
  2739.   #define vm_addr_mask 0xFAFFFFFFUL
  2740. #elif defined(UNIX_SYSV_PTX)
  2741.   # Bits 31..24 = Typcode, Bits 23..0 = Adresse
  2742.   #define oint_type_shift 24
  2743.   #define oint_type_len 8
  2744.   #define oint_type_mask 0xFF000000UL
  2745.   #define oint_addr_shift 0
  2746.   #define oint_addr_len 24
  2747.   #define oint_addr_mask 0x00FFFFFFUL
  2748.   # UNIX_SYSV_PTX has its stack above (or below??) 0x40000000. We avoid this
  2749.   # address range of VM addresses by not using bit 30 in our typecode bit
  2750.   # encoding scheme.
  2751.   #define vm_addr_mask 0xBFFFFFFFUL
  2752. #elif defined(UNIX_NETBSD) # experimentell??
  2753.   # Bits 31..24 = Typcode, Bits 23..0 = Adresse
  2754.   #define oint_type_shift 24
  2755.   #define oint_type_len 8
  2756.   #define oint_type_mask 0xFF000000UL
  2757.   #define oint_addr_shift 0
  2758.   #define oint_addr_len 24
  2759.   #define oint_addr_mask 0x00FFFFFFUL
  2760.   # NetBSD 1.0 has its shared libraries above 0x10000000. We avoid this
  2761.   # address range of VM addresses by not using bit 28 in our typecode bit
  2762.   # encoding scheme.
  2763.   #define vm_addr_mask 0xEFFFFFFFUL
  2764. #elif defined(CONVEX) && defined(UNIX_CONVEX)
  2765.   # Bits 30..24 = Typcode, Bits 31,23..0 = Adresse
  2766.   #define oint_type_shift 24
  2767.   #define oint_type_len 8
  2768.   #define oint_type_mask 0x7F000000UL
  2769.   #define oint_addr_shift 0
  2770.   #define oint_addr_len 24
  2771.   #define oint_addr_mask 0x80FFFFFFUL
  2772.   # UNIX_CONVEX user space addresses are in the range 0x80000000..0xFFFFFFFF.
  2773.   # Memory mapping works in the range 0x80000000..0xBFFFFFFFUL.
  2774.   #define vm_addr_mask 0xBFFFFFFFUL
  2775. #else
  2776.   #error "How to split a pointer into type and address? -- Gr÷▀en oint_type_shift, oint_addr_shift neu einstellen!"
  2777. #endif
  2778.  
  2779. # Meist nutzen wir den ganzen Platz einer Adresse fⁿr die Daten von Fixnums etc.
  2780. # Stets ist  [oint_data_shift..oint_data_shift+oint_data_len-1] subset
  2781. #            [oint_addr_shift..oint_addr_shift+oint_addr_len-1],
  2782. # also       oint_data_len <= oint_addr_len,
  2783. # aber auch  oint_data_len <= intLsize = 32 .
  2784. #ifndef oint_data_len
  2785.   #define oint_data_shift oint_addr_shift
  2786.   #define oint_data_len oint_addr_len
  2787.   #define oint_data_mask oint_addr_mask
  2788. #endif
  2789.  
  2790. # Integertyp fⁿr Typbits:
  2791.   #ifdef ANSI
  2792.     typedef unsigned_int_with_n_bits(oint_type_len)  tint;
  2793.   #else
  2794.     typedef uint/**/oint_type_len  tint;
  2795.   #endif
  2796.  
  2797. # Integertyp fⁿr Adressen:
  2798.   #ifdef ANSI
  2799.     typedef unsigned_int_with_n_bits(oint_addr_len)  aint;
  2800.   #else
  2801.     typedef uint/**/oint_addr_len  aint;
  2802.   #endif
  2803.  
  2804. # Anzahl der Bits, um die eine Adresse zuletzt noch geshiftet wird:
  2805.   #ifndef addr_shift
  2806.     #define addr_shift 0
  2807.   #endif
  2808.  
  2809. # Maske der Bits eines tint, die wirklich zum Typ geh÷ren:
  2810. # tint_type_mask = oint_type_mask >> oint_type_shift
  2811. # (eine Constant Expression, in der keine 'long long's vorkommen!)
  2812.   #ifdef WIDE_SOFT
  2813.     #define tint_type_mask  (bitm(oint_type_len)-1)
  2814.   #else
  2815.     #define tint_type_mask  (oint_type_mask >> oint_type_shift)
  2816.   #endif
  2817.  
  2818. # Um zu einem object/oint etwas zu addieren:
  2819. # objectplus(obj,offset)
  2820.   #if !defined(WIDE_SOFT)
  2821.     #define objectplus(obj,offset)  ((object)pointerplus(obj,offset))
  2822.   #else # defined(WIDE_SOFT)
  2823.     #define objectplus(obj,offset)  as_object(as_oint(obj)+(soint)(offset))
  2824.   #endif
  2825.  
  2826. # Bitoperationen auf Gr÷▀en vom Typ oint:
  2827. # ...wbit... statt ...bit..., "w" = "wide".
  2828.   #if !defined(WIDE_SOFT)
  2829.     #define wbit  bit
  2830.     #define wbitm  bitm
  2831.     #define wbit_test  bit_test
  2832.     #define minus_wbit  minus_bit
  2833.   #else
  2834.     #define wbit(n)  (1LL<<(n))
  2835.     #define wbitm(n)  (2LL<<((n)-1))
  2836.     #define wbit_test(x,n)  ((x) & wbit(n))
  2837.     #define minus_wbit(n)  (-1LL<<(n))
  2838.   #endif
  2839.  
  2840. # Typinfo:
  2841. # typecode(object) und mtypecode(object) liefern den Typcode eines
  2842. # Objektes obj. Bei mtypecode mu▀ er dazu im Speicher liegen.
  2843.   #if !(exact_uint_size_p(oint_type_len) && (tint_type_mask == bit(oint_type_len)-1))
  2844.     #define typecode(expr)  \
  2845.       ((tint)((oint)(expr) >> oint_type_shift) & (oint_type_mask >> oint_type_shift))
  2846.     #define mtypecode(expr)  typecode(expr)
  2847.   #else
  2848.     # Der Typ 'tint' hat genau oint_type_len Bits, und tint_type_mask = 2^oint_type_len-1.
  2849.     # Also kann man sich das ANDen sparen.
  2850.     # Allerdings ist auf einem 68000 ein ROL.L #8 schneller, auf einer SPARC ein Shift.
  2851.       #define typecode(expr)  \
  2852.         ((tint)((oint)(expr) >> oint_type_shift))
  2853.       #if defined(MC68000) && defined(GNU) && !defined(NO_ASM) && (oint_type_shift==24) && (oint_type_len==8)
  2854.         # GNU C auf einem 68000, ersetze LSR.L #24 durch ROL.L #8 :
  2855.         #undef typecode
  2856.         #define typecode(expr)  \
  2857.           ({var tint __typecode;                                              \
  2858.             __asm__ ("roll #8,%0" : "=d" (__typecode) : "0" ((oint)(expr)) ); \
  2859.             __typecode;                                                       \
  2860.            })
  2861.       #elif defined(SPARC) && !defined(WIDE)
  2862.         #undef typecode
  2863.         #define typecode(expr)  \
  2864.           (((oint)(expr) << (32-oint_type_len-oint_type_shift)) >> (32-oint_type_len))
  2865.       #elif defined(WIDE) && defined(WIDE_STRUCT)
  2866.         #undef typecode
  2867.         #define typecode(expr)  ((expr).both.type)
  2868.       #endif
  2869.     # Au▀erdem kann man Zugriffe im Speicher auch ohne Shift machen:
  2870.       #if (oint_type_shift==24) && BIG_ENDIAN_P
  2871.         #define mtypecode(expr)  (*(tint*)&(expr))
  2872.         #define fast_mtypecode
  2873.       #elif (oint_type_shift==24) && !BIG_ENDIAN_P
  2874.         #define mtypecode(expr)  (*((tint*)&(expr)+3))
  2875.         #define fast_mtypecode
  2876.       #elif (oint_type_shift==0) && BIG_ENDIAN_P
  2877.         #define mtypecode(expr)  (*((tint*)&(expr)+3))
  2878.         #define fast_mtypecode
  2879.       #elif (oint_type_shift==0) && !BIG_ENDIAN_P
  2880.         #define mtypecode(expr)  (*(tint*)&(expr))
  2881.         #define fast_mtypecode
  2882.       #elif defined(WIDE)
  2883.         #ifdef WIDE_STRUCT
  2884.           #define mtypecode(expr)  ((expr).both.type)
  2885.         #elif (oint_type_len==16)
  2886.           #if (oint_type_shift==0) == BIG_ENDIAN_P
  2887.             #define mtypecode(expr)  (*((tint*)&(expr)+3))
  2888.           #else # (oint_type_shift==48) == BIG_ENDIAN_P
  2889.             #define mtypecode(expr)  (*(tint*)&(expr))
  2890.           #endif
  2891.         #elif (oint_type_len==32)
  2892.           #if (oint_type_shift==0) == BIG_ENDIAN_P
  2893.             #define mtypecode(expr)  (*((tint*)&(expr)+1))
  2894.           #else # (oint_type_shift==32) == BIG_ENDIAN_P
  2895.             #define mtypecode(expr)  (*(tint*)&(expr))
  2896.           #endif
  2897.         #endif
  2898.         #define fast_mtypecode
  2899.       #else # keine Optimierung m÷glich
  2900.         #define mtypecode(expr)  typecode(expr)
  2901.       #endif
  2902.   #endif
  2903.  
  2904. # Extraktion des Adre▀felds ohne Typinfo:
  2905. # untype(obj)
  2906.   #if defined(WIDE) && defined(WIDE_STRUCT)
  2907.     #define untype(expr)  ((expr).both.addr)
  2908.   #elif !(defined(SPARC) && (oint_addr_len+oint_addr_shift<32))
  2909.     #define untype(expr)    \
  2910.       ((aint)((oint)(expr) >> oint_addr_shift) & (aint)(oint_addr_mask >> oint_addr_shift))
  2911.   #else
  2912.     # Auf einem SPARC-Prozessor sind lange Konstanten langsamer als Shifts:
  2913.     # Evtl. kann man sich ein ANDen sparen.
  2914.     #define untype(expr)  \
  2915.       ((aint)(((oint)(expr) << (32-oint_addr_len-oint_addr_shift)) >> (32-oint_addr_len)))
  2916.   #endif
  2917.  
  2918. # Objekt aus Typinfo und Adre▀feld:
  2919. # type_untype_object(type,address)
  2920.   #if defined(WIDE) && defined(WIDE_STRUCT)
  2921.     #if BIG_ENDIAN_P==WIDE_ENDIANNESS
  2922.       #define type_untype_object(type,address)  ((object){{(tint)(type),(aint)(address)}})
  2923.     #else
  2924.       #define type_untype_object(type,address)  ((object){{(aint)(address),(tint)(type)}})
  2925.     #endif
  2926.   #elif !(oint_addr_shift==0)
  2927.     #define type_untype_object(type,address)  \
  2928.       ((object)(  ((oint)(tint)(type) << oint_type_shift) + \
  2929.                   ((oint)(aint)(address) << oint_addr_shift) ))
  2930.   #else # bei oint_addr_shift=0 braucht man nicht zu schieben:
  2931.     #if defined(WIDE_SOFT)
  2932.       # Vorsicht: Konversion von address zum oint durch Zero-Extend!
  2933.       #define type_untype_object(type,address)              \
  2934.         objectplus((oint)(aint)(address),(oint)(tint)(type)<<oint_type_shift)
  2935.     #else
  2936.       #define type_untype_object(type,address)              \
  2937.         objectplus((address),(oint)(tint)(type)<<oint_type_shift)
  2938.     #endif
  2939.   #endif
  2940.  
  2941. # Objekt aus Typinfo und direkten Daten (als "Adresse"):
  2942. # type_data_object(type,data)
  2943.   #if defined(WIDE) && defined(WIDE_STRUCT)
  2944.     #if BIG_ENDIAN_P==WIDE_ENDIANNESS
  2945.       #define type_data_object(type,data)  ((object){{(tint)(type),(aint)(data)}})
  2946.     #else
  2947.       #define type_data_object(type,data)  ((object){{(aint)(data),(tint)(type)}})
  2948.     #endif
  2949.   #elif !(oint_addr_shift==0)
  2950.     #define type_data_object(type,data)  \
  2951.       ((object)(  ((oint)(tint)(type) << oint_type_shift) + \
  2952.                   ((oint)(aint)(data) << oint_addr_shift) ))
  2953.   #else # bei oint_addr_shift=0 braucht man nicht zu schieben:
  2954.     #define type_data_object(type,data)  \
  2955.       ((object)( ((oint)(tint)(type) << oint_type_shift) + (oint)(aint)(data) ))
  2956.   #endif
  2957.  
  2958. # Extraktion der Adresse ohne Typinfo:
  2959. # upointer(obj)
  2960. # (upointer steht fⁿr "untyped pointer".)
  2961.   #if (addr_shift==0)
  2962.     #define upointer  untype
  2963.   #else
  2964.     #define optimized_upointer(obj)  \
  2965.       ((aint)(((oint)(obj) << (32-oint_addr_len-oint_addr_shift)) >> (32-oint_addr_len-addr_shift)))
  2966.     #define upointer(obj)  (untype(obj)<<addr_shift)
  2967.   #endif
  2968.  
  2969. # Objekt aus Typinfo und Adresse:
  2970. # type_pointer_object(type,address)
  2971.   #if (addr_shift==0)
  2972.     # (Kein Cast auf aint, damit NIL als Initializer zu gebrauchen ist.)
  2973.     #define type_pointer_object(type,address)  \
  2974.       type_untype_object(type,address)
  2975.   #elif defined(WIDE_SOFT) && !defined(WIDE_STRUCT)
  2976.     #define type_pointer_object(type,address)  \
  2977.       type_untype_object(type,(aint)(address)>>addr_shift)
  2978.   #else # effizienter,
  2979.     # setzt aber voraus, da▀ address durch 2^addr_shift teilbar ist:
  2980.     #define type_pointer_object(type,address)  \
  2981.       ((object)(  ((oint)(tint)(type) << oint_type_shift) + \
  2982.                   ((oint)(aint)(address) << (oint_addr_shift-addr_shift)) ))
  2983.   #endif
  2984.  
  2985. # Objekt aus konstanter Typinfo und konstanter Adresse:
  2986. # type_constpointer_object(type,address)
  2987.   #define type_constpointer_object(type,address)  type_pointer_object(type,address)
  2988.  
  2989.  
  2990. #if (oint_type_len >= 8) && (oint_addr_shift == 0) && (addr_shift == 0) && !defined(WIDE_SOFT) && !(defined(SUN3) && !defined(UNIX_SUNOS4) && !defined(WIDE_SOFT))
  2991. # Falls tint_type_mask mindestens 8 Bit umfa▀t und nicht WIDE_SOFT,
  2992. # ist evtl. Memory-Mapping m÷glich.
  2993.  
  2994.   #if (defined(HAVE_MMAP_ANON) || defined(HAVE_MMAP_DEVZERO) || defined(HAVE_MACH_VM)) && !(defined(MULTIMAP_MEMORY) || defined(IMMUTABLE)) && !defined(NO_SINGLEMAP)
  2995.     # Zugriff auf Lisp-Objekte wird vereinfacht dadurch, da▀ jedes Lisp-Objekt
  2996.     # an eine Adresse gelegt wird, das seine Typinformation bereits enthΣlt.
  2997.       #define SINGLEMAP_MEMORY
  2998.   #endif
  2999.  
  3000.   #if defined(UNIX_SUNOS4) && (oint_addr_shift==0) && !defined(MULTIMAP_MEMORY) && !defined(SINGLEMAP_MEMORY) && !defined(NO_MULTIMAP_FILE)
  3001.     # Zugriff auf Lisp-Objekte geschieht mittels Memory-Mapping: Jede Speicher-
  3002.     # seite ist unter mehreren Adressen zugreifbar.
  3003.       #define MULTIMAP_MEMORY
  3004.       #define MULTIMAP_MEMORY_VIA_FILE
  3005.   #endif
  3006.  
  3007.   #if defined(HAVE_SHM) && (oint_addr_shift==0) && !defined(MULTIMAP_MEMORY) && !defined(SINGLEMAP_MEMORY) && !defined(NO_MULTIMAP_SHM)
  3008.     # Zugriff auf Lisp-Objekte geschieht mittels Memory-Mapping: Jede Speicher-
  3009.     # seite ist unter mehreren Adressen zugreifbar.
  3010.       #define MULTIMAP_MEMORY
  3011.       #define MULTIMAP_MEMORY_VIA_SHM
  3012.   #endif
  3013.  
  3014.   #ifdef IMMUTABLE
  3015.     #ifdef SUN4_29
  3016.       #error "Immutable objects don't work on this SUN4 architecture!"
  3017.     #endif
  3018.     #ifndef MULTIMAP_MEMORY
  3019.       #error "Immutable objects require working shared memory!"
  3020.     #endif
  3021.     # Welche Typen immutabler Objekte gibt es?
  3022.     #define IMMUTABLE_CONS   # Conses
  3023.     #define IMMUTABLE_ARRAY  # alle Arten Arrays
  3024.   #endif
  3025.  
  3026.   #if defined(MULTIMAP_MEMORY) || defined(SINGLEMAP_MEMORY)
  3027.     #define MAP_MEMORY
  3028.   #endif
  3029.  
  3030.   #ifdef MAP_MEMORY
  3031.     #if defined(SUN4_29)
  3032.       # Durchs Memory-Mapping sind jetzt die Bits 28..24 einer Adresse redundant.
  3033.       #undef addressbus_mask
  3034.       #define addressbus_mask  0xE0FFFFFFUL
  3035.     #elif defined(DECALPHA) && defined(UNIX_OSF)
  3036.       # Durchs Memory-Mapping sind jetzt die Bits 37..33 einer Adresse redundant.
  3037.       #undef addressbus_mask
  3038.       #define addressbus_mask  0xFFFFFFC1FFFFFFFFUL
  3039.     #else
  3040.       # Durchs Memory-Mapping sind jetzt die Bits 31..24 einer Adresse redundant.
  3041.       #undef addressbus_mask
  3042.       #define addressbus_mask  oint_addr_mask  # meist = 0x00FFFFFFUL
  3043.     #endif
  3044.     # Aber evtl. sind einige Typbit-Kombinationen nicht erlaubt.
  3045.     #ifdef vm_addr_mask
  3046.       #define tint_allowed_type_mask  ((oint_type_mask & vm_addr_mask) >> oint_type_shift)
  3047.     #endif
  3048.   #endif
  3049.  
  3050. #endif
  3051.  
  3052. #if (defined(HAVE_MMAP_ANON) || defined(HAVE_MMAP_DEVZERO) || defined(HAVE_MACH_VM)) && !defined(MAP_MEMORY) && !defined(NO_TRIVIALMAP)
  3053.   # mmap() erlaubt eine flexiblere Art der Speicherverwaltung als malloc().
  3054.   # Es ist kein wirkliches Memory-Mapping, sondern nur eine bequemere Art,
  3055.   # zwei gro▀e Speicherbl÷cke zu verwalten.
  3056.   #define TRIVIALMAP_MEMORY
  3057. #endif
  3058.  
  3059.  
  3060. # Art der Garbage Collection: normal oder generational.
  3061. #if defined(VIRTUAL_MEMORY) && (defined(SINGLEMAP_MEMORY) || defined(TRIVIALMAP_MEMORY)) && defined(HAVE_WORKING_MPROTECT) && defined(CAN_HANDLE_WP_FAULT) && (SAFETY < 3) && !defined(NO_GENERATIONAL_GC)
  3062.   # Fⁿr "generational garbage collection" sind einige Voraussetzungen n÷tig.
  3063.   # Unter Linux geht es erst ab Linux 1.1.52, das wird in makemake ⁿberprⁿft.
  3064.   #define GENERATIONAL_GC
  3065. #endif
  3066.  
  3067.  
  3068. # Der Typ `object' liegt nun vollstΣndig fest.
  3069. #ifdef WIDE_STRUCT
  3070.   #ifdef GENERATIONAL_GC
  3071.     # Die Generational GC kann es nicht brauchen, da▀ ein einzelner
  3072.     # Objektpointer sich auf zwei Seiten erstreckt.
  3073.     # Erzwinge daher  alignof(object) = sizeof(object).
  3074.     #define _attribute_aligned_object_  __attribute__ ((aligned(8)))
  3075.   #else
  3076.     #define _attribute_aligned_object_
  3077.   #endif
  3078.   TYPEDEF_OBJECT
  3079. #endif
  3080.  
  3081.  
  3082. # Es folgt die Festlegung der einzelnen Typbits und Typcodes.
  3083.  
  3084. # Feststellen, ob ein Typ bei GC keine VerΣnderung erfΣhrt
  3085. # (z.B. weil er keinen Pointer darstellt):
  3086.   #if 0 && defined(GNU)
  3087.     #define immediate_type_p(type)  \
  3088.       ({var reg1 boolean _erg;                 \
  3089.         switch (type)                          \
  3090.           { case_machine:                      \
  3091.             case_char: case_subr: case_system: \
  3092.             case_fixnum: case_sfloat:          \
  3093.             /* bei WIDE auch: case_ffloat: */  \
  3094.               _erg = TRUE; break;              \
  3095.             default: _erg = FALSE; break;      \
  3096.           }                                    \
  3097.         _erg;                                  \
  3098.        })
  3099.   #endif
  3100.  
  3101. #ifndef tint_allowed_type_mask
  3102.   #define tint_allowed_type_mask  tint_type_mask
  3103. #endif
  3104.  
  3105. # Wir haben 6 bis 8 Typbits zur Verfⁿgung: TB7, [TB6,] [TB5,] TB4, ..., TB0.
  3106. # Alle mⁿssen in tint_allowed_type_mask und damit auch in tint_type_mask
  3107. # gesetzt sein. Wir verteilen sie unter der Annahme, da▀ in tint_type_mask
  3108. # h÷chstens ein Bit fehlt. TB6 und TB5 werden, falls nicht benutzbar,
  3109. # auf -1 gesetzt.
  3110. #if ((0xFF & ~tint_allowed_type_mask) == 0)
  3111.   #define TB7 7
  3112.   #define TB6 6
  3113.   #define TB5 5
  3114.   #define TB4 4
  3115.   #define TB3 3
  3116.   #define TB2 2
  3117.   #define TB1 1
  3118.   #define TB0 0
  3119. #elif (oint_type_len==6)
  3120.   #define TB7 5
  3121.   #define TB6 -1
  3122.   #define TB5 -1
  3123.   #define TB4 4
  3124.   #define TB3 3
  3125.   #define TB2 2
  3126.   #define TB1 1
  3127.   #define TB0 0
  3128. #elif (oint_type_len>=8) && !((0xFF & ~tint_allowed_type_mask) == 0)
  3129.   # Manchem Bit mⁿssen wir aus dem Weg gehen:
  3130.   #define tint_avoid  (0xFF & ~tint_allowed_type_mask)
  3131.   #if ((tint_avoid & (tint_avoid-1)) == 0)
  3132.     # tint_avoid besteht aus genau einem Bit, das es zu vermeiden gilt.
  3133.     #if (tint_avoid > bit(0))
  3134.       #define TB0 0
  3135.     #else
  3136.       #define TB0 1
  3137.     #endif
  3138.     #if (tint_avoid > bit(1))
  3139.       #define TB1 1
  3140.     #else
  3141.       #define TB1 2
  3142.     #endif
  3143.     #if (tint_avoid > bit(2))
  3144.       #define TB2 2
  3145.     #else
  3146.       #define TB2 3
  3147.     #endif
  3148.     #if (tint_avoid > bit(3))
  3149.       #define TB3 3
  3150.     #else
  3151.       #define TB3 4
  3152.     #endif
  3153.     #if (tint_avoid > bit(4))
  3154.       #define TB4 4
  3155.     #else
  3156.       #define TB4 5
  3157.     #endif
  3158.     #if (tint_avoid > bit(5))
  3159.       #define TB5 5
  3160.     #else
  3161.       #define TB5 6
  3162.     #endif
  3163.     #define TB6 -1
  3164.     #if (tint_avoid > bit(6))
  3165.       #define TB7 6
  3166.     #else
  3167.       #define TB7 7
  3168.     #endif
  3169.   #else
  3170.     # tint_avoid darf h÷chstens zwei Bits enthalten:
  3171.     #if ((tint_avoid & (tint_avoid-1)) & ((tint_avoid & (tint_avoid-1)) - 1))
  3172.       #error "Bogus oint_type_mask -- oint_type_mask neu einstellen!"
  3173.     #endif
  3174.     # Das eine verbotene Bit k÷nnen wir immer noch als GC-Bit nutzen,
  3175.     # vorausgesetzt, es ist in tint_type_mask enthalten:
  3176.     #define tint_maybegc_type_mask  (0xFF & tint_type_mask & ~tint_allowed_type_mask)
  3177.     #if (tint_maybegc_type_mask==0)
  3178.       #error "Bogus oint_type_mask, vm_addr_mask -- oint_type_mask, vm_addr_mask neu einstellen!"
  3179.     #endif
  3180.     # Davon nehmen wir das kleinere Bit als GC-Bit:
  3181.     #define tint_avoid1  (tint_maybegc_type_mask & -tint_maybegc_type_mask)
  3182.     #if (tint_avoid1 == bit(0))
  3183.       #define TB7 0
  3184.     #elif (tint_avoid1 == bit(1))
  3185.       #define TB7 1
  3186.     #elif (tint_avoid1 == bit(2))
  3187.       #define TB7 2
  3188.     #elif (tint_avoid1 == bit(3))
  3189.       #define TB7 3
  3190.     #elif (tint_avoid1 == bit(4))
  3191.       #define TB7 4
  3192.     #elif (tint_avoid1 == bit(5))
  3193.       #define TB7 5
  3194.     #elif (tint_avoid1 == bit(6))
  3195.       #define TB7 6
  3196.     #elif (tint_avoid1 == bit(7))
  3197.       #define TB7 7
  3198.     #else
  3199.       #error "Bogus tint_avoid1!"
  3200.     #endif
  3201.     #define TB6 -1
  3202.     # Und das gr÷▀ere Bit gilt es noch zu vermeiden:
  3203.     #define tint_avoid2  (tint_avoid & ~tint_avoid1)
  3204.     #if (TB7 > 0) && (tint_avoid2 > bit(0))
  3205.       #define TB0 0
  3206.     #elif (TB7 > 1) || (tint_avoid2 > bit(1))
  3207.       #define TB0 1
  3208.     #else
  3209.       #define TB0 2
  3210.     #endif
  3211.     #if (TB7 > 1) && (tint_avoid2 > bit(1))
  3212.       #define TB1 1
  3213.     #elif (TB7 > 2) || (tint_avoid2 > bit(2))
  3214.       #define TB1 2
  3215.     #else
  3216.       #define TB1 3
  3217.     #endif
  3218.     #if (TB7 > 2) && (tint_avoid2 > bit(2))
  3219.       #define TB2 2
  3220.     #elif (TB7 > 3) || (tint_avoid2 > bit(3))
  3221.       #define TB2 3
  3222.     #else
  3223.       #define TB2 4
  3224.     #endif
  3225.     #if (TB7 > 3) && (tint_avoid2 > bit(3))
  3226.       #define TB3 3
  3227.     #elif (TB7 > 4) || (tint_avoid2 > bit(4))
  3228.       #define TB3 4
  3229.     #else
  3230.       #define TB3 5
  3231.     #endif
  3232.     #if (TB7 > 4) && (tint_avoid2 > bit(4))
  3233.       #define TB4 4
  3234.     #elif (TB7 > 5) || (tint_avoid2 > bit(5))
  3235.       #define TB4 5
  3236.     #else
  3237.       #define TB4 6
  3238.     #endif
  3239.     #if (TB7 > 5) && (tint_avoid2 > bit(5))
  3240.       #define TB5 5
  3241.     #elif (TB7 > 6) || (tint_avoid2 > bit(6))
  3242.       #define TB5 6
  3243.     #else
  3244.       #define TB5 7
  3245.     #endif
  3246.   #endif
  3247. #else
  3248.   #error "Bogus TB7..TB0 -- TB7..TB0 neu einstellen!"
  3249. #endif
  3250.  
  3251. #if (TB7==7)&&(TB6==6)&&(TB5==5)&&(TB4==4)&&(TB3==3)&&(TB2==2)&&(TB1==1)&&(TB0==0)
  3252.   #if defined(SUN3) && !defined(UNIX_SUNOS4) && !defined(WIDE_SOFT)
  3253.     #define SUN3_TYPECODES
  3254.   #elif defined(SUN4_29) && defined(MAP_MEMORY)
  3255.     #define PACKED_TYPECODES
  3256.   #elif defined(DECALPHA) && defined(UNIX_OSF) && defined(MAP_MEMORY)
  3257.     #define PACKED_TYPECODES
  3258.   #else
  3259.     #define STANDARD_TYPECODES
  3260.   #endif
  3261. #endif
  3262. #if (oint_type_len>=8) && (TB6==-1)
  3263.   #if defined(DECALPHA) && defined(UNIX_OSF) && defined(MAP_MEMORY)
  3264.     #define PACKED_TYPECODES
  3265.   #else
  3266.     #define SEVENBIT_TYPECODES
  3267.   #endif
  3268. #endif
  3269. #if (oint_type_len==6)
  3270.   #define SIXBIT_TYPECODES
  3271. #endif
  3272.  
  3273. #ifdef STANDARD_TYPECODES
  3274.  
  3275. #ifdef UNIX_LINUX
  3276.   # Zugriffe sind nur auf Pointer >=0, <0x60000000 erlaubt.
  3277.   # Deswegen brauchen wir die Typcode-Verteilung aber nicht zu Σndern.
  3278. #endif
  3279.  
  3280. # Typbits:
  3281. # in Typcodes (tint):
  3282.   #define garcol_bit_t     7  # gesetzt nur wΣhrend der Garbage Collection!
  3283.   #define cons_bit_t       6  # gesetzt nur bei CONS
  3284.   #define symbol_bit_t     5  # gesetzt nur bei SYMBOL
  3285.   #define number_bit_t     4  # gesetzt nur bei Zahlen
  3286.   #define notsimple_bit_t  2  # bei Arrays: gel÷scht bei Simple-Arrays
  3287.   #define sign_bit_t       0  # Vorzeichen bei reellen Zahlen (gesetzt <==> Zahl <0)
  3288.   #define float_bit_t      1
  3289.   #define float1_bit_t     3
  3290.   #define float2_bit_t     2
  3291.   #define ratio_bit_t      3
  3292.   #define bignum_bit_t     2
  3293. # in Objekten (oint):
  3294.   #define garcol_bit_o     (garcol_bit_t+oint_type_shift)    # gesetzt nur wΣhrend der Garbage Collection!
  3295.   #define cons_bit_o       (cons_bit_t+oint_type_shift)      # gesetzt nur bei CONS
  3296.   #define symbol_bit_o     (symbol_bit_t+oint_type_shift)    # gesetzt nur bei SYMBOL
  3297.   #define number_bit_o     (number_bit_t+oint_type_shift)    # gesetzt nur bei Zahlen
  3298.   #define notsimple_bit_o  (notsimple_bit_t+oint_type_shift) # bei Arrays: gel÷scht bei Simple-Arrays
  3299.   #define sign_bit_o       (sign_bit_t+oint_type_shift)      # Vorzeichen bei reellen Zahlen
  3300.   #define float_bit_o      (float_bit_t+oint_type_shift)
  3301.   #define float1_bit_o     (float1_bit_t+oint_type_shift)
  3302.   #define float2_bit_o     (float2_bit_t+oint_type_shift)
  3303.   #define ratio_bit_o      (ratio_bit_t+oint_type_shift)
  3304.   #define bignum_bit_o     (bignum_bit_t+oint_type_shift)
  3305.  
  3306. # konstante Typcodes:
  3307.   #define machine_type   0x00  # %00000000  ; Maschinenpointer
  3308.   #define sbvector_type  0x01  # %00000001  ; Simple-Bit-Vector
  3309.   #define sstring_type   0x02  # %00000010  ; Simple-String
  3310.   #define svector_type   0x03  # %00000011  ; Simple-Vector
  3311.   #define array_type     0x04  # %00000100  ; sonstiger Array (Rang /=1 oder
  3312.                                #            ; - spΣter vielleicht - anderer Elementtyp)
  3313.   #define bvector_type   0x05  # %00000101  ; sonstiger Bit-Vector oder Byte-Vector
  3314.   #define string_type    0x06  # %00000110  ; sonstiger String
  3315.   #define vector_type    0x07  # %00000111  ; sonstiger (VECTOR T)
  3316.   #define closure_type   0x08  # %00001000  ; Closure
  3317.   #define structure_type 0x09  # %00001001  ; Structure
  3318.   #define stream_type    0x0A  # %00001010  ; Stream
  3319.   #define orecord_type   0x0B  # %00001011  ; OtherRecord (Package, Byte, ...)
  3320.   #define instance_type  0x0C  # %00001100  ; CLOS-Instanz
  3321.   #define char_type      0x0D  # %00001101  ; Character
  3322.   #define subr_type      0x0E  # %00001110  ; SUBR
  3323.   #define system_type    0x0F  # %00001111  ; Frame-Pointer, Read-Label, SYSTEM
  3324.   #define fixnum_type    0x10  # %00010000  ; Fixnum
  3325.   #define sfloat_type    0x12  # %00010010  ; Short-Float
  3326.   #define bignum_type    0x14  # %00010100  ; Bignum
  3327.   #define ffloat_type    0x16  # %00010110  ; Single-Float
  3328.   #define ratio_type     0x18  # %00011000  ; Ratio
  3329.   #define dfloat_type    0x1A  # %00011010  ; Double-float
  3330.   #define complex_type   0x1C  # %00011100  ; Complex
  3331.   #define lfloat_type    0x1E  # %00011110  ; Long-Float
  3332.   #ifndef IMMUTABLE_ARRAY
  3333.   #define symbol_type    0x20  # %00100000  ; Symbol
  3334.           # Bits fⁿr Symbole in VAR/FUN-Frames (im LISP-Stack):
  3335.           #define active_bit  1  # gesetzt: Bindung ist aktiv
  3336.           #define dynam_bit   2  # gesetzt: Bindung ist dynamisch
  3337.           #define svar_bit    3  # gesetzt: nΣchster Parameter ist supplied-p-Parameter fⁿr diesen
  3338.           #define oint_symbolflags_shift  oint_type_shift
  3339.           # Bits fⁿr Symbole im Selbstpointer:
  3340.           #define constant_bit_t  1  # zeigt an, ob das Symbol eine Konstante ist
  3341.           #define special_bit_t   2  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3342.           #define keyword_bit_t   3  # zeigt an, ob das Symbol ein Keyword ist
  3343.   #else
  3344.   #define imm_array_mask     0x20  # Maske, die immutable von normalen Arrays unterscheidet
  3345.   #define imm_sbvector_type  0x21  # %00100001  ; immutabler Simple-Bit-Vector
  3346.   #define imm_sstring_type   0x22  # %00100010  ; immutabler Simple-String
  3347.   #define imm_svector_type   0x23  # %00100011  ; immutabler Simple-Vector
  3348.   #define imm_array_type     0x24  # %00100100  ; immutabler sonstiger Array (Rang /=1 oder
  3349.                                    #            ; - spΣter vielleicht - anderer Elementtyp)
  3350.   #define imm_bvector_type   0x25  # %00100101  ; immutabler sonstiger Bit-Vector oder Byte-Vector
  3351.   #define imm_string_type    0x26  # %00100110  ; immutabler sonstiger String
  3352.   #define imm_vector_type    0x27  # %00100111  ; immutabler sonstiger (VECTOR T)
  3353.   #define symbol_type    0x28  # %00101000  ; Symbol
  3354.           # Bits fⁿr Symbole in VAR/FUN-Frames (im LISP-Stack):
  3355.           #define active_bit  0  # gesetzt: Bindung ist aktiv
  3356.           #define dynam_bit   1  # gesetzt: Bindung ist dynamisch
  3357.           #define svar_bit    2  # gesetzt: nΣchster Parameter ist supplied-p-Parameter fⁿr diesen
  3358.           #define oint_symbolflags_shift  oint_type_shift
  3359.           # Bits fⁿr Symbole im Selbstpointer:
  3360.           #define constant_bit_t  0  # zeigt an, ob das Symbol eine Konstante ist
  3361.           #define special_bit_t   1  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3362.           #define keyword_bit_t   2  # zeigt an, ob das Symbol ein Keyword ist
  3363.   #undef symbol_bit_t
  3364.   #undef symbol_bit_o
  3365.   #endif
  3366.   #define cons_type      0x40  # %01000000  ; Cons
  3367.   #ifdef IMMUTABLE_CONS
  3368.   #define imm_cons_type  0x41  # %01000001  ; immutable Cons
  3369.   #endif
  3370.  
  3371. #ifndef WIDE
  3372.   # Typ ist GC-invariant, wenn
  3373.   # Typinfobyte=0 oder char_type <= Typinfobyte < bignum_type.
  3374.     #define immediate_type_p(type)  \
  3375.       ((type==0) || ((char_type<=type) && (type<bignum_type)))
  3376. #else
  3377.   # Typ ist GC-invariant, wenn
  3378.   # Typinfobyte eines von 0x00,0x0D..0x13,0x16..0x17 ist.
  3379.     #define immediate_type_p(type)  \
  3380.       ((type<0x18) && ((bit(type) & 0xFF301FFEUL) == 0))
  3381. #endif
  3382.  
  3383. #endif # STANDARD_TYPECODES
  3384.  
  3385. #ifdef PACKED_TYPECODES
  3386.  
  3387. #ifdef SUN4_29
  3388. # Zugriffe sind nur auf Pointer >=0, <2^29 erlaubt.
  3389. # Daher eine etwas gedrΣngte Typcode-Verteilung.
  3390. #endif
  3391.  
  3392. #if defined(DECALPHA) && defined(UNIX_OSF) && !(defined(NO_SINGLEMAP) || defined(NO_TRIVIALMAP))
  3393. # mmap() geht nur mit Adressen >=0, <2^38, aber da gew÷hnliche Pointer im
  3394. # Bereich 1*2^32..2*2^32 liegen, bleiben uns nur die Bits 37..33 als Typbits.
  3395. #endif
  3396.  
  3397. # Typbits:
  3398. # in Typcodes (tint):
  3399.   #define garcol_bit_t     TB7  # gesetzt nur wΣhrend der Garbage Collection!
  3400.   #define number_bit_t     TB4  # gesetzt nur bei Zahlen
  3401.   #define notsimple_bit_t  TB2  # bei Arrays: gel÷scht bei Simple-Arrays
  3402.   #define sign_bit_t       TB0  # Vorzeichen bei reellen Zahlen (gesetzt <==> Zahl <0)
  3403.   #define float_bit_t      TB1
  3404.   #define float1_bit_t     TB3
  3405.   #define float2_bit_t     TB2
  3406.   #define ratio_bit_t      TB3
  3407.   #define bignum_bit_t     TB2
  3408. # in Objekten (oint):
  3409.   #define garcol_bit_o     (garcol_bit_t+oint_type_shift)    # gesetzt nur wΣhrend der Garbage Collection!
  3410.   #define number_bit_o     (number_bit_t+oint_type_shift)    # gesetzt nur bei Zahlen
  3411.   #define notsimple_bit_o  (notsimple_bit_t+oint_type_shift) # bei Arrays: gel÷scht bei Simple-Arrays
  3412.   #define sign_bit_o       (sign_bit_t+oint_type_shift)      # Vorzeichen bei reellen Zahlen
  3413.   #define float_bit_o      (float_bit_t+oint_type_shift)
  3414.   #define float1_bit_o     (float1_bit_t+oint_type_shift)
  3415.   #define float2_bit_o     (float2_bit_t+oint_type_shift)
  3416.   #define ratio_bit_o      (ratio_bit_t+oint_type_shift)
  3417.   #define bignum_bit_o     (bignum_bit_t+oint_type_shift)
  3418.  
  3419. # konstante Typcodes:
  3420.   #define machine_type   (0)                                            # 0x00  # %00000000  ; Maschinenpointer
  3421.   #define sbvector_type  (                                    bit(TB0)) # 0x01  # %00000001  ; Simple-Bit-Vector
  3422.   #define sstring_type   (                           bit(TB1)         ) # 0x02  # %00000010  ; Simple-String
  3423.   #define svector_type   (                           bit(TB1)|bit(TB0)) # 0x03  # %00000011  ; Simple-Vector
  3424.   #define array_type     (                  bit(TB2)                  ) # 0x04  # %00000100  ; sonstiger Array (Rang /=1 oder
  3425.                                                                                 #            ; - spΣter vielleicht - anderer Elementtyp)
  3426.   #define bvector_type   (                  bit(TB2)         |bit(TB0)) # 0x05  # %00000101  ; sonstiger Bit-Vector oder Byte-Vector
  3427.   #define string_type    (                  bit(TB2)|bit(TB1)         ) # 0x06  # %00000110  ; sonstiger String
  3428.   #define vector_type    (                  bit(TB2)|bit(TB1)|bit(TB0)) # 0x07  # %00000111  ; sonstiger (VECTOR T)
  3429.   #define closure_type   (         bit(TB3)                           ) # 0x08  # %00001000  ; Closure
  3430.   #define structure_type (         bit(TB3)                  |bit(TB0)) # 0x09  # %00001001  ; Structure
  3431.   #define stream_type    (         bit(TB3)         |bit(TB1)         ) # 0x0A  # %00001010  ; Stream
  3432.   #define orecord_type   (         bit(TB3)         |bit(TB1)|bit(TB0)) # 0x0B  # %00001011  ; OtherRecord (Package, Byte, ...)
  3433.   #define instance_type  (         bit(TB3)|bit(TB2)                  ) # 0x0C  # %00001100  ; CLOS-Instanz
  3434.   #define subr_type      (         bit(TB3)|bit(TB2)         |bit(TB0)) # 0x0D  # %00001101  ; SUBR
  3435.   #define symbol_type    (         bit(TB3)|bit(TB2)|bit(TB1)         ) # 0x0E  # %00001110  ; Symbol
  3436.           # Bits fⁿr Symbole in VAR/FUN-Frames (im LISP-Stack):
  3437.           # sitzen nicht im oint_type-Teil, sondern im oint_addr-Teil.
  3438.           #define active_bit  0  # gesetzt: Bindung ist aktiv
  3439.           #define dynam_bit   1  # gesetzt: Bindung ist dynamisch
  3440.           #define svar_bit    2  # gesetzt: nΣchster Parameter ist supplied-p-Parameter fⁿr diesen
  3441.           #define oint_symbolflags_shift  oint_addr_shift
  3442.           # Bits fⁿr Symbole im Selbstpointer:
  3443.           #if !((TB3+3==TB7) || (TB3+2==TB7) || (TB3+1==TB7))
  3444.             #define constant_bit_t  (TB3+3)  # zeigt an, ob das Symbol eine Konstante ist
  3445.             #define special_bit_t   (TB3+2)  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3446.             #define keyword_bit_t   (TB3+1)  # zeigt an, ob das Symbol ein Keyword ist
  3447.           #else
  3448.             #define constant_bit_t  (TB7+3)  # zeigt an, ob das Symbol eine Konstante ist
  3449.             #define special_bit_t   (TB7+2)  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3450.             #define keyword_bit_t   (TB7+1)  # zeigt an, ob das Symbol ein Keyword ist
  3451.           #endif
  3452.   #define cons_type      (         bit(TB3)|bit(TB2)|bit(TB1)|bit(TB0)) # 0x0F  # %00001111  ; Cons
  3453.   #define fixnum_type    (bit(TB4)                                    ) # 0x10  # %00010000  ; Fixnum
  3454.   #define sfloat_type    (bit(TB4)                  |bit(TB1)         ) # 0x12  # %00010010  ; Short-Float
  3455.   #define bignum_type    (bit(TB4)         |bit(TB2)                  ) # 0x14  # %00010100  ; Bignum
  3456.   #define ffloat_type    (bit(TB4)         |bit(TB2)|bit(TB1)         ) # 0x16  # %00010110  ; Single-Float
  3457.   #define ratio_type     (bit(TB4)|bit(TB3)                           ) # 0x18  # %00011000  ; Ratio
  3458.   #define dfloat_type    (bit(TB4)|bit(TB3)         |bit(TB1)         ) # 0x1A  # %00011010  ; Double-float
  3459.   #define complex_type   (bit(TB4)|bit(TB3)|bit(TB2)                  ) # 0x1C  # %00011100  ; Complex
  3460.   #define lfloat_type    (bit(TB4)|bit(TB3)|bit(TB2)|bit(TB1)         ) # 0x1E  # %00011110  ; Long-Float
  3461.   #define system_type    (bit(TB5)                                    ) # 0x20  # %00100000  ; Frame-Pointer, Read-Label, SYSTEM
  3462.   #define char_type      (bit(TB5)|bit(TB0)                           ) # 0x21  # %00100001  ; Character
  3463.  
  3464. # Typ ist GC-invariant, wenn
  3465.   #if (TB5==5)&&(TB4==4)&&(TB3==3)&&(TB2==2)&&(TB1==1)&&(TB0==0) && !defined(WIDE)
  3466.     # Typinfobyte eines von 0x00,0x0D,0x10,0x11,0x12,0x13,0x20,0x21 ist.
  3467.     #define immediate_type_p(type)  \
  3468.       ((type>=32) || ((bit(type) & 0xFFF0DFFEUL) == 0))
  3469.   #elif (TB5==6)&&(TB4==5)&&(TB3==4)&&(TB2==3)&&(TB1==2)&&(TB0==1) && defined(WIDE)
  3470.     # Typinfobyte/2 eines von 0x00,0x0D,0x10,0x11,0x12,0x13,0x16,0x17,0x20,0x21 ist.
  3471.     #define immediate_type_p(type)  \
  3472.       ((type>=64) || ((bit((type)>>1) & 0xFF30DFFEUL) == 0))
  3473.   #endif
  3474.  
  3475. #endif # PACKED_TYPECODES
  3476.  
  3477. #ifdef SEVENBIT_TYPECODES
  3478.  
  3479. #ifdef UNIX_SYSV_UHC_1
  3480. # Mallozierter Speicher belegt den Bereich ab 0x08000000.
  3481. # Fⁿr die Typinformation stehen nur 7 Bit zur Verfⁿgung, und die fⁿr den
  3482. # Typcode zur Verfⁿgung stehenden Bits liegen nicht am Stⁿck.
  3483. # Wir mⁿssen Bit 3 aus dem Weg gehen.
  3484. #endif
  3485.  
  3486. #if defined(UNIX_IRIX) || defined(UNIX_DEC_ULTRIX)
  3487. # Mallozierter Speicher belegt den Bereich ab 0x10000000.
  3488. # Fⁿr die Typinformation stehen nur 7 Bit zur Verfⁿgung, und die fⁿr den
  3489. # Typcode zur Verfⁿgung stehenden Bits liegen nicht am Stⁿck.
  3490. # Wir mⁿssen Bit 4 aus dem Weg gehen.
  3491. #endif
  3492.  
  3493. #ifdef UNIX_AIX
  3494. # Mallozierter Speicher belegt den Bereich ab 0x20000000.
  3495. # Fⁿr die Typinformation stehen nur 7 Bit zur Verfⁿgung, und die fⁿr den
  3496. # Typcode zur Verfⁿgung stehenden Bits liegen nicht am Stⁿck.
  3497. # Wir mⁿssen Bit 5 aus dem Weg gehen.
  3498. #endif
  3499.  
  3500. #if defined(UNIX_NEXTSTEP) && defined(MAP_MEMORY)
  3501. # UNIX_NEXTSTEP verbietet uns die Benutzung von Adressen im Bereich von
  3502. # unterhalb 0x04000000 bis oberhalb 0x05000000. Wir vermeiden daher als
  3503. # Typbits Bit 0 und Bit 2 (ausgenommen GC-Bit, das ja vor jedem Speicherzugriff
  3504. # wegmaskiert wird).
  3505. #endif
  3506.  
  3507. #if defined(UNIX_CONVEX) && defined(MAP_MEMORY)
  3508. # Bei UNIX_CONVEX liegt der Adre▀raum der Prozesse ab 0x80000000.
  3509. # mmap() funktioniert allerdings nur unterhalb von 0xC000000. Daher
  3510. # geh÷rt Bit 31 zur Adresse, und Bit 30 mⁿssen wir aus dem Weg gehen.
  3511. #endif
  3512.  
  3513. # Typbits:
  3514. # in Typcodes (tint):
  3515.   #define garcol_bit_t     TB7  # gesetzt nur wΣhrend der Garbage Collection!
  3516.   #define number_bit_t     TB4  # gesetzt nur bei Zahlen
  3517.   #define notsimple_bit_t  TB2  # bei Arrays: gel÷scht bei Simple-Arrays
  3518.   #define sign_bit_t       TB0  # Vorzeichen bei reellen Zahlen (gesetzt <==> Zahl <0)
  3519.   #define float_bit_t      TB1
  3520.   #define float1_bit_t     TB3
  3521.   #define float2_bit_t     TB2
  3522.   #define ratio_bit_t      TB3
  3523.   #define bignum_bit_t     TB2
  3524. # in Objekten (oint):
  3525.   #define garcol_bit_o     (garcol_bit_t+oint_type_shift)    # gesetzt nur wΣhrend der Garbage Collection!
  3526.   #define number_bit_o     (number_bit_t+oint_type_shift)    # gesetzt nur bei Zahlen
  3527.   #define notsimple_bit_o  (notsimple_bit_t+oint_type_shift) # bei Arrays: gel÷scht bei Simple-Arrays
  3528.   #define sign_bit_o       (sign_bit_t+oint_type_shift)      # Vorzeichen bei reellen Zahlen
  3529.   #define float_bit_o      (float_bit_t+oint_type_shift)
  3530.   #define float1_bit_o     (float1_bit_t+oint_type_shift)
  3531.   #define float2_bit_o     (float2_bit_t+oint_type_shift)
  3532.   #define ratio_bit_o      (ratio_bit_t+oint_type_shift)
  3533.   #define bignum_bit_o     (bignum_bit_t+oint_type_shift)
  3534.  
  3535. # konstante Typcodes:
  3536.   #define machine_type   (0)                                             # %000000  ; Maschinenpointer
  3537.   #define sbvector_type  (                                    bit(TB0))  # %000001  ; Simple-Bit-Vector
  3538.   #define sstring_type   (                           bit(TB1)         )  # %000010  ; Simple-String
  3539.   #define svector_type   (                           bit(TB1)|bit(TB0))  # %000011  ; Simple-Vector
  3540.   #define array_type     (                  bit(TB2)                  )  # %000100  ; sonstiger Array (Rang /=1 oder
  3541.                                                                          #          ; - spΣter vielleicht - anderer Elementtyp)
  3542.   #define bvector_type   (                  bit(TB2)         |bit(TB0))  # %000101  ; sonstiger Bit-Vector oder Byte-Vector
  3543.   #define string_type    (                  bit(TB2)|bit(TB1)         )  # %000110  ; sonstiger String
  3544.   #define vector_type    (                  bit(TB2)|bit(TB1)|bit(TB0))  # %000111  ; sonstiger (VECTOR T)
  3545.   #define closure_type   (         bit(TB3)                           )  # %001000  ; Closure
  3546.   #define structure_type (         bit(TB3)                  |bit(TB0))  # %001001  ; Structure
  3547.   #define stream_type    (         bit(TB3)         |bit(TB1)         )  # %001010  ; Stream
  3548.   #define orecord_type   (         bit(TB3)         |bit(TB1)|bit(TB0))  # %001011  ; OtherRecord (Package, Byte, ...)
  3549.   #define instance_type  (         bit(TB3)|bit(TB2)                  )  # %001100  ; CLOS-Instanz
  3550.   #define char_type      (         bit(TB3)|bit(TB2)         |bit(TB0))  # %001101  ; Character
  3551.   #define subr_type      (         bit(TB3)|bit(TB2)|bit(TB1)         )  # %001110  ; SUBR
  3552.   #define system_type    (         bit(TB3)|bit(TB2)|bit(TB1)|bit(TB0))  # %001111  ; Frame-Pointer, Read-Label, SYSTEM
  3553.   #define fixnum_type    (bit(TB4)                                    )  # %010000  ; Fixnum
  3554.   #define sfloat_type    (bit(TB4)                  |bit(TB1)         )  # %010010  ; Short-Float
  3555.   #define bignum_type    (bit(TB4)         |bit(TB2)                  )  # %010100  ; Bignum
  3556.   #define ffloat_type    (bit(TB4)         |bit(TB2)|bit(TB1)         )  # %010110  ; Single-Float
  3557.   #define ratio_type     (bit(TB4)|bit(TB3)                           )  # %011000  ; Ratio
  3558.   #define dfloat_type    (bit(TB4)|bit(TB3)         |bit(TB1)         )  # %011010  ; Double-float
  3559.   #define complex_type   (bit(TB4)|bit(TB3)|bit(TB2)                  )  # %011100  ; Complex
  3560.   #define lfloat_type    (bit(TB4)|bit(TB3)|bit(TB2)|bit(TB1)         )  # %011110  ; Long-Float
  3561.   #define symbol_type    (bit(TB5)                                    )  # %100000  ; Symbol
  3562.           # Bits fⁿr Symbole in VAR/FUN-Frames (im LISP-Stack):
  3563.           #define active_bit  TB0  # gesetzt: Bindung ist aktiv
  3564.           #define dynam_bit   TB1  # gesetzt: Bindung ist dynamisch
  3565.           #define svar_bit    TB2  # gesetzt: nΣchster Parameter ist supplied-p-Parameter fⁿr diesen
  3566.           #define oint_symbolflags_shift  oint_type_shift
  3567.           # Bits fⁿr Symbole im Selbstpointer:
  3568.           #define constant_bit_t  TB0  # zeigt an, ob das Symbol eine Konstante ist
  3569.           #define special_bit_t   TB1  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3570.           #define keyword_bit_t   TB2  # zeigt an, ob das Symbol ein Keyword ist
  3571.   #define cons_type      (bit(TB5)|bit(TB3))                             # %101000  ; Cons
  3572.  
  3573. #ifndef WIDE
  3574.   # Typ ist GC-invariant, wenn
  3575.   # Typinfobyte=0 oder char_type <= Typinfobyte < bignum_type.
  3576.     #define immediate_type_p(type)  \
  3577.       ((type==0) || ((char_type<=type) && (type<bignum_type)))
  3578. #else
  3579.   #error "immediate_type_p() implementieren!"
  3580. #endif
  3581.  
  3582. #endif # SEVENBIT_TYPECODES
  3583.  
  3584. #ifdef SIXBIT_TYPECODES
  3585.  
  3586. #if defined(ATARITT) || defined(ACORN_3) || defined(ACORN_4)
  3587. # Speicher kann den Bereich von 0x00000000 bis 0x03FFFFFF umfassen.
  3588. # Fⁿr die Typinformation stehen nur 6 Bit zur Verfⁿgung.
  3589. #endif
  3590.  
  3591. #ifdef AMIGA3000
  3592. # Speicher kann den Bereich von 0x07000000 bis 0x0FFFFFFF umfassen.
  3593. # Fⁿr die Typinformation stehen nur 6 Bit zur Verfⁿgung, und dies auch nur,
  3594. # wenn wir Alignment = 4 voraussetzen.
  3595. # Das k÷nnen wir aber nicht, da der C-Compiler bzw. der Linker im Text-Segment
  3596. # nur Alignment = 2 hat. Somit k÷nnen wir nur den Bereich von 0x07000000 bis
  3597. # 0x07FFFFFF nutzen.
  3598. #endif
  3599.  
  3600. #if defined(HPPA) && defined(UNIX_HPUX)
  3601. # Mallozierter Speicher belegt den Bereich ab 0x40000000.
  3602. # Fⁿr die Typinformation stehen die Bits 29..24 zur Verfⁿgung.
  3603. #endif
  3604.  
  3605. #ifdef UNIX_AMIX
  3606. # Bits 31..30 werden vom Betriebssystem belegt.
  3607. # Fⁿr die Typinformation stehen die Bits 29..24 zur Verfⁿgung.
  3608. #endif
  3609.  
  3610. #ifdef UNIX_SYSV_UHC_2
  3611. # Mallozierter Speicher belegt den Bereich ab 0x08000000.
  3612. # Fⁿr die Typinformation stehen nur 6 Bit zur Verfⁿgung, und dies auch nur,
  3613. # wenn wir Alignment = 4 voraussetzen.
  3614. #endif
  3615.  
  3616. #ifdef WATCOM_BLAKE
  3617. # When run with virtual memory or in the DOS box, the DOS4GW extender returns
  3618. # malloc'ed memory in the range beginning at 0x80000000.
  3619. # The type information can use the bits 30..25.
  3620. #endif
  3621.  
  3622. # Fⁿr die Typinformation stehen nur 6 Bit zur Verfⁿgung.
  3623. # Daher eine etwas gedrΣngte Typcode-Verteilung.
  3624.  
  3625. # Typbits:
  3626. # in Typcodes (tint):
  3627.   #define garcol_bit_t     5  # gesetzt nur wΣhrend der Garbage Collection!
  3628.   #define number_bit_t     4  # gesetzt nur bei Zahlen
  3629.   #define notsimple_bit_t  2  # bei Arrays: gel÷scht bei Simple-Arrays
  3630.   #define sign_bit_t       0  # Vorzeichen bei reellen Zahlen (gesetzt <==> Zahl <0)
  3631.   #define float_bit_t      1
  3632.   #define float1_bit_t     3
  3633.   #define float2_bit_t     2
  3634.   #define ratio_bit_t      3
  3635.   #define bignum_bit_t     2
  3636. # in Objekten (oint):
  3637.   #define garcol_bit_o     (garcol_bit_t+oint_type_shift)    # gesetzt nur wΣhrend der Garbage Collection!
  3638.   #define number_bit_o     (number_bit_t+oint_type_shift)    # gesetzt nur bei Zahlen
  3639.   #define notsimple_bit_o  (notsimple_bit_t+oint_type_shift) # bei Arrays: gel÷scht bei Simple-Arrays
  3640.   #define sign_bit_o       (sign_bit_t+oint_type_shift)      # Vorzeichen bei reellen Zahlen
  3641.   #define float_bit_o      (float_bit_t+oint_type_shift)
  3642.   #define float1_bit_o     (float1_bit_t+oint_type_shift)
  3643.   #define float2_bit_o     (float2_bit_t+oint_type_shift)
  3644.   #define ratio_bit_o      (ratio_bit_t+oint_type_shift)
  3645.   #define bignum_bit_o     (bignum_bit_t+oint_type_shift)
  3646.  
  3647. # konstante Typcodes:
  3648.   #define machine_type   0x00  # %000000  ; Maschinenpointer
  3649.   #define sbvector_type  0x01  # %000001  ; Simple-Bit-Vector
  3650.   #define sstring_type   0x02  # %000010  ; Simple-String
  3651.   #define svector_type   0x03  # %000011  ; Simple-Vector
  3652.   #define array_type     0x04  # %000100  ; sonstiger Array (Rang /=1 oder
  3653.                                #          ; - spΣter vielleicht - anderer Elementtyp)
  3654.   #define bvector_type   0x05  # %000101  ; sonstiger Bit-Vector oder Byte-Vector
  3655.   #define string_type    0x06  # %000110  ; sonstiger String
  3656.   #define vector_type    0x07  # %000111  ; sonstiger (VECTOR T)
  3657.   #define symbol_type    0x08  # %001000  ; Symbol
  3658.           # Bits fⁿr Symbole in VAR/FUN-Frames (im LISP-Stack):
  3659.           #define active_bit  0  # gesetzt: Bindung ist aktiv
  3660.           #define dynam_bit   1  # gesetzt: Bindung ist dynamisch
  3661.           #define svar_bit    2  # gesetzt: nΣchster Parameter ist supplied-p-Parameter fⁿr diesen
  3662.           #if defined(ATARITT) || defined(ACORN_3) || defined(ACORN_4) || defined(AMIGA3000) || defined(UNIX_AMIX) || defined(WATCOM_BLAKE)
  3663.             #define NO_symbolflags # active_bit, dynam_bit, svar_bit haben im Symbol keinen Platz
  3664.           #endif
  3665.           #if defined(HPPA) && defined(UNIX_HPUX)
  3666.             # sitzen nicht im oint_type-Teil, sondern im oint_addr-Teil.
  3667.             #define oint_symbolflags_shift  oint_addr_shift
  3668.           #endif
  3669.           #if defined(UNIX_SYSV_UHC_2)
  3670.             # sitzen im oberen oint_addr-Teil.
  3671.             #define oint_symbolflags_shift  (24-addr_shift + oint_addr_shift)
  3672.           #endif
  3673.           # Bits fⁿr Symbole im Selbstpointer:
  3674.           #define constant_bit_t  4  # zeigt an, ob das Symbol eine Konstante ist
  3675.           #define special_bit_t   0  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3676.           #define keyword_bit_t   2  # zeigt an, ob das Symbol ein Keyword ist
  3677.   #define cons_type      0x09  # %001001  ; Cons
  3678.   #define subr_type      0x0A  # %001010  ; SUBR
  3679.   #define instance_type  0x0B  # %001011  ; CLOS-Instanz
  3680.   #define closure_type   0x0C  # %001100  ; Closure
  3681.   #define orecord_type   0x0D  # %001101  ; OtherRecord (Structure, Stream, Package, Byte, ...)
  3682.   #define system_type    0x0E  # %001110  ; Frame-Pointer, Read-Label, SYSTEM
  3683.   #define char_type      0x0F  # %001111  ; Character
  3684.   #define fixnum_type    0x10  # %010000  ; Fixnum
  3685.   #define sfloat_type    0x12  # %010010  ; Short-Float
  3686.   #define bignum_type    0x14  # %010100  ; Bignum
  3687.   #define ffloat_type    0x16  # %010110  ; Single-Float
  3688.   #define ratio_type     0x18  # %011000  ; Ratio
  3689.   #define dfloat_type    0x1A  # %011010  ; Double-float
  3690.   #define complex_type   0x1C  # %011100  ; Complex
  3691.   #define lfloat_type    0x1E  # %011110  ; Long-Float
  3692.  
  3693. # Typ ist GC-invariant, wenn
  3694. # Typinfobyte eines von 0x00,0x0A,0x0E,0x0F,0x10,0x11,0x12,0x13 ist.
  3695.   #define immediate_type_p(type)  \
  3696.     ((bit(type) & 0xFFF03BFEUL) == 0)
  3697.  
  3698. #endif # SIXBIT_TYPECODES
  3699.  
  3700. #ifdef SUN3_TYPECODES
  3701.  
  3702. # Typbits:
  3703. # in Typcodes (tint):
  3704.   #define garcol_bit_t     1  # gesetzt nur wΣhrend der Garbage Collection!
  3705.   #define cons_bit_t       7  # gesetzt nur bei CONS
  3706.   #define symbol_bit_t     6  # gesetzt nur bei SYMBOL
  3707.   #define number_bit_t     2  # gesetzt nur bei Zahlen
  3708.   #define notsimple_bit_t  0  # bei Arrays: gel÷scht bei Simple-Arrays
  3709.   #define sign_bit_t       0  # Vorzeichen bei reellen Zahlen (gesetzt <==> Zahl <0)
  3710.   #define float_bit_t      5
  3711.   #define float1_bit_t     3
  3712.   #define float2_bit_t     4
  3713.   #define ratio_bit_t      3
  3714.   #define bignum_bit_t     4
  3715. # in Objekten (oint):
  3716.   #define garcol_bit_o     (garcol_bit_t+oint_type_shift)    # gesetzt nur wΣhrend der Garbage Collection!
  3717.   #define cons_bit_o       (cons_bit_t+oint_type_shift)      # gesetzt nur bei CONS
  3718.   #define symbol_bit_o     (symbol_bit_t+oint_type_shift)    # gesetzt nur bei SYMBOL
  3719.   #define number_bit_o     (number_bit_t+oint_type_shift)    # gesetzt nur bei Zahlen
  3720.   #define notsimple_bit_o  (notsimple_bit_t+oint_type_shift) # bei Arrays: gel÷scht bei Simple-Arrays
  3721.   #define sign_bit_o       (sign_bit_t+oint_type_shift)      # Vorzeichen bei reellen Zahlen
  3722.   #define float_bit_o      (float_bit_t+oint_type_shift)
  3723.   #define float1_bit_o     (float1_bit_t+oint_type_shift)
  3724.   #define float2_bit_o     (float2_bit_t+oint_type_shift)
  3725.   #define ratio_bit_o      (ratio_bit_t+oint_type_shift)
  3726.   #define bignum_bit_o     (bignum_bit_t+oint_type_shift)
  3727.  
  3728. # konstante Typcodes:
  3729.   #define machine_type   0x00  # %00000000  ; Maschinenpointer
  3730.   #define sbvector_type  0x10  # %00010000  ; Simple-Bit-Vector
  3731.   #define sstring_type   0x08  # %00001000  ; Simple-String
  3732.   #define svector_type   0x18  # %00011000  ; Simple-Vector
  3733.   #define array_type     0x01  # %00000001  ; sonstiger Array (Rang /=1 oder
  3734.                                #            ; - spΣter vielleicht - anderer Elementtyp)
  3735.   #define bvector_type   0x11  # %00010001  ; sonstiger Bit-Vector oder Byte-Vector
  3736.   #define string_type    0x09  # %00001001  ; sonstiger String
  3737.   #define vector_type    0x19  # %00011001  ; sonstiger (VECTOR T)
  3738.   #define closure_type   0x20  # %00100000  ; Closure
  3739.   #define structure_type 0x21  # %00100001  ; Structure
  3740.   #define stream_type    0x28  # %00101000  ; Stream
  3741.   #define orecord_type   0x29  # %00101001  ; OtherRecord (Package, Byte, ...)
  3742.   #define instance_type  0x39  # %00111001  ; CLOS-Instanz
  3743.   #define char_type      0x31  # %00110001  ; Character
  3744.   #define subr_type      0x30  # %00110000  ; SUBR
  3745.   #define system_type    0x38  # %00111000  ; Frame-Pointer, Read-Label, SYSTEM
  3746.   #define fixnum_type    0x04  # %00000100  ; Fixnum
  3747.   #define sfloat_type    0x24  # %00100100  ; Short-Float
  3748.   #define bignum_type    0x14  # %00010100  ; Bignum
  3749.   #define ffloat_type    0x34  # %00110100  ; Single-Float
  3750.   #define ratio_type     0x0C  # %00001100  ; Ratio
  3751.   #define dfloat_type    0x2C  # %00101100  ; Double-float
  3752.   #define complex_type   0x1C  # %00011100  ; Complex
  3753.   #define lfloat_type    0x3C  # %00111100  ; Long-Float
  3754.   #define symbol_type    0x40  # %01000000  ; Symbol
  3755.           # Bits fⁿr Symbole in VAR/FUN-Frames (im LISP-Stack):
  3756.           #define active_bit  3  # gesetzt: Bindung ist aktiv
  3757.           #define dynam_bit   4  # gesetzt: Bindung ist dynamisch
  3758.           #define svar_bit    5  # gesetzt: nΣchster Parameter ist supplied-p-Parameter fⁿr diesen
  3759.           #define oint_symbolflags_shift  oint_type_shift
  3760.           # Bits fⁿr Symbole im Selbstpointer:
  3761.           #define constant_bit_t  3  # zeigt an, ob das Symbol eine Konstante ist
  3762.           #define special_bit_t   4  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3763.           #define keyword_bit_t   5  # zeigt an, ob das Symbol ein Keyword ist
  3764.   #define cons_type      0x80  # %10000000  ; Cons
  3765.  
  3766. # Typ ist GC-invariant, wenn
  3767. # Typinfobyte eines von 0x00,0x04,0x05,0x24,0x25,0x30,0x31,0x38 ist.
  3768.   #define immediate_type_p(type)  \
  3769.     ((type<0x39) && ((type==0) || !((bit(type>>1) & 0x11040004) == 0)))
  3770.  
  3771. #endif # SUN3_TYPECODES
  3772.  
  3773. #if !(immediate_type_p(ffloat_type) == defined(WIDE))
  3774.   #error "immediate_type_p() fehlerhaft implementiert!"
  3775. #endif
  3776.  
  3777. #if defined(SINGLEMAP_MEMORY) && (((system_type*1UL << oint_type_shift) & addressbus_mask) == 0)
  3778.   # Auch der STACK liegt in einem Singlemap-Bereich, Typinfo system_type.
  3779.   #define SINGLEMAP_MEMORY_STACK
  3780. #endif
  3781.  
  3782.  
  3783. #ifdef oint_symbolflags_shift
  3784.   #if defined(SINGLEMAP_MEMORY) && (oint_symbolflags_shift==oint_type_shift)
  3785.     # Da wir die symbol_tab nicht multimappen k÷nnen, mⁿssen wir auf extra Bits
  3786.     # im Typcode von Symbolen verzichten.
  3787.     #undef oint_symbolflags_shift
  3788.     #define NO_symbolflags
  3789.   #endif
  3790. #endif
  3791. #ifdef NO_symbolflags
  3792.   #define oint_symbolflags_shift  -1 # ungⁿltiger Wert
  3793. #endif
  3794.  
  3795.  
  3796. # Fallunterscheidungen nach Typcodes:
  3797. # Einzuleiten durch switch (typecode(obj)), danach wie in einer
  3798. # switch-Anweisung beliebig viele case-Labels.
  3799. # Beispiel:  switch (typecode(arg)) { case_string: ...; break; ... }
  3800.   #define case_machine    case machine_type   # Maschinenpointer
  3801.   #ifdef IMMUTABLE_ARRAY
  3802.   #define case_sstring    case imm_sstring_type: case sstring_type    # Simple-String
  3803.   #define case_ostring    case imm_string_type: case string_type      # Other String
  3804.   #define case_string     case_sstring: case_ostring                  # String allgemein
  3805.   #define case_sbvector   case imm_sbvector_type: case sbvector_type  # Simple-Bit-Vector
  3806.   #define case_obvector   case imm_bvector_type: case bvector_type    # Other Bit/Byte-Vector
  3807.   #define case_bvector    case_sbvector: case_obvector                # Bit-Vector allgemein
  3808.   #define case_svector    case imm_svector_type: case svector_type    # Simple-(General-)Vector
  3809.   #define case_ovector    case imm_vector_type: case vector_type      # Other (General-)Vector
  3810.   #define case_vector     case_svector: case_ovector                  # (General-)Vector allgemein
  3811.   #define case_array1     case imm_array_type: case array_type        # sonstiger Array
  3812.   #define case_array      case_string: case_bvector: case_vector: case_array1 # Array allgemein
  3813.   #else
  3814.   #define case_sstring    case sstring_type   # Simple-String
  3815.   #define case_ostring    case string_type    # Other String
  3816.   #define case_string     case_sstring: case_ostring # String allgemein
  3817.   #define case_sbvector   case sbvector_type  # Simple-Bit-Vector
  3818.   #define case_obvector   case bvector_type   # Other Bit/Byte-Vector
  3819.   #define case_bvector    case_sbvector: case_obvector # Bit-Vector allgemein
  3820.   #define case_svector    case svector_type   # Simple-(General-)Vector
  3821.   #define case_ovector    case vector_type    # Other (General-)Vector
  3822.   #define case_vector     case_svector: case_ovector # (General-)Vector allgemein
  3823.   #define case_array1     case array_type     # sonstiger Array
  3824.   #define case_array      case_string: case_bvector: case_vector: case_array1 # Array allgemein
  3825.   #define imm_array_mask     0
  3826.   #define imm_sbvector_type  sbvector_type
  3827.   #define imm_sstring_type   sstring_type
  3828.   #define imm_svector_type   svector_type
  3829.   #define imm_array_type     array_type
  3830.   #define imm_bvector_type   bvector_type
  3831.   #define imm_string_type    string_type
  3832.   #define imm_vector_type    vector_type
  3833.   #endif
  3834.   #define case_closure    case closure_type   # Closure
  3835.   #ifdef structure_type
  3836.   #define case_structure  case structure_type # Structure
  3837.   #else
  3838.   #define structure_type  orecord_type        # Structures sind OtherRecords
  3839.   #endif
  3840.   #ifdef stream_type
  3841.   #define case_stream     case stream_type    # Stream
  3842.   #else
  3843.   #define stream_type     orecord_type        # Streams sind OtherRecords
  3844.   #endif
  3845.   #define case_orecord    case orecord_type   # Other Record
  3846.   #define case_instance   case instance_type  # CLOS-Instanz
  3847.   #if defined(case_structure) || defined(case_stream)
  3848.   #define case_record     case_closure: case_structure: case_stream: case_orecord: case_instance # Record allgemein
  3849.   #else
  3850.   #define case_record     case_closure: case_orecord: case_instance # Record allgemein
  3851.   #endif
  3852.   #define case_char       case char_type      # Character
  3853.   #define case_subr       case subr_type      # SUBR
  3854.   #define case_system     case system_type    # Frame-Pointer, Read-Label, System
  3855.   #define case_posfixnum  case fixnum_type    # Fixnum >=0
  3856.   #define case_negfixnum  case fixnum_type|bit(sign_bit_t) # Fixnum <0
  3857.   #define case_fixnum     case_posfixnum: case_negfixnum # Fixnum
  3858.   #define case_posbignum  case bignum_type    # Bignum >0
  3859.   #define case_negbignum  case bignum_type|bit(sign_bit_t) # Bignum <0
  3860.   #define case_bignum     case_posbignum: case_negbignum # Bignum
  3861.   #define case_integer    case_fixnum: case_bignum # Integer
  3862.   #define case_ratio      case ratio_type: case ratio_type|bit(sign_bit_t) # Ratio
  3863.   #define case_rational   case_integer: case_ratio # Rational
  3864.   #define case_sfloat     case sfloat_type: case sfloat_type|bit(sign_bit_t) # Short-Float
  3865.   #define case_ffloat     case ffloat_type: case ffloat_type|bit(sign_bit_t) # Single-Float
  3866.   #define case_dfloat     case dfloat_type: case dfloat_type|bit(sign_bit_t) # Double-Float
  3867.   #define case_lfloat     case lfloat_type: case lfloat_type|bit(sign_bit_t) # Long-Float
  3868.   #define case_float      case_sfloat: case_ffloat: case_dfloat: case_lfloat # Float
  3869.   #define case_real       case_rational: case_float # Real
  3870.   #define case_complex    case complex_type # Complex
  3871.   #define case_number     case_real: case_complex # Number
  3872.   #define case_symbol     case symbol_type # Symbol
  3873.   #if /* !defined(NO_symbolflags) && */ (oint_symbolflags_shift==oint_type_shift)
  3874.   #define case_symbolflagged  # Symbol mit Flags \
  3875.                           case symbol_type: \
  3876.                           case symbol_type|bit(active_bit): \
  3877.                           case symbol_type|bit(dynam_bit): \
  3878.                           case symbol_type|bit(dynam_bit)|bit(active_bit): \
  3879.                           case symbol_type|bit(svar_bit): \
  3880.                           case symbol_type|bit(svar_bit)|bit(active_bit): \
  3881.                           case symbol_type|bit(svar_bit)|bit(dynam_bit): \
  3882.                           case symbol_type|bit(svar_bit)|bit(dynam_bit)|bit(active_bit)
  3883.   #else
  3884.   #define case_symbolflagged  case_symbol # Symbol mit Flags
  3885.   #endif
  3886.   #ifdef IMMUTABLE_CONS
  3887.   #define case_cons       case imm_cons_type: case cons_type # Cons
  3888.   #else
  3889.   #define case_cons       case cons_type # Cons
  3890.   #define imm_cons_type   cons_type
  3891.   #endif
  3892.  
  3893.  
  3894. # ################## Speicheraufbau von LISP-Objekten ##################### #
  3895.  
  3896. # Objekte mit genau zwei Pointern:
  3897.  
  3898. # Cons
  3899. typedef struct { object cdr;   # CDR
  3900.                  object car; } # CAR
  3901.         cons_;
  3902. typedef cons_ *  Cons;
  3903.  
  3904. # liefert das immutable Pendant zu einem Cons
  3905. #define make_imm_cons(obj)  \
  3906.   objectplus(obj,(oint)type_data_object(imm_cons_type,0)-(oint)type_data_object(cons_type,0))
  3907.  
  3908. # Ratio
  3909. typedef struct { object rt_num;   # ZΣhler, Integer
  3910.                  object rt_den; } # Nenner, Integer >0
  3911.         ratio_;
  3912. typedef ratio_ *  Ratio;
  3913.  
  3914. # Complex
  3915. typedef struct { object c_real;   # Realteil, reelle Zahl
  3916.                  object c_imag; } # ImaginΣrteil, reelle Zahl
  3917.         complex_;
  3918. typedef complex_ *  Complex;
  3919.  
  3920. # Objekte variabler LΣnge:
  3921. # Die erste Komponente (die ersten vier Bytes) sind fⁿr die Garbage
  3922. # Collection reserviert. Das erste Byte davon mu▀ die Typinfo des
  3923. # Objektes enthalten (bei Symbolen zusΣtzlich noch max. 3 Flag-Bits); bis
  3924. # auf das GC-Bit 7 wird es von der GC unverΣndert gelassen. Die drei weiteren
  3925. # Bytes der ersten Komponente werden von der GC als Zwischenpointer genutzt;
  3926. # nach Beendigung der GC steht dort ein Selbstpointer.
  3927.  
  3928. # Typ der Header-Flags:
  3929.   #if (oint_type_len<=8) && !defined(ARM) && !defined(DECALPHA)
  3930.     # Zugriff auf ein einzelnes Byte m÷glich
  3931.     #define hfintsize  intBsize
  3932.     typedef uintB  hfint;
  3933.   #else
  3934.     # Zugriff auf ein ganzes Wort
  3935.     #define hfintsize  intLsize
  3936.     typedef uintL  hfint;
  3937.   #endif
  3938.  
  3939. # Objekt variabler LΣnge
  3940. #define VAROBJECT_HEADER  \
  3941.                union { object _GCself;  # Selbstpointer fⁿr GC            \
  3942.                        hfint flags[sizeof(object)/sizeof(hfint)]; # Flags \
  3943.                      } header;
  3944. typedef struct { VAROBJECT_HEADER }
  3945.         varobject_;
  3946. typedef varobject_ *  Varobject;
  3947. #define GCself  header._GCself
  3948. # Der Typcode ist im Byte ((Varobject)p)->header_flags enthalten.
  3949.   #if !(oint_type_len>=hfintsize ? oint_type_shift%hfintsize==0 : floor(oint_type_shift,hfintsize)==floor(oint_type_shift+oint_type_len-1,hfintsize))
  3950.     #error "Bogus header_flags -- header_flags neu definieren!"
  3951.   #endif
  3952.   #if BIG_ENDIAN_P
  3953.     #define header_flags  header.flags[sizeof(object)-1-floor(oint_type_shift,hfintsize)]
  3954.   #else
  3955.     #define header_flags  header.flags[floor(oint_type_shift,hfintsize)]
  3956.   #endif
  3957.   # Es gilt  mtypecode(((Varobject)p)->GCself) =
  3958.   # (((Varobject)p)->header_flags >> (oint_type_shift%hfintsize)) & tint_type_mask
  3959.   # Bits fⁿr Symbole im Selbstpointer (siehe oben):
  3960.   # define constant_bit_t  ...  # zeigt an, ob das Symbol eine Konstante ist
  3961.   # define special_bit_t   ...  # zeigt an, ob das Symbol SPECIAL-proklamiert ist
  3962.   # define keyword_bit_t   ...  # zeigt an, ob das Symbol ein Keyword ist
  3963.   #define constant_bit_hf  (constant_bit_t+(oint_type_shift%hfintsize))
  3964.   #define special_bit_hf  (special_bit_t+(oint_type_shift%hfintsize))
  3965.   #define keyword_bit_hf  (keyword_bit_t+(oint_type_shift%hfintsize))
  3966.  
  3967. # Symbol
  3968. typedef struct { VAROBJECT_HEADER
  3969.                  object symvalue;    # Wertzelle
  3970.                  object symfunction; # Funktiondefinitionszelle
  3971.                  object proplist;    # Property-Liste
  3972.                  object pname;       # Printname
  3973.                  object homepackage; # Home-Package oder NIL
  3974.                }
  3975.         symbol_;
  3976. typedef symbol_ *  Symbol;
  3977. #define symbol_objects_offset  offsetof(symbol_,symvalue)
  3978.  
  3979. # Jedes Keyword ist eine Konstante.
  3980. # Bei Konstanten ist das Special-Bit bedeutungslos (denn Konstanten
  3981. # k÷nnen bei uns weder lexikalisch noch dynamisch gebunden werden).
  3982.  
  3983. # Test, ob ein Symbol eine Konstante ist:
  3984.   #define constantp(sym)  \
  3985.     (((sym)->header_flags) & bit(constant_bit_hf))
  3986.  
  3987. # Test, ob ein Symbol eine SPECIAL-proklamierte Variable ist:
  3988.   #define special_var_p(sym)  \
  3989.     (((sym)->header_flags) & bit(special_bit_hf))
  3990.  
  3991. # Test, ob ein Symbol ein Keyword ist:
  3992.   #define keywordp(sym)  \
  3993.     ((TheSymbol(sym)->header_flags) & bit(keyword_bit_hf))
  3994.  
  3995. # Constant-Flag eines Symbols setzen:
  3996.   #define set_const_flag(sym)  \
  3997.     (((sym)->header_flags) |= bit(constant_bit_hf))
  3998.  
  3999. # Constant-Flag eines Symbols l÷schen:
  4000. # (Symbol darf kein Keyword sein, vgl. spvw.d:case_symbolwithflags)
  4001.   #define clear_const_flag(sym)  \
  4002.     (((sym)->header_flags) &= ~bit(constant_bit_hf))
  4003.  
  4004. # Special-Flag eines Symbols setzen:
  4005.   #define set_special_flag(sym)  \
  4006.     (((sym)->header_flags) |= bit(special_bit_hf))
  4007.  
  4008. # Special-Flag eines Symbols l÷schen:
  4009.   #define clear_special_flag(sym)  \
  4010.     (((sym)->header_flags) &= ~bit(special_bit_hf))
  4011.  
  4012. # Symbol als Konstante mit gegebenem Wert val definieren.
  4013. # val darf keine GC ausl÷sen!
  4014.   #define define_constant(sym,val)                              \
  4015.     {var reg1 Symbol sym_from_define_constant = TheSymbol(sym); \
  4016.      set_const_flag(sym_from_define_constant);                  \
  4017.      sym_from_define_constant->symvalue = (val);                \
  4018.     }
  4019.  
  4020. # Symbol als Variable mit gegebenem Initialisierungswert val definieren.
  4021. # val darf keine GC ausl÷sen!
  4022.   #define define_variable(sym,val)                              \
  4023.     {var reg1 Symbol sym_from_define_variable = TheSymbol(sym); \
  4024.      set_special_flag(sym_from_define_variable);                \
  4025.      sym_from_define_variable->symvalue = (val);                \
  4026.     }
  4027.  
  4028. # Flagbits in einem Symbol entfernen:
  4029.   #if defined(NO_symbolflags)
  4030.     #define symbol_without_flags(symbol)  symbol
  4031.   #elif (oint_symbolflags_shift==oint_type_shift)
  4032.     #define symbol_without_flags(symbol)  \
  4033.       as_object(as_oint(symbol) & (as_oint(type_data_object(symbol_type,0)) | oint_addr_mask))
  4034.   #else
  4035.     #define symbol_without_flags(symbol)  \
  4036.       as_object(as_oint(symbol) & ~((wbit(active_bit)|wbit(dynam_bit)|wbit(svar_bit))<<oint_symbolflags_shift))
  4037.   #endif
  4038.  
  4039. # Characters
  4040. # Implementiert sind 4 Bits und 16 Fonts.
  4041. # Aufteilung in code, bits, font:
  4042. #   Fontnummer  in den Bits 15..12,
  4043. #   Bits        in den Bits 11..8,
  4044. #   Ascii-Code  in den Bits 7..0.
  4045. # Bits: 8=Control, 9=Meta, 10=Super, 11=Hyper.
  4046. # Fonts: 0=Default, restliche ungenutzt und non-graphic.
  4047.  
  4048. # Integer, der die Daten eines Character ganz fa▀t:
  4049.   #define char_int_len 16
  4050.   #define char_int_limit  (1UL<<char_int_len)
  4051.   #ifdef ANSI
  4052.     typedef unsigned_int_with_n_bits(char_int_len)  cint;
  4053.   #else
  4054.     typedef uint/**/char_int_len  cint;
  4055.   #endif
  4056. # Aus einem Integer-Code ein Character machen:
  4057.   #define int_char(int_from_int_char)  \
  4058.     type_data_object(char_type,(aint)(cint)(int_from_int_char))
  4059. # Aus einem Character seinen Integer-Code herausziehen:
  4060.   #if !((oint_data_shift==0) && (char_int_len<=oint_data_len) && (exact_uint_size_p(char_int_len)))
  4061.     #define char_int(char_from_char_int)  \
  4062.       ((cint)(untype(char_from_char_int)))
  4063.   #else
  4064.     # Falls oint_data_shift=0, braucht untype nicht zu shiften;
  4065.     # falls auch char_int_len<=oint_data_len und ein cint genau char_int_len
  4066.     # Bits hat, braucht untype nicht zu ANDen.
  4067.     #define char_int(char_from_char_int)  \
  4068.       ((cint)as_oint(char_from_char_int))
  4069.   #endif
  4070. # Characters k÷nnen somit mit EQ auf Gleichheit verglichen werden,
  4071. # das ist ein oint-Vergleich bzw. (unter Characters) sogar ein
  4072. # cint-Vergleich ihrer Integer-Codes.
  4073.  
  4074. # Aufteilung eines Integer-Codes in Bits:
  4075.   #define char_code_shift_c   0      # (sollte =0 sein, siehe CLTL S. 242)
  4076.   #define char_code_len_c     8      # Ascii-Zeichensatz mit 8 Bits, pa▀t in uintB
  4077.   #define char_code_limit     (1UL<<char_code_len_c)
  4078.   #define char_code_mask_c    ((char_code_limit-1)<<char_code_shift_c)
  4079.   #define char_bits_shift_c   8
  4080.   #define char_bits_len_c     4
  4081.   #define char_bits_limit     (1UL<<char_bits_len_c)
  4082.   #define char_bits_mask_c    ((char_bits_limit-1)<<char_bits_shift_c)
  4083.   #define char_font_shift_c  12
  4084.   #define char_font_len_c     4
  4085.   #define char_font_limit     (1UL<<char_font_len_c)
  4086.   #define char_font_mask_c    ((char_font_limit-1)<<char_font_shift_c)
  4087. # Aus dem Code eines String-Char ein Character machen:
  4088.   #if !(char_code_shift_c==0)
  4089.     #define code_char(code_from_code_char)  \
  4090.       int_char((cint)(code_from_code_char)<<char_code_shift_c)
  4091.   #else
  4092.     # falls nicht geschoben werden mu▀ (umgeht Bug in Coherent386 cc):
  4093.     #define code_char(code_from_code_char)  \
  4094.       int_char((cint)(code_from_code_char))
  4095.   #endif
  4096. # Aus einem Character den Code extrahieren:
  4097.   #if !((char_code_shift_c==0)&&(char_code_len_c==8))
  4098.     #define char_code(char_from_char_code)  \
  4099.       ((uintB)((char_int(char_from_char_code)&char_code_mask_c)>>char_code_shift_c))
  4100.   #else
  4101.     # falls der char-code genau das untere Byte belegt:
  4102.     #define char_code(char_from_char_code)  ((uintB)(char_int(char_from_char_code)))
  4103.   #endif
  4104. # Bits im cint:
  4105.   #define char_control_bit_c  8
  4106.   #define char_meta_bit_c     9
  4107.   #define char_super_bit_c   10
  4108.   #define char_hyper_bit_c   11
  4109. # Bitmasken im cint:
  4110.   #define char_control_c  bit(char_control_bit_c)
  4111.   #define char_meta_c     bit(char_meta_bit_c)
  4112.   #define char_super_c    bit(char_super_bit_c)
  4113.   #define char_hyper_c    bit(char_hyper_bit_c)
  4114. # wird verwendet von STREAM, DEBUG, EVAL
  4115.  
  4116. # Fixnums
  4117.  
  4118. # fixnum(x) ist ein Fixnum mit Wert x>=0.
  4119. # x eine Expression mit 0 <= x < 2^oint_data_len.
  4120. # (Sollte eigentlich posfixnum(x) hei▀en.)
  4121.   #define fixnum(x)  type_data_object(fixnum_type,x)
  4122.  
  4123. # Fixnum_0 ist die Zahl 0, Fixnum_1 ist die Zahl 1,
  4124. # Fixnum_minus1 ist die Zahl -1
  4125.   #define Fixnum_0  fixnum(0)
  4126.   #define Fixnum_1  fixnum(1)
  4127.   #define Fixnum_minus1  type_data_object( fixnum_type | bit(sign_bit_t), bitm(oint_data_len)-1 )
  4128.  
  4129. # Wert eines nichtnegativen Fixnum:
  4130. # posfixnum_to_L(obj)
  4131. # Ergebnis ist >= 0, < 2^oint_data_len.
  4132.   #if !(defined(SPARC) && (oint_data_len+oint_data_shift<32))
  4133.     #define posfixnum_to_L(obj)  \
  4134.       ((uintL)((as_oint(obj)&(wbitm(oint_data_len+oint_data_shift)-1))>>oint_data_shift))
  4135.   #else
  4136.     # Auf einem SPARC-Prozessor sind lange Konstanten langsamer als Shifts:
  4137.     #define posfixnum_to_L(obj)  \
  4138.       ((uintL)((as_oint(obj) << (32-oint_data_len-oint_data_shift)) >> (32-oint_data_len)))
  4139.   #endif
  4140.  
  4141. # Wert eines negativen Fixnum:
  4142. # negfixnum_to_L(obj)
  4143. # Ergebnis ist >= - 2^oint_data_len, < 0.
  4144.   #define negfixnum_to_L(obj)  (posfixnum_to_L(obj) | (-bitm(oint_data_len)))
  4145.  
  4146. # Betrag eines negativen Fixnum:
  4147. # negfixnum_abs_L(obj)
  4148. # Ergebnis ist > 0, <= 2^oint_data_len.
  4149. # Vorsicht: Wraparound bei oint_data_len=intLsize m÷glich!
  4150.   #define negfixnum_abs_L(obj)  \
  4151.     ((uintL)((as_oint(fixnum_inc(Fixnum_minus1,1))-as_oint(obj))>>oint_data_shift))
  4152.  
  4153. # Wert eines Fixnum, obj sollte eine Variable sein:
  4154. # fixnum_to_L(obj)
  4155. # Ergebnis ist >= - 2^oint_data_len, < 2^oint_data_len und vom Typ sintL.
  4156. # Die Verwendung dieses Macros ist nur bei oint_data_len+1 <= intLsize sinnvoll!
  4157.   #if (oint_data_len>=intLsize)
  4158.     # Kein Platz mehr fⁿrs Vorzeichenbit, daher fixnum_to_L = posfixnum_to_L = negfixnum_to_L !
  4159.     #define fixnum_to_L(obj)  (sintL)posfixnum_to_L(obj)
  4160.   #elif (sign_bit_o == oint_data_len+oint_data_shift)
  4161.     #define fixnum_to_L(obj)  \
  4162.       (((sintL)as_oint(obj) << (intLsize-1-sign_bit_o)) >> (intLsize-1-sign_bit_o+oint_data_shift))
  4163.   #else
  4164.     #if !defined(SPARC)
  4165.       #define fixnum_to_L(obj)  \
  4166.         (sintL)( ((((sintL)as_oint(obj) >> sign_bit_o) << (intLsize-1)) >> (intLsize-1-oint_data_len)) \
  4167.                 |((uintL)((as_oint(obj) & (wbitm(oint_data_len+oint_data_shift)-1)) >> oint_data_shift)) \
  4168.                )
  4169.     #else
  4170.       # Auf einem SPARC-Prozessor sind lange Konstanten langsamer als Shifts:
  4171.       #define fixnum_to_L(obj)  \
  4172.         (sintL)( ((((sintL)as_oint(obj) >> sign_bit_o) << (intLsize-1)) >> (intLsize-1-oint_data_len)) \
  4173.                 |(((uintL)as_oint(obj) << (intLsize-oint_data_len-oint_data_shift)) >> (intLsize-oint_data_len)) \
  4174.                )
  4175.     #endif
  4176.   #endif
  4177.  
  4178. #ifdef intQsize
  4179. # Wert eines Fixnum, obj sollte eine Variable sein:
  4180. # fixnum_to_Q(obj)
  4181. # Ergebnis ist >= - 2^oint_data_len, < 2^oint_data_len.
  4182.   #if (sign_bit_o == oint_data_len+oint_data_shift)
  4183.     #define fixnum_to_Q(obj)  \
  4184.       (((sintQ)as_oint(obj) << (intQsize-1-sign_bit_o)) >> (intQsize-1-sign_bit_o+oint_data_shift))
  4185.   #else
  4186.     #define fixnum_to_Q(obj)  \
  4187.       ( ((((sintQ)as_oint(obj) >> sign_bit_o) << (intQsize-1)) >> (intQsize-1-oint_data_len)) \
  4188.        |((uintQ)((as_oint(obj) & (wbitm(oint_data_len+oint_data_shift)-1)) >> oint_data_shift)) \
  4189.       )
  4190.   #endif
  4191. #endif
  4192.  
  4193. # Zu einem nichtnegativen Fixnum eine Konstante addieren, vorausgesetzt,
  4194. # das Ergebnis ist wieder ein nichtnegatives Fixnum:
  4195. # fixnum_inc(obj,delta)
  4196. # > obj: ein Fixnum
  4197. # > delta: eine Konstante
  4198. # < ergebnis: erh÷htes Fixnum
  4199.   #define fixnum_inc(obj,delta)  \
  4200.     objectplus(obj, (soint)(delta) << oint_data_shift)
  4201.  
  4202. # posfixnum(x) ist ein Fixnum mit Wert x>=0.
  4203.   #define posfixnum(x)  fixnum_inc(Fixnum_0,x)
  4204.  
  4205. # negfixnum(x) ist ein Fixnum mit Wert x<0.
  4206. # (Vorsicht, wenn x unsigned ist!)
  4207.   #define negfixnum(x)  fixnum_inc(fixnum_inc(Fixnum_minus1,1),x)
  4208.  
  4209. # sfixnum(x) ist ein Fixnum mit Wert x,
  4210. # x eine Constant-Expression mit -2^oint_data_len <= x < 2^oint_data_len.
  4211.   #define sfixnum(x) ((x)>=0 ? posfixnum(x) : negfixnum(x))
  4212.  
  4213. # Aus einem Character ein Fixnum >=0 machen (wie bei char-int):
  4214.   #ifdef WIDE_STRUCT
  4215.     #define char_to_fixnum(obj)  \
  4216.       type_data_object(fixnum_type,untype(obj))
  4217.   #else
  4218.     #define char_to_fixnum(obj)  \
  4219.       objectplus(obj,(oint)type_data_object(fixnum_type,0)-(oint)type_data_object(char_type,0))
  4220.   #endif
  4221.  
  4222. # Aus einem passenden Fixnum >=0 ein Character machen (wie bei int-char):
  4223.   #ifdef WIDE_STRUCT
  4224.     #define fixnum_to_char(obj)  \
  4225.       type_data_object(char_type,untype(obj))
  4226.   #else
  4227.     #define fixnum_to_char(obj)  \
  4228.       objectplus(obj,(oint)type_data_object(char_type,0)-(oint)type_data_object(fixnum_type,0))
  4229.   #endif
  4230.  
  4231. # Bignums
  4232. typedef struct { VAROBJECT_HEADER  # Selbstpointer fⁿr GC
  4233.                  uintC length;     # LΣnge in Digits
  4234.                  uintD data[unspecified]; # Zahl in Zweierkomplementdarstellung
  4235.                }
  4236.         bignum_;
  4237. typedef bignum_ *  Bignum;
  4238.  
  4239. # Single-Floats
  4240. typedef uint32 ffloat; # 32-Bit-Float im IEEE-Format
  4241. typedef union { ffloat explicit;     # Wert, explizit
  4242.                 #ifdef FAST_FLOAT
  4243.                 float machine_float; # Wert, als C-'float'
  4244.                 #endif
  4245.               }
  4246.         ffloatjanus;
  4247. #ifndef WIDE
  4248. typedef struct { VAROBJECT_HEADER            # Selbstpointer fⁿr GC
  4249.                  ffloatjanus representation; # Wert
  4250.                }
  4251.         ffloat_;
  4252. typedef ffloat_ *  Ffloat;
  4253. #define ffloat_value(obj)  (TheFfloat(obj)->float_value)
  4254. #else
  4255. # Der Float-Wert wird im Pointer selbst untergebracht, wie bei Short-Floats.
  4256. #define ffloat_value(obj)  ((ffloat)untype(obj))
  4257. #endif
  4258.  
  4259. # Double-Floats
  4260. typedef # 64-Bit-Float im IEEE-Format:
  4261.         #ifdef intQsize
  4262.           # Sign/Exponent/Mantisse
  4263.           uint64
  4264.         #else
  4265.           # Sign/Exponent/MantisseHigh und MantisseLow
  4266.           #if BIG_ENDIAN_P
  4267.             struct {uint32 semhi,mlo;}
  4268.           #else
  4269.             struct {uint32 mlo,semhi;}
  4270.           #endif
  4271.         #endif
  4272.         dfloat;
  4273. typedef union { dfloat explicit;       # Wert, explizit
  4274.                 #ifdef FAST_DOUBLE
  4275.                 double machine_double; # Wert, als C-'double'
  4276.                 #endif
  4277.               }
  4278.         dfloatjanus;
  4279. typedef struct { VAROBJECT_HEADER            # Selbstpointer fⁿr GC
  4280.                  dfloatjanus representation; # Wert
  4281.                }
  4282.         dfloat_;
  4283. typedef dfloat_ *  Dfloat;
  4284.  
  4285. # Single- und Double-Floats
  4286.   #define float_value  representation.explicit
  4287.  
  4288. # Long-Floats
  4289. typedef struct { VAROBJECT_HEADER   # Selbstpointer fⁿr GC
  4290.                  uintC  len;        # LΣnge der Mantisse in Digits
  4291.                  uint32 expo;       # Exponent
  4292.                  uintD  data[unspecified]; # Mantisse
  4293.                }
  4294.         lfloat_;
  4295. typedef lfloat_ *  Lfloat;
  4296.  
  4297. # Simple-Array (umfa▀t einfache eindimensionale Arrays:
  4298. # Simple-Bit-Vector, Simple-String, Simple-Vector)
  4299. typedef struct { VAROBJECT_HEADER # Selbstpointer fⁿr GC
  4300.                  uintL  length;   # LΣnge in Elementen
  4301.                }
  4302.         sarray_;
  4303. typedef sarray_ *  Sarray;
  4304.  
  4305. # Simple-Bit-Vektor
  4306. typedef struct { VAROBJECT_HEADER # Selbstpointer fⁿr GC
  4307.                  uintL  length;   # LΣnge in Bits
  4308.                  uint8  data[unspecified]; # Bits, in Bytes unterteilt
  4309.                }
  4310.         sbvector_;
  4311. typedef sbvector_ *  Sbvector;
  4312.  
  4313. # Simple-String
  4314. typedef struct { VAROBJECT_HEADER # Selbstpointer fⁿr GC
  4315.                  uintL  length;   # LΣnge in Bytes
  4316.                  uintB  data[unspecified]; # Characters
  4317.                }
  4318.         sstring_;
  4319. typedef sstring_ *  Sstring;
  4320.  
  4321. # Simple-Vector
  4322. typedef struct { VAROBJECT_HEADER # Selbstpointer fⁿr GC
  4323.                  uintL  length;   # LΣnge in Objekten
  4324.                  object data[unspecified]; # Elemente
  4325.                }
  4326.         svector_;
  4327. typedef svector_ *  Svector;
  4328.  
  4329. # nicht-simpler Array
  4330. typedef struct { VAROBJECT_HEADER  # Selbstpointer fⁿr GC
  4331.                  uintB flags;      # Flags
  4332.                                    # dann ein Byte unbenutzt
  4333.                  uintC rank;       # Rang n
  4334.                  object data;      # Datenvektor
  4335.                  uintL totalsize;  # Totalsize = Produkt der n Dimensionen
  4336.                  uintL dims[unspecified]; # evtl. displaced-offset,
  4337.                                    # n Dimensionen,
  4338.                                    # evtl. Fill-Pointer
  4339.                }
  4340.         array_;
  4341. typedef array_ *  Array;
  4342. #define array_data_offset  offsetof(array_,data)
  4343. # Bits in den Flags:
  4344.   #define arrayflags_adjustable_bit  7 # gesetzt, wenn Array adjustable
  4345.   #define arrayflags_fillp_bit       6 # gesetzt, wenn Fill-Pointer vorhanden (nur bei n=1 m÷glich)
  4346.   #define arrayflags_displaced_bit   5 # gesetzt, wenn Array displaced
  4347.   #define arrayflags_dispoffset_bit  4 # gesetzt, wenn Platz fⁿr den
  4348.                                        # Displaced-Offset vorhanden ist
  4349.                                        # (<==> Array adjustable oder displaced)
  4350.   #define arrayflags_notbytep_bit    3 # gel÷scht bei Byte-Vektoren
  4351.   #define arrayflags_atype_mask  0x07  # Maske fⁿr Elementtyp
  4352. # Elementtypen von Arrays in Bits 2..0 der flags:
  4353.   # Die ersten sind so gewΣhlt, da▀ 2^Atype_nBit = n ist.
  4354.   #define Atype_Bit          0         # arrayflags_notbytep_bit gesetzt!
  4355.   #define Atype_2Bit         1
  4356.   #define Atype_4Bit         2
  4357.   #define Atype_8Bit         3
  4358.   #define Atype_16Bit        4
  4359.   #define Atype_32Bit        5
  4360.   #define Atype_T            6         # arrayflags_notbytep_bit gesetzt!
  4361.   #define Atype_String_Char  7         # arrayflags_notbytep_bit gesetzt!
  4362.  
  4363. # liefert das immutable Pendant zu einem Array
  4364. #define make_imm_array(obj)  \
  4365.   as_object(as_oint(obj) | as_oint(type_data_object(imm_array_mask,0)))
  4366.  
  4367. # Records
  4368. #define RECORD_HEADER  \
  4369.                  VAROBJECT_HEADER # Selbstpointer fⁿr GC      \
  4370.                  uintB recflags;  # bei OtherRecord: Flags    \
  4371.                  uintB rectype;   # bei OtherRecord: Untertyp \
  4372.                  uintW reclength; # LΣnge in Objekten
  4373. typedef struct { RECORD_HEADER
  4374.                  object recdata[unspecified]; # Elemente
  4375.                }
  4376.         record_;
  4377. typedef record_ *  Record;
  4378. # Elementtypen von OtherRecords:
  4379.   #if !(defined(UNIX_COHERENT) && !defined(GNU))
  4380.   #define Rectype_Hashtable     ((uintB)(-1))
  4381.   #else # Coherent386 cc Bug umgehen
  4382.   #define Rectype_Hashtable     ((uintB)255)
  4383.   #endif
  4384.   #define Rectype_Package       0
  4385.   #define Rectype_Readtable     1
  4386.   #define Rectype_Pathname      2
  4387.   #define Rectype_Logpathname   3 # nur gebraucht, falls defined(LOGICAL_PATHNAMES)
  4388.   #define Rectype_Random_State  4
  4389.   #define Rectype_Structure     5 # nur gebraucht, falls !defined(case_structure)
  4390.   #define Rectype_Stream        6 # nur gebraucht, falls !defined(case_stream)
  4391.   #define Rectype_Byte          7
  4392.   #define Rectype_Fsubr         8
  4393.   #define Rectype_Loadtimeeval  9
  4394.   #define Rectype_Symbolmacro  10
  4395.   #define Rectype_Alienfun     11
  4396.   #define Rectype_Alien        12
  4397.   # Die ersten 8 davon sind COMMON-Typen.
  4398.  
  4399. # Packages
  4400. typedef struct { RECORD_HEADER
  4401.                  object pack_external_symbols;
  4402.                  object pack_internal_symbols;
  4403.                  object pack_shadowing_symbols;
  4404.                  object pack_use_list;
  4405.                  object pack_used_by_list;
  4406.                  object pack_name;
  4407.                  object pack_nicknames;
  4408.                }
  4409.         *  Package;
  4410. #define package_length  ((sizeof(*(Package)0)-offsetofa(record_,recdata))/sizeof(object))
  4411.  
  4412. # Hash-Tables
  4413. typedef struct { RECORD_HEADER
  4414.                  #ifdef GENERATIONAL_GC
  4415.                  object ht_lastrehash;
  4416.                  #endif
  4417.                  object ht_size;
  4418.                  object ht_maxcount;
  4419.                  object ht_itable;
  4420.                  object ht_ntable;
  4421.                  object ht_kvtable;
  4422.                  object ht_freelist;
  4423.                  object ht_count;
  4424.                  object ht_rehash_size;
  4425.                  object ht_mincount_threshold;
  4426.                  object ht_mincount;
  4427.                }
  4428.         *  Hashtable;
  4429. #define hashtable_length  ((sizeof(*(Hashtable)0)-offsetofa(record_,recdata))/sizeof(object))
  4430. # Markiere eine Hash-Table als neu zu reorganisieren:
  4431. # mark_ht_invalid(TheHashtable(ht));
  4432.   #ifdef GENERATIONAL_GC
  4433.     #define mark_ht_invalid(ptr)  (ptr)->ht_lastrehash = unbound
  4434.     #define mark_ht_valid(ptr)  (ptr)->ht_lastrehash = O(gc_count)
  4435.     #define ht_validp(ptr)  eq((ptr)->ht_lastrehash,O(gc_count))
  4436.   #else
  4437.     #define mark_ht_invalid(ptr)  (ptr)->recflags |= bit(7)
  4438.     #define mark_ht_valid(ptr)  (ptr)->recflags &= ~bit(7)
  4439.     #define ht_validp(ptr)  (((ptr)->recflags & bit(7)) == 0)
  4440.   #endif
  4441.  
  4442. # Readtables
  4443. typedef struct { RECORD_HEADER
  4444.                  object readtable_syntax_table;
  4445.                  object readtable_macro_table;
  4446.                  object readtable_case;
  4447.                }
  4448.         *  Readtable;
  4449. #define readtable_length  ((sizeof(*(Readtable)0)-offsetofa(record_,recdata))/sizeof(object))
  4450.  
  4451. # Pathnames
  4452. typedef struct { RECORD_HEADER
  4453.                  #if HAS_HOST
  4454.                    object pathname_host;
  4455.                  #endif
  4456.                  #if HAS_DEVICE
  4457.                    object pathname_device;
  4458.                  #endif
  4459.                  #if 1
  4460.                    object pathname_directory;
  4461.                    object pathname_name;
  4462.                    object pathname_type;
  4463.                  #endif
  4464.                  #if HAS_VERSION
  4465.                    object pathname_version;
  4466.                  #endif
  4467.                }
  4468.         *  Pathname;
  4469. #define pathname_length  ((sizeof(*(Pathname)0)-offsetofa(record_,recdata))/sizeof(object))
  4470.  
  4471. #ifdef LOGICAL_PATHNAMES
  4472. # Logical Pathnames
  4473. typedef struct { RECORD_HEADER
  4474.                  object pathname_host;
  4475.                  object pathname_directory;
  4476.                  object pathname_name;
  4477.                  object pathname_type;
  4478.                  object pathname_version;
  4479.                }
  4480.         *  Logpathname;
  4481. #define logpathname_length  ((sizeof(*(Logpathname)0)-offsetofa(record_,recdata))/sizeof(object))
  4482. #endif
  4483.  
  4484. # Random-States
  4485. typedef struct { RECORD_HEADER
  4486.                  object random_state_seed;
  4487.                }
  4488.         *  Random_state;
  4489. #define random_state_length  ((sizeof(*(Random_state)0)-offsetofa(record_,recdata))/sizeof(object))
  4490.  
  4491. # Bytes
  4492. typedef struct { RECORD_HEADER
  4493.                  object byte_size;
  4494.                  object byte_position;
  4495.                }
  4496.         *  Byte;
  4497. #define byte_length  ((sizeof(*(Byte)0)-offsetofa(record_,recdata))/sizeof(object))
  4498.  
  4499. # Fsubrs
  4500. typedef struct { RECORD_HEADER
  4501.                  object name;
  4502.                  object argtype;
  4503.                  object function;
  4504.                }
  4505.         *  Fsubr;
  4506. #define fsubr_length  ((sizeof(*(Fsubr)0)-offsetofa(record_,recdata))/sizeof(object))
  4507.  
  4508. # Load-time-evals
  4509. typedef struct { RECORD_HEADER
  4510.                  object loadtimeeval_form;
  4511.                }
  4512.         *  Loadtimeeval;
  4513. #define loadtimeeval_length  ((sizeof(*(Loadtimeeval)0)-offsetofa(record_,recdata))/sizeof(object))
  4514.  
  4515. # Symbol-macros
  4516. typedef struct { RECORD_HEADER
  4517.                  object symbolmacro_expansion;
  4518.                }
  4519.         *  Symbolmacro;
  4520. #define symbolmacro_length  ((sizeof(*(Symbolmacro)0)-offsetofa(record_,recdata))/sizeof(object))
  4521.  
  4522. # Alienfuns
  4523. typedef struct { RECORD_HEADER
  4524.                  object alienfun_address;
  4525.                  object alienfun_inconv;
  4526.                  object alienfun_outconv;
  4527.                }
  4528.         * Alienfun;
  4529. #define alienfun_length  ((sizeof(*(Alienfun)0)-offsetofa(record_,recdata))/sizeof(object))
  4530.  
  4531. # Aliens
  4532. typedef struct { RECORD_HEADER
  4533.                  object alien_type;
  4534.                  object alien_address;
  4535.                  object alien_bytesize;
  4536.                }
  4537.         * Alien;
  4538. #define alien_length  ((sizeof(*(Alien)0)-offsetofa(record_,recdata))/sizeof(object))
  4539.  
  4540. # Streams
  4541. typedef struct {
  4542.                  #ifdef case_stream
  4543.                  VAROBJECT_HEADER # Selbstpointer fⁿr GC
  4544.                  uintB strmflags; # Flags
  4545.                  uintB strmtype;  # Untertyp
  4546.                  uintW reclength; # LΣnge in Objekten
  4547.                  #else
  4548.                  # Mu▀ strmflags und strmtype aus Platzgrⁿnden in einem Fixnum
  4549.                  # in recdata[0] unterbringen.
  4550.                  #if !((oint_addr_len+oint_addr_shift>=24) && (8>=oint_addr_shift))
  4551.                  #error "No room for stream flags -- Stream-Flags neu unterbringen!!"
  4552.                  #endif
  4553.                  RECORD_HEADER
  4554.                  uintB strmfiller1;
  4555.                  uintB strmflags; # Flags
  4556.                  uintB strmtype;  # Untertyp
  4557.                  uintB strmfiller2;
  4558.                  #endif
  4559.                  object strm_rd_by;
  4560.                  object strm_wr_by;
  4561.                  object strm_rd_ch;
  4562.                  object strm_rd_ch_last;
  4563.                  object strm_wr_ch;
  4564.                  object strm_wr_ch_lpos;
  4565.                  #ifdef STRM_WR_SS
  4566.                  object strm_wr_ss;
  4567.                  #endif
  4568.                  object strm_other[unspecified]; # typspezifische Komponenten
  4569.                }
  4570.         *  Stream;
  4571. #define strm_len  ((sizeof(*(Stream)0)-offsetofa(record_,recdata))/sizeof(object))
  4572. # Bitmaske in den Flags:
  4573.   #define strmflags_open_B   0xF0  # gibt an, ob der Stream offen ist
  4574.   #define strmflags_rd_ch_bit_B  6  # gesetzt, falls READ-CHAR m÷glich ist
  4575.   #ifdef IMMUTABLE
  4576.   #define strmflags_immut_B  0x08  # gibt an, ob gelesene Objekte immutabel sind
  4577.   #endif
  4578. # NΣhere Typinfo:
  4579.   enum { # Die Werte dieser AufzΣhlung sind der Reihe nach 0,1,2,...
  4580.                               enum_strmtype_sch_file,
  4581.   #define strmtype_sch_file   (uintB)enum_strmtype_sch_file
  4582.                               enum_strmtype_ch_file,
  4583.   #define strmtype_ch_file    (uintB)enum_strmtype_ch_file
  4584.                               enum_strmtype_iu_file,
  4585.   #define strmtype_iu_file    (uintB)enum_strmtype_iu_file
  4586.                               enum_strmtype_is_file,
  4587.   #define strmtype_is_file    (uintB)enum_strmtype_is_file
  4588.   #ifdef HANDLES
  4589.                               enum_strmtype_handle,
  4590.   #define strmtype_handle     (uintB)enum_strmtype_handle
  4591.   #endif
  4592.   #ifdef KEYBOARD
  4593.                               enum_strmtype_keyboard,
  4594.   #define strmtype_keyboard   (uintB)enum_strmtype_keyboard
  4595.   #endif
  4596.                               enum_strmtype_terminal,
  4597.   #define strmtype_terminal   (uintB)enum_strmtype_terminal
  4598.                               enum_strmtype_synonym,
  4599.   #define strmtype_synonym    (uintB)enum_strmtype_synonym
  4600.                               enum_strmtype_broad,
  4601.   #define strmtype_broad      (uintB)enum_strmtype_broad
  4602.                               enum_strmtype_concat,
  4603.   #define strmtype_concat     (uintB)enum_strmtype_concat
  4604.                               enum_strmtype_twoway,
  4605.   #define strmtype_twoway     (uintB)enum_strmtype_twoway
  4606.                               enum_strmtype_echo,
  4607.   #define strmtype_echo       (uintB)enum_strmtype_echo
  4608.                               enum_strmtype_str_in,
  4609.   #define strmtype_str_in     (uintB)enum_strmtype_str_in
  4610.                               enum_strmtype_str_out,
  4611.   #define strmtype_str_out    (uintB)enum_strmtype_str_out
  4612.                               enum_strmtype_str_push,
  4613.   #define strmtype_str_push   (uintB)enum_strmtype_str_push
  4614.                               enum_strmtype_pphelp,
  4615.   #define strmtype_pphelp     (uintB)enum_strmtype_pphelp
  4616.                               enum_strmtype_buff_in,
  4617.   #define strmtype_buff_in    (uintB)enum_strmtype_buff_in
  4618.                               enum_strmtype_buff_out,
  4619.   #define strmtype_buff_out   (uintB)enum_strmtype_buff_out
  4620.   #ifdef SCREEN
  4621.                               enum_strmtype_window,
  4622.   #define strmtype_window     (uintB)enum_strmtype_window
  4623.   #endif
  4624.   #ifdef PRINTER
  4625.                               enum_strmtype_printer,
  4626.   #define strmtype_printer    (uintB)enum_strmtype_printer
  4627.   #endif
  4628.   #ifdef PIPES
  4629.                               enum_strmtype_pipe_in,
  4630.   #define strmtype_pipe_in    (uintB)enum_strmtype_pipe_in
  4631.                               enum_strmtype_pipe_out,
  4632.   #define strmtype_pipe_out   (uintB)enum_strmtype_pipe_out
  4633.   #endif
  4634.   #ifdef SOCKETS
  4635.                               enum_strmtype_socket,
  4636.   #define strmtype_socket     (uintB)enum_strmtype_socket
  4637.   #endif
  4638.   #ifdef GENERIC_STREAMS
  4639.                               enum_strmtype_generic,
  4640.   #define strmtype_generic    (uintB)enum_strmtype_generic
  4641.   #endif
  4642.                               enum_strmtype_dummy
  4643.   };
  4644.   # Bei ─nderung dieser Tabelle auch
  4645.   # - die acht Sprungtabellen bei STREAM-ELEMENT-TYPE, INTERACTIVE-STREAM-P,
  4646.   #   CLOSE, LISTEN, CLEAR_INPUT, FINISH_OUTPUT, FORCE_OUTPUT, CLEAR_OUTPUT
  4647.   #   in STREAM.D und
  4648.   # - die Namenstabelle in CONSTOBJ.D und
  4649.   # - die Sprungtabelle bei PR_STREAM in IO.D und
  4650.   # - die Pseudofunktionentabelle in PSEUDOFUN.D
  4651.   # anpassen!
  4652. # weitere typspezifische Komponenten:
  4653.   #define strm_file_name       strm_other[3] # Filename, ein Pathname
  4654.   #define strm_file_truename   strm_other[4] # Truename, ein nicht-Logical Pathname
  4655.   #define strm_file_handle     strm_other[2] # Handle, ein Fixnum >=0, <2^16
  4656.   #define strm_sch_file_lineno strm_other[8] # Zeilennummer beim Lesen, ein Fixnum >0
  4657.   #define strm_synonym_symbol  strm_other[0]
  4658.   #define strm_broad_list      strm_other[0] # Liste von Streams
  4659.   #define strm_concat_list     strm_other[0] # Liste von Streams
  4660.   #define strm_pphelp_lpos     strm_wr_ch_lpos # Line Position (Fixnum>=0)
  4661.   #define strm_pphelp_strings  strm_other[0]   # Semi-Simple-Strings fⁿr Output
  4662.   #define strm_pphelp_modus    strm_other[1]   # Modus (NIL=Einzeiler, T=Mehrzeiler)
  4663.   #define strm_buff_in_fun     strm_other[0] # Lesefunktion
  4664.   #define strm_buff_out_fun    strm_other[0] # Ausgabefunktion
  4665.   #ifdef PIPES
  4666.   #define strm_pipe_pid        strm_other[3] # Proze▀-Id, ein Fixnum >=0
  4667.   #endif
  4668.   #ifdef SOCKETS
  4669.   #define strm_socket_connect  strm_other[3] # Liste (host display)
  4670.   #endif
  4671.   #ifdef GENERIC_STREAMS
  4672.   #define strm_controller_object strm_other[0] # Controller (meist CLOS-Instanz)
  4673.   #endif
  4674. # wird verwendet von STREAM, PATHNAME, IO
  4675.  
  4676. # Structures
  4677. typedef Record  Structure;
  4678.   #define structure_types   recdata[0]
  4679.  
  4680. # CLOS-Klassen (= Instanzen von <class>), siehe clos.lsp
  4681. typedef struct { RECORD_HEADER
  4682.                  object structure_types_2;   # Liste (metaclass <class>)
  4683.                  object metaclass;           # eine Subklasse von <class>
  4684.                  object classname;           # ein Symbol
  4685.                  object direct_superclasses; # direkte Oberklassen
  4686.                  object all_superclasses;    # alle Oberklassen inkl. sich selbst
  4687.                  object precedence_list;     # angeordnete Liste aller Oberklassen
  4688.                  object slot_location_table; # Hashtabelle Slotname -> wo der Slot sitzt
  4689.                  # ab hier nur bei metaclass = <standard-class>
  4690.                  object direct_slots;
  4691.                  object slots;
  4692.                  object instance_slot_count;
  4693.                  object shared_slots;
  4694.                  object direct_default_initargs;
  4695.                  object default_initargs;
  4696.                  object valid_initargs;
  4697.                  object other[unspecified];
  4698.                }
  4699.         *  Class;
  4700.  
  4701. # CLOS-Instanzen
  4702. typedef struct { RECORD_HEADER
  4703.                  object class; # eine CLOS-Klasse
  4704.                  object other[unspecified];
  4705.                }
  4706.         *  Instance;
  4707.  
  4708. # Closures
  4709. typedef struct { RECORD_HEADER
  4710.                  object clos_name;
  4711.                  object clos_codevec;
  4712.                  object other[unspecified];
  4713.                }
  4714.         *  Closure;
  4715. # interpretierte Closure:
  4716. typedef struct { RECORD_HEADER
  4717.                  object clos_name;
  4718.                  object clos_form;
  4719.                  object clos_docstring;
  4720.                  object clos_body;
  4721.                  object clos_var_env;
  4722.                  object clos_fun_env;
  4723.                  object clos_block_env;
  4724.                  object clos_go_env;
  4725.                  object clos_decl_env;
  4726.                  object clos_vars;
  4727.                  object clos_varflags;
  4728.                  object clos_spec_anz;
  4729.                  object clos_req_anz;
  4730.                  object clos_opt_anz;
  4731.                  object clos_opt_inits;
  4732.                  object clos_key_anz;
  4733.                  object clos_keywords;
  4734.                  object clos_key_inits;
  4735.                  object clos_allow_flag;
  4736.                  object clos_rest_flag;
  4737.                  object clos_aux_anz;
  4738.                  object clos_aux_inits;
  4739.                }
  4740.         *  Iclosure;
  4741. #define iclos_length  ((sizeof(*(Iclosure)0)-offsetofa(record_,recdata))/sizeof(object))
  4742. # compilierte Closure:
  4743. typedef struct { RECORD_HEADER
  4744.                  object clos_name;
  4745.                  object clos_codevec;
  4746.                  object clos_consts[unspecified]; # Closure-Konstanten
  4747.                }
  4748.         *  Cclosure;
  4749. #define clos_venv  clos_consts[0]
  4750. # Compilierte Closures, bei denen Bit 4 in den Flags von clos_codevec
  4751. # gesetzt ist, sind generische Funktionen.
  4752.  
  4753. # Eine compilierte LISP-Funktion bekommt ihre Argumente auf dem STACK
  4754. # und liefert ihre Werte im MULTIPLE_VALUE_SPACE. Als C-Funktion liefert
  4755. # sie keinen Wert.
  4756.   # Rⁿckgabe von Multiple Values geschieht vollstΣndig ⁿber den
  4757.   # MULTIPLE_VALUE_SPACE. Als C-Funktion: Ergebnistyp Values.
  4758.     #ifndef Values
  4759.     typedef void Values;
  4760.     #endif
  4761.   # Um einen Typ vom Wert Values weiterzureichen: return_Values(...);
  4762.     #define return_Values  return_void
  4763.   # Eine Lisp-Funktion ist ein Pointer auf eine C-Funktion ohne Rⁿckgabewert
  4764.     typedef Values (*lisp_function)();
  4765. # Sollte dies geΣndert werden, so ist jeder Aufruf einer C-Funktion vom
  4766. # Ergebnistyp 'Values' (insbesondere 'funcall', 'apply', 'eval') zu ⁿberprⁿfen.
  4767.  
  4768. # FSUBRs
  4769. # Als C-Funktionen: vom Typ fsubr_function (keine Argumente, kein Wert):
  4770.   typedef Values fsubr_function (void);
  4771. # Die Adressen dieser C-Funktionen werden direkt angesprungen.
  4772. # Fⁿr SAVEMEM/LOADMEM gibt es eine Tabelle aller FSUBRs.
  4773.   typedef fsubr_function * fsubr_;
  4774. # Signatur von FSUBRs im Lisp-Sinne:
  4775. #         argtype          Kⁿrzel fⁿr den Argumente-Typ     fsubr_argtype_
  4776. #         req_anz          Anzahl required Parameter        uintW
  4777. #         opt_anz          Anzahl optionaler Parameter      uintW
  4778. #         body_flag        Body-Flag                        fsubr_body_
  4779. # Die Komponente body_flag enthΣlt ein uintW, gemeint ist aber:
  4780.   typedef enum { fsubr_nobody, fsubr_body } fsubr_body_;
  4781. # Die Komponente argtype enthΣlt ein Fixnum, gemeint ist aber:
  4782.   typedef enum {
  4783.                 fsubr_argtype_1_0_nobody,
  4784.                 fsubr_argtype_2_0_nobody,
  4785.                 fsubr_argtype_1_1_nobody,
  4786.                 fsubr_argtype_2_1_nobody,
  4787.                 fsubr_argtype_0_body,
  4788.                 fsubr_argtype_1_body,
  4789.                 fsubr_argtype_2_body
  4790.                }
  4791.           fsubr_argtype_;
  4792. # Umwandlung siehe SPVW:
  4793. # extern fsubr_argtype_ fsubr_argtype (uintW req_anz, uintW opt_anz, fsubr_body_ body_flag);
  4794.  
  4795. # SUBRs
  4796. # SUBR-Tabellen-Eintrag:
  4797.   typedef struct { lisp_function function; # Funktion
  4798.                    object name;            # Name
  4799.                    object keywords;        # NIL oder Vektor mit den Keywords
  4800.                    uintW argtype;          # Kⁿrzel fⁿr den Argumente-Typ
  4801.                    uintW req_anz;          # Anzahl required Parameter
  4802.                    uintW opt_anz;          # Anzahl optionaler Parameter
  4803.                    uintB rest_flag;        # Flag fⁿr beliebig viele Argumente
  4804.                    uintB key_flag;         # Flag fⁿr Keywords
  4805.                    uintW key_anz;          # Anzahl Keywordparameter
  4806.                  }
  4807.           subr_;
  4808.   typedef subr_ *  Subr;
  4809. # GC ben÷tigt Information, wo hierin Objekte stehen:
  4810.   #define subr_const_offset  offsetof(subr_,name)
  4811.   #define subr_const_anz     2
  4812. # Die Komponente rest_flag enthΣlt ein uintB, gemeint ist aber:
  4813.   typedef enum { subr_norest, subr_rest } subr_rest_;
  4814. # Die Komponente key_flag enthΣlt ein uintB, gemeint ist aber:
  4815.   typedef enum { subr_nokey, subr_key, subr_key_allow } subr_key_;
  4816. # Die Komponente argtype enthΣlt ein uintW, gemeint ist aber:
  4817.   typedef enum {
  4818.                 subr_argtype_0_0,
  4819.                 subr_argtype_1_0,
  4820.                 subr_argtype_2_0,
  4821.                 subr_argtype_3_0,
  4822.                 subr_argtype_4_0,
  4823.                 subr_argtype_5_0,
  4824.                 subr_argtype_6_0,
  4825.                 subr_argtype_0_1,
  4826.                 subr_argtype_1_1,
  4827.                 subr_argtype_2_1,
  4828.                 subr_argtype_3_1,
  4829.                 subr_argtype_4_1,
  4830.                 subr_argtype_0_2,
  4831.                 subr_argtype_1_2,
  4832.                 subr_argtype_2_2,
  4833.                 subr_argtype_0_3,
  4834.                 subr_argtype_0_4,
  4835.                 subr_argtype_0_5,
  4836.                 subr_argtype_0_0_rest,
  4837.                 subr_argtype_1_0_rest,
  4838.                 subr_argtype_2_0_rest,
  4839.                 subr_argtype_3_0_rest,
  4840.                 subr_argtype_0_0_key,
  4841.                 subr_argtype_1_0_key,
  4842.                 subr_argtype_2_0_key,
  4843.                 subr_argtype_3_0_key,
  4844.                 subr_argtype_4_0_key,
  4845.                 subr_argtype_0_1_key,
  4846.                 subr_argtype_1_1_key,
  4847.                 subr_argtype_1_2_key
  4848.                }
  4849.           subr_argtype_;
  4850. # Umwandlung siehe SPVW:
  4851. # extern subr_argtype_ subr_argtype (uintW req_anz, uintW opt_anz, subr_rest_ rest_flag, subr_key_ key_flag);
  4852.  
  4853. # System-Pointer
  4854.   #define make_system(data)  \
  4855.     type_data_object(system_type, bit(oint_data_len-1) | bit(0) | ((bitm(oint_data_len)-1) & (data)))
  4856. # Alle solchen mⁿssen in io.d:pr_system() eine spezielle print-Routine bekommen.
  4857.  
  4858. # Indikator fⁿr nicht vorhandenen Wert:
  4859.   #define unbound  make_system(0xFFFFFFUL)
  4860.  
  4861. # Indikator fⁿr nicht vorhandenes Objekt (nur intern verwendet):
  4862.   #define nullobj  type_pointer_object(machine_type,NULL) # = as_object((oint)0)
  4863.  
  4864. # Um auf die Komponenten eines Objekts zugreifen zu k÷nnen, mu▀ man erst
  4865. # die Typbits entfernen:
  4866.   #if !((oint_addr_shift==0) && (addr_shift==0) && (((tint_type_mask<<oint_type_shift) & addressbus_mask) == 0))
  4867.     #define pointable(obj)  ((void*)upointer(obj))
  4868.   #else
  4869.     # Ist oint_addr_shift=0 und addr_shift=0, so braucht man nicht zu shiften;
  4870.     # ist ferner oint_type_mask von addressbus_mask disjunkt, so werden
  4871.     # sowieso keine Typbits auf den Adre▀bus geschickt.
  4872.     # Also ist gar nichts zu tun:
  4873.     #define pointable(obj)  (obj)
  4874.   #endif
  4875.  
  4876. # Wenn man auf ein Objekt zugreifen will, das eine bekannte Typinfo hat,
  4877. # dessen gesetzte Typbits vom Adre▀bus verschluckt werden (auf die
  4878. # Typbits, die =0 sind, kommt es nicht an), so kann man auf das 'untype'
  4879. # verzichten:
  4880.   #if defined(WIDE_STRUCT)
  4881.     #define type_pointable(type,obj)  ((void*)((obj).both.addr))
  4882.   #elif !((oint_addr_shift==0) && (addr_shift==0) && (((tint_type_mask<<oint_type_shift) & addressbus_mask) == 0))
  4883.     #if (addr_shift==0)
  4884.       #define type_pointable(type,obj)  \
  4885.         ((oint_addr_shift==0) && (((oint)type_data_object(type,0) & addressbus_mask) == 0) \
  4886.          ? (void*)(aint)(obj)                                                              \
  4887.          : (void*)(aint)pointable(obj)                                                     \
  4888.         )
  4889.     #elif !(addr_shift==0)
  4890.       # Analog, nur dass der Macro 'optimized_upointer' die Rolle des Adre▀bus ⁿbernimmt:
  4891.       #define type_pointable(type,obj)  \
  4892.         ((optimized_upointer(type_data_object(type,0)) == 0) \
  4893.          ? (void*)(aint)optimized_upointer(obj)              \
  4894.          : (void*)(aint)pointable(obj)                       \
  4895.         )
  4896.     #endif
  4897.   #else
  4898.     # Wenn pointable(obj) = obj, braucht auch type_pointable() nichts zu tun:
  4899.     #define type_pointable(type,obj)  ((void*)(aint)(obj))
  4900.   #endif
  4901.  
  4902. # Wenn man auf ein Objekt zugreifen will, das eine von mehreren bekannten
  4903. # Typinfos hat, kann man evtl. auf das 'untype' verzichten. Ma▀geblich
  4904. # ist das OR der Typinfos.
  4905.   #define types_pointable(ORed_types,obj)  type_pointable(ORed_types,obj)
  4906.  
  4907. # TheCons(object) liefert das zu object Σquivalente Cons.
  4908. # Die Information, da▀ es Cons darstellt, mu▀ hineingesteckt werden.
  4909. # Analog die anderen Typumwandlungen.
  4910.   #define TheCons(obj)  ((Cons)(types_pointable(cons_type|imm_cons_type,obj)))
  4911.   #define TheRatio(obj)  ((Ratio)(types_pointable(ratio_type|bit(sign_bit_t),obj)))
  4912.   #define TheComplex(obj)  ((Complex)(type_pointable(complex_type,obj)))
  4913.   #define TheSymbol(obj)  ((Symbol)(type_pointable(symbol_type,obj)))
  4914.   #if (oint_symbolflags_shift==oint_type_shift)
  4915.   #define TheSymbolflagged(obj)  ((Symbol)(types_pointable(symbol_type|bit(active_bit)|bit(dynam_bit)|bit(svar_bit),obj)))
  4916.   #else
  4917.   #define TheSymbolflagged(obj)  TheSymbol(symbol_without_flags(obj))
  4918.   #endif
  4919.   #define TheBignum(obj)  ((Bignum)(types_pointable(bignum_type|bit(sign_bit_t),obj)))
  4920.   #ifndef WIDE
  4921.   #define TheFfloat(obj)  ((Ffloat)(types_pointable(ffloat_type|bit(sign_bit_t),obj)))
  4922.   #endif
  4923.   #define TheDfloat(obj)  ((Dfloat)(types_pointable(dfloat_type|bit(sign_bit_t),obj)))
  4924.   #define TheLfloat(obj)  ((Lfloat)(types_pointable(lfloat_type|bit(sign_bit_t),obj)))
  4925.   #define TheSarray(obj)  ((Sarray)(types_pointable(sbvector_type|imm_sbvector_type|sstring_type|imm_sstring_type|svector_type|imm_svector_type,obj)))
  4926.   #define TheSbvector(obj)  ((Sbvector)(types_pointable(sbvector_type|imm_sbvector_type,obj)))
  4927.   #define TheSstring(obj)  ((Sstring)(types_pointable(sstring_type|imm_sstring_type,obj)))
  4928.   #define TheSvector(obj)  ((Svector)(types_pointable(svector_type|imm_svector_type,obj)))
  4929.   #define TheArray(obj)  ((Array)(types_pointable(array_type|imm_array_type|bvector_type|imm_bvector_type|string_type|imm_string_type|vector_type|imm_vector_type,obj)))
  4930.   #define TheRecord(obj)  ((Record)(types_pointable(closure_type|structure_type|stream_type|orecord_type|instance_type,obj)))
  4931.   #define ThePackage(obj)  ((Package)(type_pointable(orecord_type,obj)))
  4932.   #define TheHashtable(obj)  ((Hashtable)(type_pointable(orecord_type,obj)))
  4933.   #define TheReadtable(obj)  ((Readtable)(type_pointable(orecord_type,obj)))
  4934.   #define ThePathname(obj)  ((Pathname)(type_pointable(orecord_type,obj)))
  4935. #ifdef LOGICAL_PATHNAMES
  4936.   #define TheLogpathname(obj)  ((Logpathname)(type_pointable(orecord_type,obj)))
  4937. #endif
  4938.   #define The_Random_state(obj)  ((Random_state)(type_pointable(orecord_type,obj)))
  4939.   #define TheByte(obj)  ((Byte)(type_pointable(orecord_type,obj)))
  4940.   #define TheFsubr(obj)  ((Fsubr)(type_pointable(orecord_type,obj)))
  4941.   #define TheLoadtimeeval(obj)  ((Loadtimeeval)(type_pointable(orecord_type,obj)))
  4942.   #define TheSymbolmacro(obj)  ((Symbolmacro)(type_pointable(orecord_type,obj)))
  4943.   #define TheAlienfun(obj)  ((Alienfun)(type_pointable(orecord_type,obj)))
  4944.   #define TheAlien(obj)  ((Alien)(type_pointable(orecord_type,obj)))
  4945.   #define TheStream(obj)  ((Stream)(type_pointable(stream_type,obj)))
  4946.   #define TheStructure(obj)  ((Structure)(type_pointable(structure_type,obj)))
  4947.   #define TheClass(obj)  ((Class)(type_pointable(structure_type,obj)))
  4948.   #define TheClosure(obj)  ((Closure)(type_pointable(closure_type,obj)))
  4949.   #define TheIclosure(obj)  ((Iclosure)(type_pointable(closure_type,obj)))
  4950.   #define TheCclosure(obj)  ((Cclosure)(type_pointable(closure_type,obj)))
  4951.   #define TheInstance(obj)  ((Instance)(type_pointable(instance_type,obj)))
  4952.   #define TheSubr(obj)  ((Subr)(type_pointable(subr_type,obj)))
  4953.   #define TheFramepointer(obj)  ((object*)(type_pointable(system_type,obj)))
  4954.   #define TheMachine(obj)  ((void*)(type_pointable(machine_type,obj)))
  4955.   #define ThePseudofun(obj)  ((Pseudofun)TheMachine(obj))
  4956.   #ifdef FOREIGN
  4957.   #define TheForeign(obj)  (*(FOREIGN*)(&TheSbvector(obj)->data[0]))
  4958.   #endif
  4959.   #ifdef FOREIGN_HANDLE
  4960.   # Handle in Sbvector verpackt
  4961.   #define TheHandle(obj)  (*(Handle*)(&TheSbvector(obj)->data[0]))
  4962.   #else
  4963.   # Handle in Fixnum>=0 verpackt
  4964.   #define TheHandle(obj)  ((Handle)posfixnum_to_L(obj))
  4965.   #endif
  4966.   #ifdef IMMUTABLE
  4967.   # Read-Write-Zugriff auf immutable Objekte:
  4968.   #ifdef IMMUTABLE_ARRAY
  4969.   #define TheImmSvector(obj)  \
  4970.     ((Svector)(type_pointable(imm_svector_type, \
  4971.                objectplus(obj,-(oint)type_data_object(imm_array_mask,0)))))
  4972.   #define TheImmArray(obj)  \
  4973.     ((Array)(types_pointable(imm_sbvector_type|imm_sstring_type|imm_array_type|imm_bvector_type|imm_string_type|imm_vector_type, \
  4974.              objectplus(obj,-(oint)type_data_object(imm_array_mask,0)))))
  4975.   #endif
  4976.   #ifdef IMMUTABLE_CONS
  4977.   #define TheImmCons(obj)  \
  4978.     ((Cons)type_pointable(cons_type,objectplus(obj,(oint)type_data_object(cons_type,0)-(oint)type_data_object(imm_cons_type,0))))
  4979.   #endif
  4980.   #endif
  4981.   # Objekt variabler LΣnge:
  4982.   #define TheVarobject(obj)  \
  4983.     ((Varobject)                                                                               \
  4984.      (types_pointable                                                                          \
  4985.       (sbvector_type|sstring_type|svector_type|array_type|bvector_type|string_type|vector_type \
  4986.        |imm_sbvector_type|imm_sstring_type|imm_svector_type|imm_array_type|imm_bvector_type|imm_string_type|imm_vector_type \
  4987.        |closure_type|structure_type|stream_type|orecord_type|symbol_type                       \
  4988.        |bignum_type|ffloat_type|dfloat_type|lfloat_type|bit(sign_bit_t),                       \
  4989.        obj                                                                                     \
  4990.     )))
  4991.   # Objekt, das einen Pointer in den Speicher darstellt:
  4992.   #define ThePointer(obj)  \
  4993.     (types_pointable                                                                            \
  4994.      (sbvector_type|sstring_type|svector_type|array_type|bvector_type|string_type|vector_type   \
  4995.       |imm_sbvector_type|imm_sstring_type|imm_svector_type|imm_array_type|imm_bvector_type|imm_string_type|imm_vector_type \
  4996.       |closure_type|structure_type|stream_type|orecord_type|symbol_type|cons_type|imm_cons_type \
  4997.       |bignum_type|ffloat_type|dfloat_type|lfloat_type|ratio_type|complex_type|bit(sign_bit_t), \
  4998.       obj                                                                                       \
  4999.     ))
  5000.  
  5001. # Ein paar Abkⁿrzungen:
  5002.   # Zugriff auf Objekte, die Conses sind:
  5003.     #define Car(obj)  (TheCons(obj)->car)
  5004.     #define Cdr(obj)  (TheCons(obj)->cdr)
  5005.   # Zugriff auf Objekte, die Symbole sind:
  5006.     #define Symbol_value(obj)  (TheSymbol(obj)->symvalue)
  5007.     #define Symbol_function(obj)  (TheSymbol(obj)->symfunction)
  5008.     #define Symbol_plist(obj)  (TheSymbol(obj)->proplist)
  5009.     #define Symbol_name(obj)  (TheSymbol(obj)->pname)
  5010.     #define Symbol_package(obj)  (TheSymbol(obj)->homepackage)
  5011.  
  5012.  
  5013. # ####################### TyptestprΣdikate ################################ #
  5014. # Die gibt es in zwei Formen:
  5015. # 1.  ???p, mit 'if' abzufragen:  if ???p(object)
  5016. # 2.  if_???p, aufzurufen als
  5017. #         if_???p(object, statement1, statement2)
  5018. #       statt
  5019. #         if ???p(object) statement1 else statement2
  5020.  
  5021. # UP: testet auf Pointergleichheit EQ
  5022. # eq(obj1,obj2)
  5023. # > obj1,obj2: Lisp-Objekte
  5024. # < ergebnis: TRUE, falls Objekte gleich
  5025.   #ifdef WIDE_STRUCT
  5026.     #define eq(obj1,obj2)  (as_oint(obj1) == as_oint(obj2))
  5027.   #else
  5028.     #define eq(obj1,obj2)  ((obj1) == (obj2))
  5029.   #endif
  5030.  
  5031. # Test auf NIL
  5032.   #define nullp(obj)  (eq(obj,NIL))
  5033.  
  5034. # Test auf Cons
  5035.   #if defined(cons_bit_o) /* || defined(IMMUTABLE_CONS) */
  5036.     # define consp(obj)  ((oint)(obj) & wbit(cons_bit_o))
  5037.     #define consp(obj)  (wbit_test((oint)(obj),cons_bit_o))
  5038.     #ifdef fast_mtypecode
  5039.       #ifdef WIDE_STRUCT
  5040.         #undef consp
  5041.         #define consp(obj)  (typecode(obj) & bit(cons_bit_t))
  5042.       #endif
  5043.       #define mconsp(obj)  (mtypecode(obj) & bit(cons_bit_t))
  5044.     #else
  5045.       #define mconsp(obj)  consp(obj)
  5046.     #endif
  5047.   #else
  5048.     #define consp(obj)  (typecode(obj) == cons_type)
  5049.     #define mconsp(obj)  (mtypecode(obj) == cons_type)
  5050.   #endif
  5051.  
  5052. # Test auf Atom
  5053.   #if defined(cons_bit_o) /* || defined(IMMUTABLE_CONS) */
  5054.     # define atomp(obj)  (((oint)(obj) & wbit(cons_bit_o))==0)
  5055.     #define atomp(obj)  (!wbit_test((oint)(obj),cons_bit_o))
  5056.     #ifdef fast_mtypecode
  5057.       #ifdef WIDE_STRUCT
  5058.         #undef atomp
  5059.         #define atomp(obj)  ((typecode(obj) & bit(cons_bit_t))==0)
  5060.       #endif
  5061.       #define matomp(obj)  ((mtypecode(obj) & bit(cons_bit_t))==0)
  5062.     #else
  5063.       #define matomp(obj)  atomp(obj)
  5064.     #endif
  5065.   #else
  5066.     #define atomp(obj)  (!(typecode(obj) == cons_type))
  5067.     #define matomp(obj)  (!(mtypecode(obj) == cons_type))
  5068.   #endif
  5069.  
  5070. # Test auf Liste, obj sollte eine Variable sein
  5071.   #define listp(obj)  (nullp(obj) || consp(obj))
  5072.  
  5073. # Test auf Symbol
  5074.   #if defined(symbol_bit_o)
  5075.     # define symbolp(obj)  ((oint)(obj) & wbit(symbol_bit_o))
  5076.     #define symbolp(obj)  (wbit_test((oint)(obj),symbol_bit_o))
  5077.     #ifdef fast_mtypecode
  5078.       #ifdef WIDE_STRUCT
  5079.         #undef symbolp
  5080.         #define symbolp(obj)  (typecode(obj) & bit(symbol_bit_t))
  5081.       #endif
  5082.       #define msymbolp(obj)  (mtypecode(obj) & bit(symbol_bit_t))
  5083.     #else
  5084.       #define msymbolp(obj)  symbolp(obj)
  5085.     #endif
  5086.   #else
  5087.     #define symbolp(obj)  (typecode(obj) == symbol_type)
  5088.     #define msymbolp(obj)  (mtypecode(obj) == symbol_type)
  5089.   #endif
  5090.  
  5091. # Test auf Zahl
  5092.   # define numberp(obj)  ((oint)(obj) & wbit(number_bit_o))
  5093.   #define numberp(obj)  (wbit_test((oint)(obj),number_bit_o))
  5094.   #ifdef fast_mtypecode
  5095.     #ifdef WIDE_STRUCT
  5096.       #undef numberp
  5097.       #define numberp(obj)  (typecode(obj) & bit(number_bit_t))
  5098.     #endif
  5099.     #define mnumberp(obj)  (mtypecode(obj) & bit(number_bit_t))
  5100.   #else
  5101.     #define mnumberp(obj)  numberp(obj)
  5102.   #endif
  5103.  
  5104. # Test auf Vector (Typbytes %001,%010,%011,%101,%110,%111)
  5105.   #if 0
  5106.     #define if_vectorp(obj,statement1,statement2)  \
  5107.       {var reg2 object obj_from_if_vectorp = (obj);                          \
  5108.        var reg1 tint type_from_if_vectorp = typecode(obj_from_if_vectorp) & !imm_array_mask; \
  5109.        type_from_if_vectorp = type_from_if_vectorp & ~bit(notsimple_bit_t);  \
  5110.        if (!(type_from_if_vectorp==0)&&(type_from_if_vectorp<=svector_type)) \
  5111.          { statement1 } else { statement2 }                                  \
  5112.       }
  5113.   #else # effizienter
  5114.     #define if_vectorp(obj,statement1,statement2)  \
  5115.       if (vectorp(obj)) { statement1 } else { statement2 }
  5116.   #endif
  5117.   #define vectorp(obj)  \
  5118.     ((tint)((typecode(obj) & ~imm_array_mask & ~bit(notsimple_bit_t))-1) <= (tint)(svector_type-1))
  5119.   #define mvectorp(obj)  \
  5120.     ((tint)((mtypecode(obj) & ~imm_array_mask & ~bit(notsimple_bit_t))-1) <= (tint)(svector_type-1))
  5121.  
  5122. # Test auf simple-vector oder simple-bit-vector oder simple-string
  5123.   #if 0
  5124.     #define if_simplep(obj,statement1,statement2)  \
  5125.       {var reg2 object obj_from_if_simplep = (obj);                          \
  5126.        var reg1 tint type_from_if_simplep = typecode(obj_from_if_simplep) & ~imm_array_mask; \
  5127.        if (!(type_from_if_simplep==0)&&(type_from_if_simplep<=svector_type)) \
  5128.          { statement1 } else { statement2 }                                  \
  5129.       }
  5130.   #else # effizienter
  5131.     #define if_simplep(obj,statement1,statement2)  \
  5132.       if (simplep(obj)) { statement1 } else { statement2 }
  5133.   #endif
  5134.   #define simplep(obj)  \
  5135.     ((tint)((typecode(obj) & ~imm_array_mask) - 1) <= (tint)(svector_type-1))
  5136.  
  5137. # Test eines Array auf simple-vector oder simple-bit-vector oder simple-string
  5138.   #define array_simplep(obj)  \
  5139.     ((typecode(obj) & ~imm_array_mask) <= svector_type)
  5140.  
  5141. # Test auf simple-vector
  5142.   #define simple_vector_p(obj)  \
  5143.     ((typecode(obj) & ~imm_array_mask) == svector_type)
  5144.   #define m_simple_vector_p(obj)  \
  5145.     ((mtypecode(obj) & ~imm_array_mask) == svector_type)
  5146.  
  5147. # Test auf general-vector=(vector t)
  5148.   #define general_vector_p(obj)  \
  5149.     ((typecode(obj) & ~imm_array_mask & ~bit(notsimple_bit_t)) == svector_type)
  5150.   #define m_general_vector_p(obj)  \
  5151.     ((mtypecode(obj) & ~imm_array_mask & ~bit(notsimple_bit_t)) == svector_type)
  5152.  
  5153. # Test auf simple-string
  5154.   #define simple_string_p(obj)  \
  5155.     ((typecode(obj) & ~imm_array_mask) == sstring_type)
  5156.   #define m_simple_string_p(obj)  \
  5157.     ((mtypecode(obj) & ~imm_array_mask) == sstring_type)
  5158.  
  5159. # Test auf string
  5160.   #define stringp(obj)  \
  5161.     ((typecode(obj) & ~imm_array_mask & ~bit(notsimple_bit_t)) == sstring_type)
  5162.   #define mstringp(obj)  \
  5163.     ((mtypecode(obj) & ~imm_array_mask & ~bit(notsimple_bit_t)) == sstring_type)
  5164.  
  5165. # Test auf simple-bit-vector
  5166.   #define simple_bit_vector_p(obj)  \
  5167.     ((typecode(obj) & ~imm_array_mask) == sbvector_type)
  5168.   #define m_simple_bit_vector_p(obj)  \
  5169.     ((mtypecode(obj) & ~imm_array_mask) == sbvector_type)
  5170.  
  5171. # Test auf bit-vector
  5172.   #define bit_vector_p(obj)  \
  5173.     (((typecode(obj) & ~imm_array_mask) == sbvector_type)                 \
  5174.      || (((typecode(obj) & ~imm_array_mask) == bvector_type)              \
  5175.          && ((TheArray(obj)->flags & arrayflags_atype_mask) == Atype_Bit) \
  5176.     )   )
  5177.   #define m_bit_vector_p(obj)  \
  5178.     (((mtypecode(obj) & ~imm_array_mask) == sbvector_type)                \
  5179.      || (((mtypecode(obj) & ~imm_array_mask) == bvector_type)             \
  5180.          && ((TheArray(obj)->flags & arrayflags_atype_mask) == Atype_Bit) \
  5181.     )   )
  5182.  
  5183. # Test auf Array allgemein
  5184.   #if 0
  5185.     #define if_arrayp(obj,statement1,statement2)  \
  5186.       {var reg2 object obj_from_if_arrayp = (obj);                        \
  5187.        var reg1 tint type_from_if_arrayp = typecode(obj_from_if_arrayp) & ~imm_array_mask; \
  5188.        if (!(type_from_if_arrayp==0)&&(type_from_if_arrayp<=vector_type)) \
  5189.          { statement1 } else { statement2 }                               \
  5190.       }
  5191.   #else # effizienter
  5192.     #define if_arrayp(obj,statement1,statement2)  \
  5193.       if (arrayp(obj)) { statement1 } else { statement2 }
  5194.   #endif
  5195.   #define arrayp(obj)  \
  5196.     ((tint)((typecode(obj) & ~imm_array_mask) - 1) <= (tint)(vector_type-1))
  5197.  
  5198. # Test auf Array, der kein Vector ist (Typbyte %100)
  5199.   #define array1p(obj)  \
  5200.     ((typecode(obj) & ~imm_array_mask) == array_type)
  5201.   #define marray1p(obj)  \
  5202.     ((mtypecode(obj) & ~imm_array_mask) == array_type)
  5203.  
  5204. # Test auf Closure/Structure/Stream/Instanz/OtherRecord
  5205.   #define if_recordp(obj,statement1,statement2)  \
  5206.     { switch (typecode(obj))              \
  5207.         { case_record: statement1; break; \
  5208.           default: statement2; break;     \
  5209.     }   }
  5210.   #define if_mrecordp(obj,statement1,statement2)  \
  5211.     { switch (mtypecode(obj))             \
  5212.         { case_record: statement1; break; \
  5213.           default: statement2; break;     \
  5214.     }   }
  5215.  
  5216. # Test auf Closure
  5217.   #define closurep(obj)  (typecode(obj)==closure_type)
  5218.   #define mclosurep(obj)  (mtypecode(obj)==closure_type)
  5219.  
  5220. # Test auf compilierte Closure
  5221.   # In einer Closure ist die zweite Komponente
  5222.   # entweder eine Liste (der Lambdabody bei interpretierten Closures)
  5223.   # oder ein Simple-Bit-Vector (der Codevektor bei compilierten Closures).
  5224.   #define cclosurep(obj)  \
  5225.     (closurep(obj) && m_simple_bit_vector_p(TheClosure(obj)->clos_codevec))
  5226.  
  5227. # Test auf generische Funktion, obj sollte eine Variable sein
  5228.   #define genericfunctionp(obj)  \
  5229.     (cclosurep(obj)                                                         \
  5230.      && (TheSbvector(TheClosure(obj)->clos_codevec)->data[CCHD+4] & bit(4)) \
  5231.     )
  5232.  
  5233. # Test auf CLOS-Instanz
  5234.   #define instancep(obj)  (typecode(obj)==instance_type)
  5235.   #define minstancep(obj)  (mtypecode(obj)==instance_type)
  5236.  
  5237. # Test auf CLOS-Klasse, obj sollte eine Variable sein.
  5238. # Unser CLOS implementiert alle Klassen als Instanzen einer direkten
  5239. # Unterklasse von <class>.
  5240.   #define classp(obj)  \
  5241.     (structurep(obj)                                                         \
  5242.      && eq(Cdr(TheStructure(obj)->structure_types),O(class_structure_types)) \
  5243.     )
  5244.  
  5245. # Test auf Structure, obj sollte eine Variable sein??
  5246.   #ifdef case_structure
  5247.     #define structurep(obj)  (typecode(obj)==structure_type)
  5248.     #define mstructurep(obj)  (mtypecode(obj)==structure_type)
  5249.   #else
  5250.     #define structurep(obj)  \
  5251.       (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Structure))
  5252.     #define mstructurep(obj)  \
  5253.       (morecordp(obj) && (TheRecord(obj)->rectype == Rectype_Structure))
  5254.   #endif
  5255.  
  5256. # Test auf Stream, obj sollte eine Variable sein??
  5257.   #ifdef case_stream
  5258.     #define streamp(obj)  (typecode(obj)==stream_type)
  5259.     #define mstreamp(obj)  (mtypecode(obj)==stream_type)
  5260.   #else
  5261.     #define streamp(obj)  \
  5262.       (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Stream))
  5263.     #define mstreamp(obj)  \
  5264.       (morecordp(obj) && (TheRecord(obj)->rectype == Rectype_Stream))
  5265.   #endif
  5266.  
  5267. # Test, ob ein Stream vom Typ gebufferter File-Stream ist:
  5268.   #define if_strm_bfile_p(strm,statement1,statement2)  \
  5269.     switchu (TheStream(strm)->strmtype) \
  5270.       { case strmtype_sch_file:        \
  5271.         case strmtype_ch_file:         \
  5272.         case strmtype_iu_file:         \
  5273.         case strmtype_is_file:         \
  5274.           statement1; break;           \
  5275.         default:                       \
  5276.           statement2; break;           \
  5277.       }
  5278. # wird verwendet von STREAM
  5279.  
  5280. # Test, ob ein Stream vom Typ File-Stream ist:
  5281.   #ifdef HANDLES
  5282.     #define if_strm_file_p(strm,statement1,statement2)  \
  5283.       switchu (TheStream(strm)->strmtype) \
  5284.         { case strmtype_sch_file:        \
  5285.           case strmtype_ch_file:         \
  5286.           case strmtype_iu_file:         \
  5287.           case strmtype_is_file:         \
  5288.           case strmtype_handle:          \
  5289.             statement1; break;           \
  5290.           default:                       \
  5291.             statement2; break;           \
  5292.         }
  5293.   #else
  5294.     #define if_strm_file_p  if_strm_bfile_p
  5295.   #endif
  5296. # wird verwendet von PATHNAME
  5297.  
  5298. # Test auf Other-Record
  5299.   #define orecordp(obj)  (typecode(obj)==orecord_type)
  5300.   #define morecordp(obj)  (mtypecode(obj)==orecord_type)
  5301.  
  5302. # Test auf Package, obj sollte eine Variable sein
  5303.   #define packagep(obj)  \
  5304.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Package))
  5305.  
  5306. # Test auf Hash-Table, obj sollte eine Variable sein
  5307.   #define hash_table_p(obj)  \
  5308.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Hashtable))
  5309.  
  5310. # Test auf Readtable, obj sollte eine Variable sein
  5311.   #define readtablep(obj)  \
  5312.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Readtable))
  5313.  
  5314. # Test auf Pathname, obj sollte eine Variable sein
  5315.   #define pathnamep(obj)  \
  5316.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Pathname))
  5317.  
  5318. # Test auf Logical Pathname, obj sollte eine Variable sein
  5319. #ifdef LOGICAL_PATHNAMES
  5320.   #define logpathnamep(obj)  \
  5321.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Logpathname))
  5322. #else
  5323.   #define logpathnamep(obj)  FALSE
  5324. #endif
  5325.  
  5326. # Test auf Extended Pathname (d.h. Pathname oder Logical Pathname),
  5327. # obj sollte eine Variable sein
  5328. # define xpathnamep(obj)  (pathnamep(obj) || logpathnamep(obj))
  5329. #ifdef LOGICAL_PATHNAMES
  5330.   #define xpathnamep(obj)  \
  5331.     (orecordp(obj)                                           \
  5332.      && ((TheRecord(obj)->rectype == Rectype_Pathname)       \
  5333.          || (TheRecord(obj)->rectype == Rectype_Logpathname) \
  5334.     )   )
  5335. #else
  5336.   #define xpathnamep(obj)  pathnamep(obj)
  5337. #endif
  5338.  
  5339. # Test auf Random-State, obj sollte eine Variable sein
  5340.   #define random_state_p(obj)  \
  5341.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Random_State))
  5342.  
  5343. # Test auf Byte, obj sollte eine Variable sein
  5344.   #define bytep(obj)  \
  5345.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Byte))
  5346.  
  5347. # Test auf Fsubr, obj sollte eine Variable sein
  5348.   #define fsubrp(obj)  \
  5349.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Fsubr))
  5350.  
  5351. # Test auf Loadtimeeval, obj sollte eine Variable sein
  5352.   #define loadtimeevalp(obj)  \
  5353.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Loadtimeeval))
  5354.  
  5355. # Test auf Symbolmacro, obj sollte eine Variable sein
  5356.   #define symbolmacrop(obj)  \
  5357.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Symbolmacro))
  5358.  
  5359. # Test auf Alienfun, obj sollte eine Variable sein
  5360.   #define alienfunp(obj)  \
  5361.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Alienfun))
  5362.  
  5363. # Test auf Alien, obj sollte eine Variable sein
  5364.   #define alienp(obj)  \
  5365.     (orecordp(obj) && (TheRecord(obj)->rectype == Rectype_Alien))
  5366.  
  5367. # Test auf Character
  5368.   #define charp(obj)  (typecode(obj)==char_type)
  5369.   #define mcharp(obj)  (mtypecode(obj)==char_type)
  5370.  
  5371. # Test auf String-Char
  5372.   #define string_char_p(obj)  \
  5373.     ((as_oint(obj) & ~(((oint)char_code_mask_c)<<oint_data_shift)) == as_oint(type_data_object(char_type,0)))
  5374.  
  5375. # Test auf SUBR (compiliertes funktionales Objekt)
  5376.   #define subrp(obj)  (typecode(obj)==subr_type)
  5377.   #define msubrp(obj)  (mtypecode(obj)==subr_type)
  5378.  
  5379. # Test auf STACK-Environment-Pointer
  5380.   #define stack_env_p(obj)  (typecode(obj)==system_type) # andere FΣlle??
  5381.  
  5382. # Test auf Systeminterne Konstante
  5383.   #define systemp(obj)  (typecode(obj)==system_type) # andere FΣlle??
  5384.  
  5385. #ifdef FOREIGN
  5386. # PlausibilitΣtstest auf Foreign-Verpackung
  5387.   #define foreignp(obj)  \
  5388.     (simple_bit_vector_p(obj) && (TheSbvector(obj)->length == sizeof(FOREIGN)*8))
  5389. #endif
  5390.  
  5391. # Test auf reelle Zahl
  5392.   #define if_realp(obj,statement1,statement2)  \
  5393.     {var reg1 object obj_from_if_realp = (obj);                      \
  5394.      var reg1 tint type_from_if_realp = typecode(obj_from_if_realp); \
  5395.      if ( (type_from_if_realp & bit(number_bit_t))                   \
  5396.           && !(type_from_if_realp==complex_type) )                   \
  5397.        { statement1 } else { statement2 }                            \
  5398.     }
  5399.  
  5400. # Test auf rationale Zahl
  5401.   #define if_rationalp(obj,statement1,statement2)  \
  5402.     {var reg1 object obj_from_if_rationalp = (obj);                          \
  5403.      var reg1 tint type_from_if_rationalp = typecode(obj_from_if_rationalp); \
  5404.      if ( (!(type_from_if_rationalp==complex_type))                          \
  5405.           &&                                                                 \
  5406.           ((type_from_if_rationalp &                                         \
  5407.             ~((fixnum_type|bignum_type|ratio_type|bit(sign_bit_t)) & ~fixnum_type) \
  5408.            ) == fixnum_type                                                  \
  5409.         ) )                                                                  \
  5410.        { statement1 } else { statement2 }                                    \
  5411.     }
  5412.  
  5413. # Test auf ganze Zahl
  5414.   #define integerp(obj)  \
  5415.     ((typecode(obj) &                                             \
  5416.       ~((fixnum_type|bignum_type|bit(sign_bit_t)) & ~fixnum_type) \
  5417.      ) == fixnum_type                                             \
  5418.     )
  5419.   #define mintegerp(obj)  \
  5420.     ((mtypecode(obj) &                                            \
  5421.       ~((fixnum_type|bignum_type|bit(sign_bit_t)) & ~fixnum_type) \
  5422.      ) == fixnum_type                                             \
  5423.     )
  5424.  
  5425. # Test auf Fixnum
  5426.   #define fixnump(obj)  ((typecode(obj) & ~bit(sign_bit_t)) == fixnum_type)
  5427.   #define mfixnump(obj)  ((mtypecode(obj) & ~bit(sign_bit_t)) == fixnum_type)
  5428.  
  5429. # Test auf Fixnum >=0
  5430.   #define posfixnump(obj)  (typecode(obj) == fixnum_type)
  5431.   #define mposfixnump(obj)  (mtypecode(obj) == fixnum_type)
  5432.  
  5433. # Test auf Bignum
  5434.   #define bignump(obj)  ((typecode(obj) & ~bit(sign_bit_t)) == bignum_type)
  5435.   #define mbignump(obj)  ((mtypecode(obj) & ~bit(sign_bit_t)) == bignum_type)
  5436.  
  5437. # Test auf Ratio
  5438.   #define ratiop(obj)  ((typecode(obj) & ~bit(sign_bit_t)) == ratio_type)
  5439.   #define mratiop(obj)  ((mtypecode(obj) & ~bit(sign_bit_t)) == ratio_type)
  5440.  
  5441. # Test auf Float
  5442.   #define floatp(obj)  \
  5443.     ((typecode(obj) &  \
  5444.      ~((sfloat_type|ffloat_type|dfloat_type|lfloat_type|bit(sign_bit_t)) & ~sfloat_type) \
  5445.      ) == sfloat_type)
  5446.   #define mfloatp(obj)  \
  5447.     ((mtypecode(obj) &  \
  5448.      ~((sfloat_type|ffloat_type|dfloat_type|lfloat_type|bit(sign_bit_t)) & ~sfloat_type) \
  5449.      ) == sfloat_type)
  5450.  
  5451. # Test auf Short-Float
  5452.   #define short_float_p(obj)  ((typecode(obj) & ~bit(sign_bit_t)) == sfloat_type)
  5453.   #define m_short_float_p(obj)  ((mtypecode(obj) & ~bit(sign_bit_t)) == sfloat_type)
  5454.  
  5455. # Test auf Single-Float
  5456.   #define single_float_p(obj)  ((typecode(obj) & ~bit(sign_bit_t)) == ffloat_type)
  5457.   #define m_single_float_p(obj)  ((mtypecode(obj) & ~bit(sign_bit_t)) == ffloat_type)
  5458.  
  5459. # Test auf Double-Float
  5460.   #define double_float_p(obj)  ((typecode(obj) & ~bit(sign_bit_t)) == dfloat_type)
  5461.   #define m_double_float_p(obj)  ((mtypecode(obj) & ~bit(sign_bit_t)) == dfloat_type)
  5462.  
  5463. # Test auf Long-Float
  5464.   #define long_float_p(obj)  ((typecode(obj) & ~bit(sign_bit_t)) == lfloat_type)
  5465.   #define m_long_float_p(obj)  ((mtypecode(obj) & ~bit(sign_bit_t)) == lfloat_type)
  5466.  
  5467. # Test auf Complex
  5468.   #define complexp(obj)  (typecode(obj) == complex_type)
  5469.   #define mcomplexp(obj)  (mtypecode(obj) == complex_type)
  5470.  
  5471. # Test einer reellen Zahl, ob sie >=0 ist:
  5472.   # define positivep(obj)  (((oint)(obj) & wbit(sign_bit_o)) == 0)
  5473.   #define positivep(obj)  (!wbit_test((oint)(obj),sign_bit_o))
  5474.   #ifdef fast_mtypecode
  5475.     #ifdef WIDE_STRUCT
  5476.       #undef positivep
  5477.       #define positivep(obj)  ((typecode(obj) & bit(sign_bit_t)) == 0)
  5478.     #endif
  5479.     #define mpositivep(obj)  ((mtypecode(obj) & bit(sign_bit_t)) == 0)
  5480.   #else
  5481.     #define mpositivep(obj)  positivep(obj)
  5482.   #endif
  5483.  
  5484. # ################# Deklarationen zur Arithmetik ########################## #
  5485.  
  5486.  
  5487. # Typenhierarchie:
  5488. # Number (N) =
  5489. #    Real (R) =
  5490. #       Float (F) =
  5491. #          Short float (SF)
  5492. #          Single float (FF)
  5493. #          Double float (DF)
  5494. #          Long float (LF)
  5495. #       Rational (RA) =
  5496. #          Integer (I) =
  5497. #             Fixnum (FN)
  5498. #             Bignum (BN)
  5499. #          Ratio (RT)
  5500. #    Complex (C)
  5501.  
  5502.  
  5503. # Typfeld:
  5504. # Bits zum Testen, ob dieser Typ vorliegt (Bit gesetzt, wenn ja).
  5505. # _bit_t zum Test im Typbyte (tint)
  5506. # _bit_o zum Test im Objekt (oint)
  5507.  
  5508. # siehe oben:
  5509. # #define number_bit_t     4  # gesetzt nur bei Zahlen
  5510. # #define number_bit_o     (number_bit_t+oint_type_shift)    # gesetzt nur bei Zahlen
  5511.  
  5512. # float_bit:
  5513. # in einer Zahl: Bit gesetzt, falls es sich um ein Float handelt.
  5514. #                Bit gel÷scht, falls es sich um eine rationale oder komplexe Zahl handelt.
  5515. # #define float_bit_t      1
  5516. # #define float_bit_o      (float_bit_t+oint_type_shift)
  5517.  
  5518. # float1_bit:
  5519. # In einem Floating-point: entscheidet genauer:
  5520. # Float-Bit   1 2
  5521. #             0 0    Short Float (SF)
  5522. #             0 1    Single Float (FF)
  5523. #             1 0    Double Float (DF)
  5524. #             1 1    Long Float (LF)
  5525. # #define float1_bit_t     3
  5526. # #define float1_bit_o     (float1_bit_t+oint_type_shift)
  5527. # #define float2_bit_t     2
  5528. # #define float2_bit_o     (float2_bit_t+oint_type_shift)
  5529.  
  5530. # ratio_bit:
  5531. # In rationalen Zahlen: Bit gesetzt, falls es sich um einen echten Bruch hand.
  5532. #                       Bit gel÷scht, falls es sich um ein Integer handelt.
  5533. # #define ratio_bit_t      3
  5534. # #define ratio_bit_o      (ratio_bit_t+oint_type_shift)
  5535.  
  5536. # bignum_bit:
  5537. # In ganzen Zahlen: Bit gesetzt, falls es sich um ein Bignum handelt.
  5538. #                   Bit gel÷scht, falls es sich um ein Fixnum handelt.
  5539. # #define bignum_bit_t     2
  5540. # #define bignum_bit_o     (bignum_bit_t+oint_type_shift)
  5541.  
  5542. # vorz_bit:
  5543. # Bei Reals:
  5544. # gibt das Vorzeichen der Zahl an.
  5545. # Bit gesetzt, falls Zahl < 0,
  5546. # Bit gel÷scht, falls Zahl >=0.
  5547.   #define vorz_bit_t       sign_bit_t
  5548.                            # sollte = 0 sein, damit das Vorzeichen-Extend
  5549.                            # bei Fixnums einfacher geht.
  5550.   #define vorz_bit_o       (vorz_bit_t+oint_type_shift)
  5551.  
  5552. # Liefert das Vorzeichen einer reellen Zahl (0 falls >=0, -1 falls <0)
  5553.   #if (vorz_bit_o<32) && !defined(WIDE_STRUCT)
  5554.     #define R_sign(obj)  ((signean)sign_of_sint32( (sint32)((uint32)as_oint(obj) << (31-vorz_bit_o)) ))
  5555.   #else
  5556.     # define R_sign(obj)  ((signean)sign_of_sint32( (sint32)(uint32)(as_oint(obj) >> (vorz_bit_o-31)) ))
  5557.     #define R_sign(obj)  ((signean)sign_of_sint32( (sint32)((uint32)typecode(obj) << (31-vorz_bit_t)) ))
  5558.   #endif
  5559.  
  5560. # Stellt fest, ob zwei reelle Zahlen dasselbe Vorzeichen haben:
  5561.   #define same_sign_p(obj1,obj2)  \
  5562.     (wbit_test(as_oint(obj1)^as_oint(obj2),vorz_bit_o)==0)
  5563.  
  5564.  
  5565. # Typtestmacros:
  5566. # (Liefern /=0, falls erfⁿllt. PrΣfix 'm', wenn Argument im Speicher sitzt.)
  5567.  
  5568. # Testet ein Objekt, ob es eine Zahl ist: (siehe oben)
  5569.   # define numberp(obj)  (as_oint(obj) & wbit(number_bit_o))
  5570.   # define mnumberp(obj)  (mtypecode(obj) & bit(number_bit_t))
  5571.  
  5572. # Testet eine Zahl, ob es ein Float ist.
  5573.   # define N_floatp(obj)  (as_oint(obj) & wbit(float_bit_o))
  5574.   #define N_floatp(obj)  (wbit_test(as_oint(obj),float_bit_o))
  5575.   #define N_mfloatp(obj)  (mtypecode(obj) & bit(float_bit_t))
  5576.  
  5577. # Testet eine Zahl, ob es ein Integer ist.
  5578.   #define N_integerp(obj)  (!( as_oint(obj) & (wbit(float_bit_o)|wbit(ratio_bit_o)) ))
  5579.   #define N_mintegerp(obj)  (!( mtypecode(obj) & (bit(float_bit_t)|bit(ratio_bit_t)) ))
  5580.  
  5581. # Testet eine reelle Zahl, ob sie rational ist.
  5582.   # define R_rationalp(obj)  (!( as_oint(obj) & wbit(float_bit_o) ))
  5583.   #define R_rationalp(obj)  (!wbit_test(as_oint(obj),float_bit_o))
  5584.   #define R_mrationalp(obj)  (!( mtypecode(obj) & bit(float_bit_t) ))
  5585.  
  5586. # Testet eine reelle Zahl, ob sie ein Float ist.
  5587.   # define R_floatp(obj)  ( as_oint(obj) & wbit(float_bit_o) )
  5588.   #define R_floatp(obj)  (wbit_test(as_oint(obj),float_bit_o))
  5589.   #define R_mfloatp(obj)  ( mtypecode(obj) & bit(float_bit_t) )
  5590.  
  5591. # Testet eine reelle Zahl, ob sie <0 ist.
  5592.   # define R_minusp(obj)  ( as_oint(obj) & wbit(vorz_bit_o) )
  5593.   #define R_minusp(obj)  (wbit_test(as_oint(obj),vorz_bit_o))
  5594.   #define R_mminusp(obj)  ( mtypecode(obj) & bit(vorz_bit_t) )
  5595.  
  5596. # Testet eine rationale Zahl, ob sie ganz ist.
  5597.   # define RA_integerp(obj)  (!( as_oint(obj) & wbit(ratio_bit_o) ))
  5598.   #define RA_integerp(obj)  (!wbit_test(as_oint(obj),ratio_bit_o))
  5599.   #define RA_mintegerp(obj)  (!( mtypecode(obj) & bit(ratio_bit_t) ))
  5600.  
  5601. # Testet eine rationale Zahl, ob sie gebrochen ist.
  5602.   # define RA_ratiop(obj)  ( as_oint(obj) & wbit(ratio_bit_o) )
  5603.   #define RA_ratiop(obj)  (wbit_test(as_oint(obj),ratio_bit_o))
  5604.   #define RA_mratiop(obj)  ( mtypecode(obj) & bit(ratio_bit_t) )
  5605.  
  5606. # Testet eine ganze Zahl, ob sie ein Bignum ist.
  5607.   # define I_bignump(obj)  ( as_oint(obj) & wbit(bignum_bit_o) )
  5608.   #define I_bignump(obj)  (wbit_test(as_oint(obj),bignum_bit_o))
  5609.   #define I_mbignump(obj)  ( mtypecode(obj) & bit(bignum_bit_t) )
  5610.  
  5611. # Testet eine ganze Zahl, ob sie ein Fixnum ist.
  5612.   # define I_fixnump(obj)  (!( as_oint(obj) & wbit(bignum_bit_o) ))
  5613.   #define I_fixnump(obj)  (!wbit_test(as_oint(obj),bignum_bit_o))
  5614.   #define I_mfixnump(obj)  (!( mtypecode(obj) & bit(bignum_bit_t) ))
  5615.  
  5616. # Testet eine Zahl, ob sie eine reelle Zahl ist.
  5617.   #define N_realp(obj)  (!( typecode(obj) == complex_type ))
  5618.   #define N_mrealp(obj)  (!( mtypecode(obj) == complex_type ))
  5619.  
  5620. # Testet eine Zahl, ob sie eine komplexe Zahl ist.
  5621.   #define N_complexp(obj)  ( typecode(obj) == complex_type )
  5622.   #define N_mcomplexp(obj)  ( mtypecode(obj) == complex_type )
  5623.  
  5624. # Test auf ein Integer eines vorgegebenen Bereiches.
  5625. # obj sollte eine Variable sein
  5626.   #define uint8_p(obj)  \
  5627.     ((as_oint(obj) & ~((oint)0xFF << oint_data_shift)) == as_oint(Fixnum_0))
  5628.   #define sint8_p(obj)  \
  5629.     (((as_oint(obj) ^ (positivep(obj) ? 0 : as_oint(Fixnum_minus1)^as_oint(Fixnum_0))) & ~((oint)0x7F << oint_data_shift)) == as_oint(Fixnum_0))
  5630.   #define uint16_p(obj)  \
  5631.     ((as_oint(obj) & ~((oint)0xFFFF << oint_data_shift)) == as_oint(Fixnum_0))
  5632.   #define sint16_p(obj)  \
  5633.     (((as_oint(obj) ^ (positivep(obj) ? 0 : as_oint(Fixnum_minus1)^as_oint(Fixnum_0))) & ~((oint)0x7FFF << oint_data_shift)) == as_oint(Fixnum_0))
  5634.   #if (oint_data_len>=32)
  5635.     #define uint32_p(obj)  \
  5636.       ((as_oint(obj) & ~((oint)0xFFFFFFFFUL << oint_data_shift)) == as_oint(Fixnum_0))
  5637.   #else
  5638.     #define uint32_p(obj)  \
  5639.       ((typecode(obj)==fixnum_type) \
  5640.        || ((typecode(obj)==bignum_type) \
  5641.            && (TheBignum(obj)->length <= ceiling(33,intDsize)) \
  5642.            && ((TheBignum(obj)->length < ceiling(33,intDsize)) \
  5643.                || (TheBignum(obj)->data[0] < (uintD)bit(32%intDsize)) \
  5644.       )   )   )
  5645.   #endif
  5646.   #if (oint_data_len>=31)
  5647.     #define sint32_p(obj)  \
  5648.       (((as_oint(obj) ^ (positivep(obj) ? 0 : as_oint(Fixnum_minus1)^as_oint(Fixnum_0))) & ~((oint)0x7FFFFFFFUL << oint_data_shift)) == as_oint(Fixnum_0))
  5649.   #else
  5650.     #define sint32_p(obj)  \
  5651.       (((typecode(obj) & ~bit(sign_bit_t)) == fixnum_type) \
  5652.        || (((typecode(obj) & ~bit(sign_bit_t)) == bignum_type) \
  5653.            && (TheBignum(obj)->length <= ceiling(32,intDsize)) \
  5654.            && ((TheBignum(obj)->length < ceiling(32,intDsize)) \
  5655.                || ((TheBignum(obj)->data[0] ^ (positivep(obj) ? (uintD)0 : ~(uintD)0)) < (uintD)bit(31%intDsize)) \
  5656.       )   )   )
  5657.   #endif
  5658.   #define uint64_p(obj)  \
  5659.     ((typecode(obj)==fixnum_type) \
  5660.      || ((typecode(obj)==bignum_type) \
  5661.          && (TheBignum(obj)->length <= ceiling(65,intDsize)) \
  5662.          && ((TheBignum(obj)->length < ceiling(65,intDsize)) \
  5663.              || (TheBignum(obj)->data[0] < (uintD)bit(64%intDsize)) \
  5664.     )   )   )
  5665.   #define sint64_p(obj)  \
  5666.     (((typecode(obj) & ~bit(sign_bit_t)) == fixnum_type) \
  5667.      || (((typecode(obj) & ~bit(sign_bit_t)) == bignum_type) \
  5668.          && (TheBignum(obj)->length <= ceiling(64,intDsize)) \
  5669.          && ((TheBignum(obj)->length < ceiling(64,intDsize)) \
  5670.              || ((TheBignum(obj)->data[0] ^ (positivep(obj) ? (uintD)0 : ~(uintD)0)) < (uintD)bit(63%intDsize)) \
  5671.     )   )   )
  5672.   #if (int_bitsize==16)
  5673.     #define uint_p  uint16_p
  5674.     #define sint_p  sint16_p
  5675.   #else # (int_bitsize==32)
  5676.     #define uint_p  uint32_p
  5677.     #define sint_p  sint32_p
  5678.   #endif
  5679.   #if (long_bitsize==32)
  5680.     #define ulong_p  uint32_p
  5681.     #define slong_p  sint32_p
  5682.   #else # (long_bitsize==64)
  5683.     #define ulong_p  uint64_p
  5684.     #define slong_p  sint64_p
  5685.   #endif
  5686.  
  5687.  
  5688. # ####################### SPVWBIBL zu SPVW.D ############################## #
  5689.  
  5690. /*
  5691.                           Die Stacks
  5692.                           ==========
  5693.  
  5694. Es werden zwei Stacks verwendet:
  5695.   - der C-Programmstack (Stackpointer SP = Register A7),
  5696.   - der LISP-Stack (Stackpointer STACK).
  5697. Alle Unterprogrammaufrufe geschehen mittels BSR/JSR ⁿber den Programmstack,
  5698. er dient au▀erdem zur Zwischenspeicherung von Daten, die keine LISP-Objekte
  5699. sind. Der LISP-Stack wird verwendet zur Ablage der Frames und zur Zwischen-
  5700. speicherung von LISP-Objekten.
  5701. Fⁿr beide Stacks werden die Wachstumsgrenzen von der Speicherverwaltung
  5702. kontrolliert ⁿber folgende Macros:
  5703.   check_SP();             testet den Programmstack gegen ▄berlauf
  5704.   check_STACK();          testet den LISP-Stack gegen ▄berlauf
  5705.   get_space_on_STACK(n);  testet, ob noch D0.L Bytes auf dem LISP-Stack frei sind
  5706. Auf dem LISP-Stack dⁿrfen grundsΣtzlich nur Langw÷rter abgelegt werden.
  5707. Ist dabei FRAME_BIT gesetzt, so handelt es sich um das untere Ende eines
  5708. Frames; dieses Langwort ist ein Pointer ⁿber den Frame, zusammen mit
  5709. einem Frame-Typ-Byte; falls darin SKIP2_BIT gel÷scht ist, ist das
  5710. darⁿberliegende Langwort kein LISP-Objekt.
  5711. Alle anderen Langw÷rter auf dem LISP-Stack stellen LISP-Objekte dar.
  5712. */
  5713.  
  5714. # Maschinenstack: SP
  5715. # SP() liefert den aktuellen Wert des SP.
  5716. # setSP(adresse); setzt den SP auf einen gegebenen Wert. Extrem gefΣhrlich!
  5717. # FAST_SP definiert, falls SP-Zugriffe schnell sind.
  5718.   #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM)
  5719.     # Zugriff auf eine globale Register"variable" SP
  5720.     #ifdef __REGISTER_PREFIX__ # GNU C Version >= 2.4 hat %/ und __REGISTER_PREFIX__
  5721.       # Aber der Wert von __REGISTER_PREFIX__ ist unbrauchbar, weil wir evtl.
  5722.       # cross-compilieren.
  5723.       #define REGISTER_PREFIX  "%/"
  5724.     #else
  5725.       #define REGISTER_PREFIX  "" # oder "%%", je nach verwendetem Assembler
  5726.     #endif
  5727.     #define SP()  \
  5728.       ({var aint __SP;                                                          \
  5729.         __asm__ __volatile__ ("movel "REGISTER_PREFIX"sp,%0" : "=g" (__SP) : ); \
  5730.         __SP;                                                                   \
  5731.        })
  5732.     #define setSP(adresse)  \
  5733.       ({ __asm__ __volatile__ ("movel %0,"REGISTER_PREFIX"sp" : : "g" ((aint)(adresse)) : "sp" ); })
  5734.     #define FAST_SP
  5735.   #elif defined(GNU) && defined(SPARC)
  5736.     # Zugriff auf eine Register"variable" %sp = %o6
  5737.     register __volatile__ aint __SP __asm__("%sp");
  5738.     #define SP()  __SP
  5739.     # Wir dⁿrfen hier kein setSP() durchfⁿhren, ohne zu beachten, da▀
  5740.     # 1. %sp ein Alignment von 8 Byte beachten mu▀,
  5741.     # 2. oberhalb von %sp immer 92 Byte frei bleiben mⁿssen (dorthin kommen
  5742.     #    die Registerinhalte, wenn durch ein 'save' in einem Unterprogramm
  5743.     #    ein 'register window overflow trap' ausgel÷st wird).
  5744.   #elif defined(GNU) && defined(HPPA)
  5745.     # Zugriff auf eine Register"variable" %sp = %r30
  5746.     register __volatile__ aint __SP __asm__("%r30");
  5747.     #define SP()  __SP
  5748.   #elif defined(GNU) && defined(MIPS)
  5749.     # Zugriff auf eine Register"variable" $sp = $29
  5750.     #if (__GNUC__ >= 2) # ab GNU-C 2.0
  5751.       #define SP_register "$sp"
  5752.     #else
  5753.       #define SP_register "sp"
  5754.     #endif
  5755.     register __volatile__ aint __SP __asm__(SP_register);
  5756.     #define SP()  __SP
  5757.   #elif defined(GNU) && defined(M88000)
  5758.     # Zugriff auf eine Register"variable" %sp = %r31
  5759.     register __volatile__ aint __SP __asm__("%r31");
  5760.     #define SP()  __SP
  5761.   #elif defined(GNU) && defined(CONVEX)
  5762.     # Zugriff auf eine Register"variable" $sp = $a0
  5763.     register __volatile__ aint __SP __asm__("sp");
  5764.     #define SP()  __SP
  5765.   #elif defined(GNU) && defined(DECALPHA)
  5766.     # Zugriff auf eine Register"variable" $sp = $30
  5767.     register __volatile__ aint __SP __asm__("$30");
  5768.     #define SP()  __SP
  5769.   #elif defined(GNU) && defined(I80Z86) && !defined(NO_ASM)
  5770.     # Zugriff auf eine Register"variable" %esp
  5771.     #define SP()  \
  5772.       ({var aint __SP;                                           \
  5773.         __asm__ __volatile__ ("movl %%esp,%0" : "=g" (__SP) : ); \
  5774.         __SP;                                                    \
  5775.        })
  5776.     #define setSP(adresse)  \
  5777.       ({ __asm__ __volatile__ ("movl %0,%%esp" : : "g" ((aint)(adresse)) : "sp" ); })
  5778.     #define FAST_SP
  5779.   #elif defined(WATCOM) && defined(I80Z86) && !defined(NO_ASM)
  5780.     # Zugriff auf ein Register %esp
  5781.     #define SP  getSP
  5782.     extern void* getSP (void);
  5783.     extern void setSP (void* adresse);
  5784.     #pragma aux  getSP =  0x89 0xe0 /* mov %esp,%eax */  parm value [eax] modify nomemory;
  5785.     #pragma aux  setSP =  0x89 0xc4 /* mov %eax,%esp */  parm caller [eax] modify nomemory [esp];
  5786.     #define FAST_SP
  5787.   #elif defined(MC680X0) || defined(SPARC) || defined(MIPS) || defined(I80Z86)
  5788.     # Zugriffsfunktionen extern, in Assembler
  5789.     #define SP  getSP
  5790.     extern void* SP (void);
  5791.     extern void setSP (void* adresse);
  5792.   #else
  5793.     # Zugriffsfunktion portabel in C
  5794.     extern void* SP (void);
  5795.   #endif
  5796. #if defined(stack_grows_down) # defined(MC680X0) || defined(I80X86) || defined(SPARC) || defined(MIPS) || defined(M88000) || defined(DECALPHA) || ...
  5797.   #define SP_DOWN # SP wΣchst nach unten
  5798.   #define SPoffset 0 # top-of-SP ist *(SP+SPoffset)
  5799. #endif
  5800. #if defined(stack_grows_up) # defined(HPPA) || ...
  5801.   #define SP_UP # SP wΣchst nach oben
  5802.   #define SPoffset -1 # top-of-SP ist *(SP+SPoffset)
  5803. #endif
  5804. #if (defined(SP_DOWN) && defined(SP_UP)) || (!defined(SP_DOWN) && !defined(SP_UP))
  5805.   #error "Unknown SP direction -- SP_DOWN/SP_UP neu einstellen!"
  5806. #endif
  5807. # Darauf aufbauend:
  5808. # SPint  ist der Typ der Elemente auf dem SP, ein Integertyp mindestens so
  5809. #        breit wie uintL und mindestens so breit wie aint bzw. void*.
  5810. # SP_(n) = (n+1)tes Langwort auf dem SP.
  5811. # _SP_(n) = &SP_(n).
  5812. # pushSP(item)  legt ein Langwort auf dem SP ab. Synonym: -(SP).
  5813. # popSP(item=)  liefert item=SP_(0) und nimmt es dabei vom SP herunter.
  5814. # skipSP(n);  nimmt n Langworte vom SP herunter.
  5815.   #if (oint_addr_len <= intLsize)
  5816.     typedef uintL  SPint;
  5817.   #else
  5818.     typedef aint  SPint;
  5819.   #endif
  5820.   #ifdef SP_DOWN
  5821.     #define skipSPop  +=
  5822.     #define SPop      +
  5823.   #endif
  5824.   #ifdef SP_UP
  5825.     #define skipSPop  -=
  5826.     #define SPop      -
  5827.   #endif
  5828.   #define _SP_(n)  (((SPint*)SP()) + SPoffset SPop (uintP)(n))
  5829.   #if !(defined(GNU) && (defined(MC680X0)) && !defined(NO_ASM)) # im allgemeinen
  5830.     #define SP_(n)  (((SPint*)SP())[SPoffset SPop (uintP)(n)])
  5831.     #define skipSP(n)  \
  5832.       {var reg1 SPint* sp = (SPint*)SP(); \
  5833.        sp skipSPop (uintP)(n);            \
  5834.        setSP(sp);                         \
  5835.       }
  5836.     #define pushSP(item)  \
  5837.       {var reg1 SPint* sp = (SPint*)SP();                                    \
  5838.        sp skipSPop -1;                                                       \
  5839.        setSP(sp);             # Erst SP herabsetzen (wegen Interruptgefahr!) \
  5840.        sp[SPoffset] = (item); # dann item als top-of-SP eintragen            \
  5841.       }
  5842.     #define popSP(item_zuweisung)  \
  5843.       {var reg1 SPint* sp = (SPint*)SP();                                        \
  5844.        item_zuweisung sp[SPoffset]; # Erst item als top-of-SP holen              \
  5845.        sp skipSPop 1;                                                            \
  5846.        setSP(sp);                   # dann erst (Interruptgefahr!) SP hochsetzen \
  5847.       }
  5848.   #endif
  5849.   #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM)
  5850.     # Mit GNU auf einem 680X0 liegt SP in einem Register. Zugriff und
  5851.     # VerΣnderung von SP bilden daher eine ununterbrechbare Einheit.
  5852.     # Und es gilt SP_DOWN und SPoffset=0.
  5853.     #define SP_(n)  \
  5854.       ({var reg1 uintL __n = sizeof(SPint) * (n); \
  5855.         var reg1 SPint __item;                    \
  5856.         __asm__ __volatile__ ("movel "REGISTER_PREFIX"sp@(%1:l),%0" : "=g" (__item) : "r" (__n) ); \
  5857.         __item;                                   \
  5858.        })
  5859.     #define skipSP(n)  \
  5860.       {var reg1 uintL __n = sizeof(SPint) * (n);                                   \
  5861.        __asm__ __volatile__ ("addl %0,"REGISTER_PREFIX"sp" : : "g" (__n) : "sp" ); \
  5862.       }
  5863.     #define pushSP(item)  \
  5864.       {var reg1 SPint __item = (item);                                                   \
  5865.        __asm__ __volatile__ ("movel %0,"REGISTER_PREFIX"sp@-" : : "g" (__item) : "sp" ); \
  5866.       }
  5867.     #define popSP(item_zuweisung)  \
  5868.       {var reg1 SPint __item;                                                             \
  5869.        __asm__ __volatile__ ("movel "REGISTER_PREFIX"sp@+,%0" : "=r" (__item) : : "sp" ); \
  5870.        item_zuweisung __item;                                                             \
  5871.       }
  5872.   #endif
  5873. # Gr÷▀e eines jmp_buf im SP:
  5874.   #define jmpbufsize  ceiling(sizeof(jmp_buf),sizeof(SPint))
  5875. # Header im Bytecode einer compilierten Closure:
  5876.   #ifndef FAST_SP
  5877.     #define CCHD 2
  5878.   #else
  5879.     #define CCHD 0
  5880.   #endif
  5881.  
  5882. # LISP-Stack: STACK
  5883.   #if defined(GNU) && (SAFETY < 2)
  5884.     #if defined(MC680X0)
  5885.       #define STACK_register  "a4"  # h÷chstes Adre▀register nach sp=A7,fp=A6/A5
  5886.     #endif
  5887.     #if defined(SPARC)
  5888.       #define STACK_register  "%g5"  # ein globales Register
  5889.     #endif
  5890.     #if defined(HPPA_REG_WORKS)
  5891.       #define STACK_register  "%r10"  # eines der allgemeinen Register %r5..%r18
  5892.     #endif
  5893.     #if defined(M88000)
  5894.       #define STACK_register  "%r14"  # eines der allgemeinen Register %r14..%r25
  5895.     #endif
  5896.     #if defined(ARM)
  5897.       #define STACK_register  "%r8"  # eines der allgemeinen Register %r4..%r8
  5898.     #endif
  5899.     #if defined(DECALPHA)
  5900.       #define STACK_register  "$9"  # eines der allgemeinen Register $9..$14
  5901.     #endif
  5902.   #endif
  5903.   #if !defined(STACK_register)
  5904.     # eine globale Variable
  5905.     extern object* STACK;
  5906.   #else
  5907.     # eine globale Registervariable
  5908.     register object* STACK __asm__(STACK_register);
  5909.   #endif
  5910.   #if defined(SPARC) && !defined(GNU) && (SAFETY < 2)
  5911.     # eine globale Registervariable, aber Zugriffsfunktionen extern in Assembler
  5912.     #define STACK  _getSTACK()
  5913.     extern object* _getSTACK (void);
  5914.     #define setSTACK(zuweisung)  \
  5915.       { var object* tempSTACK; _setSTACK(temp##zuweisung); } # ─hem, igitt!
  5916.     extern void _setSTACK (void* new_STACK);
  5917.   #else
  5918.     #define setSTACK(zuweisung)  zuweisung
  5919.   #endif
  5920. #if defined(ATARI) || defined(AMIGAOS)
  5921.   #define STACK_DOWN # STACK wΣchst nach unten
  5922. #endif
  5923. #if defined(UNIX) || defined(DJUNIX) || defined(EMUNIX) || defined(WATCOM) || defined(RISCOS) || defined(HYPERSTONE)
  5924.   #define STACK_UP # STACK wΣchst nach oben
  5925. #endif
  5926. #if (defined(STACK_DOWN) && defined(STACK_UP)) || (!defined(STACK_DOWN) && !defined(STACK_UP))
  5927.   #error "Unknown STACK direction -- STACK_DOWN/STACK_UP neu einstellen!"
  5928. #endif
  5929.  
  5930. # Jeder Aufruf einer externen Funktion (oder eine Folge von solchen) mu▀
  5931. # zwischen
  5932. #   begin_call();
  5933. # und
  5934. #   end_call();
  5935. # eingerahmt werden.
  5936. # Zweck: Damit im Falle einer Unterbrechung wΣhrend des entsprechenden
  5937. # Zeitraums der STACK - falls er in einem Register liegt - auf einen halbwegs
  5938. # aktuellen Wert gebracht werden kann.
  5939. # Soll wΣhrend des Ablaufs einer externen Funktion doch wieder auf den STACK
  5940. # zugegriffen werden, so ist der entsprechende Code zwischen
  5941. #   begin_callback();
  5942. # und
  5943. #   end_callback();
  5944. # einzurahmen.
  5945. #if defined(STACK_register) && !(defined(SUN4) && (SAFETY < 2))
  5946.   #define HAVE_SAVED_STACK
  5947.   extern object* saved_STACK;
  5948.   #define begin_call()  saved_STACK = STACK
  5949.   #define end_call()  saved_STACK = (object*)NULL
  5950.   #define begin_callback()  setSTACK(STACK = saved_STACK); end_call()
  5951.   #define end_callback()  begin_call()
  5952. #elif defined(EMUNIX) && defined(WINDOWS)
  5953.   # Bei RSXW32 mⁿssen wir den SP vorⁿbergehend in die unteren 64 KB legen,
  5954.   # damit MS-Windows-Aufrufe m÷glich werden. Ansonsten brauchen wir aber
  5955.   # einen gr÷▀eren Stack.
  5956.   #define begin_call()  if ((aint)SP() > (aint)SP_start) alloca((aint)SP() - (aint)SP_start)
  5957.   #define end_call()
  5958.   # Bei Callbacks bleiben wir im kleinen Stack.
  5959.   #define begin_callback()
  5960.   #define end_callback()
  5961. #else
  5962.   # Falls STACK eine globale Variable ist oder in einem Register liegt,
  5963.   # das von Betriebssystem und Library intakt gelassen wird (das ist bei
  5964.   # SUN4 der Fall), brauchen wir uns auch keine Sorgen zu machen.
  5965.   #if defined(GNU) && (SAFETY < 2) && defined(SPARC) && !defined(WIDE)
  5966.     # subr_self_register %g4 mu▀ gerettet werden.
  5967.     #define HAVE_SAVED_SUBR_SELF
  5968.     extern object saved_subr_self;
  5969.     #define begin_call()  saved_subr_self = subr_self
  5970.     #define end_call()  subr_self = saved_subr_self
  5971.     #define begin_callback()  end_call()
  5972.     #define end_callback()  begin_call()
  5973.   #else
  5974.     #define begin_call()
  5975.     #define end_call()
  5976.     #define begin_callback()  end_call()
  5977.     #define end_callback()  begin_call()
  5978.   #endif
  5979. #endif
  5980.  
  5981. # Jeder Betriebsystem-Aufruf (oder eine Folge von solchen) mu▀ zwischen
  5982. #   begin_system_call();
  5983. # und
  5984. #   end_system_call();
  5985. # eingerahmt werden.
  5986. # Zweck: Damit im Falle einer Unterbrechung wΣhrend des entsprechenden
  5987. # Zeitraums der STACK - falls er in einem Register liegt - auf einen halbwegs
  5988. # aktuellen Wert gebracht werden kann.
  5989. #if defined(ATARI) || defined(AMIGAOS) || defined(NO_ASYNC_INTERRUPTS)
  5990.   # ATARI: WΣhrend Betriebssystem-Aufrufen ist das Programm sowieso nicht
  5991.   #   unterbrechbar.
  5992.   # AMIGAOS: Solange nicht ixemul.library benutzt wird, ist wΣhrend
  5993.   #   Betriebssystem-Aufrufen das Programm sowieso nicht unterbrechbar.
  5994.   # NO_ASYNC_INTERRUPTS: Wenn wir auf asynchrone Interrupts nicht reagieren,
  5995.   #   ist das Programm nicht unterbrechbar.
  5996.   #define begin_system_call()
  5997.   #define end_system_call()
  5998. #else
  5999.   #define begin_system_call()  begin_call()
  6000.   #define end_system_call()  end_call()
  6001. #endif
  6002.  
  6003. # Unter Unix wird der Speicherbereich fⁿr den SP vom
  6004. # Betriebssystem bereitgestellt, kein malloc() n÷tig.
  6005. # Ebenso unter EMX (ausgenommen RSXW32 mit seinem Mini-60KB-Stack).
  6006. #if (defined(UNIX) && !defined(UNIX_MINT)) || (defined(EMUNIX) && !defined(WINDOWS)) || defined(RISCOS) # || defined(AMIGAOS) # ?JCH??
  6007.   #define NO_SP_MALLOC
  6008. #endif
  6009.  
  6010. # Testet auf SP-▄berlauf.
  6011. # check_SP();            testet auf ▄berlauf
  6012. # check_SP_notUNIX();    dito, au▀er wenn temporΣrer ▄berlauf nicht ins Gewicht fΣllt
  6013.   #define check_SP()  if (SP_overflow()) SP_ueber()
  6014.   #if (defined(EMUNIX) && defined(WINDOWS))
  6015.     # Der SP liegt entweder im Original-Bereich (<= SP_start) oder
  6016.     # im neu allozierten Bereich, der durch SP_bound begrenzt ist.
  6017.     #define SP_overflow()  \
  6018.       ( (aint)SP() > (aint)SP_start && (aint)SP() < (aint)SP_bound )
  6019.     extern void* SP_start;
  6020.   #elif !defined(NO_SP_MALLOC) || defined(AMIGAOS)
  6021.     #ifdef SP_DOWN
  6022.       #define SP_overflow()  ( (aint)SP() < (aint)SP_bound )
  6023.     #endif
  6024.     #ifdef SP_UP
  6025.       #define SP_overflow()  ( (aint)SP() > (aint)SP_bound )
  6026.     #endif
  6027.   #else # NO_SP_MALLOC
  6028.     # Fⁿr den SP ist das Betriebssystem verantwortlich.
  6029.     # Woher sollen wir einen vernⁿnftigen Wert fⁿr SP_bound bekommen?
  6030.     #define SP_overflow()  FALSE
  6031.   #endif
  6032.   extern void* SP_bound;
  6033.   nonreturning_function(extern, SP_ueber, (void));
  6034.   #ifdef UNIX
  6035.     #define check_SP_notUNIX()
  6036.   #else
  6037.     #define check_SP_notUNIX()  check_SP()
  6038.   #endif
  6039.  
  6040. # Testet auf STACK-▄berlauf.
  6041. # check_STACK();
  6042.   #define check_STACK()  if (STACK_overflow()) STACK_ueber()
  6043.   #ifdef STACK_DOWN
  6044.     #define STACK_overflow()  ( (aint)STACK < (aint)STACK_bound )
  6045.   #endif
  6046.   #ifdef STACK_UP
  6047.     #define STACK_overflow()  ( (aint)STACK > (aint)STACK_bound )
  6048.   #endif
  6049.   extern void* STACK_bound;
  6050.   nonreturning_function(extern, STACK_ueber, (void));
  6051.  
  6052. # Testet, ob noch n Bytes auf dem STACK frei sind.
  6053. # get_space_on_STACK(n);
  6054.   #ifdef STACK_DOWN
  6055.     #define get_space_on_STACK(n)  \
  6056.       if ( (aint)STACK < (aint)STACK_bound + (aint)(n) ) STACK_ueber()
  6057.   #else
  6058.     #define get_space_on_STACK(n)  \
  6059.       if ( (aint)STACK + (aint)(n) > (aint)STACK_bound ) STACK_ueber()
  6060.   #endif
  6061.  
  6062. # LISP-Interpreter verlassen
  6063. # quit();
  6064. # > final_exitcode: 0 bei normalem Ende, 1 bei Abbruch
  6065.   nonreturning_function(extern, quit, (void));
  6066.   extern boolean final_exitcode;
  6067. # wird verwendet von CONTROL, WINDOWS
  6068.  
  6069. # Fehlermeldung wegen Erreichen einer unerreichbaren Programmstelle.
  6070. # Kehrt nicht zurⁿck.
  6071. # fehler_notreached(file,line);
  6072. # > file: Filename (mit Anfⁿhrungszeichen) als konstanter ASCIZ-String
  6073. # > line: Zeilennummer
  6074.   nonreturning_function(extern, fehler_notreached, (const char * file, uintL line));
  6075. # wird von allen Modulen verwendet
  6076.  
  6077. #ifndef LANGUAGE_STATIC
  6078. # Sprache, in der mit dem Benutzer kommuniziert wird:
  6079.   extern uintL language;
  6080.   #define language_english   0
  6081.   #define language_deutsch   1
  6082.   #define language_francais  2
  6083. # wird von allen Modulen verwendet
  6084. #endif
  6085.  
  6086. # Ausgabe eines konstanten ASCIZ-Strings, direkt ⁿbers Betriebssystem:
  6087. # asciz_out(string);
  6088.   extern void asciz_out (const char * asciz);
  6089. # wird verwendet von SPVW
  6090.  
  6091. # uintL in Dezimalnotation direkt ⁿbers Betriebssystem ausgeben:
  6092. # dez_out(zahl);
  6093.   #define dez_out(x)  dez_out_((uintL)(x))
  6094.   extern void dez_out_ (uintL zahl);
  6095. # wird zum Debuggen verwendet
  6096.  
  6097. # unsigned long in Hexadezimalnotation direkt ⁿbers Betriebssystem ausgeben:
  6098. # hex_out(zahl);
  6099.   #define hex_out(x)  hex_out_((unsigned long)(x))
  6100.   extern void hex_out_ (unsigned long zahl);
  6101. # wird zum Debuggen verwendet
  6102.  
  6103. # Speicherbereich in Hexadezimalnotation direkt ⁿbers Betriebssystem ausgeben:
  6104. # mem_hex_out(buf,count);
  6105.   extern void mem_hex_out (void* buf, uintL count);
  6106. # wird zum Debuggen verwendet
  6107.  
  6108. # Lisp-Objekt in Lisp-Notation relativ direkt ⁿbers Betriebssystem ausgeben:
  6109. # object_out(obj);
  6110. # kann GC ausl÷sen
  6111.   extern void object_out (object obj);
  6112. # wird zum Debuggen verwendet
  6113.  
  6114. # Methode der Speicherverwaltung:
  6115. # SPVW_BLOCKS : Speicherverwaltung mit wenigen Speicherbl÷cken
  6116. # SPVW_PAGES  : Speicherverwaltung mit vielen Speicherseiten
  6117. # SPVW_MIXED  : Objekte verschiedenen Typs in derselben Seite/demselben Block
  6118. #               m÷glich
  6119. # SPVW_PURE   : Jeder Speicherblock/jede Speicherseite enthΣlt nur Objekte
  6120. #               ein und desselben Typs
  6121. #if defined(ATARI) || defined(WATCOM) || defined(UNIX_LINUX) || defined(MAP_MEMORY) || defined(TRIVIALMAP_MEMORY)
  6122.   # Auf dem Atari und auf der DOSe mit dem WATCOM-Extender steht nur
  6123.   # endlich viel Speicher zur Verfⁿgung.
  6124.   # Bei Linux legt zu viel malloc() den Rechner fⁿr lΣngere Zeit lahm.
  6125.   # Multimapping einzelner Pages ist noch nicht implementiert.??
  6126.   # Singlemapping einzelner Pages ist noch nicht implementiert.??
  6127.   # Verwendet man mmap() als malloc()-Ersatz, braucht man keine einzelnen Pages.
  6128.   #define SPVW_BLOCKS
  6129. #elif (defined(AMIGA) || defined(VIRTUAL_MEMORY)) && defined(GENTAG)
  6130.   # Auf dem Amiga sollte man nicht zu viel Speicher auf einmal holen.
  6131.   # Auf Unix-Systemen kann man nachtrΣglich immer noch Speicher holen,
  6132.   # man sollte aber die Daten wenn m÷glich in wenigen Pages konzentrieren.
  6133.   # avl.d setzt den Macro GENTAG voraus.
  6134.   #define SPVW_PAGES
  6135. #else
  6136.   #define SPVW_BLOCKS
  6137. #endif
  6138. #if defined(MULTIMAP_MEMORY)
  6139.   # MULTIMAP_MEMORY -> Mixed Pages dienen besserer Speicher-Ausnutzung.
  6140.   #define SPVW_MIXED
  6141. #elif defined(SINGLEMAP_MEMORY)
  6142.   # SINGLEMAP_MEMORY -> Nur Pure Pages/Blocks sinnvoll, denn
  6143.   # die Adresse einer Page bestimmt den Typ der Objekte, die sie enthΣlt.
  6144.   #define SPVW_PURE
  6145. #elif defined(MC68000) || defined(SUN3) || defined(AMIGA) || defined(SPVW_BLOCKS) || defined(TRIVIALMAP_MEMORY)
  6146.   # MC68000 oder SUN3 -> type_pointable(...) kostet nichts oder nur wenig.
  6147.   # AMIGA -> nur endlich viel Speicher, Mixed Pages nutzen ihn besser.
  6148.   # SPVW_BLOCKS -> SPVW_PURE_BLOCKS nur fⁿr SINGLEMAP_MEMORY implementiert.
  6149.   # TRIVIALMAP_MEMORY -> Nicht viele Bl÷cke m÷glich, da wenig Adre▀raum.
  6150.   #define SPVW_MIXED
  6151. #elif 1 # vorlΣufig! ??
  6152.   #define SPVW_MIXED
  6153. #endif
  6154. #if !(defined(SPVW_BLOCKS) || defined(SPVW_PAGES))
  6155.   #error "SPVW_BLOCKS/SPVW_PAGES neu einstellen!"
  6156. #endif
  6157. #if !(defined(SPVW_MIXED) || defined(SPVW_PURE))
  6158.   #error "SPVW_MIXED/SPVW_PURE neu einstellen!"
  6159. #endif
  6160. #if (defined(SPVW_BLOCKS) && defined(SPVW_PURE)) != defined(SINGLEMAP_MEMORY)
  6161.   #error "SINGLEMAP_MEMORY impliziert SPVW_PURE_BLOCKS und umgekehrt!"
  6162. #endif
  6163. #if (defined(SPVW_BLOCKS) && defined(SPVW_MIXED)) < defined(TRIVIALMAP_MEMORY)
  6164.   #error "TRIVIALMAP_MEMORY impliziert SPVW_MIXED_BLOCKS!"
  6165. #endif
  6166. #if (defined(SPVW_BLOCKS) && (defined(SPVW_PURE) || (defined(SPVW_MIXED) && defined(TRIVIALMAP_MEMORY)))) < defined(GENERATIONAL_GC)
  6167.   #error "GENERATIONAL_GC impliziert SPVW_PURE_BLOCKS oder SPVW_MIXED_BLOCKS_TRIVIALMAP!"
  6168. #endif
  6169.  
  6170. # Objekte variabler LΣnge mⁿssen an durch 2 (o.Σ.) teilbaren Adressen liegen:
  6171. #if defined(VAX) # ?? gcc/config/vax/vax.h sagt: Alignment = 4
  6172.   #define Varobject_alignment  1
  6173. #endif
  6174. #if defined(MC680X0)
  6175.   #if !(addr_shift==0)
  6176.     #define Varobject_alignment  bit(addr_shift)  # wegen der gedrΣngten Typcodeverteilung
  6177.   #else
  6178.     #define Varobject_alignment  2
  6179.   #endif
  6180. #endif
  6181. #if defined(I80Z86) || defined(RS6000) || defined(CONVEX) || defined(ARM)
  6182.   #define Varobject_alignment  4
  6183. #endif
  6184. #if defined(SPARC) || defined(HPPA) || defined(MIPS) || defined(M88000) || defined(DECALPHA)
  6185.   #define Varobject_alignment  8
  6186. #endif
  6187. #if defined(GENERATIONAL_GC) && (Varobject_alignment < 4)
  6188.   #undef Varobject_alignment
  6189.   #define Varobject_alignment  4
  6190. #endif
  6191. #if defined(GENERATIONAL_GC) && defined(WIDE) && (Varobject_alignment < 8)
  6192.   #undef Varobject_alignment
  6193.   #define Varobject_alignment  8
  6194. #endif
  6195. # Varobject_alignment sollte definiert sein:
  6196. #ifndef Varobject_alignment
  6197.   #error "Varobject_alignment depends on CPU -- Varobject_alignment neu einstellen!!"
  6198. #endif
  6199. # Varobject_alignment sollte eine Zweierpotenz sein:
  6200. #if !((Varobject_alignment & (Varobject_alignment-1)) ==0)
  6201.   #error "Bogus Varobject_alignment -- Varobject_alignment neu einstellen!!"
  6202. #endif
  6203. # Varobject_alignment sollte ein Vielfaches von 2^addr_shift sein:
  6204. #if (Varobject_alignment % bit(addr_shift))
  6205.   #error "Bogus Varobject_alignment -- Varobject_alignment neu einstellen!!"
  6206. #endif
  6207. # wird verwendet von SPVW, ARRAY
  6208.  
  6209. # UP, fⁿhrt eine Garbage Collection aus
  6210. # gar_col();
  6211. # kann GC ausl÷sen
  6212.   extern void gar_col(void);
  6213. # wird verwendet von DEBUG
  6214.  
  6215. # UP, beschafft ein Cons
  6216. # allocate_cons()
  6217. # < ergebnis: Pointer auf neues CONS, mit CAR und CDR =NIL
  6218. # kann GC ausl÷sen
  6219.   extern object allocate_cons (void);
  6220. # wird verwendet von LIST, SEQUENCE, PACKAGE, EVAL, CONTROL, RECORD,
  6221. #                    PREDTYPE, IO, STREAM, PATHNAME, SYMBOL, ARRAY, LISPARIT
  6222.  
  6223. # UP: Liefert ein neu erzeugtes uninterniertes Symbol mit gegebenem Printnamen.
  6224. # make_symbol(string)
  6225. # > string: Simple-String
  6226. # < ergebnis: neues Symbol mit diesem Namen, mit Home-Package=NIL.
  6227. # kann GC ausl÷sen
  6228.   extern object make_symbol (object string);
  6229. # wird verwendet von PACKAGE, IO, SYMBOL
  6230.  
  6231. # UP, beschafft Vektor
  6232. # allocate_vector(len)
  6233. # > len: LΣnge des Vektors
  6234. # < ergebnis: neuer Vektor (Elemente werden mit NIL initialisiert)
  6235. # kann GC ausl÷sen
  6236.   extern object allocate_vector (uintL len);
  6237. # wird verwendet von ARRAY, IO, EVAL, PACKAGE, CONTROL, HASHTABL
  6238.  
  6239. # UP, beschafft Bit-Vektor
  6240. # allocate_bit_vector(len)
  6241. # > len: LΣnge des Bitvektors (in Bits)
  6242. # < ergebnis: neuer Bitvektor (LISP-Objekt)
  6243. # kann GC ausl÷sen
  6244.   extern object allocate_bit_vector (uintL len);
  6245. # wird verwendet von ARRAY, IO, RECORD, LISPARIT, STREAM
  6246.  
  6247. # UP, beschafft String
  6248. # allocate_string(len)
  6249. # > len: LΣnge des Strings (in Bytes)
  6250. # < ergebnis: neuer Simple-String (LISP-Objekt)
  6251. # kann GC ausl÷sen
  6252.   extern object allocate_string (uintL len);
  6253. # wird verwendet von ARRAY, CHARSTRG, STREAM, PATHNAME
  6254.  
  6255. # UP, beschafft Array
  6256. # allocate_array(flags,rank,type)
  6257. # > uintB flags: Flags
  6258. # > uintC rank: Rang
  6259. # > tint type: Typinfo
  6260. # < ergebnis: LISP-Objekt Array
  6261. # kann GC ausl÷sen
  6262.   extern object allocate_array (uintB flags, uintC rank, tint type);
  6263. # wird verwendet von ARRAY, IO
  6264.  
  6265. # UP, beschafft Record
  6266. # allocate_record(flags,rectype,reclen,type)
  6267. # > uintB flags: Flags
  6268. # > uintB rectype: nΣhere Typinfo
  6269. # > uintC (eigentlich uintW) reclen: LΣnge
  6270. # > tint type: Typinfo
  6271. # < ergebnis: LISP-Objekt Record (Elemente werden mit NIL initialisiert)
  6272. # kann GC ausl÷sen
  6273.   #define allocate_record(flags,rectype,reclen,type)  \
  6274.     allocate_record_(                                              \
  6275.        (BIG_ENDIAN_P ? ((uintW)(flags)<<intBsize)+(uintW)(rectype) \
  6276.                      : (uintW)(flags)+((uintW)(rectype)<<intBsize) \
  6277.        ),                                                          \
  6278.        reclen,                                                     \
  6279.        type)
  6280.   extern object allocate_record_ (uintW flags_rectype, uintC reclen, tint type);
  6281. # wird verwendet von RECORD, EVAL
  6282.  
  6283. # UP, beschafft Structure
  6284. # allocate_structure(reclen)
  6285. # > uintC reclen: LΣnge
  6286. # < ergebnis: LISP-Objekt Structure (Elemente werden mit NIL initialisiert)
  6287. # kann GC ausl÷sen
  6288.   #ifdef case_structure
  6289.     #define allocate_structure(reclen)  \
  6290.       allocate_record(0,0,reclen,structure_type)
  6291.   #else
  6292.     #define allocate_structure(reclen)  \
  6293.       allocate_record(0,Rectype_Structure,reclen,orecord_type)
  6294.   #endif
  6295. # wird verwendet von RECORD
  6296.  
  6297. # UP, beschafft Stream
  6298. # allocate_stream(strmflags,strmtype,reclen)
  6299. # > uintB strmflags: Flags
  6300. # > uintB strmtype: nΣhere Typinfo
  6301. # > uintC reclen: LΣnge
  6302. # < ergebnis: LISP-Objekt Stream (Elemente werden mit NIL initialisiert)
  6303. # kann GC ausl÷sen
  6304.   #ifdef case_stream
  6305.     #define allocate_stream(strmflags,strmtype,reclen)  \
  6306.       allocate_record(strmflags,strmtype,reclen,stream_type)
  6307.   #else
  6308.     extern object allocate_stream (uintB strmflags, uintB strmtype, uintC reclen);
  6309.   #endif
  6310. # wird verwendet von STREAM
  6311.  
  6312. # UP, beschafft Package
  6313. # allocate_package()
  6314. # < ergebnis: LISP-Objekt Package
  6315. # kann GC ausl÷sen
  6316.   #define allocate_package()  \
  6317.     allocate_record(0,Rectype_Package,package_length,orecord_type)
  6318. # wird verwendet von PACKAGE
  6319.  
  6320. # UP, beschafft Hash-Table
  6321. # allocate_hash_table()
  6322. # < ergebnis: LISP-Objekt Hash-Table
  6323. # kann GC ausl÷sen
  6324.   #define allocate_hash_table()  \
  6325.     allocate_record(0,Rectype_Hashtable,hashtable_length,orecord_type)
  6326. # wird verwendet von
  6327.  
  6328. # UP, beschafft Readtable
  6329. # allocate_readtable()
  6330. # < ergebnis: LISP-Objekt Readtable
  6331. # kann GC ausl÷sen
  6332.   #define allocate_readtable()  \
  6333.     allocate_record(0,Rectype_Readtable,readtable_length,orecord_type)
  6334. # wird verwendet von IO
  6335.  
  6336. # UP, beschafft Pathname
  6337. # allocate_pathname()
  6338. # < ergebnis: LISP-Objekt Pathname
  6339. # kann GC ausl÷sen
  6340.   #define allocate_pathname()  \
  6341.     allocate_record(0,Rectype_Pathname,pathname_length,orecord_type)
  6342. # wird verwendet von PATHNAME
  6343.  
  6344. #ifdef LOGICAL_PATHNAMES
  6345. # UP, beschafft Logical Pathname
  6346. # allocate_logpathname()
  6347. # < ergebnis: LISP-Objekt Logical Pathname
  6348. # kann GC ausl÷sen
  6349.   #define allocate_logpathname()  \
  6350.     allocate_record(0,Rectype_Logpathname,logpathname_length,orecord_type)
  6351. # wird verwendet von PATHNAME
  6352. #endif
  6353.  
  6354. # UP, beschafft Random-State
  6355. # allocate_random_state()
  6356. # < ergebnis: LISP-Objekt Random-State
  6357. # kann GC ausl÷sen
  6358.   #define allocate_random_state()  \
  6359.     allocate_record(0,Rectype_Random_State,random_state_length,orecord_type)
  6360. # wird verwendet von IO, LISPARIT
  6361.  
  6362. # UP, beschafft Byte
  6363. # allocate_byte()
  6364. # < ergebnis: LISP-Objekt Byte
  6365. # kann GC ausl÷sen
  6366.   #define allocate_byte()  \
  6367.     allocate_record(0,Rectype_Byte,byte_length,orecord_type)
  6368. # wird verwendet von LISPARIT
  6369.  
  6370. # UP, beschafft Fsubr
  6371. # allocate_fsubr()
  6372. # < ergebnis: LISP-Objekt Fsubr
  6373. # kann GC ausl÷sen
  6374.   #define allocate_fsubr()  \
  6375.     allocate_record(0,Rectype_Fsubr,fsubr_length,orecord_type)
  6376. # wird verwendet von SPVW
  6377.  
  6378. # UP, beschafft Load-time-Eval
  6379. # allocate_loadtimeeval()
  6380. # < ergebnis: LISP-Objekt Load-time-Eval
  6381. # kann GC ausl÷sen
  6382.   #define allocate_loadtimeeval()  \
  6383.     allocate_record(0,Rectype_Loadtimeeval,loadtimeeval_length,orecord_type)
  6384. # wird verwendet von IO, RECORD
  6385.  
  6386. # UP, beschafft Symbol-Macro
  6387. # allocate_symbolmacro()
  6388. # < ergebnis: LISP-Objekt Symbol-Macro
  6389. # kann GC ausl÷sen
  6390.   #define allocate_symbolmacro()  \
  6391.     allocate_record(0,Rectype_Symbolmacro,symbolmacro_length,orecord_type)
  6392. # wird verwendet von CONTROL, RECORD
  6393.  
  6394. # UP, beschafft Alienfun
  6395. # allocate_alienfun()
  6396. # < ergebnis: LISP-Objekt Alienfun
  6397. # kann GC ausl÷sen
  6398.   #define allocate_alienfun()  \
  6399.     allocate_record(0,Rectype_alienfun,alienfun_length,orecord_type)
  6400. # wird verwendet von
  6401.  
  6402. # UP, beschafft Alien
  6403. # allocate_alien()
  6404. # < ergebnis: LISP-Objekt Alien
  6405. # kann GC ausl÷sen
  6406.   #define allocate_alien()  \
  6407.     allocate_record(0,Rectype_alien,alien_length,orecord_type)
  6408. # wird verwendet von
  6409.  
  6410. #ifdef FOREIGN
  6411. # UP, beschafft Foreign-Verpackung
  6412. # allocate_foreign(foreign)
  6413. # > foreign: vom Typ FOREIGN
  6414. # < ergebnis: LISP-Objekt, das foreign enthΣlt
  6415. # kann GC ausl÷sen
  6416.   extern object allocate_foreign (FOREIGN foreign);
  6417. # wird verwendet von REXX
  6418. #endif
  6419.  
  6420. # UP, beschafft Handle-Verpackung
  6421. # allocate_handle(handle)
  6422. # < ergebnis: LISP-Objekt, das handle enthΣlt
  6423.   #ifdef FOREIGN_HANDLE
  6424.     # kann GC ausl÷sen
  6425.     extern object allocate_handle (Handle handle);
  6426.   #else
  6427.     #define allocate_handle(handle)  fixnum((uintL)(handle))
  6428.   #endif
  6429.  
  6430. # UP, beschafft Bignum
  6431. # allocate_bignum(len,sign)
  6432. # > uintC len: LΣnge der Zahl (in Digits)
  6433. # > sintB sign: Flag fⁿr Vorzeichen (0 = +, -1 = -)
  6434. # < ergebnis: neues Bignum (LISP-Objekt)
  6435. # kann GC ausl÷sen
  6436.   extern object allocate_bignum (uintC len, sintB sign);
  6437. # wird verwendet von LISPARIT, STREAM
  6438.  
  6439. # UP, beschafft Single-Float
  6440. # allocate_ffloat(value)
  6441. # > ffloat value: Zahlwert (Bit 31 = Vorzeichen)
  6442. # < ergebnis: neues Single-Float (LISP-Objekt)
  6443. # kann GC ausl÷sen
  6444.   extern object allocate_ffloat (ffloat value);
  6445. # wird verwendet von LISPARIT
  6446.  
  6447. # UP, beschafft Double-Float
  6448. #ifdef intQsize
  6449. # allocate_dfloat(value)
  6450. # > dfloat value: Zahlwert (Bit 63 = Vorzeichen)
  6451. # < ergebnis: neues Double-Float (LISP-Objekt)
  6452. # kann GC ausl÷sen
  6453.   extern object allocate_dfloat (dfloat value);
  6454. #else
  6455. # allocate_dfloat(semhi,mlo)
  6456. # > semhi,mlo: Zahlwert (Bit 31 von semhi = Vorzeichen)
  6457. # < ergebnis: neues Double-Float (LISP-Objekt)
  6458. # kann GC ausl÷sen
  6459.   extern object allocate_dfloat (uint32 semhi, uint32 mlo);
  6460. #endif
  6461. # wird verwendet von LISPARIT
  6462.  
  6463. # UP, beschafft Long-Float
  6464. # allocate_lfloat(len,expo,sign)
  6465. # > uintC len: LΣnge der Mantisse (in Digits)
  6466. # > uintL expo: Exponent
  6467. # > signean sign: Vorzeichen (0 = +, -1 = -)
  6468. # < ergebnis: neues Long-Float, noch ohne Mantisse
  6469. # Ein LISP-Objekt liegt erst dann vor, wenn die Mantisse eingetragen ist!
  6470. # kann GC ausl÷sen
  6471.   extern object allocate_lfloat (uintC len, uintL expo, signean sign);
  6472. # wird verwendet von LISPARIT
  6473.  
  6474. # UP, erzeugt Bruch
  6475. # make_ratio(num,den)
  6476. # > object num: ZΣhler (mu▀ Integer /= 0 sein, relativ prim zu den)
  6477. # > object den: Nenner (mu▀ Integer > 1 sein)
  6478. # < ergebnis: Bruch
  6479. # kann GC ausl÷sen
  6480.   extern object make_ratio (object num, object den);
  6481. # wird verwendet von LISPARIT
  6482.  
  6483. # UP, erzeugt komplexe Zahl
  6484. # make_complex(real,imag)
  6485. # > real: Realteil (mu▀ reelle Zahl sein)
  6486. # > imag: ImaginΣrteil (mu▀ reelle Zahl /= Fixnum 0 sein)
  6487. # < ergebnis: komplexe Zahl
  6488. # kann GC ausl÷sen
  6489.   extern object make_complex (object real, object imag);
  6490. # wird verwendet von LISPARIT
  6491.  
  6492. # UP: Liefert einen LISP-String mit vorgegebenem Inhalt.
  6493. # make_string(charptr,len)
  6494. # > uintB* charptr: Adresse einer Zeichenfolge
  6495. # > uintL len: LΣnge der Zeichenfolge
  6496. # < ergebnis: Simple-String mit den len Zeichen ab charptr als Inhalt
  6497. # kann GC ausl÷sen
  6498.   extern object make_string (const uintB* charptr, uintL len);
  6499. # wird verwendet von PATHNAME, LISPARIT
  6500.  
  6501. # UP: Liefert die LΣnge eines ASCIZ-Strings.
  6502. # asciz_length(asciz)
  6503. # > char* asciz: ASCIZ-String
  6504. #       (Adresse einer durch ein Nullbyte abgeschlossenen Zeichenfolge)
  6505. # < ergebnis: LΣnge der Zeichenfolge (ohne Nullbyte)
  6506.   extern uintL asciz_length (const char * asciz);
  6507. # wird verwendet von SPVW
  6508.  
  6509. # UP: Vergleicht zwei ASCIZ-Strings.
  6510. # asciz_equal(asciz1,asciz2)
  6511. # > char* asciz1: erster ASCIZ-String
  6512. # > char* asciz2: zweiter ASCIZ-String
  6513. # < ergebnis: TRUE falls die Zeichenfolgen gleich sind
  6514.   extern boolean asciz_equal (const char * asciz1, const char * asciz2);
  6515. # wird verwendet von STREAM
  6516.  
  6517. #if defined(GNU) && (SAFETY < 2)
  6518.   #if (__GNUC__ >= 2) # GCC 2 hat __builtin_strlen und __builtin_strcmp
  6519.     #define asciz_length(a)  ((uintL)__builtin_strlen(a))
  6520.     #if !defined(AMIGAOS) # der Amiga-GCC2 macht da aber eine Ausnahme
  6521.       #define asciz_equal(a1,a2)  (__builtin_strcmp(a1,a2)==0)
  6522.     #endif
  6523.   #endif
  6524. #endif
  6525. #ifndef asciz_length
  6526.   #ifdef HAVE_SAVED_STACK
  6527.     # Kann nicht strlen() statt asciz_length() benutzen, denn das wⁿrde
  6528.     # ein begin_system_call()/end_system_call() erfordern.
  6529.   #else
  6530.     # Gehen wir davon aus, da▀ strlen() effizient implementiert ist.
  6531.     #ifdef STDC_HEADERS
  6532.       #include <string.h> # deklariert strlen()
  6533.     #endif
  6534.     #ifdef RETSTRLENTYPE # wenn strlen() kein Macro ist
  6535.       extern RETSTRLENTYPE strlen (STRLEN_CONST char* s);
  6536.     #endif
  6537.     #define asciz_length(a)  ((uintL)strlen(a))
  6538.   #endif
  6539. #endif
  6540. #ifndef asciz_equal
  6541.   #if 1
  6542.     # strcmp() ist vermutlich Overkill fⁿr asciz_equal().
  6543.   #else
  6544.     # Gehen wir davon aus, da▀ strcmp() es auch tut.
  6545.     #ifdef STDC_HEADERS
  6546.       #include <string.h> # deklariert strcmp()
  6547.     #else
  6548.       extern int strcmp (char* s1, char* s2);
  6549.     #endif
  6550.     #define asciz_equal(p1,p2)  (strcmp(p1,p2)==0)
  6551.   #endif
  6552. #endif
  6553.  
  6554. # UP: Wandelt einen ASCIZ-String in einen LISP-String um.
  6555. # asciz_to_string(asciz)
  6556. # > char* asciz: ASCIZ-String
  6557. #       (Adresse einer durch ein Nullbyte abgeschlossenen Zeichenfolge)
  6558. # < ergebnis: String mit der Zeichenfolge (ohne Nullbyte) als Inhalt
  6559. # kann GC ausl÷sen
  6560.   extern object asciz_to_string (const char * asciz);
  6561. # wird verwendet von SPVW/CONSTSYM, STREAM, PATHNAME, PACKAGE, GRAPH
  6562.  
  6563. # UP: Wandelt einen String in einen ASCIZ-String um.
  6564. # string_to_asciz(obj)
  6565. # > object obj: String
  6566. # < ergebnis: Simple-String mit denselben Zeichen und einem Nullbyte mehr am Schlu▀
  6567. # < TheAsciz(ergebnis): Adresse der darin enthaltenen Zeichenfolge
  6568. # kann GC ausl÷sen
  6569.   extern object string_to_asciz (object obj);
  6570.   #define TheAsciz(obj)  ((char*)(&TheSstring(obj)->data[0]))
  6571. # wird verwendet von STREAM, PATHNAME, PACKAGE, MISC
  6572.  
  6573. # UP: Liefert eine Tabelle aller ZirkularitΣten innerhalb eines Objekts.
  6574. # (Eine ZirkularitΣt ist ein in diesem Objekt enthaltenes Teil-Objekt,
  6575. # auf den es mehr als einen Zugriffsweg gibt.)
  6576. # get_circularities(obj,pr_array,pr_closure)
  6577. # > object obj: Objekt
  6578. # > boolean pr_array: Flag, ob Arrayelemente rekursiv als Teilobjekte gelten
  6579. # > boolean pr_closure: Flag, ob Closurekomponenten rekursiv als Teilobjekte gelten
  6580. # < ergebnis: T falls Stackⁿberlauf eintrat,
  6581. #             NIL falls keine ZirkularitΣten vorhanden,
  6582. #             #(0 ...) ein (n+1)-elementiger Vektor, der die Zahl 0 und die n
  6583. #                      ZirkularitΣten als Elemente enthΣlt, n>0.
  6584. # kann GC ausl÷sen
  6585.   extern object get_circularities (object obj, boolean pr_array, boolean pr_closure);
  6586. # wird verwendet von IO
  6587.  
  6588. # UP: Entflicht #n# - Referenzen im Objekt *ptr mit Hilfe der Aliste alist.
  6589. # > *ptr : Objekt
  6590. # > alist : Aliste (Read-Label --> zu substituierendes Objekt)
  6591. # < *ptr : Objekt mit entflochtenen Referenzen
  6592. # < ergebnis : fehlerhafte Referenz oder nullobj falls alles OK
  6593.   extern object subst_circ (object* ptr, object alist);
  6594. # wird verwendet von IO
  6595.  
  6596. # Break-Semaphoren
  6597. # Solange eine Break-Semaphore gesetzt ist, kann das Lisp-Programm nicht
  6598. # unterbrochen werden. Zweck:
  6599. # - Sicherstellung von Konsistenzen,
  6600. # - Nicht reentrante Datenstrukturen (wie z.B. DTA_buffer) k÷nnen nicht
  6601. #   rekursiv verwendet werden.
  6602.   typedef union {uintB einzeln[4]; uintL gesamt; } break_sems_;
  6603.   extern break_sems_ break_sems;
  6604.   #define break_sem_1  break_sems.einzeln[0]
  6605.   #define break_sem_2  break_sems.einzeln[1]
  6606.   #define break_sem_3  break_sems.einzeln[2]
  6607.   #define break_sem_4  break_sems.einzeln[3]
  6608. # wird verwendet von SPVW, Macros set/clr_break_sem_1/2/3/4
  6609.  
  6610. # Setzt Break-Semaphore 1 und schⁿtzt so gegen Unterbrechungen
  6611. # set_break_sem_1();
  6612.   #define set_break_sem_1()  (break_sem_1 = 1)
  6613. # wird verwendet von SPVW, ARRAY
  6614.  
  6615. # L÷scht Break-Semaphore 1 und gibt so Unterbrechungen wieder frei
  6616. # clr_break_sem_1();
  6617.   #define clr_break_sem_1()  (break_sem_1 = 0)
  6618. # wird verwendet von SPVW, ARRAY
  6619.  
  6620. # Setzt Break-Semaphore 2 und schⁿtzt so gegen Unterbrechungen
  6621. # set_break_sem_2();
  6622.   #define set_break_sem_2()  (break_sem_2 = 1)
  6623. # wird verwendet von PACKAGE, HASHTABL
  6624.  
  6625. # L÷scht Break-Semaphore 2 und gibt so Unterbrechungen wieder frei
  6626. # clr_break_sem_2();
  6627.   #define clr_break_sem_2()  (break_sem_2 = 0)
  6628. # wird verwendet von PACKAGE, HASHTABL
  6629.  
  6630. # Setzt Break-Semaphore 3 und schⁿtzt so gegen Unterbrechungen
  6631. # set_break_sem_3();
  6632.   #define set_break_sem_3()  (break_sem_3 = 1)
  6633. # wird verwendet von PACKAGE
  6634.  
  6635. # L÷scht Break-Semaphore 3 und gibt so Unterbrechungen wieder frei
  6636. # clr_break_sem_3();
  6637.   #define clr_break_sem_3()  (break_sem_3 = 0)
  6638. # wird verwendet von PACKAGE
  6639.  
  6640. # Setzt Break-Semaphore 4 und schⁿtzt so gegen Unterbrechungen
  6641. # set_break_sem_4();
  6642.   #define set_break_sem_4()  (break_sem_4 = 1)
  6643. # wird verwendet von STREAM, PATHNAME
  6644.  
  6645. # L÷scht Break-Semaphore 4 und gibt so Unterbrechungen wieder frei
  6646. # clr_break_sem_4();
  6647.   #define clr_break_sem_4()  (break_sem_4 = 0)
  6648. # wird verwendet von STREAM, PATHNAME
  6649.  
  6650. # Typ, der fⁿr 'Internal Time' verwendet wird:
  6651. #ifdef TIME_1
  6652.   typedef uintL internal_time;      # abgegriffener Wert des Tick-ZΣhlers
  6653.   #ifdef TIME_ATARI
  6654.     #define ticks_per_second  200UL   # 1 Tick = 1/200 sec, 200Hz-ZΣhler
  6655.   #endif
  6656.   #ifdef TIME_AMIGAOS
  6657.     #define ticks_per_second  50UL    # 1 Tick = 1/50 sec, 50Hz-ZΣhler
  6658.   #endif
  6659.   #ifdef TIME_MSDOS
  6660.     #define ticks_per_second  100UL   # 1 Tick = 1/100 sec, 100Hz-ZΣhler
  6661.   #endif
  6662.   #if defined(TIME_UNIX_TIMES) || defined(TIME_RISCOS)
  6663.     #define ticks_per_second  CLK_TCK
  6664.   #endif
  6665.   #define sub_internal_time(x,y, z)  z = (x) - (y)
  6666.   #define add_internal_time(x,y, z)  z = (x) + (y)
  6667. #endif
  6668. #ifdef TIME_2
  6669.   #ifdef TIME_UNIX
  6670.     typedef struct { uintL tv_sec;    # ganze Sekunden seit 1.1.1970 00:00 GMT,
  6671.                                       # Ein 'uintL' fⁿr tv_sec reicht fⁿr 136 Jahre.
  6672.                      uintL tv_usec;   # zusΣtzliche Mikrosekunden
  6673.                    }
  6674.             internal_time;
  6675.     #define ticks_per_second  1000000UL  # 1 Tick = 1 ╡sec
  6676.   #endif
  6677.   #define sub_internal_time(x,y, z)  # z:=x-y  \
  6678.     { (z).tv_sec = (x).tv_sec - (y).tv_sec;                   \
  6679.       if ((x).tv_usec < (y).tv_usec)                          \
  6680.         { (x).tv_usec += ticks_per_second; (z).tv_sec -= 1; } \
  6681.       (z).tv_usec = (x).tv_usec - (y).tv_usec;                \
  6682.     }
  6683.   #define add_internal_time(x,y, z)  # z:=x+y  \
  6684.     { (z).tv_sec = (x).tv_sec + (y).tv_sec;                   \
  6685.       (z).tv_usec = (x).tv_usec + (y).tv_usec;                \
  6686.       if ((z).tv_usec >= ticks_per_second)                    \
  6687.         { (z).tv_usec -= ticks_per_second; (z).tv_sec += 1; } \
  6688.     }
  6689. #endif
  6690.  
  6691. #ifndef HAVE_RUN_TIME
  6692.  
  6693. # UP: HΣlt die Run-Time-Stoppuhr an
  6694. # run_time_stop();
  6695.   extern void run_time_stop (void);
  6696. # wird verwendet von STREAM
  6697.  
  6698. # UP: LΣ▀t die Run-Time-Stoppuhr weiterlaufen
  6699. # run_time_restart();
  6700.   extern void run_time_restart (void);
  6701. # wird verwendet von STREAM
  6702.  
  6703. #else
  6704.  
  6705. # Man braucht keine Run-Time-Stoppuhr
  6706.   #define run_time_stop()
  6707.   #define run_time_restart()
  6708.  
  6709. #endif
  6710.  
  6711. #ifdef TIME_1
  6712.  
  6713. # UP: Liefert die Real-Time
  6714. # get_real_time()
  6715. # < uintL ergebnis: Zeit seit LISP-System-Start (in 1/200 sec bzw. in 1/50 sec bzw. in 1/100 sec bzw. in 1/CLK_TCK sec)
  6716.   extern uintL get_real_time (void);
  6717. # wird verwendet von MISC, STREAM, LISPARIT
  6718.  
  6719. #endif
  6720.  
  6721. #ifdef TIME_2
  6722.  
  6723. # UP: Liefert die Real-Time
  6724. # get_real_time()
  6725. # < internal_time* ergebnis: absolute Zeit
  6726.   extern internal_time* get_real_time (void);
  6727. # wird verwendet von MISC, LISPARIT
  6728.  
  6729. #endif
  6730.  
  6731. # UP: Liefert die Run-Time
  6732. # get_running_times(×core);
  6733. # < timescore.runtime:  Run-Time seit LISP-System-Start (in Ticks)
  6734. # < timescore.realtime: Real-Time seit LISP-System-Start (in Ticks)
  6735. # < timescore.gctime:   GC-Time seit LISP-System-Start (in Ticks)
  6736. # < timescore.gccount:  Anzahl der GC's seit LISP-System-Start
  6737. # < timescore.gcfreed:  Gr÷▀e des von den GC's bisher wiederbeschafften Platzes
  6738.   typedef struct { internal_time runtime;
  6739.                    internal_time realtime;
  6740.                    internal_time gctime;
  6741.                    uintL gccount;
  6742.                    uintL2 gcfreed; }
  6743.           timescore;
  6744.   extern void get_running_times (timescore*);
  6745. # wird verwendet von MISC
  6746.  
  6747. # Zeitangabe in Decoded-Time:
  6748.   typedef struct { object Sekunden, Minuten, Stunden, Tag, Monat, Jahr; }
  6749.           decoded_time;
  6750.  
  6751. #if defined(ATARI) || defined(MSDOS)
  6752. # UP: Wandelt das Atari-Zeitformat in Decoded-Time um.
  6753. # convert_time(time,date,&timepoint);
  6754. # > uintW time: Uhrzeit
  6755. #         Als Word: Bits 15..11: Stunde in {0,...,23},
  6756. #                   Bits 10..5:  Minute in {0,...,59},
  6757. #                   Bits 4..0:   Sekunde/2 in {0,...,29}.
  6758. # > uintW date: Datum
  6759. #         Als Word: Bits 15..9: Jahr-1980 in {0,...,119},
  6760. #                   Bits 8..5:  Monat in {1,...,12},
  6761. #                   Bits 4..0:  Tag in {1,...,31}.
  6762. # < timepoint.Sekunden, timepoint.Minuten, timepoint.Stunden,
  6763. #   timepoint.Tag, timepoint.Monat, timepoint.Jahr, jeweils als Fixnums
  6764.   extern void convert_timedate (uintW time, uintW date, decoded_time* timepoint);
  6765. # wird verwendet von PATHNAME
  6766. #endif
  6767. #ifdef AMIGAOS
  6768. # UP: Wandelt das Amiga-Zeitformat in Decoded-Time um.
  6769. # convert_time(&datestamp,&timepoint);
  6770. # > struct DateStamp datestamp: Uhrzeit
  6771. #          datestamp.ds_Days   : Anzahl Tage seit 1.1.1978
  6772. #          datestamp.ds_Minute : Anzahl Minuten seit 00:00 des Tages
  6773. #          datestamp.ds_Tick   : Anzahl Ticks seit Beginn der Minute
  6774. # < timepoint.Sekunden, timepoint.Minuten, timepoint.Stunden,
  6775. #   timepoint.Tag, timepoint.Monat, timepoint.Jahr, jeweils als Fixnums
  6776.   extern void convert_time (struct DateStamp * datestamp, decoded_time* timepoint);
  6777. # wird verwendet von PATHNAME
  6778. #endif
  6779. #if defined(UNIX) || defined(MSDOS)
  6780. # UP: Wandelt das System-Zeitformat in Decoded-Time um.
  6781. # convert_time(&time,&timepoint);
  6782. # > time_t time: Zeit im System-Zeitformat
  6783. # < timepoint.Sekunden, timepoint.Minuten, timepoint.Stunden,
  6784. #   timepoint.Tag, timepoint.Monat, timepoint.Jahr, jeweils als Fixnums
  6785.   extern void convert_time (time_t* time, decoded_time* timepoint);
  6786. # wird verwendet von PATHNAME
  6787. #endif
  6788.  
  6789. # Flag, ob SYS::READ-FORM sich ILISP-kompatibel verhalten soll:
  6790.   extern boolean ilisp_mode;
  6791.  
  6792. # Liefert die Gr÷▀e des von den LISP-Objekten belegten Platzes.
  6793.   extern uintL used_space (void);
  6794. # wird verwendet von MISC, DEBUG
  6795.  
  6796. # Liefert die Gr÷▀e des fⁿr LISP-Objekte noch verfⁿgbaren Platzes.
  6797.   extern uintL free_space (void);
  6798. # wird verwendet von DEBUG
  6799.  
  6800. # UP, speichert Speicherabbild auf Diskette
  6801. # savemem(stream);
  6802. # > object stream: offener File-Output-Stream, wird geschlossen
  6803. # kann GC ausl÷sen
  6804.   extern void savemem (object stream);
  6805. # wird verwendet von PATHNAME
  6806.  
  6807. # UP: Ruft ein Fremdprogramm auf.
  6808. # execute(memneed)
  6809. # > -(STACK): Filename des Fremdprogramms, ein Simple-ASCIZ-String
  6810. # > -(STACK): Argumente (Command Tail), ein Simple-String
  6811. # > uintL memneed: Fⁿrs Fremdprogramm zu reservierende Byte-Zahl (gerade)
  6812. # < sintL ergebnis : Falls negativ, Fehlernummer.
  6813. #                    Sonst Returncode des aufgerufenen Programms.
  6814. # STACK wird aufgerΣumt
  6815. # kann GC ausl÷sen
  6816.   extern sintL execute (uintL memneed);
  6817. # wird verwendet von PATHNAME
  6818.  
  6819.  
  6820. # Deklaration der FSUBRs.
  6821. # Als C-Funktionen: C_name, vom Typ fsubr_function (keine Argumente, kein Wert)
  6822.  
  6823. # C-Funktionen sichtbar machen:
  6824.   #define LISPSPECFORM  LISPSPECFORM_A
  6825.   #include "fsubr.c"
  6826.   #undef LISPSPECFORM
  6827. # wird verwendet von
  6828.  
  6829. # Fsubr-Tabelle sichtbar machen:
  6830.   #define LISPSPECFORM  LISPSPECFORM_C
  6831.   extern struct fsubr_tab_ {
  6832.                              #include "fsubr.c"
  6833.                            }
  6834.          fsubr_tab;
  6835.   #undef LISPSPECFORM
  6836. # wird verwendet von CONTROL, SPVW
  6837.  
  6838.  
  6839. # Deklaration der SUBR-Tabelle.
  6840. # Als C-Funktionen: C_name
  6841. # vom Typ subr_norest_function (keine Argumente, kein Wert)
  6842. # bzw. subr_rest_function (zwei Argumente, kein Wert):
  6843.   typedef Values subr_norest_function (void);
  6844.   typedef Values subr_rest_function (reg4 uintC argcount, reg3 object* rest_args_pointer);
  6845.  
  6846. # Als LISP-Subr:    L(name)
  6847.  
  6848. # C-Funktionen sichtbar machen:
  6849.   #define LISPFUN  LISPFUN_A
  6850.   #include "subr.c"
  6851.   #undef LISPFUN
  6852. # wird verwendet von
  6853.  
  6854. # Subr-Tabelle sichtbar machen:
  6855.   #define LISPFUN  LISPFUN_C
  6856.   extern struct subr_tab_ {
  6857.                             #include "subr.c"
  6858.                           }
  6859.          subr_tab_data;
  6860.   #undef LISPFUN
  6861. # wird verwendet von Macro L
  6862.  
  6863. # Abkⁿrzung fⁿrs LISP-Subr mit einem gegebenen Namen: L(name)
  6864.   #if !defined(MAP_MEMORY)
  6865.     #define subr_tab  subr_tab_data
  6866.     #define subr_tab_ptr_as_object(subr_addr)  (type_constpointer_object(subr_type,subr_addr))
  6867.     #define L(name)  subr_tab_ptr_as_object(&subr_tab.D_##name)
  6868.   #else
  6869.     #define subr_tab_addr  ((struct subr_tab_ *)type_constpointer_object(subr_type,0))
  6870.     #define subr_tab  (*subr_tab_addr)
  6871.     #define subr_tab_ptr_as_object(subr_addr)  ((object)(subr_addr))
  6872.     #define L(name)  subr_tab_ptr_as_object(&subr_tab_addr->D_##name)
  6873.   #endif
  6874. # wird verwendet von allen Modulen
  6875.  
  6876.  
  6877. # Pseudofunktionen sind Adressen von C-Funktionen, die direkt angesprungen werden k÷nnen.
  6878. # Fⁿr SAVEMEM/LOADMEM gibt es eine Tabelle aller Pseudofunktionen.
  6879.   typedef object pseudofun_(); # C-Funktion mit Objekt als Ergebnis
  6880.   typedef pseudofun_ *  Pseudofun; # Pointer auf so eine Funktion
  6881.  
  6882. # Deklaration der Pseudofunktionen-Tabelle:
  6883.   #ifdef STRM_WR_SS
  6884.     #define PSEUDOFUNSS(name)  PSEUDOFUN(name)
  6885.   #else
  6886.     #define PSEUDOFUNSS(name)
  6887.   #endif
  6888.   #define PSEUDOFUN  PSEUDOFUN_A
  6889.   extern struct pseudofun_tab_ {
  6890.                                  #include "pseudofun.c"
  6891.                                }
  6892.          pseudofun_tab;
  6893.   #undef PSEUDOFUN
  6894. # wird verwendet von STREAM, SPVW
  6895.  
  6896.  
  6897. # Deklaration der Symbol-Tabelle:
  6898.   #define LISPSYM  LISPSYM_A
  6899.   extern struct symbol_tab_ {
  6900.                               #include "constsym.c"
  6901.                             }
  6902.          symbol_tab_data;
  6903.   #undef LISPSYM
  6904. # wird verwendet von Macro S
  6905.  
  6906. # Abkⁿrzung fⁿr LISP-Symbol mit einem gegebenen Namen: S(name)
  6907.   #define S(name)  S_help_(S_##name)
  6908.   #if !defined(MAP_MEMORY)
  6909.     #define symbol_tab  symbol_tab_data
  6910.     #define S_help_(name)  (type_constpointer_object(symbol_type,&symbol_tab.name))
  6911.   #else
  6912.     #define symbol_tab_addr ((struct symbol_tab_ *)type_constpointer_object(symbol_type,0))
  6913.     #define symbol_tab  (*symbol_tab_addr)
  6914.     #define S_help_(name)  ((object)(&symbol_tab_addr->name))
  6915.     #if 0 # Manche Compiler erlauben obigen Ausdruck
  6916.           # - obwohl eine 'constant expression' -
  6917.           # nicht als Initialisierer von static-Variablen.
  6918.           # Wir mⁿssen nachhelfen:
  6919.       #undef S_help_
  6920.       #define S_help_(name)  ((object)( (char*)(&((struct symbol_tab_ *)0)->name) + (uintP)symbol_tab_addr ))
  6921.     #endif
  6922.   #endif
  6923. # wird verwendet von allen Modulen
  6924.  
  6925. #define NIL  S(nil)
  6926. #define T    S(t)
  6927.  
  6928. # Der Macro NIL_IS_CONSTANT gibt an, ob NIL vom C-Compiler als
  6929. # 'constant expression' anerkannt wird. Wenn ja, k÷nnen die Tabellen
  6930. # zum gro▀en Teil bereits vom C-Compiler initialisiert werden.
  6931.   #if (oint_addr_shift==0)
  6932.     #define NIL_IS_CONSTANT  TRUE
  6933.   #else
  6934.     #define NIL_IS_CONSTANT  FALSE
  6935.   #endif
  6936.  
  6937. # Deklaration der Tabelle der sonstigen festen Objekte:
  6938.   #define LISPOBJ  LISPOBJ_A
  6939.   extern struct object_tab_ {
  6940.                               #include "constobj.c"
  6941.                             }
  6942.          object_tab;
  6943.   #undef LISPOBJ
  6944. # wird verwendet von Macro O
  6945.  
  6946. # Abkⁿrzung fⁿr sonstiges LISP-Objekt mit einem gegebenem Namen:
  6947.   #define O(name)  (object_tab.name)
  6948.  
  6949. # Abkⁿrzung fⁿr von language abhΣngiges LISP-Objekt mit einem gegebenem Namen:
  6950.   #ifdef LANGUAGE_STATIC
  6951.     #define OL(name)  O(name)
  6952.   #else
  6953.     #define OL(name)  ((&O(name))[language])
  6954.   #endif
  6955.  
  6956. #if defined(GENERATIONAL_GC) && defined(SPVW_MIXED)
  6957. # handle_fault_range(PROT_READ,start,end) macht einen Adre▀bereich lesbar,
  6958. # handle_fault_range(PROT_READ_WRITE,start,end) macht ihn schreibbar.
  6959. extern boolean handle_fault_range (int prot, aint start_address, aint end_address);
  6960. #endif
  6961.  
  6962.  
  6963. # ####################### MODBIBL zu EVAL.D ############################## #
  6964.  
  6965. # Anzahl der externen Module:
  6966.   extern uintC module_count;
  6967.  
  6968. # Daten fⁿr die Initialisierung der subr_tab eines Moduls:
  6969.   typedef struct { char* packname; # Name der Home-Package des Symbols oder NULL
  6970.                    char* symname; # Name des Symbols
  6971.                  }
  6972.           subr_initdata;
  6973.  
  6974. # Tabelle bzw. Liste der Module:
  6975.   typedef struct module_
  6976.                  { char* name; # Name
  6977.                    subr_* stab; uintC* stab_size; # eine eigene subr_tab
  6978.                    object* otab; uintC* otab_size; # eine eigene object_tab
  6979.                    boolean initialized;
  6980.                    # Daten zur Initialisierung:
  6981.                    subr_initdata* stab_initdata;
  6982.                    # Funktion zur Initialisierung
  6983.                    void (*initfunction) _ARGS((struct module_ *));
  6984.                    #ifdef DYNAMIC_MODULES
  6985.                    struct module_ * next; # verkettete Liste
  6986.                    #endif
  6987.                  }
  6988.           module_;
  6989.   #ifdef DYNAMIC_MODULES
  6990.     BEGIN_DECLS
  6991.     extern void add_module (module_ * new_module);
  6992.     END_DECLS
  6993.   #else
  6994.     extern module_ modules[]; # 1+module_count EintrΣge, dann ein leerer Eintrag
  6995.   #endif
  6996.  
  6997.  
  6998. # ####################### EVALBIBL zu EVAL.D ############################## #
  6999.  
  7000. /*
  7001.  
  7002. Spezifikationen fⁿr den Evaluator
  7003. #################################
  7004.  
  7005. SUBRs und FSUBRs
  7006. ================
  7007.  
  7008. Sie werden konstruiert mit
  7009.   LISPFUN             fⁿr allgemeine LISP-Funktionen,
  7010.   LISPFUNN            fⁿr normale LISP-Funktionen (nur required-Parameter),
  7011.   LISPSPECFORM        fⁿr Special-Forms (FSUBRs).
  7012. Beachte, da▀ SUBRs mit KEY_ANZ=0 vom Evaluator als SUBRs ohne Keyword-
  7013. Parameter betrachtet werden (was zur Folge hat, da▀ in diesem Fall das
  7014. ALLOW_FLAG bedeutungslos ist und kein Keyword, auch nicht :ALLOW-OTHER-KEYS,
  7015. akzeptiert wird)!
  7016.  
  7017. Werte
  7018. =====
  7019.  
  7020. Folgendes Format wird fⁿr die ▄bergabe von multiple values verwendet:
  7021. value1 enthΣlt den ersten Wert (NIL falls keine Werte).
  7022. mv_count enthΣlt die Anzahl der Werte.
  7023. Falls mindestens ein Wert vorhanden:   value1 = erster Wert.
  7024. Falls mindestens zwei Werte vorhanden: value2 = zweiter Wert.
  7025. Falls mindestens drei Werte vorhanden: value3 = dritter Wert.
  7026. Alle Werte sind in mv_space abgelegt.
  7027. Empfohlene Befehle zur Rⁿckgabe (an den Aufrufer) von
  7028.   0 Werten:   value1=NIL; mv_count=0;
  7029.   1 Wert:     value1=...; mv_count=1;
  7030.   2 Werten:   value1=...; value2=...; mv_count=2;
  7031.   3 Werten:   value1=...; value2=...; value3=...; mv_count=3;
  7032.   mehr als 3 Werten:
  7033.               if (Wertezahl >= mv_limit) goto fehler_zuviele_werte;
  7034.               Werte der Reihe nach auf den STACK legen
  7035.               STACK_to_mv(Wertezahl);
  7036.  
  7037. Parameterⁿbergabe an SUBRs
  7038. ==========================
  7039.  
  7040. Die Argumente werden auf dem LISP-Stack ⁿbergeben, dabei liegt das erste
  7041. Argument zuoberst. Zuerst kommen die required-Argumente, dann die optionalen
  7042. Argumente (jeweils #UNBOUND, falls nicht angegeben), dann die
  7043. Keyword-Argumente (wieder jeweils #UNBOUND, falls nicht angegeben).
  7044. In subr_self befindet sich das SUBR-Objekt.
  7045. Ist kein &REST-Argument vorgesehen, so ist dies alles. Ist &REST-Argument
  7046. vorgesehen, so folgen im Stack alle weiteren Argumente (nach den optionalen)
  7047. einzeln, und es werden ⁿbergeben: die Anzahl dieser Argumente und ein Pointer
  7048. ⁿbers erste dieser Argumente. (Dann ist die Anzahl der LISP-Objekte auf dem
  7049. Stack also nicht immer dieselbe!)
  7050. Beim Rⁿcksprung mⁿssen alle Argumente vom LISP-Stack entfernt sein
  7051. (d.h. z.B. bei SUBRs mit &REST: der Stackpointer STACK mu▀ den Wert
  7052. args_pointer = rest_args_pointer STACKop (feste Argumentezahl)
  7053. = Pointer ⁿbers erste Argument ⁿberhaupt) haben, und mv_count/mv_space
  7054. mu▀ die Werte enthalten.
  7055.  
  7056. Parameterⁿbergabe an FSUBRs
  7057. ===========================
  7058.  
  7059. Die Parameter werden auf dem LISP-Stack ⁿbergeben, dabei liegt der erste
  7060. Parameter zuoberst. Zuerst kommen die required-Parameter, dann die optionalen
  7061. Parameter (#UNBOUND, falls nicht angegeben), dann - falls Body-Flag wahr -
  7062. der gesamte restliche Body (meist eine Liste).
  7063. Die Anzahl der auf dem LISP-Stack liegenden Objekte ist also immer dieselbe,
  7064. nΣmlich  reqParameterZahl + optParameterZahl + (0 oder 1 falls Body-Flag).
  7065. Beim Aufruf enthΣlt subr_self das FSUBR-Objekt, und die gesamte Form befindet
  7066. sich im EVAL-Frame, direkt ⁿber den Parametern.
  7067. Beim Rⁿcksprung mⁿssen alle Parameter vom LISP-Stack entfernt sein
  7068. (d.h. der Stackpointer STACK mu▀ um Objektezahl erh÷ht worden sein),
  7069. und mv_count/mv_space mu▀ die Werte enthalten.
  7070.  
  7071. Environments
  7072. ============
  7073.  
  7074. Allgemeines
  7075. -----------
  7076. Das lexikalische Environment ist aufgeteilt in 5 Komponenten:
  7077.   - Das Variablen-Environment (VAR_ENV),
  7078.   - Das Funktions- und Macro-Environment (FUN_ENV),
  7079.   - Das Block-Environment (BLOCK_ENV),
  7080.   - Das Tagbody-Environment (GO_ENV),
  7081.   - Das Deklarations-Environment (DECL_ENV).
  7082. Das Environment wird in 5 "globalen Variablen" gehalten. Bei VerΣnderung
  7083. wird es mit speziellen Frames dynamisch gebunden.
  7084. An SYM_FUNCTION, MACROEXP, MACROEXP0, PARSE_DD wird ein einzelnes
  7085. Funktions- und Macro-Environment ⁿbergeben.
  7086. GET_CLOSURE erwartet einen Pointer auf alle Environments en bloc: A3 mit
  7087. VAR_(A3)=VAR_ENV, FUN_(A3)=FUN_ENV, BLOCK_(A3)=BLOCK_ENV, GO_(A3)=GO_ENV,
  7088. DECL_(A3)=DECL_ENV.
  7089.  
  7090. Das Variablen-Environment
  7091. -------------------------
  7092. Es enthΣlt die lokalen Variablenbindungen.
  7093. Ein Variablen-Environment ist gegeben durch einen Pointer auf einen
  7094. Variablenbindungs-Frame oder durch NIL (das bedeutet ein leeres lexikalisches
  7095. Environment) oder durch einen Vektor folgenden Aufbaus:
  7096. Der Vektor enthΣlt n Bindungen und hat die LΣnge 2n+1. Die Elemente sind
  7097. n-mal jeweils Variable (ein Symbol) und zugeh÷riger Wert (als "Wert" kann
  7098. auch #<SPECDECL> auftreten, dann ist die Variable dynamisch zu referenzieren)
  7099. und als letztes Element das VorgΣnger-Environment.
  7100.  
  7101. Das Funktions- und Macro-Environment
  7102. ------------------------------------
  7103. Es enthΣlt die lokalen Funktions- und Macro-Definitionen.
  7104. Ein Funktions- und Macro-Environment ist gegeben durch einen Pointer auf
  7105. einen Funktions- oder Macrobindungs-Frame oder durch NIL (das bedeutet ein
  7106. leeres lexikalisches Environment) oder durch einen Vektor folgenden Aufbaus:
  7107. Der Vektor enthΣlt n Bindungen und hat die LΣnge 2n+1. Die Elemente sind
  7108. n-mal jeweils Funktionsname (ein Symbol) und zugeh÷rige Definition (eine
  7109. Closure oder NIL oder ein Cons (SYS::MACRO . Closure) ) und als letztes
  7110. Element das VorgΣnger-Environment.
  7111.  
  7112. Das Block-Environment
  7113. ---------------------
  7114. Es enthΣlt die lexikalisch sichtbaren Block-Exitpoints.
  7115. Ein Block-Environment ist gegeben durch einen Pointer auf einen Block-Frame
  7116. oder durch eine Assoziationsliste, deren Elemente jeweils als CAR den
  7117. Block-Namen (ein Symbol) haben und als CDR entweder den Pointer auf den
  7118. zugeh÷rigen Frame oder, falls der Block bereits verlassen wurde, #DISABLED.
  7119.  
  7120. Das Tagbody-Environment
  7121. -----------------------
  7122. Es enthΣlt die lexikalisch sichtbaren Go-Marken der Tagbodys.
  7123. Ein Tagbody-Environment ist gegeben durch einen Pointer auf einen
  7124. Tagbody-Frame oder durch eine Assoziationsliste, deren Elemente jeweils als
  7125. CAR einen Vektor (mit den Go-Marken als Elementen) haben und als CDR entweder
  7126. den Pointer auf den zugeh÷rigen Frame oder, falls der Tagbody bereits
  7127. verlassen wurde, #<DISABLED>.
  7128.  
  7129. Das Deklarations-Environment
  7130. ----------------------------
  7131. Es enthΣlt die lexikalisch sichtbaren Deklarationen.
  7132. Ein Deklarations-Environment ist gegeben durch eine Liste von Declaration-
  7133. Specifiers, deren CAR jeweils entweder OPTIMIZE oder DECLARATION oder
  7134. ein benutzerdefinierter Deklarationstyp ist.
  7135.  
  7136. ▄bergabe von Environments an LISP-Funktionen
  7137. --------------------------------------------
  7138. Dafⁿr gibt es zwei Datenstrukturen:
  7139. Bei ▄bergabe als zweites Argument an Macro-Expander-Funktionen (CLTL S.
  7140. 145-146) und bei Annahme durch MACROEXPAND und MACROEXPAND-1 (CLTL S. 151)
  7141. handelt es sich nur um einen 2-elementigen Simple-Vector, bestehend aus einem
  7142. genesteten Variablen-Environment und einem genesteten Funktions- und Macro-
  7143. Environment. Dasselbe bei ▄bergabe an SYSTEM::%EXPAND-LAMBDABODY-MAIN u.Σ.
  7144. Bei ▄bergabe als zweites Argument an den Wert von *EVALHOOK* bzw. als drittes
  7145. Argument an den Wert von *APPLYHOOK* (CLTL S. 322) und bei Annahme durch
  7146. EVALHOOK und APPLYHOOK (CLTL S. 323) handelt es sich um einen 5-elementigen
  7147. Simple-Vector mit den fⁿnf Einzelkomponenten, alle genestet.
  7148.  
  7149. Frames
  7150. ======
  7151. Fⁿr den Aufruf von SUBRs, FSUBRs und compilierten Closures werden keine
  7152. Frames verwendet.
  7153. Es gibt folgende 14 Arten von Frames:
  7154.   - Environmentbindungs-Frame (ENV_FRAME),
  7155.   - APPLY-Frame (APPLY_FRAME),
  7156.   - EVAL-Frame (EVAL_FRAME),
  7157.   - dynamischer Variablenbindungs-Frame (DYNBIND_FRAME),
  7158.   - Variablenbindungs-Frame (VAR_FRAME),
  7159.   - Funktions- oder Macrobindungs-Frame (FUN_FRAME),
  7160.   - interpretierter Block-Frame (IBLOCK_FRAME),
  7161.   - compilierter Block-Frame (CBLOCK_FRAME),
  7162.   - interpretierter Tagbody-Frame (ITAGBODY_FRAME),
  7163.   - compilierter Tagbody-Frame (CTAGBODY_FRAME),
  7164.   - Catch-Frame (CATCH_FRAME),
  7165.   - Unwind-Protect-Frame (UNWIND_PROTECT_FRAME),
  7166.   - Handler-Frame (HANDLER_FRAME),
  7167.   - Driver-Frame (DRIVER_FRAME).
  7168. Zuunterst in einem Frame kommt ein Langwort, das die Frametyp-Information
  7169. und einen Pointer ⁿber den Frame (= den Wert des STACK vor Aufbau und nach
  7170. Abbau des Frame) enthΣlt.
  7171. In der Frame-Info sind die Bits
  7172.   SKIP2_BIT      gel÷scht, falls darⁿber noch ein weiteres Langwort kommt,
  7173.                    das kein LISP-Objekt ist und deswegen von der GC
  7174.                    ⁿbersprungen werden mu▀,
  7175.   EXITPOINT_BIT  gesetzt bei allen au▀er VAR und FUN,
  7176.   NESTED_BIT     bei IBLOCK und ITAGBODY gesetzt, wenn Exitpoint bzw.
  7177.                    Go-Marken bereits in eine Aliste gesteckt wurden.
  7178. Die Normalwerte fⁿr die Frametyp-Info-Bytes sind ENVxx_FRAME_INFO,
  7179. APPLY_FRAME_INFO, EVAL_FRAME_INFO, VAR_FRAME_INFO, FUN_FRAME_INFO,
  7180. IBLOCK_FRAME_INFO, CBLOCK_FRAME_INFO, ITAGBODY_FRAME_INFO, CTAGBODY_FRAME_INFO,
  7181. CATCH_FRAME_INFO, UNWIND_PROTECT_FRAME_INFO, DRIVER_FRAME_INFO.
  7182. Die Routine, die in (SP).L mit SP=SP_(STACK) steht (bei IBLOCK-, CBLOCK-,
  7183. ITAGBODY-, CTAGBODY-, CATCH-, UNWIND-PROTECT-Frames), wird
  7184. angesprungen durch   MOVE.L SP_(STACK),SP ! RTS  .
  7185. Bei DRIVER-Frames durch   MOVE.L SP_(STACK),SP ! MOVE.L (SP),-(SP) ! RTS  .
  7186. In der portablen C-Version steht in SP_(STACK) ein Pointer auf einen
  7187. setjmp/longjmp-Buffer.
  7188.  
  7189. Environmentbindungs-Frames
  7190. --------------------------
  7191. Sie enthalten dynamische Bindungen von maximal 5 Environments.
  7192. Frame-Info ist ENVxx_FRAME_INFO (xx je nachdem, welche der Environments hier
  7193. gebunden sind). Aufbau:
  7194.     Offset        Stack-Inhalt
  7195.   20/16/12/8/4  [alter Wert von DECL_ENV]
  7196.   16/12/8/4     [alter Wert von GO_ENV]
  7197.   12/8/4        [alter Wert von BLOCK_ENV]
  7198.   8/4           [alter Wert von FUN_ENV]
  7199.   4             [alter Wert von VAR_ENV]
  7200.   0             Frame-Info; Pointer ⁿber Frame
  7201. Im einzelnen:
  7202. ENV1V_frame    fⁿr 1 VAR_ENV
  7203. ENV1F_frame    fⁿr 1 FUN_ENV
  7204. ENV1B_frame    fⁿr 1 BLOCK_ENV
  7205. ENV1G_frame    fⁿr 1 GO_ENV
  7206. ENV1D_frame    fⁿr 1 DECL_ENV
  7207. ENV2VD_frame   fⁿr 1 VAR_ENV und 1 DECL_ENV
  7208. ENV5_frame     fⁿr alle 5 Environments
  7209.  
  7210. APPLY-Frames
  7211. ------------
  7212. Sie werden erzeugt bei jedem Aufruf (APPLY oder FUNCALL) einer interpretierten
  7213. Closure.
  7214. Aufbau:
  7215.   Offset     Stack-Inhalt
  7216.   4n+12
  7217.   4n+8      Argument 1
  7218.   ...
  7219.   12        Argument n
  7220.   8         Funktion, die gerade aufgerufen wird
  7221.   4         SP
  7222.   0         Frame-Info; Pointer ⁿber Frame
  7223. SP ist ein Pointer in den Programmstack. Rⁿcksprung zu (SP).L nach Aufl÷sung
  7224. des APPLY-Frames gibt den Inhalt von A0/... als Werte der Form zurⁿck.
  7225. Die Frame-Info hat den Wert APPLY_FRAME_INFO oder TRAPPED_APPLY_FRAME_INFO.
  7226.  
  7227. EVAL-Frames
  7228. -----------
  7229. Sie werden erzeugt bei jedem Aufruf des EVAL-Unterprogramms.
  7230. Aufbau:
  7231.   Offset     Stack-Inhalt
  7232.   8         Form, die gerade evaluiert wird
  7233.   4         SP
  7234.   0         Frame-Info; Pointer ⁿber Frame
  7235. SP ist ein Pointer in den Programmstack. Rⁿcksprung zu (SP).L nach Aufl÷sung
  7236. des EVAL-Frames gibt den Inhalt von A0/... als Werte der Form zurⁿck.
  7237. Die Frame-Info hat den Wert EVAL_FRAME_INFO oder TRAPPED_EVAL_FRAME_INFO.
  7238.  
  7239. Dynamische Variablenbindungs-Frames
  7240. -----------------------------------
  7241. Sie binden dynamisch Symbole an Werte.
  7242. Der Aufbau eines solchen Frames mit n Bindungen ist wie folgt:
  7243.   Offset  Stack-Inhalt
  7244.   8n+4
  7245.   8n      Wert 1
  7246.   8n-4    Symbol 1
  7247.   ...     ...
  7248.   8       Wert n
  7249.   4       Symbol n
  7250.   0       Frame-Info; Pointer ⁿber Frame
  7251. Der Inhalt des Frameinfo-Bytes ist DYNBIND_FRAME_INFO.
  7252.  
  7253. Variablenbindungs-Frames
  7254. ------------------------
  7255. Sie werden erzeugt beim Anwenden von interpretierten Closures (fⁿr die in der
  7256. Lambda-Liste spezifizierten Variablenbindungen und ggfs. in den Deklarationen
  7257. angegebenen dynamischen Referenzen) und von LET und LET*, sowie von allen
  7258. Konstrukten, die implizit LET oder LET* benutzen (wie DO, DO*, PROG, PROG*,
  7259. DOLIST, DOTIMES, ...).
  7260. Der Aufbau eines Variablenbindungs-Frames mit n Bindungen ist wie folgt:
  7261. #ifndef NO_symbolflags
  7262.   Offset  Stack-Inhalt
  7263.   12+8n
  7264.   8+8n    Wert 1
  7265.   4+8n    Symbol 1
  7266.   ...     ...
  7267.   16      Wert n
  7268.   12      Symbol n
  7269.   8       NEXT_ENV
  7270.   4       m
  7271.   0       Frame-Info; Pointer ⁿber Frame
  7272. #else
  7273.   Offset  Stack-Inhalt
  7274.   12+12n
  7275.   8+12n   Wert 1
  7276.   4+12n   Symbol 1
  7277.   12n     Markierungsbits 1
  7278.   ...     ...
  7279.   20      Wert n
  7280.   16      Symbol n
  7281.   12      Markierungsbits n
  7282.   8       NEXT_ENV
  7283.   4       m
  7284.   0       Frame-Info; Pointer ⁿber Frame
  7285. #endif
  7286. Die Symbol/Wert-Paare sind dabei in der Reihenfolge numeriert und abgelegt,
  7287. in der die Bindungen aktiv werden (d.h. z.B. bei interpretierten Closures:
  7288. zuerst die dynamischen Referenzen (SPECIAL-Deklarationen), dann die required-
  7289. Parameter, dann die optionalen Parameter, dann der Rest-Parameter, dann die
  7290. Keyword-Parameter, dann die AUX-Variablen).
  7291. Die Symbole enthalten im Stack folgende Markierungsbits: ACTIVE_BIT, ist
  7292. gesetzt, wenn die Bindung aktiv ist, DYNAM_BIT ist gesetzt, wenn die Bindung
  7293. dynamisch ist. (Dynamische Referenzen sind als lexikalisch gekennzeichnet
  7294. mit dem speziellen Wert #SPECDECL!).
  7295. NEXT_ENV ist das nΣchsth÷here Variablen-Environment.
  7296. m ist ein Langwort, 0 <= m <= n, und bedeutet die Anzahl der Bindungen, die
  7297. noch nicht durch NEST-Operationen in einen Vektor gesteckt wurden. Also
  7298. sind die Symbol/Wert-Paare 1,...,n-m aktiv gewesen, inzwischen aber genestet
  7299. und deswegen im Stack (sofern es statische Bindungen waren) wieder inaktiv.
  7300. Nur noch einige der Paare n-m+1,...,n k÷nnen statisch und aktiv sein.
  7301. Der Inhalt des Frameinfo-Bytes ist VAR_FRAME_INFO.
  7302.  
  7303. Funktions- und Macrobindungs-Frames
  7304. -----------------------------------
  7305. Sie werden erzeugt von FLET und MACROLET.
  7306. Der Aufbau eines Variablenbindungs-Frames mit n Bindungen ist wie folgt:
  7307.   Offset  Stack-Inhalt
  7308.   12+8n
  7309.   8+8n    Wert 1
  7310.   4+8n    Symbol 1
  7311.   ...     ...
  7312.   16      Wert n
  7313.   12      Symbol n
  7314.   8       NEXT_ENV
  7315.   4       m
  7316.   0       Frame-Info; Pointer ⁿber Frame
  7317. NEXT_ENV ist das nΣchsth÷here Funktions-Environment.
  7318. m ist ein Langwort, 0 <= m <= n, und bedeutet die Anzahl der Bindungen, die
  7319. noch nicht durch NEST-Operationen in einen Vektor gesteckt wurden. Also sind
  7320. die Symbol/Wert-Paare 1,...,n-m aktiv gewesen, inzwischen aber genestet und
  7321. deswegen im Stack wieder inaktiv. Nur noch die Paare n-m+1,...,n sind aktiv.
  7322. Markierungsbits werden hier im Gegensatz zu den Variablenbindungs-Frames
  7323. nicht ben÷tigt.
  7324. Alle Werte sind Closures oder Conses (SYSTEM::MACRO . Closure).
  7325. Der Inhalt des Frameinfo-Bytes ist FUN_FRAME_INFO.
  7326.  
  7327. Interpretierte Block-Frames
  7328. ---------------------------
  7329. Sie werden erzeugt von BLOCK und allen Konstrukten, die ein implizites BLOCK
  7330. enthalten (z.B. DO, DO*, LOOP, PROG, PROG*, ...). Der Aufbau ist folgender:
  7331.   Offset  Stack-Inhalt
  7332.   16
  7333.   12       NAME
  7334.   8        NEXT_ENV
  7335.   4        SP
  7336.   0        Frame-Info; Pointer ⁿber Frame
  7337. NAME ist der Name des Blocks. NEXT_ENV ist das nΣchsth÷here Block-Environment.
  7338. SP ist ein Pointer in den Programmstack, (SP).L ist eine Routine, die den
  7339. Block-Frame aufl÷st und den Block mit den Werten A0-A2/... verlΣ▀t.
  7340. Frame-Info ist IBLOCK_FRAME_INFO, evtl. mit gesetztem NESTED_BIT (dann zeigt
  7341. NEXT_ENV auf eine Aliste, deren erstes Element das Paar (NAME . <Framepointer>)
  7342. ist, weil der Block noch nicht DISABLED ist).
  7343.  
  7344. Compilierte Block-Frames
  7345. ------------------------
  7346. Aufbau:
  7347.   Offset  Stack-Inhalt
  7348.    12
  7349.    8        Cons (NAME . <Framepointer>)
  7350.    4        SP
  7351.    0        Frame-Info; Pointer ⁿber Frame
  7352. NAME ist der Name des Blocks.
  7353. SP ist ein Pointer in den Programmstack, (SP).L ist eine Routine, die den
  7354. Block-Frame aufl÷st und den Block mit den Werten A0-A2/... verlΣ▀t.
  7355. Frame-Info ist CBLOCK_FRAME_INFO.
  7356.  
  7357. Interpretierte Tagbody-Frames
  7358. -----------------------------
  7359. Sie werden erzeugt von TAGBODY und allen Konstrukten, die ein implizites
  7360. TAGBODY enthalten (z.B. DO, DO*, PROG, PROG*, ...).
  7361. Der Aufbau eines Tagbody-Frames mit n Tags ist folgender:
  7362.   Offset  Stack-Inhalt
  7363.   12+8n
  7364.   8+8n     BODY 1
  7365.   4+8n     MARKE 1
  7366.   ...      ...
  7367.   16       BODY n
  7368.   12       MARKE n
  7369.   8        NEXT_ENV
  7370.   4        SP
  7371.   0        Frame-Info; Pointer ⁿber Frame
  7372. Die Marken sind die Sprungziele; es sind Symbole ud Integers, die sich im
  7373. Body befinden. Der zugeh÷rige "Wert" BODY i enthΣlt den Teil des Bodys, der
  7374. auf MARKE i folgt. NEXT_ENV ist das nΣchsth÷here Tagbody-Environment.
  7375. SP ist ein Pointer in den Programmstack, (SP).L ist eine Routine, die die
  7376. Aktion (GO MARKEi) ausfⁿhrt, wenn sie mit BODYi in A0 angesprungen wird.
  7377. Frame-Info ist ITAGBODY_FRAME_INFO, evtl. mit gesetztem NESTED_BIT (dann
  7378. zeigt NEXT_ENV auf eine Aliste, deren erstes Element die Form
  7379. (#(MARKE1 ... MARKEn) . <Framepointer>) hat, weil der Tagbody noch nicht
  7380. DISABLED ist).
  7381.  
  7382. Compilierte Tagbody-Frames
  7383. --------------------------
  7384. Aufbau:
  7385.   Offset  Stack-Inhalt
  7386.    12
  7387.    8        Cons (#(MARKE1 ... MARKEn) . <Framepointer>)
  7388.    4        SP
  7389.    0        Frame-Info; Pointer ⁿber Frame
  7390. MARKE1, ..., MARKEn sind die Namen der Tags (im compilierten Code eigentlich
  7391. nur noch zu Fehlermeldungszwecken vorhanden).
  7392. SP ist ein Pointer in den Programmstack, (SP).L ist eine Routine, die die
  7393. Aktion (GO MARKEi) ausfⁿhrt, wenn sie mit value1 = i (1 <= i <= n) angesprungen
  7394. wird.
  7395. Frame-Info ist CTAGBODY_FRAME_INFO.
  7396.  
  7397. Catch-Frames
  7398. ------------
  7399. Sie werden erzeugt von der Special-Form CATCH. Ihr Aufbau ist wie folgt:
  7400.   Offset  Stack-Inhalt
  7401.    12
  7402.    8        TAG
  7403.    4        SP
  7404.    0        Frame-Info; Pointer ⁿber Frame
  7405. Dabei ist TAG die Marke des Catchers.
  7406. SP ist ein Pointer in den Programmstack, (SP).L ist eine Routine, die den
  7407. Frame aufl÷st und die Werte A0-A2/... zurⁿckgibt.
  7408. Frame-Info ist CATCH_FRAME_INFO.
  7409.  
  7410. Unwind-Protect-Frames
  7411. ---------------------
  7412. Sie werden erzeugt von der Special-Form UNWIND-PROTECT und allen Konstrukten,
  7413. die ein implizites UNWIND-PROTECT enthalten (wie WITH-OPEN-STREAM oder
  7414. WITH-OPEN-FILE). Ihr Aufbau ist wie folgt:
  7415.   Offset  Stack-Inhalt
  7416.    8
  7417.    4        SP
  7418.    0        Frame-Info; Pointer ⁿber Frame
  7419. SP ist ein Pointer in den Programmstack. (SP).L ist eine Routine, die den
  7420. Frame aufl÷st, die aktuellen Werte A0-A2/... rettet, den Cleanup durchfⁿhrt,
  7421. die geretteten Werte zurⁿckschreibt und schlie▀lich die Adresse anspringt
  7422. (mit RTS), die anstelle ihrer eigenen im Programmstack eingetragen wurde,
  7423. und dabei D6 unverΣndert lΣ▀t.
  7424.  
  7425. Handler-Frames
  7426. --------------
  7427. Sie werden erzeugt vom Macro HANDLER-BIND. Ihr Aufbau ist wie folgt:
  7428.   Offset  Stack-Inhalt
  7429.    16
  7430.    12       Cons (#(type1 label1 ... typem labelm) . SPdepth)
  7431.    8        Closure
  7432.    4        SP
  7433.    0        Frame-Info; Pointer ⁿber Frame
  7434. SP ist ein Pointer in den Programmstack. Wenn eine Condition vom Typ typei
  7435. auftritt, wird als Handler die Closure ab Byte labeli abinterpretiert, wobei
  7436. zuerst ein Stⁿck Programmstack der LΣnge SPdepth dupliziert wird.
  7437.  
  7438. Driver-Frames
  7439. -------------
  7440. Sie werden erzeut beim Eintritt in eine Top-Level-Schleife (meist eine
  7441. READ-EVAL-PRINT-Schleife) und dienen dazu, nach Fehlermeldungen die
  7442. vorherige Top-Level-Schleife fortzusetzen. Der Aufbau ist einfach:
  7443.   Offset  Stack-Inhalt
  7444.    8
  7445.    4        SP
  7446.    0        Frame-Info; Pointer ⁿber Frame
  7447. SP ist ein Pointer in den Programmstack. (SP).L ist eine Routine, die
  7448. wieder in die zugeh÷rige Top-Level-Schleife einsteigt.
  7449.  
  7450. */
  7451.  
  7452. # STACK:
  7453. # STACK ist der LISP-Stack.
  7454. # STACK_0 ist das erste Objekt auf dem STACK.
  7455. # STACK_1 ist das zweite Objekt auf dem STACK.
  7456. # etc., allgemein STACK_(n) = (n+1)tes Objekt auf dem STACK.
  7457. # pushSTACK(object)  legt ein Objekt auf dem STACK ab. Synonym: -(STACK).
  7458. # popSTACK()  liefert STACK_0 und nimmt es dabei vom STACK herunter.
  7459. # skipSTACK(n);  nimmt n Objekte vom STACK herunter.
  7460. # Will man den Wert des STACK retten, so geht das so:
  7461. #   var object* temp = STACK; ... (kein Zugriff ⁿber temp !) ... setSTACK(STACK = temp);
  7462. #   jedoch: Zugriff ⁿber  STACKpointable(temp)  m÷glich.
  7463. # Will man einen Pointer, der durch den Stack laufen kann, so geht das so:
  7464. #   var object* ptr = &STACK_0;  oder  = STACKpointable(STACK);
  7465. #   assert( *(ptr STACKop 0) == STACK_0 );
  7466. #   assert( *(ptr STACKop 1) == STACK_1 );
  7467. #   ...
  7468. #   ptr skipSTACKop n;
  7469. #   assert( *(ptr STACKop 0) == STACK_(n) );
  7470. #   ...
  7471. #   Dieser Pointer darf nicht wieder dem STACK zugewiesen werden!
  7472. # Bringt man im STACK Bl÷cke von Objekten unter und will den (n+1)-ten Block,
  7473. #   so geht das so:  STACKblock_(type,n). Dabei sollte type ein
  7474. #   struct-Typ sein mit sizeof(type) ein Vielfaches  von sizeof(object).
  7475.  
  7476.   #ifdef STACK_DOWN
  7477.     #define STACK_(n)  (STACK[(sintP)(n)])
  7478.     #define STACKpointable(STACKvar)  ((object*)(STACKvar))
  7479.     #define skipSTACKop  +=
  7480.     #define STACKop      +
  7481.     #define cmpSTACKop   <
  7482.     #define STACKblock_(type,n)  (((type*)STACK)[(sintP)(n)])
  7483.   #endif
  7484.   #ifdef STACK_UP
  7485.     #define STACK_(n)  (STACK[-1-(sintP)(n)])
  7486.     #define STACKpointable(STACKvar)  ((object*)(STACKvar)-1)
  7487.     #define skipSTACKop  -=
  7488.     #define STACKop      -
  7489.     #define cmpSTACKop   >
  7490.     #define STACKblock_(type,n)  (((type*)STACK)[-1-(sintP)(n)])
  7491.   #endif
  7492.   #define pushSTACK(obj)  (STACK_(-1) = (obj), STACK skipSTACKop -1)
  7493.     # Fast Σquivalent zu  *--STACK = obj  bzw.  *STACK++ = obj  , jedoch
  7494.     # Vorsicht: erst Objekt in STACK_(-1) eintragen, dann erst STACK verΣndern!
  7495.   #define popSTACK()  (STACK skipSTACKop 1, STACK_(-1))
  7496.   #define skipSTACK(n)  (STACK skipSTACKop (sintP)(n))
  7497.  
  7498.   #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM) && !defined(WIDE)
  7499.     # Mit GNU auf einem 680X0 liegt STACK in einem Register. Zugriff und
  7500.     # VerΣnderung von STACK bilden daher eine ununterbrechbare Einheit.
  7501.     #undef pushSTACK
  7502.     #undef popSTACK
  7503.     #ifdef STACK_DOWN
  7504.       # define pushSTACK(obj)  (*--STACK = (obj))
  7505.       #define pushSTACK(obj)  \
  7506.         ({ __asm__ __volatile__ ("movel %0,"REGISTER_PREFIX""STACK_register"@-" : : "g" ((object)(obj)) : STACK_register ); })
  7507.       # define popSTACK()  (*STACK++)
  7508.       #define popSTACK()  \
  7509.         ({var object __result;                                                                                         \
  7510.           __asm__ __volatile__ ("movel "REGISTER_PREFIX""STACK_register"@+,%0" : "=g" (__result) : : STACK_register ); \
  7511.           __result;                                                                                                    \
  7512.          })
  7513.     #endif
  7514.     #ifdef STACK_UP
  7515.       # define pushSTACK(obj)  (*STACK++ = (obj))
  7516.       #define pushSTACK(obj)  \
  7517.         ({ __asm__ __volatile__ ("movel %0,"REGISTER_PREFIX""STACK_register"@+" : : "g" ((object)(obj)) : STACK_register ); })
  7518.       # define popSTACK()  (*--STACK)
  7519.       #define popSTACK()  \
  7520.         ({var object __result;                                                                                         \
  7521.           __asm__ __volatile__ ("movel "REGISTER_PREFIX""STACK_register"@-,%0" : "=g" (__result) : : STACK_register ); \
  7522.           __result;                                                                                                    \
  7523.          })
  7524.     #endif
  7525.   #endif
  7526.   #if defined(SPARC) && !defined(GNU) && (SAFETY < 2)
  7527.     #undef pushSTACK
  7528.     #undef popSTACK
  7529.     #undef skipSTACK
  7530.     #define pushSTACK(obj)  (STACK_(-1) = (obj), _setSTACK(STACK STACKop -1))
  7531.     #define popSTACK()  (_setSTACK(STACK STACKop 1), STACK_(-1))
  7532.     #define skipSTACK(n)  (_setSTACK(STACK STACKop (sintP)(n)))
  7533.   #endif
  7534.  
  7535.   #define STACK_0  (STACK_(0))
  7536.   #define STACK_1  (STACK_(1))
  7537.   #define STACK_2  (STACK_(2))
  7538.   #define STACK_3  (STACK_(3))
  7539.   #define STACK_4  (STACK_(4))
  7540.   #define STACK_5  (STACK_(5))
  7541.   #define STACK_6  (STACK_(6))
  7542.   #define STACK_7  (STACK_(7))
  7543.   #define STACK_8  (STACK_(8))
  7544.   #define STACK_9  (STACK_(9))
  7545.   #define STACK_10  (STACK_(10))
  7546.   # usw.
  7547.  
  7548.  
  7549. # Werte:
  7550.  
  7551. # Maximalzahl multiple values + 1
  7552.   #define mv_limit  128
  7553. # Werte werden immer im MULTIPLE_VALUE_SPACE mv_space ⁿbergeben:
  7554.   # uintC mv_count : Anzahl der Werte, >=0, <mv_limit
  7555.   # object mv_space [mv_limit-1] : die Werte.
  7556.   #   Bei mv_count>0 sind genau die ersten mv_count Elemente belegt.
  7557.   #   Bei mv_count=0 ist der erste Wert = NIL.
  7558.   #   Die Werte in mv_space unterliegen nicht der Garbage Collection!
  7559.   #if defined(GNU) && (SAFETY < 2)
  7560.     #if defined(SPARC)
  7561.       #define mv_count_register  "%g6"
  7562.     #endif
  7563.     #if defined(HPPA)
  7564.       #define mv_count_register  "%r11"  # eines der allgemeinen Register %r5..%r18
  7565.       #define NEED_temp_mv_count
  7566.     #endif
  7567.     #if defined(M88000)
  7568.       #define mv_count_register  "%r15"  # eines der allgemeinen Register %r14..%r25
  7569.       #define NEED_temp_mv_count
  7570.     #endif
  7571.     #if defined(DECALPHA)
  7572.       #define mv_count_register  "$10"  # eines der allgemeinen Register $9..$14
  7573.       #define NEED_temp_mv_count
  7574.     #endif
  7575.     #if defined(CONVEX)
  7576.       #define mv_count_register  "s5"
  7577.     #endif
  7578.   #endif
  7579.   #if !defined(mv_count_register)
  7580.     # eine globale Variable
  7581.     extern uintC mv_count;
  7582.   #else
  7583.     # ein globales Register
  7584.     register uintC mv_count __asm__(mv_count_register);
  7585.   #endif
  7586.   extern object mv_space [mv_limit-1];
  7587.   # Synonyme:
  7588.   #if defined(GNU) && !defined(WIDE_SOFT) && (SAFETY < 2)
  7589.     #if defined(SPARC)
  7590.       #define value1_register  "%g7"
  7591.     #endif
  7592.     #if defined(HPPA)
  7593.       #define value1_register  "%r12"  # eines der allgemeinen Register %r5..%r18
  7594.       #define NEED_temp_value1
  7595.     #endif
  7596.     #if defined(M88000)
  7597.       #define value1_register  "%r16"  # eines der allgemeinen Register %r14..%r25
  7598.       #define NEED_temp_value1
  7599.     #endif
  7600.     #if defined(DECALPHA)
  7601.       #define value1_register  "$11"  # eines der allgemeinen Register $9..$14
  7602.       #define NEED_temp_value1
  7603.     #endif
  7604.     #if defined(CONVEX)
  7605.       #define value1_register  "s6"
  7606.     #endif
  7607.   #endif
  7608.   #if !defined(value1_register)
  7609.     #define value1  mv_space[0]
  7610.   #else
  7611.     # Der erste Wert mv_space[0] wird permanent in einem Register gelagert:
  7612.     register object value1 __asm__(value1_register);
  7613.     #define VALUE1_EXTRA # und mu▀ deswegen immer extra behandelt werden...
  7614.   #endif
  7615.   #define value2  mv_space[1]
  7616.   #define value3  mv_space[2]
  7617. # Zur ▄bergabe mit setjmp/longjmp braucht man evtl. noch globale Variablen:
  7618.   #ifdef NEED_temp_mv_count
  7619.     extern uintC temp_mv_count;
  7620.     #define SAVE_mv_count()  temp_mv_count = mv_count
  7621.     #define RESTORE_mv_count()  mv_count = temp_mv_count
  7622.   #else
  7623.     #define SAVE_mv_count()
  7624.     #define RESTORE_mv_count()
  7625.   #endif
  7626.   #ifdef NEED_temp_value1
  7627.     extern object temp_value1;
  7628.     #define SAVE_value1()  temp_value1 = value1
  7629.     #define RESTORE_value1()  value1 = temp_value1
  7630.   #else
  7631.     #define SAVE_value1()
  7632.     #define RESTORE_value1()
  7633.   #endif
  7634. # wird verwendet von EVAL, CONTROL,
  7635. #                    Macros LIST_TO_MV, MV_TO_LIST, STACK_TO_MV, MV_TO_STACK
  7636.  
  7637. # Liefert die untersten count Objekte vom STACK als Multiple Values.
  7638. # STACK_to_mv(count)
  7639. # count: Anzahl der Objekte, < mv_limit.
  7640.   #if !defined(VALUE1_EXTRA)
  7641.     #define STACK_to_mv(countx)  \
  7642.       { var reg2 uintC count = (countx);                       \
  7643.         mv_count = count;                                      \
  7644.         if (count == 0)                                        \
  7645.           { value1 = NIL; }                                    \
  7646.           else                                                 \
  7647.           { object* mvp = &mv_space[count]; # Zeiger hinter Platz fⁿr letzten Wert \
  7648.             dotimespC(count,count, { *--mvp = popSTACK(); } ); \
  7649.       }   }
  7650.   #else
  7651.     #define STACK_to_mv(countx)  \
  7652.       { var reg2 uintC count = (countx);                           \
  7653.         mv_count = count;                                          \
  7654.         if (count == 0)                                            \
  7655.           { value1 = NIL; }                                        \
  7656.           else                                                     \
  7657.           { count--;                                               \
  7658.             if (count > 0)                                         \
  7659.               { object* mvp = &mv_space[1+count]; # Zeiger hinter Platz fⁿr letzten Wert \
  7660.                 dotimespC(count,count, { *--mvp = popSTACK(); } ); \
  7661.               }                                                    \
  7662.             value1 = popSTACK();                                   \
  7663.       }   }
  7664.   #endif
  7665. # wird verwendet von EVAL, CONTROL
  7666.  
  7667. # Legt alle Werte auf dem STACK ab.
  7668. # mv_to_STACK()
  7669. # > mv_count/mv_space : Werte
  7670. # < Werte auf dem Stack (erster Wert zuoberst)
  7671. # STACK-Overflow wird abgeprⁿft.
  7672. # verΣndert STACK
  7673.   #if !defined(VALUE1_EXTRA)
  7674.     #define mv_to_STACK()  \
  7675.       { var reg2 uintC count = mv_count;                      \
  7676.         if (count==0) ; # keine Werte -> nichts auf den STACK \
  7677.           else                                                \
  7678.           { var reg1 object* mvp = &mv_space[0];              \
  7679.             dotimespC(count,count, { pushSTACK(*mvp++); } );  \
  7680.             check_STACK();                                    \
  7681.       }   }
  7682.   #else
  7683.     #define mv_to_STACK()  \
  7684.       { var reg2 uintC count = mv_count;                         \
  7685.         if (count==0) ; # keine Werte -> nichts auf den STACK    \
  7686.           else                                                   \
  7687.           { pushSTACK(value1);                                   \
  7688.             count--;                                             \
  7689.             if (count > 0)                                       \
  7690.               { var reg1 object* mvp = &mv_space[1];             \
  7691.                 dotimespC(count,count, { pushSTACK(*mvp++); } ); \
  7692.               }                                                  \
  7693.             check_STACK();                                       \
  7694.       }   }
  7695.   #endif
  7696. # wird verwendet von EVAL, CONTROL
  7697.  
  7698. # Liefert die Elemente einer Liste als Multiple Values.
  7699. # list_to_mv(list,fehler_statement)
  7700. # fehler_statement: im Fehlerfall (zuviele Werte).
  7701.   #if !defined(VALUE1_EXTRA)
  7702.     #define list_to_mv(lst,fehler_statement)  \
  7703.       {var reg1 object l = (lst);                                              \
  7704.        var reg3 uintC count = 0;                                               \
  7705.        if (atomp(l))                                                           \
  7706.          value1 = NIL;                                                         \
  7707.          else                                                                  \
  7708.          { var reg2 object* mvp = &mv_space[0];                                \
  7709.            *mvp++ = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_fertig; \
  7710.            *mvp++ = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_fertig; \
  7711.            *mvp++ = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_fertig; \
  7712.            do { *mvp++ = Car(l); l = Cdr(l);                                   \
  7713.                 count++; if (count==mv_limit) { fehler_statement; }            \
  7714.               }                                                                \
  7715.               while (consp(l));                                                \
  7716.            mv_fertig: mv_count = count;                                        \
  7717.       }  }
  7718.   #else
  7719.     #define list_to_mv(lst,fehler_statement)  \
  7720.       {var reg1 object l = (lst);                                              \
  7721.        var reg3 uintC count = 0;                                               \
  7722.        if (atomp(l))                                                           \
  7723.          value1 = NIL;                                                         \
  7724.          else                                                                  \
  7725.          { value1 = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_fertig; \
  7726.           {var reg2 object* mvp = &mv_space[1];                                \
  7727.            *mvp++ = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_fertig; \
  7728.            *mvp++ = Car(l); l = Cdr(l); count++; if (atomp(l)) goto mv_fertig; \
  7729.            do { *mvp++ = Car(l); l = Cdr(l);                                   \
  7730.                 count++; if (count==mv_limit) { fehler_statement; }            \
  7731.               }                                                                \
  7732.               while (consp(l));                                                \
  7733.            mv_fertig: mv_count = count;                                        \
  7734.       }  }}
  7735.   #endif
  7736. # wird verwendet von EVAL, CONTROL
  7737.  
  7738. # Liefert die Liste der Multiple Values auf -(STACK).
  7739. # mv_to_list()
  7740. # kann GC ausl÷sen
  7741.   #define mv_to_list()  \
  7742.     { mv_to_STACK(); # erst alle Werte auf den Stack               \
  7743.       pushSTACK(NIL); # Listenanfang                               \
  7744.       { var reg2 uintC count;                                      \
  7745.         dotimesC(count,mv_count, # bis alle Werte verbraucht sind: \
  7746.           { var reg1 object l = allocate_cons(); # neue Zelle      \
  7747.             Cdr(l) = popSTACK(); # Liste bisher                    \
  7748.             Car(l) = STACK_0; # nΣchster Wert                      \
  7749.             STACK_0 = l; # neues Cons sichern                      \
  7750.           });                                                      \
  7751.     } }
  7752. # wird verwendet von EVAL, CONTROL, DEBUG
  7753.  
  7754. # Fehlermeldung bei zu vielen Werten
  7755. # fehler_mv_zuviel(caller);
  7756. # > caller: Aufrufer, ein Symbol
  7757.   nonreturning_function(extern, fehler_mv_zuviel, (object caller));
  7758. # wird verwendet von EVAL, CONTROL, LISPARIT
  7759.  
  7760. # WΣhrend der Ausfⁿhrung eines SUBR, FSUBR: das aktuelle SUBR bzw. FSUBR
  7761.   #if defined(GNU) && (SAFETY < 2)
  7762.     #if defined(SPARC) && !defined(WIDE)
  7763.       #define subr_self_register  "%g4"  # ein globales Register
  7764.       # Neuerdings - bei gcc 2.3 - ist %g4 offenbar ein Scratch-Register.
  7765.       # Ab libc.so.1.6.1 (in getwd()) macht das Probleme.
  7766.       # Deswegen ist oben HAVE_SAVED_SUBR_SELF definiert.
  7767.     #endif
  7768.     #if defined(HPPA) && !defined(WIDE)
  7769.       #define subr_self_register  "%r13"  # eines der allgemeinen Register %r5..%r18
  7770.     #endif
  7771.     #if defined(CONVEX)
  7772.       #define subr_self_register  "s7"
  7773.     #endif
  7774.   #endif
  7775.   #if !defined(subr_self_register)
  7776.     extern object subr_self;
  7777.   #else
  7778.     register object subr_self __asm__(subr_self_register);
  7779.   #endif
  7780.  
  7781. # Innerhalb des Body eines SUBR: Zugriff auf die Argumente.
  7782. # Ein SUBR mit fester Argumentezahl kann ⁿber den STACK auf die Argumente
  7783. #   zugreifen: STACK_0 = letztes Argument, STACK_1 = vorletztes Argument etc.
  7784. #   STACK aufrΣumen: mit skipSTACK(Argumentezahl) .
  7785. # Ein SUBR mit beliebig vielen Argumenten (&REST-Parameter) bekommt ⁿbergeben:
  7786. #     uintC argcount              die Anzahl der restlichen Argumente
  7787. #     object* rest_args_pointer   Pointer ⁿber die restlichen Argumente
  7788. #   ZusΣtzlich:
  7789. #     object* args_end_pointer    Pointer unter alle Argumente, von STACK abhΣngig
  7790. #   ZusΣtzlich m÷glich:
  7791. #     object* args_pointer = rest_args_pointer STACKop (feste Argumentezahl);
  7792. #                                 Pointer ⁿber das erste Argument
  7793. #   Typische Abarbeitungsschleifen:
  7794. #     von vorne:
  7795. #       until (argcount==0)
  7796. #         { var object arg = NEXT(rest_args_pointer); ...; argcount--; }
  7797. #       until (rest_args_pointer==args_end_pointer)
  7798. #         { var object arg = NEXT(rest_args_pointer); ...; }
  7799. #     von hinten:
  7800. #       until (argcount==0)
  7801. #         { var object arg = BEFORE(args_end_pointer); ...; argcount--; }
  7802. #       until (rest_args_pointer==args_end_pointer)
  7803. #         { var object arg = BEFORE(args_end_pointer); ...; }
  7804. #   Die Macros NEXT und BEFORE verΣndern ihr Argument!
  7805. #   STACK aufrΣumen: mit set_args_end_pointer(args_pointer)
  7806. #     oder skipSTACK((feste Argumentezahl) + (uintL) (restliche Argumentezahl)) .
  7807.   #define args_end_pointer  STACK
  7808.   #define set_args_end_pointer(new_args_end_pointer)  \
  7809.     setSTACK(STACK = (new_args_end_pointer))
  7810.   #ifdef STACK_DOWN
  7811.     #define NEXT(argpointer)  (*(--(argpointer)))
  7812.     #define BEFORE(argpointer)  (*((argpointer)++))
  7813.   #endif
  7814.   #ifdef STACK_UP
  7815.     #define NEXT(argpointer)  (*((argpointer)++))
  7816.     #define BEFORE(argpointer)  (*(--(argpointer)))
  7817.   #endif
  7818. # Next(pointer) liefert denselben Wert wie NEXT(pointer),
  7819. # ohne dabei jedoch den Wert von pointer zu verΣndern.
  7820. # Before(pointer) liefert denselben Wert wie BEFORE(pointer),
  7821. # ohne dabei jedoch den Wert von pointer zu verΣndern.
  7822.   #define Next(pointer)  (*(STACKpointable(pointer) STACKop -1))
  7823.   #define Before(pointer)  (*(STACKpointable(pointer) STACKop 0))
  7824.  
  7825. # Environments:
  7826.  
  7827. typedef struct { object var_env;   # Variablenbindungs-Environment
  7828.                  object fun_env;   # Funktionsbindungs-Environment
  7829.                  object block_env; # Block-Environment
  7830.                  object go_env;    # Tagbody/Go-Environment
  7831.                  object decl_env;  # Deklarations-Environment
  7832.                }
  7833.         environment;
  7834.  
  7835. # Das aktuelle Environment:
  7836.   # extern environment aktenv;
  7837. # ist ein Teil der Objekttabelle:
  7838. # O(akt_var_env), O(akt_fun_env), O(akt_block_env), O(akt_go_env), O(akt_decl_env).
  7839.   #define aktenv  (*(environment*)(&O(akt_var_env)))
  7840.  
  7841. # Frameinfobits in Frames:
  7842. # im Frame-Info-Byte (tint):
  7843. #if (oint_type_len>=7) && 0 # vorlΣufig??
  7844. # Bitnummern im Frame-Info-Byte:
  7845. # belegen Bits 6..0 (bzw. Bits 7,5..0 falls garcol_bit_t=7).
  7846.   #define FB7  garcol_bit_t
  7847.   #define FB6  (garcol_bit_t>TB5 ? TB5 : TB6)
  7848.   #define FB5  (garcol_bit_t>TB4 ? TB4 : TB5)
  7849.   #define FB4  (garcol_bit_t>TB3 ? TB3 : TB4)
  7850.   #define FB3  (garcol_bit_t>TB2 ? TB2 : TB3)
  7851.   #define FB2  (garcol_bit_t>TB1 ? TB1 : TB2)
  7852.   #define FB1  (garcol_bit_t>TB0 ? TB0 : TB1)
  7853. # davon abhΣngig:
  7854.   #define frame_bit_t    FB7  # garcol_bit als FRAME-Kennzeichen
  7855.   #define skip2_bit_t    FB6  # gel÷scht wenn GC zwei Langworte ⁿberspringen mu▀
  7856.   #define unwind_bit_t   FB5  # gesetzt, wenn beim Aufl÷sen (UNWIND) des Frames
  7857.                               # etwas zu tun ist
  7858.   # skip2-Bit=1 ==> unwind-Bit=1.
  7859.   # zur nΣheren Information innerhalb der Frames mit skip2-Bit=1:
  7860.     #define envbind_bit_t  FB4  # Bit ist gesetzt bei ENV-Frames.
  7861.                                 # Bit ist gel÷scht bei DYNBIND-Frames.
  7862.     # zur nΣheren Identifikation innerhalb der ENV-Frames:
  7863.       #define envbind_case_mask_t  (bit(FB3)|bit(FB2)|bit(FB1))
  7864.   # zur nΣheren Unterscheidung innerhalb der Frames mit skip2-Bit=0:
  7865.     #define entrypoint_bit_t  FB4  # Bit ist gesetzt, wenn FRAME einen
  7866.                                    # nicht-lokalen Einsprung enthΣlt, mit Offset SP_ ist SP im STACK.
  7867.                                    # Bit ist gel÷scht bei VAR-Frame und FUN-Frame.
  7868.     # zur nΣheren Unterscheidung in BLOCK/TAGBODY/APPLY/EVAL/CATCH/UNWIND_PROTECT/HANDLER/DRIVER:
  7869.       #define blockgo_bit_t    FB3  # Bit gesetzt bei BLOCK- und TAGBODY-FRAME
  7870.       # zur nΣheren Unterscheidung in BLOCK/TAGBODY:
  7871.         # Bit FB2 gesetzt bei TAGBODY, gel÷scht bei BLOCK,
  7872.         #define cframe_bit_t     FB1  # gesetzt bei compilierten, gel÷scht bei
  7873.                                     # interpretierten BLOCK/TAGBODY-Frames
  7874.         #define nested_bit_t unwind_bit_t # fⁿr IBLOCK und ITAGBODY, gesetzt,
  7875.                                     # wenn Exitpoint bzw. Tags genestet wurden
  7876.       # zur nΣheren Unterscheidung in APPLY/EVAL/CATCH/UNWIND_PROTECT/HANDLER/DRIVER:
  7877.         #define dynjump_bit_t  FB2    # gel÷scht bei APPLY und EVAL, gesetzt
  7878.                                       # bei CATCH/UNWIND_PROTECT/DRIVER-Frames
  7879.         #define trapped_bit_t unwind_bit_t # fⁿr APPLY und EVAL, gesetzt, wenn
  7880.                                     # beim Aufl÷sen des Frames unterbrochen wird
  7881.         # unwind-Bit gesetzt bei UNWIND_PROTECT/DRIVER/TRAPPED_APPLY/TRAPPED_EVAL,
  7882.         # gel÷scht sonst.
  7883.         #define eval_bit_t     FB1    # gesetzt bei EVAL-Frames,
  7884.                                       # gel÷scht bei APPLY-Frames
  7885.         #define driver_bit_t   FB1    # gesetzt bei DRIVER-Frames,
  7886.                                       # gel÷scht bei UNWIND_PROTECT-Frames
  7887.         #define handler_bit_t  FB1    # gesetzt bei HANDLER-Frames,
  7888.                                       # gel÷scht bei CATCH-Frames
  7889.     # zur nΣheren Unterscheidung in VAR/FUN:
  7890.       #define fun_bit_t        FB3  # gesetzt bei FUNCTION-FRAME, gel÷scht bei VAR-FRAME
  7891. # in Objekten auf dem STACK (oint):
  7892.   #define frame_bit_o  (frame_bit_t+oint_type_shift)
  7893.   #define skip2_bit_o  (skip2_bit_t+oint_type_shift)
  7894.   #define unwind_bit_o  (unwind_bit_t+oint_type_shift)
  7895.     #define envbind_bit_o  (envbind_bit_t+oint_type_shift)
  7896.     #define entrypoint_bit_o  (entrypoint_bit_t+oint_type_shift)
  7897.       #define blockgo_bit_o  (blockgo_bit_t+oint_type_shift)
  7898.         #define cframe_bit_o  (cframe_bit_t+oint_type_shift)
  7899.         #define nested_bit_o  (nested_bit_t+oint_type_shift)
  7900.         #define dynjump_bit_o  (dynjump_bit_t+oint_type_shift)
  7901.         #define trapped_bit_o  (trapped_bit_t+oint_type_shift)
  7902.         #define eval_bit_o  (eval_bit_t+oint_type_shift)
  7903.         #define driver_bit_o  (driver_bit_t+oint_type_shift)
  7904.         #define handler_bit_o  (handler_bit_t+oint_type_shift)
  7905.       #define fun_bit_o  (fun_bit_t+oint_type_shift)
  7906. # einzelne Frame-Info-Bytes:
  7907.   #define DYNBIND_frame_info          /* %1110... */ (bit(FB7)|bit(FB6)|bit(FB5))
  7908.   #define ENV1V_frame_info            /* %1111000 */ (bit(FB7)|bit(FB6)|bit(FB5)|bit(FB4))
  7909.   #define ENV1F_frame_info            /* %1111001 */ (bit(FB7)|bit(FB6)|bit(FB5)|bit(FB4)|bit(FB1))
  7910.   #define ENV1B_frame_info            /* %1111010 */ (bit(FB7)|bit(FB6)|bit(FB5)|bit(FB4)|bit(FB2))
  7911.   #define ENV1G_frame_info            /* %1111011 */ (bit(FB7)|bit(FB6)|bit(FB5)|bit(FB4)|bit(FB2)|bit(FB1))
  7912.   #define ENV1D_frame_info            /* %1111100 */ (bit(FB7)|bit(FB6)|bit(FB5)|bit(FB4)|bit(FB3))
  7913.   #define ENV2VD_frame_info           /* %1111101 */ (bit(FB7)|bit(FB6)|bit(FB5)|bit(FB4)|bit(FB3)|bit(FB1))
  7914.   #define ENV5_frame_info             /* %1111110 */ (bit(FB7)|bit(FB6)|bit(FB5)|bit(FB4)|bit(FB3)|bit(FB2))
  7915.   #define VAR_frame_info              /* %10100.. */ (bit(FB7)|bit(FB5))
  7916.   #define FUN_frame_info              /* %10101.. */ (bit(FB7)|bit(FB5)|bit(FB3))
  7917.   #define IBLOCK_frame_info           /* %1001100 */ (bit(FB7)|bit(FB4)|bit(FB3))
  7918.   #define NESTED_IBLOCK_frame_info    /* %1011100 */ (bit(FB7)|bit(FB5)|bit(FB4)|bit(FB3))
  7919.   #define CBLOCK_frame_info           /* %1011101 */ (bit(FB7)|bit(FB5)|bit(FB4)|bit(FB3)|bit(FB1))
  7920.   #define ITAGBODY_frame_info         /* %1001110 */ (bit(FB7)|bit(FB4)|bit(FB3)|bit(FB2))
  7921.   #define NESTED_ITAGBODY_frame_info  /* %1011110 */ (bit(FB7)|bit(FB5)|bit(FB4)|bit(FB3)|bit(FB2))
  7922.   #define CTAGBODY_frame_info         /* %1011111 */ (bit(FB7)|bit(FB5)|bit(FB4)|bit(FB3)|bit(FB2)|bit(FB1))
  7923.   #define APPLY_frame_info            /* %1001000 */ (bit(FB7)|bit(FB4))
  7924.   #define TRAPPED_APPLY_frame_info    /* %1011000 */ (bit(FB7)|bit(FB5)|bit(FB4))
  7925.   #define EVAL_frame_info             /* %1001001 */ (bit(FB7)|bit(FB4)|bit(FB1))
  7926.   #define TRAPPED_EVAL_frame_info     /* %1011001 */ (bit(FB7)|bit(FB5)|bit(FB4)|bit(FB1))
  7927.   #define CATCH_frame_info            /* %1001010 */ (bit(FB7)|bit(FB4)|bit(FB2))
  7928.   #define HANDLER_frame_info          /* %1001011 */ (bit(FB7)|bit(FB4)|bit(FB2)|bit(FB1))
  7929.   #define UNWIND_PROTECT_frame_info   /* %1011010 */ (bit(FB7)|bit(FB5)|bit(FB4)|bit(FB2))
  7930.   #define DRIVER_frame_info           /* %1011011 */ (bit(FB7)|bit(FB5)|bit(FB4)|bit(FB2)|bit(FB1))
  7931. #endif
  7932. #if (oint_type_len==6) || 1 # vorlΣufig??
  7933. # Bitnummern im Frame-Info-Byte:
  7934. # belegen Bits 5..0 (bzw. Bits 7,4..0 falls garcol_bit_t=7).
  7935.   #define FB6  garcol_bit_t
  7936.   #define FB5  (garcol_bit_t>TB4 ? TB4 : TB5)
  7937.   #define FB4  (garcol_bit_t>TB3 ? TB3 : TB4)
  7938.   #define FB3  (garcol_bit_t>TB2 ? TB2 : TB3)
  7939.   #define FB2  (garcol_bit_t>TB1 ? TB1 : TB2)
  7940.   #define FB1  (garcol_bit_t>TB0 ? TB0 : TB1)
  7941. # davon abhΣngig:
  7942.   #define frame_bit_t    FB6  # garcol_bit als FRAME-Kennzeichen
  7943.   #define skip2_bit_t    FB5  # gel÷scht wenn GC zwei Langworte ⁿberspringen mu▀
  7944.   # define unwind_limit_t  ...  # darⁿber:
  7945.                               # ist beim Aufl÷sen (UNWIND) des Frames etwas zu tun
  7946.   # skip2-Bit=1 ==> >= unwind-limit.
  7947.   # zur nΣheren Information innerhalb der Frames mit skip2-Bit=1:
  7948.     #define envbind_bit_t  FB4  # Bit ist gesetzt bei ENV-Frames.
  7949.                                 # Bit ist gel÷scht bei DYNBIND-Frames.
  7950.     # zur nΣheren Identifikation innerhalb der ENV-Frames:
  7951.       #define envbind_case_mask_t  (bit(FB3)|bit(FB2)|bit(FB1))
  7952.   # zur nΣheren Unterscheidung innerhalb der Frames mit skip2-Bit=0:
  7953.     # define entrypoint_limit_t  ...  # darunter:
  7954.                                    # wenn FRAME einen nicht-lokalen Einsprung enthΣlt,
  7955.                                    # mit Offset SP_ ist SP im STACK.
  7956.                                    # darⁿber: bei VAR-Frame und FUN-Frame.
  7957.     # zur nΣheren Unterscheidung in BLOCK/TAGBODY/APPLY/EVAL/CATCH/UNWIND_PROTECT/HANDLER/DRIVER:
  7958.       #define blockgo_bit_t    FB3  # Bit gesetzt bei BLOCK- und TAGBODY-FRAME
  7959.       # zur nΣheren Unterscheidung in BLOCK/TAGBODY:
  7960.         # Bit FB1 gesetzt bei TAGBODY, gel÷scht bei BLOCK,
  7961.         #define cframe_bit_t   FB2  # gesetzt bei compilierten, gel÷scht bei
  7962.                                     # interpretierten BLOCK/TAGBODY-Frames
  7963.         #define nested_bit_t   FB4  # fⁿr IBLOCK und ITAGBODY, gesetzt,
  7964.                                     # wenn Exitpoint bzw. Tags genestet wurden
  7965.       # zur nΣheren Unterscheidung in APPLY/EVAL/CATCH/UNWIND_PROTECT/HANDLER/DRIVER:
  7966.         #define dynjump_bit_t  FB2  # gel÷scht bei APPLY und EVAL, gesetzt
  7967.                                     # bei CATCH/UNWIND_PROTECT/HANDLER/DRIVER-Frames
  7968.         #define trapped_bit_t  FB4  # fⁿr APPLY und EVAL, gesetzt, wenn
  7969.                                     # beim Aufl÷sen des Frames unterbrochen wird
  7970.         # >= unwind_limit_t bei UNWIND_PROTECT/DRIVER/TRAPPED_APPLY/TRAPPED_EVAL,
  7971.         # < unwind_limit_t sonst.
  7972.         #define eval_bit_t     FB1  # gesetzt bei EVAL-Frames,
  7973.                                     # gel÷scht bei APPLY-Frames
  7974.         #define driver_bit_t   FB1  # gesetzt bei DRIVER-Frames,
  7975.                                     # gel÷scht bei UNWIND_PROTECT-Frames
  7976.         #define handler_bit_t  FB1  # gesetzt bei HANDLER-Frames,
  7977.                                     # gel÷scht bei CATCH-Frames
  7978.     # zur nΣheren Unterscheidung in VAR/FUN:
  7979.       #define fun_bit_t        FB1  # gesetzt bei FUNCTION-FRAME, gel÷scht bei VAR-FRAME
  7980. # in Objekten auf dem STACK (oint):
  7981.   #define frame_bit_o  (frame_bit_t+oint_type_shift)
  7982.   #define skip2_bit_o  (skip2_bit_t+oint_type_shift)
  7983.     #define envbind_bit_o  (envbind_bit_t+oint_type_shift)
  7984.       #define blockgo_bit_o  (blockgo_bit_t+oint_type_shift)
  7985.         #define cframe_bit_o  (cframe_bit_t+oint_type_shift)
  7986.         #define nested_bit_o  (nested_bit_t+oint_type_shift)
  7987.         #define dynjump_bit_o  (dynjump_bit_t+oint_type_shift)
  7988.         #define trapped_bit_o  (trapped_bit_t+oint_type_shift)
  7989.         #define eval_bit_o  (eval_bit_t+oint_type_shift)
  7990.         #define driver_bit_o  (driver_bit_t+oint_type_shift)
  7991.         #define handler_bit_o  (handler_bit_t+oint_type_shift)
  7992.       #define fun_bit_o  (fun_bit_t+oint_type_shift)
  7993. # einzelne Frame-Info-Bytes:
  7994.   #define APPLY_frame_info            /* %100000 */ (bit(FB6))
  7995.   #define EVAL_frame_info             /* %100001 */ (bit(FB6)|bit(FB1))
  7996.   #define CATCH_frame_info            /* %100010 */ (bit(FB6)|bit(FB2))
  7997.   #define HANDLER_frame_info          /* %100011 */ (bit(FB6)|bit(FB2)|bit(FB1))
  7998.   #define IBLOCK_frame_info           /* %100100 */ (bit(FB6)|bit(FB3))
  7999.   #define ITAGBODY_frame_info         /* %100101 */ (bit(FB6)|bit(FB3)|bit(FB1))
  8000.   #define unwind_limit_t                            (bit(FB6)|bit(FB3)|bit(FB2))
  8001.   #define CBLOCK_frame_info           /* %100110 */ (bit(FB6)|bit(FB3)|bit(FB2))
  8002.   #define CTAGBODY_frame_info         /* %100111 */ (bit(FB6)|bit(FB3)|bit(FB2)|bit(FB1))
  8003.   #define TRAPPED_APPLY_frame_info    /* %101000 */ (bit(FB6)|bit(FB4))
  8004.   #define TRAPPED_EVAL_frame_info     /* %101001 */ (bit(FB6)|bit(FB4)|bit(FB1))
  8005.   #define UNWIND_PROTECT_frame_info   /* %101010 */ (bit(FB6)|bit(FB4)|bit(FB2))
  8006.   #define DRIVER_frame_info           /* %101011 */ (bit(FB6)|bit(FB4)|bit(FB2)|bit(FB1))
  8007.   #define NESTED_IBLOCK_frame_info    /* %101100 */ (bit(FB6)|bit(FB4)|bit(FB3))
  8008.   #define NESTED_ITAGBODY_frame_info  /* %101101 */ (bit(FB6)|bit(FB4)|bit(FB3)|bit(FB1))
  8009.   #define entrypoint_limit_t                        (bit(FB6)|bit(FB4)|bit(FB3)|bit(FB2))
  8010.   #define VAR_frame_info              /* %101110 */ (bit(FB6)|bit(FB4)|bit(FB3)|bit(FB2))
  8011.   #define FUN_frame_info              /* %101111 */ (bit(FB6)|bit(FB4)|bit(FB3)|bit(FB2)|bit(FB1))
  8012.   #define DYNBIND_frame_info          /* %110... */ (bit(FB6)|bit(FB5))
  8013.   #define ENV1V_frame_info            /* %111000 */ (bit(FB6)|bit(FB5)|bit(FB4))
  8014.   #define ENV1F_frame_info            /* %111001 */ (bit(FB6)|bit(FB5)|bit(FB4)|bit(FB1))
  8015.   #define ENV1B_frame_info            /* %111010 */ (bit(FB6)|bit(FB5)|bit(FB4)|bit(FB2))
  8016.   #define ENV1G_frame_info            /* %111011 */ (bit(FB6)|bit(FB5)|bit(FB4)|bit(FB2)|bit(FB1))
  8017.   #define ENV1D_frame_info            /* %111100 */ (bit(FB6)|bit(FB5)|bit(FB4)|bit(FB3))
  8018.   #define ENV2VD_frame_info           /* %111101 */ (bit(FB6)|bit(FB5)|bit(FB4)|bit(FB3)|bit(FB1))
  8019.   #define ENV5_frame_info             /* %111110 */ (bit(FB6)|bit(FB5)|bit(FB4)|bit(FB3)|bit(FB2))
  8020. #endif
  8021.  
  8022. # Bits fⁿr Symbole in VAR-Frames:
  8023.   # bit(active_bit),bit(dynam_bit),bit(svar_bit) mⁿssen in ein uintB passen:
  8024.   #if !((active_bit<intBsize) && (dynam_bit<intBsize) && (svar_bit<intBsize))
  8025.     #error "Symbol bits don't fit in a single byte -- Symbol-Bits passen nicht in ein Byte!"
  8026.   #endif
  8027.   #ifdef NO_symbolflags
  8028.     # Bits werden im Stack separat als Fixnums abgelegt.
  8029.     #undef oint_symbolflags_shift
  8030.     #define oint_symbolflags_shift  oint_addr_shift
  8031.   #else
  8032.     #if (oint_symbolflags_shift==oint_addr_shift)
  8033.       # bit(active_bit),bit(dynam_bit),bit(svar_bit) mⁿssen echte Teiler
  8034.       # von Varobject_alignment sein:
  8035.       #if (Varobject_alignment % bit(active_bit+1)) || (Varobject_alignment % bit(dynam_bit+1)) || (Varobject_alignment % bit(svar_bit+1))
  8036.         #error "No more room for three bits in a symbol -- Kein Platz fⁿr drei Bits in der Adresse eines Symbols!"
  8037.       #endif
  8038.     #endif
  8039.   #endif
  8040.   #define active_bit_o  (active_bit+oint_symbolflags_shift)  # gesetzt: Bindung ist aktiv
  8041.   #define dynam_bit_o   (dynam_bit+oint_symbolflags_shift)   # gesetzt: Bindung ist dynamisch
  8042.   #define svar_bit_o    (svar_bit+oint_symbolflags_shift)    # gesetzt: nΣchster Parameter ist supplied-p-Parameter fⁿr diesen
  8043.  
  8044. # Offsets fⁿr Daten in Frames, ⁿber STACK_(Offset) zu adressieren:
  8045.   #define frame_form      2  # EVAL
  8046.   #define frame_closure   2  # APPLY, HANDLER
  8047.   #define frame_anz       1  # VAR, FUN
  8048.   #define frame_SP        1  # IBLOCK, CBLOCK, ITAGBODY, CTAGBODY,
  8049.                              # EVAL, CATCH, UNWIND-PROTECT, HANDLER, DRIVER
  8050.   #define frame_next_env  2  # VAR, FUN, IBLOCK, ITAGBODY
  8051.   #define frame_ctag      2  # CBLOCK, CTAGBODY
  8052.   #define frame_tag       2  # CATCH
  8053.   #define frame_handlers  3  # HANDLER
  8054.   #define frame_name      3  # IBLOCK
  8055.   #define frame_args      3  # APPLY
  8056.   #define frame_bindings  3  # VAR, FUN, ITAGBODY
  8057. # Aufbau einzelner Bindungen in VAR-Frames:
  8058.   #ifdef NO_symbolflags
  8059.     #define varframe_binding_size  3
  8060.     #define varframe_binding_mark   0
  8061.     #define varframe_binding_sym    1
  8062.     #define varframe_binding_value  2
  8063.     #define pushSTACK_symbolwithflags(symbol,flags)  \
  8064.       pushSTACK(symbol); pushSTACK(as_object(as_oint(Fixnum_0) | (oint)(flags)))
  8065.   #else
  8066.     #define varframe_binding_size  2
  8067.     #define varframe_binding_mark   0
  8068.     #define varframe_binding_sym    0
  8069.     #define varframe_binding_value  1
  8070.     #define pushSTACK_symbolwithflags(symbol,flags)  \
  8071.       pushSTACK(as_object(as_oint(symbol) | (oint)(flags)))
  8072.   #endif
  8073.  
  8074. # Spezieller Wert zur Markierung nicht mehr "lebender" BLOCK- und TAGBODY-
  8075. # Referenzen (ersetzt den Frame-Pointer im CDR des entsprechenden Cons)
  8076.   #define disabled  make_system(0xDDDDDDUL)
  8077.  
  8078. # Wert zur Markierung als special deklarierter Referenzen
  8079.   #define specdecl  make_system(0xECDECDUL)
  8080.  
  8081. # Hantieren mit Frames:
  8082. # Eine lokale Variable FRAME enthalte den Wert von STACK nach Aufbau
  8083. # eines Frames. Dann kann man mit FRAME_(n) genauso wie mit STACK_(n)
  8084. # zugreifen:
  8085.   #ifdef STACK_DOWN
  8086.     #define FRAME_(n)  (FRAME[(sintP)(n)])
  8087.   #endif
  8088.   #ifdef STACK_UP
  8089.     #define FRAME_(n)  (FRAME[-1-(sintP)(n)])
  8090.   #endif
  8091. # make_framepointer(FRAME) ist der Frame-Pointer als Lisp-Objekt.
  8092. # mtypecode(FRAME_(0)) ist das Frame-Info-Byte,
  8093. # topofframe(FRAME_(0)) ist ein Pointer ⁿber den Frame.
  8094. # FRAME = uTheFramepointer(obj) ist ein Frame-Pointer als Pointer in den Stack.
  8095. #         [uTheFramepointer ist das genaue Gegenteil von make_framepointer.]
  8096. # FRAME = TheFramepointer(obj) ebenfalls, aber evtl. doch noch mit Typinfo!
  8097. #         [Eine AbschwΣchung von uTheFramepointer, die zum Zugreifen ausreicht.]
  8098.   #if !defined(SINGLEMAP_MEMORY_STACK)
  8099.     #define make_framepointer(stack_ptr)  type_pointer_object(system_type,stack_ptr)
  8100.     #define topofframe(bottomword)  (object*)upointer(bottomword)
  8101.     #define uTheFramepointer(obj)  (object*)upointer(obj)
  8102.   #else
  8103.     #define make_framepointer(stack_ptr)  ((object)(stack_ptr))
  8104.     #define topofframe(bottomword)  (object*)type_pointer_object(system_type,upointer(bottomword))
  8105.     #define uTheFramepointer(obj)  TheFramepointer(obj) # = (object*)(obj)
  8106.   #endif
  8107. # wird verwendet von EVAL, CONTROL, DEBUG
  8108.  
  8109. # Zur Bestimmung der Gr÷▀e eines Frames:
  8110. # STACK_item_count(new_STACK_ptr,old_STACK_ptr)
  8111. # berechnet die Anzahl der STACK-Elemente zwischen einem Σlteren Stackpointer
  8112. # old_STACK_ptr und einem neueren new_STACK_ptr.
  8113. # (Also count mit  old_STACK_ptr = new_STACK_ptr STACKop count .)
  8114.   #ifdef STACK_DOWN
  8115.     #define STACK_item_count(new_STACK_ptr,old_STACK_ptr)  \
  8116.       (uintL)((old_STACK_ptr) - (new_STACK_ptr))
  8117.   #endif
  8118.   #ifdef STACK_UP
  8119.     #define STACK_item_count(new_STACK_ptr,old_STACK_ptr)  \
  8120.       (uintL)((new_STACK_ptr) - (old_STACK_ptr))
  8121.   #endif
  8122.  
  8123. # Beendet einen Frame.
  8124. # finish_frame(frametype);
  8125. # > object* top_of_frame: Pointer ⁿbern Frame
  8126. # erniedrigt STACK um 1
  8127.   #if !defined(SINGLEMAP_MEMORY_STACK)
  8128.     #define framebottomword(type,top_of_frame)  \
  8129.       type_pointer_object(type,top_of_frame)
  8130.   #else # top_of_frame hat selber schon Typinfo system_type
  8131.     #define framebottomword(type,top_of_frame)  \
  8132.       (object)((oint)type_pointer_object(type,0)-(oint)type_pointer_object(system_type,0)+(oint)(top_of_frame))
  8133.   #endif
  8134.   #define finish_frame(frametype)  \
  8135.     pushSTACK(framebottomword(frametype##_frame_info,top_of_frame))
  8136. # wird verwendet von EVAL, CONTROL
  8137.  
  8138. # Baut einen Frame fⁿr alle 5 Environments
  8139. # make_ENV5_frame();
  8140. # erniedrigt STACK um 5
  8141.   #define make_ENV5_frame()  \
  8142.     {var reg1 object* top_of_frame = STACK; \
  8143.      pushSTACK(aktenv.decl_env);            \
  8144.      pushSTACK(aktenv.go_env);              \
  8145.      pushSTACK(aktenv.block_env);           \
  8146.      pushSTACK(aktenv.fun_env);             \
  8147.      pushSTACK(aktenv.var_env);             \
  8148.      finish_frame(ENV5);                    \
  8149.     }
  8150. # wird verwendet von EVAL, CONTROL, DEBUG
  8151.  
  8152. # Beendet einen Frame mit Entrypoint und setzt den Einsprungpunkt hierher.
  8153. # finish_entry_frame(frametype,returner,retval_zuweisung,reentry_statement);
  8154. # > object* top_of_frame: Pointer ⁿbern Frame
  8155. # > jmp_buf* returner: longjmp-Buffer fⁿr Wiedereintritt
  8156. # > retval_zuweisung: Zuweisung des setjmp()-Wertes an eine Variable
  8157. # > reentry_statement: Was sofort nach Wiedereintritt zu tun ist.
  8158. # erniedrigt STACK um 1
  8159.   #define finish_entry_frame(frametype,returner,retval_zuweisung,reentry_statement)  \
  8160.     { pushSTACK(as_object((aint)(returner))); # SP in den Stack                 \
  8161.       pushSTACK(nullobj); # Dummy in den Stack, bis Wiedereintritt erlaubt ist  \
  8162.       if (!((retval_zuweisung setjmpl(returner))==0)) # Wiedereinspungpunkt herstellen \
  8163.         { RESTORE_mv_count(); RESTORE_value1(); reentry_statement } # nach dem Wiedereintritt \
  8164.         else                                                                    \
  8165.         { STACK_0 = framebottomword(frametype##_frame_info,top_of_frame); }     \
  8166.     }
  8167. # wird verwendet von EVAL, CONTROL, DEBUG
  8168.  
  8169. # Springt einen Frame mit Entrypoint an, der bei STACK beginnt.
  8170. # (Wichtig: Beim Einsprung mu▀ der STACK denselben Wert haben wie beim Aufbau
  8171. # des Frames, da der STACK bei setjmp/longjmp vielleicht gerettet wird!)
  8172. # Kehrt nie zurⁿck und rΣumt den SP auf!!
  8173. # Die multiple values werden ⁿbergeben.
  8174. # enter_frame_at_STACK();
  8175.   #define enter_frame_at_STACK()  \
  8176.     { var reg1 jmp_buf* returner = (void*)(aint)as_oint(STACK_(frame_SP)); # der returner von finish_entry_frame \
  8177.       SAVE_value1(); SAVE_mv_count();                                                                            \
  8178.       longjmpl(&!*returner,(aint)returner); # dorthin springen, eigene Adresse (/=0) ⁿbergeben                   \
  8179.       NOTREACHED                                                                                                 \
  8180.     }
  8181. # wird verwendet von EVAL
  8182.  
  8183. # Bei Driver-Frames ist evtl. auch noch der Wert
  8184. # von NUM_STACK_normal vor Aufbau des Frames enthalten:
  8185.   typedef struct { jmp_buf returner; # zuerst - wie bei allen - der jmp_buf
  8186.                    #ifdef HAVE_NUM_STACK
  8187.                    uintD* old_NUM_STACK_normal;
  8188.                    #endif
  8189.                  }
  8190.           DRIVER_frame_data;
  8191.  
  8192. # UP: Wendet eine Funktion auf ihre Argumente an.
  8193. # apply(function,args_on_stack,other_args);
  8194. # > function: Funktion
  8195. # > Argumente: args_on_stack Argumente auf dem STACK,
  8196. #              restliche Argumentliste in other_args
  8197. # < STACK: aufgerΣumt (d.h. STACK wird um args_on_stack erh÷ht)
  8198. # < mv_count/mv_space: Werte
  8199. # verΣndert STACK, kann GC ausl÷sen
  8200.   extern Values apply (object fun, uintC args_on_stack, object other_args);
  8201. # wird verwendet von EVAL, CONTROL, IO, PATHNAME, ERROR
  8202.  
  8203. # UP: Wendet eine Funktion auf ihre Argumente an.
  8204. # funcall(function,argcount);
  8205. # > function: Funktion
  8206. # > Argumente: argcount Argumente auf dem STACK
  8207. # < STACK: aufgerΣumt (d.h. STACK wird um argcount erh÷ht)
  8208. # < mv_count/mv_space: Werte
  8209. # verΣndert STACK, kann GC ausl÷sen
  8210.   extern Values funcall (object fun, uintC argcount);
  8211. # wird verwendet von allen Modulen
  8212.  
  8213. # UP: Wertet eine Form im aktuellen Environment aus.
  8214. # eval(form);
  8215. # > form: Form
  8216. # < mv_count/mv_space: Werte
  8217. # kann GC ausl÷sen
  8218.   extern Values eval (object form);
  8219. # wird verwendet von CONTROL, DEBUG
  8220.  
  8221. # UP: Wertet eine Form in einem gegebenen Environment aus.
  8222. # eval_5env(form,var,fun,block,go,decl);
  8223. # > var_env: Wert fⁿr VAR_ENV
  8224. # > fun_env: Wert fⁿr FUN_ENV
  8225. # > block_env: Wert fⁿr BLOCK_ENV
  8226. # > go_env: Wert fⁿr GO_ENV
  8227. # > decl_env: Wert fⁿr DECL_ENV
  8228. # > form: Form
  8229. # < mv_count/mv_space: Werte
  8230. # kann GC ausl÷sen
  8231.   extern Values eval_5env (object form, object var_env, object fun_env, object block_env, object go_env, object decl_env);
  8232. # wird verwendet von
  8233.  
  8234. # UP: Wertet eine Form in einem leeren Environment aus.
  8235. # eval_noenv(form);
  8236. # > form: Form
  8237. # < mv_count/mv_space: Werte
  8238. # kann GC ausl÷sen
  8239.   extern Values eval_noenv (object form);
  8240. # wird verwendet von CONTROL, IO, DEBUG
  8241.  
  8242. # UP: Wertet eine Form im aktuellen Environment aus. Nimmt dabei auf
  8243. # *EVALHOOK* und *APPLYHOOK* keine Rⁿcksicht.
  8244. # eval_no_hooks(form);
  8245. # > form: Form
  8246. # < mv_count/mv_space: Werte
  8247. # kann GC ausl÷sen
  8248.   extern Values eval_no_hooks (object form);
  8249. # wird verwendet von CONTROL
  8250.  
  8251. # UP: bindet *EVALHOOK* und *APPLYHOOK* dynamisch an die gegebenen Werte.
  8252. # bindhooks(evalhook_value,applyhook_value);
  8253. # > evalhook_value: Wert fⁿr *EVALHOOK*
  8254. # > applyhook_value: Wert fⁿr *APPLYHOOK*
  8255. # verΣndert STACK
  8256.   extern void bindhooks (object evalhook_value, object applyhook_value);
  8257. # wird verwendet von CONTROL
  8258.  
  8259. # UP: L÷st einen Frame auf, auf den STACK zeigt.
  8260. # unwind();
  8261. # Die Werte mv_count/mv_space bleiben dieselben.
  8262. # Falls es kein Unwind-Protect-Frame ist: kehrt normal zurⁿck.
  8263. # Falls es ein Unwind-Protect-Frame ist:
  8264. #   rettet die Werte, klettert STACK und SP hoch
  8265. #   und springt dann unwind_protect_to_save.fun an.
  8266. # verΣndert STACK
  8267. # kann GC ausl÷sen
  8268.   typedef /* nonreturning */ void (*restart)(object* upto_frame);
  8269.   typedef struct { restart fun; object* upto_frame; } unwind_protect_caller;
  8270.   extern unwind_protect_caller unwind_protect_to_save;
  8271.   extern void unwind (void);
  8272. # wird verwendet von CONTROL, DEBUG, SPVW
  8273.  
  8274. # UP: "unwindet" den STACK bis zum nΣchsten DRIVER_FRAME und
  8275. # springt in die entsprechende Top-Level-Schleife.
  8276. # reset();
  8277.   nonreturning_function(extern, reset, (void));
  8278. # wird verwendet von SPVW, CONTROL
  8279.  
  8280. # UP: bindet dynamisch die Symbole der Liste symlist
  8281. # an die Werte aus der Liste vallist.
  8282. # progv(symlist,vallist);
  8283. # > symlist, vallist: zwei Listen
  8284. # Es wird genau ein Variablenbindungsframe aufgebaut.
  8285. # verΣndert STACK
  8286.   extern void progv (object symlist, object vallist);
  8287. # wird verwendet von CONTROL
  8288.  
  8289. # UP: L÷st die dynamische Schachtelung im STACK auf bis zu dem Frame
  8290. # (ausschlie▀lich), auf den upto zeigt, und springt diesen dann an.
  8291. # unwind_upto(upto);
  8292. # > upto: Pointer auf einen Frame (in den Stack, ohne Typinfo).
  8293. # Rettet die Werte mv_count/mv_space.
  8294. # verΣndert STACK,SP
  8295. # kann GC ausl÷sen
  8296. # Springt dann den gefundenen Frame an.
  8297.   nonreturning_function(extern, unwind_upto, (object* upto_frame));
  8298. # wird verwendet von CONTROL, DEBUG
  8299.  
  8300. # UP: throwt zum Tag tag und ⁿbergibt dabei die Werte mv_count/mv_space.
  8301. # Kommt nur dann zurⁿck, wenn es keinen CATCH-Frame dieses Tags gibt.
  8302. # throw(tag);
  8303.   extern void throw (object tag);
  8304. # wird verwendet von CONTROL
  8305.  
  8306. # UP: Ruft alle Handler zur Condition cond auf. Kommt nur zurⁿck, wenn keiner
  8307. # dieser Handler sich zustΣndig fⁿhlt (d.h. wenn jeder Handler zurⁿckkehrt).
  8308. # invoke_handlers(cond);
  8309. # kann GC ausl÷sen
  8310.   extern void invoke_handlers (object cond);
  8311. # wird verwendet von ERROR
  8312.  
  8313. # UP: Stellt fest, ob ein Objekt ein Funktionsname, d.h. ein Symbol oder
  8314. # eine Liste der Form (SETF symbol), ist.
  8315. # funnamep(obj)
  8316. # > obj: Objekt
  8317. # < ergebnis: TRUE falls Funktionsname
  8318.   extern boolean funnamep (object obj);
  8319. # wird verwendet von CONTROL
  8320.  
  8321. # UP: Stellt fest, ob ein Symbol im aktuellen Environment einen Macro darstellt.
  8322. # sym_macrop(symbol)
  8323. # > symbol: Symbol
  8324. # < ergebnis: TRUE falls sym einen Symbol-Macro darstellt
  8325.   extern boolean sym_macrop (object sym);
  8326. # wird verwendet von CONTROL
  8327.  
  8328. # UP: Setzt den Wert eines Symbols im aktuellen Environment.
  8329. # setq(symbol,value);
  8330. # > symbol: Symbol, keine Konstante
  8331. # > value: gewⁿnschter Wert des Symbols im aktuellen Environment
  8332.   extern void setq (object sym, object value);
  8333. # wird verwendet von CONTROL
  8334.  
  8335. # UP: Liefert zu einem Symbol seine Funktionsdefinition in einem Environment
  8336. # sym_function(sym,fenv)
  8337. # > sym: Funktionsname (z.B. Symbol)
  8338. # > fenv: ein Funktions- und Macrobindungs-Environment
  8339. # < ergebnis: Funktionsdefinition, entweder unbound (falls undefinierte Funktion)
  8340. #             oder Closure/SUBR/FSUBR oder ein Cons (SYS::MACRO . expander).
  8341.   extern object sym_function (object sym, object fenv);
  8342. # wird verwendet von CONTROL
  8343.  
  8344. # UP: "nestet" ein FUN-Environment, d.h. schreibt alle aktiven Bindungen
  8345. # aus dem Stack in neu allozierte Vektoren.
  8346. # nest_fun(env)
  8347. # > env: FUN-Env
  8348. # < ergebnis: selbes Environment, kein Pointer in den Stack
  8349. # kann GC ausl÷sen
  8350.   extern object nest_fun (object env);
  8351. # wird verwendet von CONTROL
  8352.  
  8353. # UP: Nestet die Environments in *env (d.h. schreibt alle Informationen in
  8354. # Stack-unabhΣngige Strukturen) und schiebt sie auf den STACK.
  8355. # nest_env(env)
  8356. # > environment* env: Pointer auf fⁿnf einzelne Environments
  8357. # < environment* ergebnis: Pointer auf die Environments im STACK
  8358. # verΣndert STACK, kann GC ausl÷sen
  8359.   extern environment* nest_env (environment* env);
  8360. # wird verwendet von Macro nest_aktenv
  8361.  
  8362. # UP: Nestet die aktuellen Environments (d.h. schreibt alle Informationen in
  8363. # Stack-unabhΣngige Strukturen) und schiebt sie auf den STACK.
  8364. # (Die Werte VAR_ENV, FUN_ENV, BLOCK_ENV, GO_ENV, DECL_ENV werden nicht
  8365. # verΣndert, da evtl. noch inaktive Bindungen in Frames sitzen, die ohne
  8366. # VerΣnderung von VAR_ENV aktiviert werden k÷nnen mⁿssen.)
  8367. # nest_aktenv()
  8368. # < environment* ergebnis: Pointer auf die Environments im STACK
  8369. # verΣndert STACK, kann GC ausl÷sen
  8370.   # extern environment* nest_aktenv (void);
  8371.   #define nest_aktenv()  nest_env(&aktenv)
  8372. # wird verwendet von CONTROL
  8373.  
  8374. # UP: ErgΣnzt ein Deklarations-Environment um ein decl-spec.
  8375. # augment_decl_env(declspec,env)
  8376. # > declspec: Deklarations-Specifier, ein Cons
  8377. # > env: Deklarations-Environment
  8378. # < ergebnis: neues (evtl. augmentiertes) Deklarations-Environment
  8379. # kann GC ausl÷sen
  8380.   extern object augment_decl_env (object new_declspec, object env);
  8381. # wird verwendet von CONTROL
  8382.  
  8383. # UP: expandiert eine Form, falls m÷glich, (nicht jedoch, wenn FSUBR-Aufruf
  8384. # oder Symbol) in einem Environment
  8385. # macroexp(form,venv,fenv);
  8386. # > form: Form
  8387. # > venv: ein Variablen- und Symbolmacro-Environment
  8388. # > fenv: ein Funktions- und Macrobindungs-Environment
  8389. # < value1: die Expansion
  8390. # < value2: NIL, wenn nicht expandiert,
  8391. #           T, wenn expandiert wurde
  8392. # kann GC ausl÷sen
  8393.   extern void macroexp (object form, object venv, object fenv);
  8394. # wird verwendet von CONTROL
  8395.  
  8396. # UP: expandiert eine Form, falls m÷glich, (auch, wenn FSUBR-Aufruf)
  8397. # in einem Environment
  8398. # macroexp0(form,env);
  8399. # > form: Form
  8400. # > env: ein Macroexpansions-Environment
  8401. # < value1: die Expansion
  8402. # < value2: NIL, wenn nicht expandiert,
  8403. #           T, wenn expandiert wurde
  8404. # kann GC ausl÷sen
  8405.   extern void macroexp0 (object form, object env);
  8406. # wird verwendet von CONTROL
  8407.  
  8408. # UP: Parse-Declarations-Docstring. Trennt von einer Formenliste diejenigen
  8409. # ab, die als Deklarationen bzw. Dokumentationsstring angesehen werden
  8410. # mⁿssen.
  8411. # parse_dd(formlist,venv,fenv)
  8412. # > formlist: ( {decl|doc-string} . body )
  8413. # > venv: ein Variablen- und Symbolmacro-Environment (fⁿr die Macroexpansionen)
  8414. # > fenv: Funktions- und Macrobindungs-Environment (fⁿr die Macroexpansionen)
  8415. # < value1: body
  8416. # < value2: Liste der decl-specs
  8417. # < value3: Doc-String oder NIL
  8418. # < ergebnis: TRUE falls eine (COMPILE)-Deklaration vorkam, FALSE sonst
  8419. # kann GC ausl÷sen
  8420.   extern boolean parse_dd (object formlist, object venv, object fenv);
  8421. # wird verwendet von CONTROL
  8422.  
  8423. # UP: Erzeugt zu einem Lambdabody die entsprechende Closure durch Zerlegen
  8424. # der Lambdaliste und eventuelles Macroexpandieren aller Formen.
  8425. # get_closure(lambdabody,name,env)
  8426. # > lambdabody: (lambda-list {decl|doc} {form})
  8427. # > name: Name, ein Symbol oder (SETF symbol)
  8428. # > env: Pointer auf die fⁿnf einzelnen Environments:
  8429. #        env->var_env = VENV, env->fun_env = FENV,
  8430. #        env->block_env = BENV, env->go_env = GENV,
  8431. #        end->decl_env = DENV.
  8432. # < ergebnis: Closure
  8433. # kann GC ausl÷sen
  8434.   extern object get_closure (object lambdabody, object name, environment* env);
  8435. # wird verwendet von CONTROL, SYMBOL, PREDTYPE
  8436.  
  8437. # UP: Wandelt ein Argument in eine Funktion um.
  8438. # coerce_function(obj)
  8439. # > obj: Objekt
  8440. # > subr_self: Aufrufer (ein SUBR)
  8441. # < ergebnis: Objekt als Funktion (SUBR oder Closure)
  8442. # kann GC ausl÷sen
  8443.   extern object coerce_function (object obj);
  8444. # wird verwendet von IO
  8445.  
  8446. # Bindet ein Symbol dynamisch an einen Wert.
  8447. # Baut hierzu einen dynamischen Variablenbindungsframe fⁿr 1 Variable auf.
  8448. # dynamic_bind(var,val)
  8449. # > var: ein Symbol
  8450. # > val: der neue Wert
  8451. # verringert STACK um 3 EintrΣge
  8452. # verΣndert STACK
  8453.   #define dynamic_bind(variable,val_to_use)  \
  8454.     { var reg2 object* top_of_frame = STACK;    \
  8455.       var reg1 object sym_to_bind = (variable); \
  8456.       # Frame aufbauen:                         \
  8457.       pushSTACK(Symbol_value(sym_to_bind));     \
  8458.       pushSTACK(sym_to_bind);                   \
  8459.       pushSTACK(framebottomword(DYNBIND_frame_info,top_of_frame)); \
  8460.       # Wert modifizieren:                      \
  8461.       Symbol_value(sym_to_bind) = (val_to_use); \
  8462.     }
  8463. # wird verwendet von IO, EVAL, DEBUG, ERROR
  8464.  
  8465. # L÷st einen dynamischen Variablenbindungsframe fⁿr 1 Variable auf.
  8466. # dynamic_unbind()
  8467. # erh÷ht STACK um 3 EintrΣge
  8468. # verΣndert STACK
  8469.   #define dynamic_unbind()  \
  8470.     { # Wert zurⁿckschreiben:              \
  8471.       Symbol_value(STACK_(1)) = STACK_(2); \
  8472.       # Frame abbauen:                     \
  8473.       skipSTACK(3);                        \
  8474.     }
  8475. # wird verwendet von IO, DEBUG
  8476.  
  8477. # Fⁿhrt "implizites PROGN" aus.
  8478. # implicit_progn(body,default)
  8479. # Fⁿhrt body als implizites PROGN aus. Falls body leer, ist default der Wert.
  8480. # kann GC ausl÷sen
  8481.   #define implicit_progn(body,default)  \
  8482.     { var reg1 object rest = (body);                                     \
  8483.       if atomp(rest)                                                     \
  8484.         { value1 = (default); mv_count=1; } # default als Wert           \
  8485.         else                                                             \
  8486.           do { pushSTACK(Cdr(rest)); eval(Car(rest)); rest=popSTACK(); } \
  8487.              while (consp(rest));                                        \
  8488.     }
  8489. # wird verwendet von EVAL, CONTROL
  8490.  
  8491. # Maximalzahl von Parametern in einer Lambdaliste
  8492. # (= Wert von LAMBDA-PARAMETERS-LIMIT - 1)
  8493.   #define lp_limit_1  ((uintL)(bitm(intCsize)-1))
  8494.  
  8495. # Maximalzahl von Argumenten bei einem Funktionsaufruf
  8496. # (= Wert von CALL-ARGUMENTS-LIMIT - 1)
  8497.   #define ca_limit_1  ((uintL)(bitm(intCsize)-1))
  8498.  
  8499. # Der Macro LISPSPECFORM leitet eine LISP-Special-Form-Deklaration ein.
  8500. # LISPSPECFORM(name,req_anz,opt_anz,body_flag)
  8501. # > name: C-Name der Funktion und des Symbols.
  8502. # > req_anz: Anzahl der required Parameter
  8503. # > opt_anz: Anzahl der optionalen Parameter
  8504. # > body_flag: body oder nobody, zeigt an, ob &BODY vorhanden
  8505. # Siehe FSUBR.D
  8506.   #define LISPSPECFORM  LISPSPECFORM_B
  8507. # wird verwendet von CONTROL
  8508.  
  8509. # Der Macro LISPFUN leitet eine LISP-Funktions-Deklaration ein.
  8510. # LISPFUN(name,req_anz,opt_anz,rest_flag,key_flag,key_anz,allow_flag,keywords)
  8511. # > name: der Funktionsname (ein C-Identifier)
  8512. # > req_anz: die Anzahl der required-Parameter (eine Zahl)
  8513. # > opt_anz: die Anzahl der optional-Parameter (eine Zahl)
  8514. # > rest_flag: entweder norest oder rest, zeigt an, ob &REST vorhanden
  8515. # > key_flag: entweder nokey oder key, zeigt an, ob &KEY vorhanden
  8516. # > key_anz: Anzahl der Keyword-Parameter, eine Zahl (0 falls nokey)
  8517. # > allow_flag: entweder noallow oder allow, zeigt an, on &ALLOW-OTHER-KEYS
  8518. #               nach &KEY vorhanden (noallow falls nokey)
  8519. # > keywords: entweder NIL oder ein Ausdruck der Form v(kw(keyword1),...,kw(keywordn))
  8520. #             (NIL falls nokey)
  8521. # Siehe SUBR.D
  8522.   #define LISPFUN  LISPFUN_B
  8523. # wird verwendet von allen Modulen
  8524.  
  8525. # Der Macro LISPFUNN leitet eine einfache LISP-Funktions-Deklaration ein.
  8526. # LISPFUNN(name,req_anz)
  8527. # > name: der Funktionsname (ein C-Identifier)
  8528. # > req_anz: die (feste) Anzahl der Argumente (eine Zahl)
  8529. # Siehe SUBR.D
  8530. # wird verwendet von allen Modulen
  8531.  
  8532.  
  8533. # ##################### CTRLBIBL zu CONTROL.D ############################# #
  8534.  
  8535. # Fehler, wenn ein Block bereits verlassen wurde.
  8536. # fehler_block_left(name);
  8537. # > name: Block-Name
  8538.   nonreturning_function(extern, fehler_block_left, (object name));
  8539. # wird verwendet von EVAL
  8540.  
  8541. # Fehlermeldung wegen undefinierter Funktion.
  8542. # fehler_undef_function(caller,symbol);
  8543. # > caller: Aufrufer (ein Symbol)
  8544. # > symbol: Symbol oder (SETF symbol)
  8545.   nonreturning_function(extern, fehler_undef_function, (object caller, object symbol));
  8546. # wird verwendet von PREDTYPE
  8547.  
  8548. # ####################### ARRBIBL zu ARRAY.D ############################## #
  8549.  
  8550. # ARRAY-TOTAL-SIZE-LIMIT wird so gro▀ gewΣhlt, da▀ die Total-Size eines
  8551. # jeden Arrays ein Fixnum (>=0, <2^oint_data_len) ist:
  8552.   #define arraysize_limit_1  ((uintL)(bitm(oint_data_len)-1))
  8553.  
  8554. # ARRAY-RANK-LIMIT wird so gro▀ gewΣhlt, da▀ der Rang eines jeden Arrays
  8555. # ein uintC ist:
  8556.   #define arrayrank_limit_1  ((uintL)(bitm(intCsize)-1))
  8557.  
  8558. # UP: Kopiert einen Simple-Vector
  8559. # copy_svector(vector)
  8560. # > vector : Simple-Vector
  8561. # < ergebnis : neuer Simple-Vector desselben Inhalts
  8562. # kann GC ausl÷sen
  8563.   extern object copy_svector (object vector);
  8564. # wird verwendet von IO, REXX
  8565.  
  8566. # UP: Bestimmt die aktive LΣnge eines Vektors (wie in LENGTH)
  8567. # vector_length(vector)
  8568. # > vector: ein Vektor
  8569. # < ergebnis: seine LΣnge als uintL
  8570.   extern uintL vector_length (object vector);
  8571. # wird verwendet von SEQUENCE, CHARSTRG, PREDTYPE, IO, HASHTABL, SPVW
  8572.  
  8573. # Wandelt element-type in einen der Standard-Typen um
  8574. # und liefert seinen Elementtyp-Code.
  8575. # eltype_code(element_type)
  8576. # > element_type: Type-Specifier
  8577. # < ergebnis: Elementtyp-Code Atype_xxx
  8578. # Standard-Typen sind die m÷glichen Ergebnisse von ARRAY-ELEMENT-TYPE
  8579. # (Symbole T, BIT, STRING-CHAR und Listen (UNSIGNED-BYTE n)).
  8580. # Das Ergebnis ist ein Obertyp von element-type.
  8581. # kann GC ausl÷sen
  8582.   extern uintB eltype_code (object element_type);
  8583. # wird verwendet von SEQUENCE
  8584.  
  8585. # UP: Liefert zu einem Array gegebener Gr÷▀e den Datenvektor und den Offset.
  8586. # ▄berprⁿft auch, ob alle Elemente des Arrays physikalisch vorhanden sind.
  8587. # array1_displace_check(array,size,&index)
  8588. # > object array: (echter) Array
  8589. # > uintL size: Gr÷▀e
  8590. # < ergebnis: Datenvektor
  8591. # < index: wird um den Offset in den Datenvektor erh÷ht.
  8592.   extern object array1_displace_check (object array, uintL size, uintL* index);
  8593. # wird verwendet von IO, CHARSTRG, PREDTYPE, STREAM, SEQUENCE
  8594.  
  8595. # UP: Liefert zu einem Array gegebener Gr÷▀e den Datenvektor und den Offset.
  8596. # ▄berprⁿft auch, ob alle Elemente des Arrays physikalisch vorhanden sind.
  8597. # array_displace_check(array,size,&index)
  8598. # > object array: Array
  8599. # > uintL size: Gr÷▀e
  8600. # < ergebnis: Datenvektor
  8601. # < index: wird um den Offset in den Datenvektor erh÷ht.
  8602.   extern object array_displace_check (object array, uintL size, uintL* index);
  8603. # wird verwendet von PATHNAME, HASHTABL, PREDTYPE, IO
  8604.  
  8605. # Fⁿhrt einen AREF-Zugriff aus.
  8606. # datenvektor_aref(datenvektor,index)
  8607. # > datenvektor : ein Datenvektor (simpler Vektor oder semi-simpler Byte-Vektor)
  8608. # > index : (geprⁿfter) Index in den Datenvektor
  8609. # < ergebnis : (AREF datenvektor index)
  8610. # kann GC ausl÷sen
  8611.   extern object datenvektor_aref (object datenvektor, uintL index);
  8612. # wird verwendet von IO
  8613.  
  8614. # UP: fragt ein Bit in einem Simple-Bit-Vector ab
  8615. # if (sbvector_btst(sbvector,index)) ...
  8616. # > sbvector: ein Simple-Bit-Vector
  8617. # > index: Index (Variable, sollte < (length sbvector) sein)
  8618.   #define sbvector_btst(sbvector_from_sbvector_btst,index_from_sbvector_btst)  \
  8619.     ( # im Byte (index div 8) das Bit 7 - (index mod 8) : \
  8620.      TheSbvector(sbvector_from_sbvector_btst)->data[(uintL)(index_from_sbvector_btst)/8] \
  8621.        & bit((~(uintL)(index_from_sbvector_btst)) % 8)    \
  8622.     )
  8623. # wird verwendet von ARRAY, SEQUENCE, IO
  8624.  
  8625. # UP: l÷scht ein Bit in einem Simple-Bit-Vector
  8626. # sbvector_bclr(sbvector,index);
  8627. # > sbvector: ein Simple-Bit-Vector
  8628. # > index: Index (Variable, sollte < (length sbvector) sein)
  8629.   #define sbvector_bclr(sbvector_from_sbvector_bclr,index_from_sbvector_bclr)  \
  8630.     ( # im Byte (index div 8) das Bit 7 - (index mod 8) l÷schen: \
  8631.       TheSbvector(sbvector_from_sbvector_bclr)->data[(uintL)(index_from_sbvector_bclr)/8] \
  8632.         &= ~bit((~(uintL)(index_from_sbvector_bclr)) % 8)        \
  8633.     )
  8634. # wird verwendet von IO
  8635.  
  8636. # UP: setzt ein Bit in einem Simple-Bit-Vector
  8637. # sbvector_bset(sbvector,index);
  8638. # > sbvector: ein Simple-Bit-Vector
  8639. # > index: Index (Variable, sollte < (length sbvector) sein)
  8640.   #define sbvector_bset(sbvector_from_sbvector_bset,index_from_sbvector_bset)  \
  8641.     ( # im Byte (index div 8) das Bit 7 - (index mod 8) setzen: \
  8642.       TheSbvector(sbvector_from_sbvector_bset)->data[(uintL)(index_from_sbvector_bset)/8] \
  8643.         |= bit((~(uintL)(index_from_sbvector_bset)) % 8)        \
  8644.     )
  8645. # wird verwendet von SEQUENCE, IO
  8646.  
  8647. # UP, liefert den Element-Typ eines Arrays
  8648. # array_element_type(array)
  8649. # > array : ein Array (simple oder nicht)
  8650. # < ergebnis : Element-Typ, eines der Symbole T, BIT, STRING-CHAR, oder eine Liste
  8651. # kann GC ausl÷sen
  8652.   extern object array_element_type (object array);
  8653. # wird verwendet von PREDTYPE, IO
  8654.  
  8655. # UP, bildet Liste der Dimensionen eines Arrays
  8656. # array_dimensions(array)
  8657. # > array: ein Array (simple oder nicht)
  8658. # < ergebnis: Liste seiner Dimensionen
  8659. # kann GC ausl÷sen
  8660.   extern object array_dimensions (object array);
  8661. # wird verwendet von PREDTYPE, IO
  8662.  
  8663. # UP, liefert Dimensionen eines Arrays und ihre Teilprodukte
  8664. # array_dims_sizes(array,&dims_sizes);
  8665. # > array: (echter) Array vom Rang r
  8666. # > struct { uintL dim; uintL dimprod; } dims_sizes[r]: Platz fⁿrs Ergebnis
  8667. # < fⁿr i=1,...r:  dims_sizes[r-i] = { Dim_i, Dim_i * ... * Dim_r }
  8668.   typedef struct { uintL dim; uintL dimprod; }  array_dim_size;
  8669.   extern void array_dims_sizes (object array, array_dim_size* dims_sizes);
  8670. # wird verwendet von IO
  8671.  
  8672. # Liefert die Gesamtgr÷▀e eines Arrays
  8673. # array_total_size(array)
  8674. # > array: ein Array (simple oder nicht)
  8675. # < uintL ergebnis: seine Gesamtgr÷▀e
  8676.   #define array_total_size(array)  \
  8677.     (array_simplep(array)                                                   \
  8678.       ? TheSarray(array)->length # simpler Vektor: LΣnge                    \
  8679.       : TheArray(array)->totalsize # nicht-simpler Array enthΣlt Total-Size \
  8680.     )
  8681. # wird verwendet von ARRAY, PREDTYPE, IO, SEQUENCE
  8682.  
  8683. # Unterprogramm fⁿr Bitvektor-Vergleich:
  8684. # bit_compare(array1,index1,array2,index2,count)
  8685. # > array1: erster Bit-Array,
  8686. # > index1: absoluter Index in array1
  8687. # > array2: zweiter Bit-Array,
  8688. # > index2: absoluter Index in array2
  8689. # > count: Anzahl der zu vergleichenden Bits
  8690. # < ergebnis: TRUE, wenn die Ausschnitte bitweise gleich sind, FALSE sonst.
  8691.   extern boolean bit_compare (object array1, uintL index1,
  8692.                               object array2, uintL index2,
  8693.                               uintL bitcount);
  8694. # wird verwendet von PREDTYPE
  8695.  
  8696. # UP: Testet, ob ein Array einen Fill-Pointer hat.
  8697. # array_has_fill_pointer_p(array)
  8698. # > array: ein Array
  8699. # < TRUE, falls ja; FALSE falls nein.
  8700.   extern boolean array_has_fill_pointer_p (object array);
  8701. # wird verwendet von SEQUENCE, STREAM, IO
  8702.  
  8703. # UP: erzeugt einen mit Nullen gefⁿllten Bitvektor
  8704. # allocate_bit_vector_0(len)
  8705. # > uintL len: LΣnge des Bitvektors (in Bits)
  8706. # < ergebnis: neuer Bitvektor, mit Nullen gefⁿllt
  8707. # kann GC ausl÷sen
  8708.   extern object allocate_bit_vector_0 (uintL len);
  8709. # wird verwendet von SEQUENCE
  8710.  
  8711. # Folgende beide Funktionen arbeiten auf "Semi-Simple String"s.
  8712. # Das sind STRING-CHAR-Arrays mit FILL-POINTER, die aber nicht adjustierbar
  8713. # und nicht displaced sind und deren Datenvektor ein Simple-String ist.
  8714. # Beim ▄berschreiten der LΣnge wird ihre LΣnge verdoppelt
  8715. # (so da▀ der Aufwand fⁿrs Erweitern nicht sehr ins Gewicht fΣllt).
  8716.  
  8717. # UP: Liefert einen Semi-Simple String gegebener LΣnge, Fill-Pointer =0.
  8718. # make_ssstring(len)
  8719. # > uintL len: LΣnge >0
  8720. # < ergebnis: neuer Semi-Simple String dieser LΣnge
  8721. # kann GC ausl÷sen
  8722.   extern object make_ssstring (uintL len);
  8723. # wird verwendet von STREAM, IO
  8724.  
  8725. # UP: Schiebt ein String-Char in einen Semi-Simple String und erweitert ihn
  8726. # dabei eventuell.
  8727. # ssstring_push_extend(ssstring,ch)
  8728. # > ssstring: Semi-Simple String
  8729. # > ch: Character
  8730. # < ergebnis: derselbe Semi-Simple String
  8731. # kann GC ausl÷sen
  8732.   extern object ssstring_push_extend (object ssstring, uintB ch);
  8733. # wird verwendet von STREAM, IO
  8734.  
  8735. #ifdef STRM_WR_SS
  8736. # UP: Stellt sicher, da▀ ein Semi-Simple String eine bestimmte LΣnge hat
  8737. # und erweitert ihn dazu eventuell.
  8738. # ssstring_extend(ssstring,size)
  8739. # > ssstring: Semi-Simple String
  8740. # > size: gewⁿnschte Mindestgr÷▀e
  8741. # < ergebnis: derselbe Semi-Simple String
  8742. # kann GC ausl÷sen
  8743.   extern object ssstring_extend (object ssstring, uintL needed_len);
  8744. # wird verwendet von STREAM
  8745. #endif
  8746.  
  8747. # ##################### CHARBIBL zu CHARSTRG.D ############################ #
  8748.  
  8749. # Spezielle Characters: (siehe auch oben)
  8750. # #define BEL   7  #  #\Bell
  8751. # #define BS    8  #  #\Backspace
  8752. # #define TAB   9  #  #\Tab
  8753. # #define LF   10  #  #\Linefeed
  8754. # #define CR   13  #  #\Return
  8755. # #define PG   12  #  #\Page
  8756.   #define NL   10  #  #\Newline
  8757.   #define NLstring  "\n"  # C-String, der #\Newline enthΣlt
  8758.   #define ESC  27  #  #\Escape
  8759.   #define ESCstring  "\033"  # C-String, der #\Escape enthΣlt
  8760.  
  8761. # Wandelt Byte ch in einen Gro▀buchstaben
  8762. # up_case(ch)
  8763.   extern uintB up_case (uintB ch);
  8764. # wird verwendet von IO, PREDTYPE, PATHNAME
  8765.  
  8766. # Wandelt Byte ch in einen Kleinbuchstaben
  8767. # down_case(ch)
  8768.   extern uintB down_case (uintB ch);
  8769. # wird verwendet von IO, PATHNAME
  8770.  
  8771. # Stellt fest, ob ein Character alphanumerisch ist.
  8772. # alphanumericp(ch)
  8773. # > ch: Character-Code
  8774. # < ergebnis: TRUE falls alphanumerisch, FALSE sonst.
  8775.   extern boolean alphanumericp (uintB ch);
  8776. # wird verwendet von IO, PATHNAME
  8777.  
  8778. # Stellt fest, ob ein Character ein Graphic-Character ("druckend") ist.
  8779. # graphic_char_p(ch)
  8780. # > ch: Character-Code
  8781. # < ergebnis: TRUE falls druckend, FALSE sonst.
  8782.   extern boolean graphic_char_p (uintB ch);
  8783. # wird verwendet von STREAM, PATHNAME
  8784.  
  8785. # UP: verfolgt einen String.
  8786. # unpack_string(string,&len)
  8787. # > object string: ein String.
  8788. # < uintL len: Anzahl der Zeichen des Strings.
  8789. # < uintB* ergebnis: Anfangsadresse der Bytes
  8790.   extern uintB* unpack_string (object string, uintL* len);
  8791. # wird verwendet von STREAM, HASHTABL, PACKAGE, SPVW, STDWIN, GRAPH
  8792.  
  8793. # UP: vergleicht zwei Strings auf Gleichheit
  8794. # string_gleich(string1,string2)
  8795. # > string1: String
  8796. # > string2: simple-string
  8797. # < ergebnis: /=0, wenn gleich
  8798.   extern boolean string_gleich (object string1, object string2);
  8799. # wird verwendet von PACKAGE, STREAM, IO
  8800.  
  8801. # UP: vergleicht zwei Strings auf Gleichheit, case-insensitive
  8802. # string_equal(string1,string2)
  8803. # > string1: String
  8804. # > string2: simple-string
  8805. # < ergebnis: /=0, wenn gleich
  8806.   extern boolean string_equal (object string1, object string2);
  8807. # wird verwendet von IO, PATHNAME
  8808.  
  8809. # UP: kopiert einen String und macht dabei einen Simple-String draus.
  8810. # copy_string(string)
  8811. # > string: String
  8812. # < ergebnis: Simple-String mit denselben Zeichen
  8813. # kann GC ausl÷sen
  8814.   extern object copy_string (object string);
  8815. # wird verwendet von IO, PATHNAME
  8816.  
  8817. # UP: wandelt einen String in einen Simple-String um.
  8818. # coerce_ss(obj)
  8819. # > obj: Lisp-Objekt, sollte ein String sein.
  8820. # < ergebnis: Simple-String mit denselben Zeichen
  8821. # kann GC ausl÷sen
  8822.   extern object coerce_ss (object obj);
  8823. # wird verwendet von STREAM, PATHNAME, Macro coerce_imm_ss
  8824.  
  8825. # UP: wandelt einen String in einen immutablen Simple-String um.
  8826. # coerce_imm_ss(obj)
  8827. # > obj: Lisp-Objekt, sollte ein String sein.
  8828. # < ergebnis: immutabler Simple-String mit denselben Zeichen
  8829. # kann GC ausl÷sen
  8830.   #ifdef IMMUTABLE_ARRAY
  8831.     #define coerce_imm_ss(obj)  make_imm_array(copy_string(obj))
  8832.   #else
  8833.     #define coerce_imm_ss(obj)  coerce_ss(obj)
  8834.   #endif
  8835. # wird verwendet von PACKAGE
  8836.  
  8837. # UP: Konversion eines Objekts zu einem Character
  8838. # coerce_char(obj)
  8839. # > obj: Lisp-Objekt
  8840. # < ergebnis: Character oder NIL
  8841.   extern object coerce_char (object obj);
  8842. # wird verwendet von PREDTYPE
  8843.  
  8844. # UP: Liefert den Namen eines Zeichens.
  8845. # char_name(code)
  8846. # > uintB code: Ascii-Code eines Zeichens
  8847. # < ergebnis: Simple-String (Name dieses Zeichens) oder NIL
  8848.   extern object char_name (uintB code);
  8849. # wird verwendet von IO
  8850.  
  8851. # UP: Bestimmt das Character mit einem gegebenen Namen
  8852. # name_char(string)
  8853. # > string: String
  8854. # < ergebnis: Character mit diesem Namen, oder NIL falls keins existiert
  8855.   extern object name_char (object string);
  8856. # wird verwendet von IO
  8857.  
  8858. # UP: ▄berprⁿft die Grenzen fⁿr ein String-Argument
  8859. # test_string_limits(&string,&start,&len)
  8860. # > STACK_2: String-Argument
  8861. # > STACK_1: optionales :start-Argument
  8862. # > STACK_0: optionales :end-Argument
  8863. # > subr_self: Aufrufer (ein SUBR)
  8864. # < object string: String
  8865. # < uintL start: Wert des :start-Arguments
  8866. # < uintL len: Anzahl der angesprochenen Characters
  8867. # < uintB* ergebnis: Ab hier kommen die angesprochenen Characters
  8868. # erh÷ht STACK um 3
  8869.   extern uintB* test_string_limits (object* string_, uintL* start_, uintL* len_);
  8870. # wird verwendet von STREAM, PATHNAME, IO
  8871.  
  8872. # UP: wandelt die Characters eines Stringstⁿcks in Gro▀buchstaben
  8873. # nstring_upcase(charptr,len);
  8874. # > uintB* charptr: Ab hier kommen die angesprochenen Characters
  8875. # > uintL len: Anzahl der angesprochenen Characters
  8876.   extern void nstring_upcase (uintB* charptr, uintL len);
  8877. # wird verwendet von
  8878.  
  8879. # UP: wandelt die Characters eines Stringstⁿcks in Kleinbuchstaben
  8880. # nstring_downcase(charptr,len);
  8881. # > uintB* charptr: Ab hier kommen die angesprochenen Characters
  8882. # > uintL len: Anzahl der angesprochenen Characters
  8883.   extern void nstring_downcase (uintB* charptr, uintL len);
  8884. # wird verwendet von PATHNAME
  8885.  
  8886. # UP: wandelt die Worte eines Stringstⁿcks in solche, die
  8887. # mit Gro▀buchstaben anfangen und mit Kleinbuchstaben weitergehen.
  8888. # nstring_capitalize(charptr,len);
  8889. # > uintB* charptr: Ab hier kommen die angesprochenen Characters
  8890. # > uintL len: Anzahl der angesprochenen Characters
  8891.   extern void nstring_capitalize (uintB* charptr, uintL len);
  8892. # wird verwendet von PATHNAME
  8893.  
  8894. # UP: wandelt einen String in Gro▀buchstaben
  8895. # string_upcase(string)
  8896. # > string: String
  8897. # < ergebnis: neuer Simple-String, in Gro▀buchstaben
  8898. # kann GC ausl÷sen
  8899.   extern object string_upcase (object string);
  8900. # wird verwendet von MISC, PATHNAME
  8901.  
  8902. # UP: wandelt einen String in Kleinbuchstaben
  8903. # string_downcase(string)
  8904. # > string: String
  8905. # < ergebnis: neuer Simple-String, in Kleinbuchstaben
  8906. # kann GC ausl÷sen
  8907.   extern object string_downcase (object string);
  8908. # wird verwendet von PATHNAME
  8909.  
  8910. # UP: bildet einen aus mehreren Strings zusammengehΣngten String.
  8911. # string_concat(argcount)
  8912. # > uintC argcount: Anzahl der Argumente
  8913. # > auf dem STACK: die Argumente (sollten Strings sein)
  8914. # > subr_self: Aufrufer (ein SUBR) (unn÷tig, falls alle Argumente Strings sind)
  8915. # < ergebnis: Gesamtstring, neu erzeugt
  8916. # < STACK: aufgerΣumt
  8917. # kann GC ausl÷sen
  8918.   extern object string_concat (uintC argcount);
  8919. # wird verwendet von PACKAGE, PATHNAME, DEBUG, SYMBOL
  8920.  
  8921. # ###################### DEBUGBIB zu DEBUG.D ############################ #
  8922.  
  8923. # Startet den normalen Driver (Read-Eval-Print-Loop)
  8924. # driver();
  8925.   extern void driver (void);
  8926. # wird verwendet von SPVW
  8927.  
  8928. # Startet einen untergeordneten Driver (Read-Eval-Print-Loop)
  8929. # break_driver(continuable);
  8930. # > continuable: Flag, ob nach Beendigung des Drivers fortgefahren werden kann.
  8931. # kann GC ausl÷sen
  8932.   extern void break_driver (object continuable);
  8933. # wird verwendet von ERROR, EVAL
  8934.  
  8935. # ##################### HASHBIBL zu HASHTABL.D ########################## #
  8936.  
  8937. # UP: Sucht ein Objekt in einer Hash-Tabelle.
  8938. # gethash(obj,ht)
  8939. # > obj: Objekt, als Key
  8940. # > ht: Hash-Tabelle
  8941. # < ergebnis: zugeh÷riger Value, falls gefunden, nullobj sonst
  8942.   extern object gethash (object obj, object ht);
  8943. # wird verwendet von EVAL, RECORD, PATHNAME
  8944.  
  8945. # UP: Sucht ein Key in einer Hash-Tabelle und liefert den vorigen Wert.
  8946. # shifthash(ht,obj,value) == (SHIFTF (GETHASH obj ht) value)
  8947. # > ht: Hash-Tabelle
  8948. # > obj: Objekt
  8949. # > value: neuer Wert
  8950. # < ergebnis: alter Wert
  8951. # kann GC ausl÷sen
  8952.   extern object shifthash (object ht, object obj, object value);
  8953. # wird verwendet von SEQUENCE, PATHNAME
  8954.  
  8955. # ######################### IOBIBL zu IO.D ############################## #
  8956.  
  8957. # spezielles Objekt, das EOF anzeigt
  8958.   #define eof_value  make_system(0xE0FE0FUL)
  8959. # wird verwendet von IO, STREAM, DEBUG, SPVW
  8960.  
  8961. # Hilfswert zum Erkennen einzelner Dots
  8962.   #define dot_value  make_system(0xD0DD0DUL)
  8963. # wird verwendet von IO, SPVW
  8964.  
  8965. # UP: Initialisiert den Reader.
  8966. # init_reader();
  8967. # kann GC ausl÷sen
  8968.   extern void init_reader (void);
  8969. # wird verwendet von SPVW
  8970.  
  8971. # UP: Liest ein Objekt ein.
  8972. # read(&stream,recursive-p,whitespace-p)
  8973. # > recursive-p: gibt an, ob rekursiver Aufruf von READ, mit Error bei EOF
  8974. # > whitespace-p: gibt an, ob danach whitespace zu verbrauchen ist
  8975. # > stream: Stream
  8976. # < stream: Stream
  8977. # < ergebnis: gelesenes Objekt (eof_value bei EOF, dot_value bei einzelnem Punkt)
  8978. # kann GC ausl÷sen
  8979.   extern object read (object* stream_, object recursive_p, object whitespace_p);
  8980. # wird verwendet von SPVW, DEBUG
  8981.  
  8982. # UP: Gibt einen Simple-String elementweise auf einen Stream aus.
  8983. # write_sstring(&stream,string);
  8984. # > string: Simple-String
  8985. # > stream: Stream
  8986. # < stream: Stream
  8987. # kann GC ausl÷sen
  8988.   extern void write_sstring (object* stream_, object string);
  8989. # wird verwendet von EVAL, DEBUG, ERROR, PACKAGE, SPVW
  8990.  
  8991. # UP: Gibt einen String elementweise auf einen Stream aus.
  8992. # write_string(&stream,string);
  8993. # > string: String
  8994. # > stream: Stream
  8995. # < stream: Stream
  8996. # kann GC ausl÷sen
  8997.   extern void write_string (object* stream_, object string);
  8998. # wird verwendet von PACKAGE, DEBUG
  8999.  
  9000. # UP: Gibt ein Objekt auf einen Stream aus.
  9001. # prin1(&stream,obj);
  9002. # > obj: Objekt
  9003. # > stream: Stream
  9004. # < stream: Stream
  9005. # kann GC ausl÷sen
  9006.   extern void prin1 (object* stream_, object obj);
  9007. # wird verwendet von EVAL, DEBUG, PACKAGE, ERROR, SPVW
  9008.  
  9009. # UP: Gibt ein Newline auf einen Stream aus.
  9010. # terpri(&stream);
  9011. # > stream: Stream
  9012. # < stream: Stream
  9013. # kann GC ausl÷sen
  9014.   # extern void terpri (object* stream_);
  9015.   #define terpri(stream_)  write_schar(stream_,NL)
  9016. # wird verwendet von IO, DEBUG, PACKAGE, ERROR, SPVW
  9017.  
  9018. # ####################### LISTBIBL zu LIST.D ############################## #
  9019.  
  9020. # UP: Kopiert eine Liste
  9021. # copy_list(list)
  9022. # > list: Liste
  9023. # < ergebnis: Kopie der Liste
  9024. # kann GC ausl÷sen
  9025.   extern object copy_list (object list);
  9026. # wird verwendet von PACKAGE
  9027.  
  9028. # UP: Dreht eine Liste konstruktiv um.
  9029. # reverse(list)
  9030. # > list: Liste (x1 ... xm)
  9031. # < ergebnis: umgedrehte Liste (xm ... x1)
  9032. # kann GC ausl÷sen
  9033.   extern object reverse (object list);
  9034. # wird verwendet von SEQUENCE, PACKAGE, PATHNAME
  9035.  
  9036. # UP: Bestimmt die LΣnge einer Liste
  9037. # llength(obj)
  9038. # > obj: Objekt
  9039. # < uintL ergebnis: LΣnge von obj, als Liste aufgefa▀t
  9040. # Testet nicht auf zyklische Listen.
  9041.   extern uintL llength (object obj);
  9042. # wird verwendet von CONTROL, EVAL, SEQUENCE, RECORD, IO, PACKAGE, HASHTABL, STREAM
  9043.  
  9044. # UP: Bildet eine Liste mit genau len Elementen
  9045. # make_list(len)
  9046. # > (STACK): Initialisierungswert fⁿr die Elemente
  9047. # > uintL len: gewⁿnschte ListenlΣnge
  9048. # < ergebnis: Liste mit D1.L Elementen
  9049. # kann GC ausl÷sen
  9050.   extern object make_list (uintL len);
  9051. # wird verwendet von
  9052.  
  9053. # UP: Dreht eine Liste destruktiv um.
  9054. # nreverse(list)
  9055. # > list: Liste (x1 ... xm)
  9056. # < ergebnis: Liste (xm ... x1), EQ zur alten
  9057.   extern object nreverse (object list);
  9058. # wird verwendet von SEQUENCE, EVAL, CONTROL, IO, PATHNAME, ERROR, DEBUG, PACKAGE
  9059.  
  9060. # UP: A0 := (nreconc A0 A1)
  9061. # nreconc(list,obj)
  9062. # > list: Liste
  9063. # > obj: Objekt
  9064. # < ergebnis: (nreconc A0 A1)
  9065.   extern object nreconc (object list, object obj);
  9066. # wird verwendet von SEQUENCE, IO, PATHNAME, CONTROL, DEBUG
  9067.  
  9068. # UP: Bilde (delete obj (the list list) :test #'EQ)
  9069. # deleteq(list,obj)
  9070. # Entferne aus der Liste list alle Elemente, die EQ zu obj sind.
  9071. # > obj: zu streichendes Element
  9072. # > list: Liste
  9073. # < ergebnis: modifizierte Liste
  9074.   extern object deleteq (object list, object obj);
  9075. # wird verwendet von PACKAGE, STREAM
  9076.  
  9077. # UP: Bildet eine Liste mit gegebenen Elementen.
  9078. # listof(len)
  9079. # > uintC len: gewⁿnschte ListenlΣnge
  9080. # > auf STACK: len Objekte, erstes zuoberst
  9081. # < ergebnis: Liste dieser Objekte
  9082. # Erh÷ht STACK
  9083. # verΣndert STACK, kann GC ausl÷sen
  9084.   extern object listof (uintC len);
  9085. # wird verwendet von STREAM, PATHNAME, PACKAGE, ARRAY, EVAL, PREDTYPE, REXX, ERROR
  9086.  
  9087. # ####################### MISCBIBL zu MISC.D ############################## #
  9088.  
  9089. #ifdef TIME_RELATIVE
  9090.  
  9091. # UP: Merkt sich die Uhrzeit beim LISP-System-Start.
  9092. # set_start_time(&timepoint);
  9093. # > timepoint: Zeit beim LISP-System-Start
  9094. # >   timepoint.Sekunden in {0,...,59},
  9095. # >   timepoint.Minuten in {0,...,59},
  9096. # >   timepoint.Stunden in {0,...,23},
  9097. # >   timepoint.Tag in {1,...,31},
  9098. # >   timepoint.Monat in {1,...,12},
  9099. # >   timepoint.Jahr in {1980,...,2999},
  9100. # >   jeweils als Fixnums.
  9101. # kann GC ausl÷sen
  9102.   extern void set_start_time (decoded_time* timepoint);
  9103. # wird verwendet von SPVW
  9104.  
  9105. #endif
  9106.  
  9107. # ####################### ERRBIBL zu ERROR.D ############################## #
  9108.  
  9109. # Klassifikation der bekannten Condition-Typen:
  9110. # (Genauer gesagt, handelt es sich hier immer um die SIMPLE-... Typen.)
  9111.   typedef enum
  9112.   {
  9113.     # all kinds of conditions
  9114.     condition,
  9115.       # conditions that require interactive intervention
  9116.       serious_condition,
  9117.         # serious conditions that occur deterministically
  9118.         error,
  9119.           # statically detectable errors of a program
  9120.           program_error,
  9121.           # not statically detectable errors in program control
  9122.           control_error,
  9123.           # errors that occur while doing arithmetic operations
  9124.           arithmetic_error,
  9125.             # trying to evaluate a mathematical function at a singularity
  9126.             division_by_zero,
  9127.             # trying to get too close to infinity in the floating point domain
  9128.             floating_point_overflow,
  9129.             # trying to get too close to zero in the floating point domain
  9130.             floating_point_underflow,
  9131.           # trying to access a location which contains #<UNBOUND>
  9132.           cell_error,
  9133.             # trying to get the value of an unbound variable
  9134.             unbound_variable,
  9135.             # trying to get the global function definition of an undefined function
  9136.             undefined_function,
  9137.           # when some datum does not belong to the expected type
  9138.           type_error,
  9139.           # errors during operation on packages
  9140.           package_error,
  9141.           # errors while doing stream I/O
  9142.           stream_error,
  9143.             # unexpected end of stream
  9144.             end_of_file,
  9145.           # errors with pathnames, OS level errors with streams
  9146.           file_error,
  9147.         # "Virtual memory exhausted"
  9148.         storage_condition,
  9149.       # conditions for which user notification is appropriate
  9150.       warning,
  9151.     # junk
  9152.     condition_for_broken_compilers_that_dont_like_trailing_commas
  9153.   }
  9154.   conditiontype;
  9155.  
  9156. # Fehlermeldung mit Errorstring. Kehrt nicht zurⁿck.
  9157. # fehler(errortype,errorstring);
  9158. # > errortype: Condition-Typ
  9159. # > errorstring: Konstanter ASCIZ-String.
  9160. #   Bei jeder Tilde wird ein LISP-Objekt vom STACK genommen und statt der
  9161. #   Tilde ausgegeben.
  9162. # > auf dem STACK: Initialisierungswerte fⁿr die Condition, je nach errortype
  9163.   nonreturning_function(extern, fehler, (conditiontype errortype, const char * errorstring));
  9164. # wird von allen Modulen verwendet
  9165.  
  9166. #ifdef ATARI
  9167.   # Behandlung von BIOS- und GEMDOS-Fehlern
  9168.   # OS_error(errorcode);
  9169.   # > sintW errorcode: negativer Fehlercode
  9170.     nonreturning_function(extern, OS_error, (sintW errorcode));
  9171.   # wird verwendet von SPVW, STREAM, PATHNAME
  9172. #endif
  9173. #ifdef AMIGAOS
  9174.   # Behandlung von AMIGAOS-Fehlern
  9175.   # OS_error();
  9176.   # > IoErr(): Fehlercode
  9177.     nonreturning_function(extern, OS_error, (void));
  9178.   # wird verwendet von SPVW, STREAM, PATHNAME
  9179. #endif
  9180. #if defined(UNIX) || defined(DJUNIX) || defined(EMUNIX) || defined(WATCOM) || defined(RISCOS)
  9181.   # Behandlung von UNIX-Fehlern
  9182.   # OS_error();
  9183.   # > int errno: Fehlercode
  9184.     nonreturning_function(extern, OS_error, (void));
  9185.   # wird verwendet von SPVW, STREAM, PATHNAME, GRAPH
  9186. #endif
  9187. #if defined(UNIX) || defined(EMUNIX) || defined(WATCOM) || defined(RISCOS)
  9188.   # Initialisierung der Fehlertabelle:
  9189.     extern int init_errormsg_table (void);
  9190. #else
  9191.   # Nichts zu initialisieren.
  9192.     #define init_errormsg_table()  0
  9193. #endif
  9194.  
  9195. #if defined(UNIX) || defined(DJUNIX) || defined(EMUNIX) || defined(WATCOM) || defined(RISCOS)
  9196.   # Ausgabe eines Fehlers, direkt ⁿbers Betriebssystem
  9197.   # errno_out(errorcode);
  9198.   # > int errorcode: Fehlercode
  9199.     extern void errno_out (int errorcode);
  9200. #endif
  9201.  
  9202. # UP: Fⁿhrt eine Break-Schleife wegen Tastaturunterbrechung aus.
  9203. # > -(STACK) : aufrufende Funktion
  9204. # verΣndert STACK, kann GC ausl÷sen
  9205.   extern void tast_break (void);
  9206. # wird verwendet von EVAL, IO, SPVW, STREAM
  9207.  
  9208. # Fehlermeldung, wenn ein Objekt keine Liste ist.
  9209. # fehler_list(obj);
  9210. # > arg: Nicht-Liste
  9211. # > subr_self: Aufrufer (ein SUBR)
  9212.   nonreturning_function(extern, fehler_list, (object obj));
  9213. # wird verwendet von LIST, EVAL
  9214.  
  9215. # Fehlermeldung, wenn ein Objekt kein Symbol ist.
  9216. # fehler_kein_symbol(caller,obj);
  9217. # > caller: Aufrufer (ein Symbol)
  9218. # > obj: Nicht-Symbol
  9219.   nonreturning_function(extern, fehler_kein_symbol, (object caller, object obj));
  9220. # wird verwendet von EVAL, CONTROL
  9221.  
  9222. # Fehlermeldung, wenn ein Objekt kein Symbol ist.
  9223. # fehler_symbol(obj);
  9224. # > subr_self: Aufrufer (ein SUBR oder FSUBR)
  9225. # > obj: Nicht-Symbol
  9226.   nonreturning_function(extern, fehler_symbol, (object obj));
  9227. # wird verwendet von SYMBOL, CONTROL
  9228.  
  9229. # Fehlermeldung, wenn ein Objekt kein Simple-Vector ist.
  9230. # fehler_kein_svector(caller,obj);
  9231. # > caller: Aufrufer (ein Symbol)
  9232. # > obj: Nicht-Svector
  9233.   nonreturning_function(extern, fehler_kein_svector, (object caller, object obj));
  9234. # wird verwendet von ARRAY, EVAL
  9235.  
  9236. # Fehlermeldung, wenn ein Objekt kein Vektor ist.
  9237. # fehler_vector(obj);
  9238. # > subr_self: Aufrufer (ein SUBR)
  9239. # > obj: Nicht-Vektor
  9240.   nonreturning_function(extern, fehler_vector, (object obj));
  9241. # wird verwendet von ARRAY
  9242.  
  9243. # Fehlermeldung, falls ein Argument kein Character ist:
  9244. # fehler_char(obj);
  9245. # > obj: Das fehlerhafte Argument
  9246. # > subr_self: Aufrufer (ein SUBR)
  9247.   nonreturning_function(extern, fehler_char, (object obj));
  9248. # wird verwendet von CHARSTRG
  9249.  
  9250. # Fehler, wenn Argument kein String-Char ist.
  9251. # fehler_string_char(obj);
  9252. # > obj: fehlerhaftes Argument
  9253. # > subr_self: Aufrufer (ein SUBR)
  9254.   nonreturning_function(extern, fehler_string_char, (object obj));
  9255. # wird verwendet von IO, STDWIN
  9256.  
  9257. # Fehlermeldung, falls ein Argument kein String ist:
  9258. # fehler_string(obj);
  9259. # > obj: Das fehlerhafte Argument
  9260. # > subr_self: Aufrufer (ein SUBR)
  9261.   nonreturning_function(extern, fehler_string, (object obj));
  9262. # wird verwendet von CHARSTRG, STDWIN
  9263.  
  9264. # Fehlermeldung, falls ein Argument kein Simple-String ist:
  9265. # fehler_sstring(obj);
  9266. # > obj: Das fehlerhafte Argument
  9267. # > subr_self: Aufrufer (ein SUBR)
  9268.   nonreturning_function(extern, fehler_sstring, (object obj));
  9269. # wird verwendet von CHARSTRG
  9270.  
  9271. # Fehlermeldung, wenn ein Argument kein Stream ist:
  9272. # fehler_stream(obj);
  9273. # > obj: Das fehlerhafte Argument
  9274. # > subr_self: Aufrufer (ein SUBR)
  9275.   nonreturning_function(extern, fehler_stream, (object obj));
  9276. # wird verwendet von IO, STREAM, DEBUG
  9277.  
  9278. #ifdef HAVE_FFI
  9279. # ▄berprⁿfung eines Arguments
  9280. # check_...(obj);
  9281. # > obj: Argument
  9282. # > subr_self: Aufrufer (ein SUBR)
  9283. # obj sollte eine Variable sein
  9284.   #define check_string_char(obj)  \
  9285.     if (!string_char_p(obj)) { fehler_string_char(obj); }
  9286.   #define check_uint8(obj)  \
  9287.     if (!uint8_p(obj)) { fehler_uint8(obj); }
  9288.   #define check_sint8(obj)  \
  9289.     if (!sint8_p(obj)) { fehler_sint8(obj); }
  9290.   #define check_uint16(obj)  \
  9291.     if (!uint16_p(obj)) { fehler_uint16(obj); }
  9292.   #define check_sint16(obj)  \
  9293.     if (!sint16_p(obj)) { fehler_sint16(obj); }
  9294.   #define check_uint32(obj)  \
  9295.     if (!uint32_p(obj)) { fehler_uint32(obj); }
  9296.   #define check_sint32(obj)  \
  9297.     if (!sint32_p(obj)) { fehler_sint32(obj); }
  9298.   #define check_uint64(obj)  \
  9299.     if (!uint64_p(obj)) { fehler_uint64(obj); }
  9300.   #define check_sint64(obj)  \
  9301.     if (!sint64_p(obj)) { fehler_sint64(obj); }
  9302.   #define check_uint(obj)  \
  9303.     if (!uint_p(obj)) { fehler_uint(obj); }
  9304.   #define check_sint(obj)  \
  9305.     if (!sint_p(obj)) { fehler_sint(obj); }
  9306.   #define check_ulong(obj)  \
  9307.     if (!ulong_p(obj)) { fehler_ulong(obj); }
  9308.   #define check_slong(obj)  \
  9309.     if (!slong_p(obj)) { fehler_slong(obj); }
  9310.   #define check_ffloat(obj)  \
  9311.     if (!single_float_p(obj)) { fehler_ffloat(obj); }
  9312.   #define check_dfloat(obj)  \
  9313.     if (!double_float_p(obj)) { fehler_dfloat(obj); }
  9314.   nonreturning_function(extern, fehler_uint8, (object obj));
  9315.   nonreturning_function(extern, fehler_sint8, (object obj));
  9316.   nonreturning_function(extern, fehler_uint16, (object obj));
  9317.   nonreturning_function(extern, fehler_sint16, (object obj));
  9318.   nonreturning_function(extern, fehler_uint32, (object obj));
  9319.   nonreturning_function(extern, fehler_sint32, (object obj));
  9320.   nonreturning_function(extern, fehler_uint64, (object obj));
  9321.   nonreturning_function(extern, fehler_sint64, (object obj));
  9322.   nonreturning_function(extern, fehler_uint, (object obj));
  9323.   nonreturning_function(extern, fehler_sint, (object obj));
  9324.   nonreturning_function(extern, fehler_ulong, (object obj));
  9325.   nonreturning_function(extern, fehler_slong, (object obj));
  9326.   nonreturning_function(extern, fehler_ffloat, (object obj));
  9327.   nonreturning_function(extern, fehler_dfloat, (object obj));
  9328. # wird verwendet vom FFI
  9329. #endif
  9330.  
  9331. # ##################### PACKBIBL zu PACKAGE.D ############################# #
  9332.  
  9333. # UP: testet, ob ein Symbol in einer Package accessible ist und dabei nicht
  9334. # von einem anderen Symbol desselben Namens verdeckt wird.
  9335. # accessiblep(sym,pack)
  9336. # > sym: Symbol
  9337. # > pack: Package
  9338. # < ergebnis: TRUE falls sym in pack accessible und nicht verdeckt ist,
  9339. #             FALSE sonst
  9340.   extern boolean accessiblep (object sym, object pack);
  9341. # wird verwendet von IO
  9342.  
  9343. # UP: testet, ob ein Symbol in einer Package als externes Symbol accessible
  9344. # ist.
  9345. # externalp(sym,pack)
  9346. # > sym: Symbol
  9347. # > pack: Package
  9348. # < ergebnis: TRUE falls sym in pack als externes Symbol accessible ist,
  9349. #             FALSE sonst
  9350.   extern boolean externalp (object sym, object pack);
  9351. # wird verwendet von IO
  9352.  
  9353. # UP: sucht ein externes Symbol gegebenen Printnamens in einer Package.
  9354. # find_external_symbol(string,pack,&sym)
  9355. # > string: String
  9356. # > pack: Package
  9357. # < ergebnis: TRUE, falls ein externes Symbol dieses Printnamens in pack gefunden.
  9358. # < sym: dieses Symbol, falls gefunden.
  9359.   extern boolean find_external_symbol (object string, object pack, object* sym_);
  9360. # wird verwendet von IO
  9361.  
  9362. # UP: sucht eine Package mit gegebenem Namen oder Nickname
  9363. # find_package(string)
  9364. # > string: String
  9365. # < ergebnis: Package mit diesem Namen oder NIL
  9366.   extern object find_package (object string);
  9367. # wird verwendet von IO
  9368.  
  9369. # UP: Interniert ein Symbol gegebenen Printnamens in einer Package.
  9370. # intern(string,pack,&sym)
  9371. # > string: String
  9372. # > pack: Package
  9373. # < sym: Symbol
  9374. # < ergebnis: 0, wenn nicht gefunden, sondern neu erzeugt
  9375. #             1, wenn als externes Symbol vorhanden
  9376. #             2, wenn vererbt ⁿber use-list
  9377. #             3, wenn als internes Symbol vorhanden
  9378. # kann GC ausl÷sen
  9379.   extern uintBWL intern (object string, object pack, object* sym_);
  9380. # wird verwendet von IO, SPVW
  9381.  
  9382. # UP: Interniert ein Symbol gegebenen Printnamens in der Keyword-Package.
  9383. # intern_keyword(string)
  9384. # > string: String
  9385. # < ergebnis: Symbol, ein Keyword
  9386. # kann GC ausl÷sen
  9387.   extern object intern_keyword (object string);
  9388. # wird verwendet von IO, EVAL, GRAPH
  9389.  
  9390. # UP: Importiert ein Symbol in eine Package
  9391. # import(&sym,&pack);
  9392. # > sym: Symbol (im STACK)
  9393. # > pack: Package (im STACK)
  9394. # < sym: Symbol, EQ zum alten
  9395. # < pack: Package, EQ zur alten
  9396. # kann GC ausl÷sen
  9397.   extern void import (object* sym_, object* pack_);
  9398. # wird verwendet von SPVW
  9399.  
  9400. # UP: Exportiert ein Symbol aus einer Package
  9401. # export(&sym,&pack);
  9402. # > sym: Symbol (im STACK)
  9403. # > pack: Package (im STACK)
  9404. # < sym: Symbol, EQ zum alten
  9405. # < pack: Package, EQ zur alten
  9406. # kann GC ausl÷sen
  9407.   extern void export (object* sym_, object* pack_);
  9408. # wird verwendet von SPVW
  9409.  
  9410. # UP: liefert die aktuelle Package
  9411. # get_current_package()
  9412. # < ergebnis: aktuelle Package
  9413.   extern object get_current_package (void);
  9414. # wird verwendet von IO
  9415.  
  9416. # UP: Initialisiert die Packageverwaltung
  9417. # init_packages();
  9418.   extern void init_packages (void);
  9419. # wird verwendet von SPVW
  9420.  
  9421. # ##################### PATHBIBL zu PATHNAME.D ############################ #
  9422.  
  9423. # UP: Liefert den Directory-Namestring eines halbwegs ⁿberprⁿften Pathname
  9424. #     unter der Annahme, da▀ das Directory dieses Pathname existiert,
  9425. #     im Betriebssystem-Format.
  9426. # assume_dir_exists()
  9427. # > STACK_0: absoluter Pathname, halbwegs ⁿberprⁿft
  9428. # < STACK_0: (evtl. derselbe) Pathname, noch besser aufgel÷st
  9429. # < ergebnis:
  9430. #     falls Name=NIL: Directory-Namestring (fⁿrs BS)
  9431. #     falls Name/=NIL: Namestring (fⁿr BS, mit Nullbyte am Schlu▀)
  9432. # kann GC ausl÷sen
  9433.   extern object assume_dir_exists (void);
  9434. # wird verwendet von STREAM
  9435.  
  9436. # UP: Initialisiert das Pathname-System.
  9437. # init_pathnames();
  9438. # kann GC ausl÷sen
  9439.   extern void init_pathnames (void);
  9440. # wird verwendet von SPVW
  9441.  
  9442. # ##################### PREDBIBL zu PREDTYPE.D ############################ #
  9443.  
  9444. # UP: testet auf Atomgleichheit EQL
  9445. # eql(obj1,obj2)
  9446. # > obj1,obj2: Lisp-Objekte
  9447. # < ergebnis: TRUE, falls Objekte gleich
  9448.   extern boolean eql (object obj1, object obj2);
  9449. # wird verwendet von CONTROL, EVAL, HASHTABL, LISPARIT
  9450.  
  9451. # UP: testet auf Gleichheit EQUAL
  9452. # equal(obj1,obj2)
  9453. # > obj1,obj2: Lisp-Objekte
  9454. # < ergebnis: TRUE, falls Objekte gleich
  9455.   extern boolean equal (object obj1, object obj2);
  9456. # wird verwendet von EVAL, PATHNAME, HASHTABL, MISC
  9457.  
  9458. # UP: testet auf laschere Gleichheit EQUALP
  9459. # equalp(obj1,obj2)
  9460. # > obj1,obj2: Lisp-Objekte
  9461. # < ergebnis: TRUE, falls Objekte gleich
  9462. # kann GC ausl÷sen
  9463.   extern boolean equalp (object obj1, object obj2);
  9464. # wird verwendet von
  9465.  
  9466. # ###################### SEQBIBL zu SEQUENCE.D ############################ #
  9467.  
  9468. # UP: Wandelt ein Objekt in eine Sequence gegebenen Typs um.
  9469. # coerce_sequence(obj,result_type)
  9470. # > obj: Objekt, sollte eine Sequence sein
  9471. # > result_type: Bezeichner (Symbol) des Sequence-Typs
  9472. # < Wert: Sequence vom Typ result_type
  9473. # kann GC ausl÷sen
  9474.   extern Values coerce_sequence (object sequence, object result_type);
  9475. # wird verwendet von PREDTYPE, EVAL
  9476.  
  9477. # Fehler, wenn beide :TEST, :TEST-NOT - Argumente angegeben wurden.
  9478. # fehler_both_tests();
  9479. # > subr_self: Aufrufer (ein SUBR)
  9480.   nonreturning_function(extern, fehler_both_tests, (void));
  9481. # wird verwendet von LIST
  9482.  
  9483. # ###################### STRMBIBL zu STREAM.D ############################# #
  9484.  
  9485. # UP: Initialisiert die Stream-Variablen.
  9486. # init_streamvars();
  9487. # kann GC ausl÷sen
  9488.   extern void init_streamvars (void);
  9489. # wird verwendet von SPVW
  9490.  
  9491. # Fehlermeldung, wenn eine Stream-Operation auf einem Stream nicht erlaubt ist.
  9492. # fehler_illegal_streamop(caller,stream);
  9493. # > caller: Aufrufer (ein Symbol)
  9494. # > stream: Stream
  9495.   nonreturning_function(extern, fehler_illegal_streamop, (object caller, object stream));
  9496. # wird verwendet von IO
  9497.  
  9498. # Liest ein Byte von einem Stream.
  9499. # read_byte(stream)
  9500. # > stream: Stream
  9501. # < ergebnis: gelesener Integer (eof_value bei EOF)
  9502. # kann GC ausl÷sen
  9503.   extern object read_byte (object stream);
  9504. # wird verwendet von PATHNAME, SEQUENCE
  9505.  
  9506. # Schreibt ein Byte auf einen Stream.
  9507. # write_byte(stream,byte);
  9508. # > stream: Stream
  9509. # > byte: auszugebender Integer
  9510. # kann GC ausl÷sen
  9511.   extern void write_byte(object stream, object byte);
  9512. # wird verwendet von SEQUENCE
  9513.  
  9514. # Liest ein Character von einem Stream.
  9515. # read_char(&stream)
  9516. # > stream: Stream
  9517. # < stream: Stream
  9518. # < ergebnis: gelesenes Character (eof_value bei EOF)
  9519. # kann GC ausl÷sen
  9520.   extern object read_char (object* stream_);
  9521. # wird verwendet von IO, DEBUG, SEQUENCE
  9522.  
  9523. # Schiebt das letzte gelesene Character auf einen Stream zurⁿck.
  9524. # unread_char(&stream,ch);
  9525. # > ch: letztes gelesenes Character
  9526. # > stream: Stream
  9527. # < stream: Stream
  9528.   extern void unread_char (object* stream_, object ch);
  9529. # wird verwendet von IO, DEBUG
  9530.  
  9531. # Liest ein Character von einem Stream, ohne es zu verbrauchen.
  9532. # peek_char(&stream)
  9533. # > stream: Stream
  9534. # < stream: Stream
  9535. # < ergebnis: gelesenes Character (eof_value bei EOF)
  9536. # kann GC ausl÷sen
  9537.   extern object peek_char (object* stream_);
  9538. # wird verwendet von IO
  9539.  
  9540. # Schreibt ein Character auf einen Stream.
  9541. # write_char(&stream,ch);
  9542. # > ch: auszugebendes Character
  9543. # > stream: Stream
  9544. # < stream: Stream
  9545. # kann GC ausl÷sen
  9546.   extern void write_char (object* stream_, object ch);
  9547. # wird verwendet von LISPARIT, IO, ERROR, SEQUENCE
  9548.  
  9549. # Schreibt ein festes Standard-Char auf einen Stream.
  9550. # write_schar(&stream,ch);
  9551. # > stream: Stream
  9552. # < stream: Stream
  9553. # kann GC ausl÷sen
  9554.   # extern void write_schar (object* stream_, uintB ch);
  9555.   #define write_schar(stream_,ch)  write_char(stream_,code_char(ch))
  9556. # wird verwendet von LISPARIT, IO, DEBUG, Macro TERPRI
  9557.  
  9558. # UP: Schlie▀t einen Stream.
  9559. # stream_close(&stream);
  9560. # > stream: Stream
  9561. # < stream: Stream
  9562. # kann GC ausl÷sen
  9563.   extern void stream_close (object* stream_);
  9564. # wird verwendet von PATHNAME, SPVW, DEBUG, MISC
  9565.  
  9566. # UP: Schlie▀t eine Liste offener Files.
  9567. # close_some_files(list);
  9568. # > list: Liste von offenen Streams
  9569. # kann GC ausl÷sen
  9570.   extern void close_some_files (object list);
  9571. # wird verwendet von SPVW
  9572.  
  9573. # UP: Schlie▀t alle offenen Files.
  9574. # close_all_files();
  9575. # kann GC ausl÷sen
  9576.   extern void close_all_files (void);
  9577. # wird verwendet von SPVW
  9578.  
  9579. # UP: ErklΣrt alle offenen File-Streams fⁿr geschlossen.
  9580. # closed_all_files();
  9581.   extern void closed_all_files (void);
  9582. # wird verwendet von SPVW
  9583.  
  9584. # UP: Stellt fest, ob im Stream stream ein Zeichen sofort verfⁿgbar ist.
  9585. # stream_listen(stream)
  9586. # > stream: Stream
  9587. # < ergebnis:  0 falls Zeichen verfⁿgbar,
  9588. #             -1 falls bei EOF angelangt,
  9589. #             +1 falls kein Zeichen verfⁿgbar, aber nicht wegen EOF
  9590. # kann GC ausl÷sen
  9591.   extern signean stream_listen (object stream);
  9592. # wird verwendet von IO, DEBUG
  9593.  
  9594. # UP: L÷scht bereits eingegebenen interaktiven Input von einem Stream stream.
  9595. # clear_input(stream)
  9596. # > stream: Stream
  9597. # < ergebnis: TRUE falls Input gel÷scht wurde
  9598. # kann GC ausl÷sen
  9599.   extern boolean clear_input (object stream);
  9600. # wird verwendet von IO, DEBUG
  9601.  
  9602. # UP: Wartenden Output eines Stream stream ans Ziel bringen.
  9603. # finish_output(stream);
  9604. # > stream: Stream
  9605. # kann GC ausl÷sen
  9606.   extern void finish_output (object stream);
  9607. # wird verwendet von IO
  9608.  
  9609. # UP: Wartenden Output eines Stream stream ans Ziel bringen.
  9610. # force_output(stream);
  9611. # > stream: Stream
  9612. # kann GC ausl÷sen
  9613.   extern void force_output (object stream);
  9614. # wird verwendet von IO
  9615.  
  9616. # UP: Wartenden Output eines Stream stream l÷schen.
  9617. # clear_output(stream);
  9618. # > stream: Stream
  9619. # kann GC ausl÷sen
  9620.   extern void clear_output (object stream);
  9621. # wird verwendet von IO
  9622.  
  9623. # UP: Liefert die Line-Position eines Streams.
  9624. # get_line_position(stream)
  9625. # > stream: Stream
  9626. # < ergebnis: Line-Position (Fixnum >=0)
  9627.   extern object get_line_position (object stream);
  9628. # wird verwendet von IO, DEBUG
  9629.  
  9630. # UP: Liest mehrere Bytes von einem Stream.
  9631. # read_byte_array(stream,byteptr,len)
  9632. # > stream: Stream
  9633. # > uintB* byteptr: Adresse der zu fⁿllenden Bytefolge
  9634. # > uintL len: LΣnge der zu fⁿllenden Bytefolge
  9635. # < uintB* ergebnis: Pointer ans Ende des gefⁿllten Bereiches oder NULL
  9636.   extern uintB* read_byte_array (object stream, uintB* byteptr, uintL len);
  9637. # wird verwendet von SEQUENCE
  9638.  
  9639. # UP: Schreibt mehrere Bytes auf einen Stream.
  9640. # write_byte_array(stream,byteptr,len)
  9641. # > stream: Stream
  9642. # > uintB* byteptr: Adresse der zu schreibenden Bytefolge
  9643. # > uintL len: LΣnge der zu schreibenden Bytefolge
  9644. # < uintB* ergebnis: Pointer ans Ende des geschriebenen Bereiches oder NULL
  9645.   extern uintB* write_byte_array (object stream, uintB* byteptr, uintL len);
  9646. # wird verwendet von SEQUENCE
  9647.  
  9648. # UP: Liest mehrere String-Characters von einem Stream.
  9649. # read_schar_array(stream,charptr,len)
  9650. # > stream: Stream
  9651. # > uintB* charptr: Adresse der zu fⁿllenden Zeichenfolge
  9652. # > uintL len: LΣnge der zu fⁿllenden Zeichenfolge
  9653. # < uintB* ergebnis: Pointer ans Ende des gefⁿllten Bereiches oder NULL
  9654.   extern uintB* read_schar_array (object stream, uintB* charptr, uintL len);
  9655. # wird verwendet von SEQUENCE
  9656.  
  9657. # UP: Schreibt mehrere String-Characters auf einen Stream.
  9658. # write_schar_array(stream,charptr,len)
  9659. # > stream: Stream
  9660. # > uintB* charptr: Adresse der zu schreibenden Zeichenfolge
  9661. # > uintL len: LΣnge der zu schreibenden Zeichenfolge
  9662. # < uintB* ergebnis: Pointer ans Ende des geschriebenen Bereiches oder NULL
  9663.   extern uintB* write_schar_array (object stream, uintB* charptr, uintL len);
  9664. # wird verwendet von SEQUENCE
  9665.  
  9666. # UP: Liefert den Stream, der der Wert einer Variablen ist.
  9667. # var_stream(sym)
  9668. # > sym: Variable (Symbol)
  9669. # < ergebnis: Stream
  9670.   extern object var_stream (object sym);
  9671. # wird verwendet von IO, PACKAGE, ERROR, DEBUG, EVAL, SPVW, PATHNAME
  9672.  
  9673. # UP: erzeugt ein File-Stream
  9674. # make_file_stream(handle,direction,type,eltype_size,append_flag)
  9675. # > handle: Handle des ge÷ffneten Files
  9676. # > STACK_1: Filename, ein Pathname
  9677. # > STACK_0: Truename, ein Pathname
  9678. # > direction: Modus (0 = :PROBE, 1 = :INPUT, 4 = :OUTPUT, 5 = :IO, 3 = :INPUT-IMMUTABLE)
  9679. # > type: nΣhere Typinfo
  9680. #         (STRMTYPE_SCH_FILE oder STRMTYPE_CH_FILE oder
  9681. #          STRMTYPE_IU_FILE oder STRMTYPE_IS_FILE)
  9682. # > eltype_size: (bei Integer-Streams) Gr÷▀e der Elemente in Bits,
  9683. #         ein Fixnum >0 und <intDsize*uintC_max
  9684. # > append_flag: TRUE falls der Stream gleich ans Ende positioniert werden
  9685. #         soll, FALSE sonst
  9686. # < ergebnis: File-Stream (oder evtl. File-Handle-Stream)
  9687. # < STACK: aufgerΣumt
  9688. # kann GC ausl÷sen
  9689.   extern object make_file_stream (object handle, uintB direction, uintB type, object eltype_size, boolean append_flag);
  9690. # wird verwendet von PATHNAME
  9691.  
  9692. # Liefert einen Broadcast-Stream zum Stream stream.
  9693. # make_broadcast1_stream(stream)
  9694. # kann GC ausl÷sen
  9695.   extern object make_broadcast1_stream (object stream);
  9696. # wird verwendet von IO
  9697.  
  9698. # Liefert einen Two-Way-Stream zu einem Input-Stream und einem Output-Stream.
  9699. # make_twoway_stream(input_stream,output_stream)
  9700. # > input_stream : Input-Stream
  9701. # > output_stream : Output-Stream
  9702. # < ergebnis : Two-Way-Stream
  9703. # kann GC ausl÷sen
  9704.   extern object make_twoway_stream (object input_stream, object output_stream);
  9705. # wird verwendet von SPVW
  9706.  
  9707. # Liefert einen String-Output-Stream.
  9708. # make_string_output_stream()
  9709. # kann GC ausl÷sen
  9710.   extern object make_string_output_stream (void);
  9711. # wird verwendet von IO, EVAL, DEBUG, ERROR
  9712.  
  9713. # UP: Liefert das von einem String-Output-Stream Angesammelte.
  9714. # get_output_stream_string(&stream)
  9715. # > stream: String-Output-Stream
  9716. # < stream: geleerter Stream
  9717. # < ergebnis: Angesammeltes, ein Simple-String
  9718. # kann GC ausl÷sen
  9719.   extern object get_output_stream_string (object* stream_);
  9720. # wird verwendet von IO, EVAL, DEBUG, ERROR
  9721.  
  9722. # UP: Liefert einen Pretty-Printer-Hilfs-Stream.
  9723. # make_pphelp_stream()
  9724. # kann GC ausl÷sen
  9725.   extern object make_pphelp_stream (void);
  9726. # wird verwendet von IO
  9727.  
  9728. #if defined(UNIX) || defined(AMIGAOS) || defined(RISCOS)
  9729. # UP: Terminal wieder in Normalzustand schalten
  9730. # terminal_sane();
  9731.   extern void terminal_sane (void);
  9732. # wird verwendet von SPVW
  9733. #endif
  9734.  
  9735. # ####################### SYMBIBL zu SYMBOL.D ############################# #
  9736.  
  9737. # UP: Liefert die globale Funktionsdefinition eines Symbols,
  9738. # mit Test, ob das Symbol eine globale Funktion darstellt.
  9739. # Symbol_function_checked(symbol)
  9740. # > symbol: Symbol
  9741. # < ergebnis: seine globale Funktionsdefinition
  9742.   extern object Symbol_function_checked (object symbol);
  9743. # wird verwendet von
  9744.  
  9745. # UP: Holt eine Property aus der Property-Liste eines Symbols.
  9746. # get(symbol,key)
  9747. # > symbol: ein Symbol
  9748. # > key: ein mit EQ zu vergleichender Key
  9749. # < value: dazugeh÷riger Wert aus der Property-Liste von symbol, oder unbound.
  9750.   extern object get (object symbol, object key);
  9751. # wird verwendet von IO, CONTROL, EVAL, PREDTYPE, SEQUENCE
  9752.  
  9753. # ##################### ARITBIBL zu LISTARIT.D ############################ #
  9754.  
  9755. # UP: Initialisiert die Arithmetik.
  9756. # init_arith();
  9757. # kann GC ausl÷sen
  9758.   extern void init_arith (void);
  9759. # wird verwendet von SPVW
  9760.  
  9761. # Wandelt Longword in Integer um.
  9762. # L_to_I(wert)
  9763. # > wert: Wert des Integers, ein signed 32-Bit-Integer.
  9764. # < ergebnis: Integer mit diesem Wert.
  9765. # kann GC ausl÷sen
  9766.   extern object L_to_I (sint32 wert);
  9767. # wird verwendet von MISC, REXX
  9768.  
  9769. # Wandelt Unsigned Longword in Integer >=0 um.
  9770. # UL_to_I(wert)
  9771. # > wert: Wert des Integers, ein unsigned 32-Bit-Integer.
  9772. # < ergebnis: Integer mit diesem Wert.
  9773. # kann GC ausl÷sen
  9774.   #if (intLsize<=oint_data_len)
  9775.     #define UL_to_I(wert)  fixnum((uintL)(wert))
  9776.   #else
  9777.     extern object UL_to_I (uintL wert);
  9778.   #endif
  9779. # wird verwendet von MISC, STREAM, PATHNAME, HASHTABL, SPVW, ARRAY
  9780.  
  9781. # Wandelt Doppel-Longword in Integer um.
  9782. # L2_to_I(wert_hi,wert_lo)
  9783. # > wert_hi|wert_lo: Wert des Integers, ein signed 64-Bit-Integer.
  9784. # < ergebnis: Integer mit diesem Wert.
  9785. # kann GC ausl÷sen
  9786.   extern object L2_to_I (sint32 wert_hi, uint32 wert_lo);
  9787. # wird verwendet von MISC
  9788.  
  9789. #ifdef HAVE_FFI
  9790. # Wandelt Unsigned Doppel-Longword in Integer um.
  9791. # UL2_to_I(wert_hi,wert_lo)
  9792. # > wert_hi|wert_lo: Wert des Integers, ein unsigned 64-Bit-Integer.
  9793. # < ergebnis: Integer mit diesem Wert.
  9794. # kann GC ausl÷sen
  9795.   extern object UL2_to_I (uint32 wert_hi, uint32 wert_lo);
  9796. # wird verwendet vom FFI
  9797. #endif
  9798.  
  9799. #ifdef intQsize
  9800. # Wandelt Quadword in Integer um.
  9801. # Q_to_I(wert)
  9802. # > wert: Wert des Integers, ein signed 64-Bit-Integer.
  9803. # < ergebnis: Integer mit diesem Wert.
  9804. # kann GC ausl÷sen
  9805.   extern object Q_to_I (sint64 wert);
  9806. # wird verwendet vom FFI
  9807. #endif
  9808.  
  9809. #if defined(intQsize) || defined(WIDE_HARD)
  9810. # Wandelt Unsigned Quadword in Integer >=0 um.
  9811. # UQ_to_I(wert)
  9812. # > wert: Wert des Integers, ein unsigned 64-Bit-Integer.
  9813. # < ergebnis: Integer mit diesem Wert.
  9814. # kann GC ausl÷sen
  9815.   extern object UQ_to_I (uint64 wert);
  9816. # wird verwendet von MISC, FFI
  9817. #endif
  9818.  
  9819. #ifdef HAVE_FFI
  9820. # Wandelt ein C-Integer gegebenen Typs in ein Integer um.
  9821. # val sollte eine Variable sein.
  9822.   #define uint8_to_I(val)  fixnum((uint8)(val))
  9823.   #define sint8_to_I(val)  L_to_I((sint32)(sint8)(val))
  9824.   #define uint16_to_I(val)  fixnum((uint16)(val))
  9825.   #define sint16_to_I(val)  L_to_I((sint32)(sint16)(val))
  9826.   #define uint32_to_I(val)  UL_to_I((uint32)(val))
  9827.   #define sint32_to_I(val)  L_to_I((sint32)(val))
  9828.   #ifdef intQsize
  9829.     #define uint64_to_I(val)  UQ_to_I((uint64)(val))
  9830.     #define sint64_to_I(val)  Q_to_I((sint64)(val))
  9831.   #else
  9832.     #define uint64_to_I(val)  UL2_to_I((uint32)((val)>>32),(uint32)(val))
  9833.     #define sint64_to_I(val)  L2_to_I((sint32)((val)>>32),(uint32)(val))
  9834.   #endif
  9835.   #if (int_bitsize==16)
  9836.     #define uint_to_I(val)  uint16_to_I(val)
  9837.     #define sint_to_I(val)  sint16_to_I(val)
  9838.   #else # (int_bitsize==32)
  9839.     #define uint_to_I(val)  uint32_to_I(val)
  9840.     #define sint_to_I(val)  sint32_to_I(val)
  9841.   #endif
  9842.   #if (long_bitsize==32)
  9843.     #define ulong_to_I(val)  uint32_to_I(val)
  9844.     #define slong_to_I(val)  sint32_to_I(val)
  9845.   #else # (long_bitsize==64)
  9846.     #define ulong_to_I(val)  uint64_to_I(val)
  9847.     #define slong_to_I(val)  sint64_to_I(val)
  9848.   #endif
  9849. # wird verwendet vom FFI
  9850. #endif
  9851.  
  9852. # Wandelt Integer >=0 in Unsigned Longword um.
  9853. # I_to_UL(obj)
  9854. # > obj: ein Objekt, sollte ein Integer >=0, <2^32 sein
  9855. # < ergebnis: der Wert des Integer als Unsigned Longword.
  9856.   extern uintL I_to_UL (object obj);
  9857. # wird verwendet von MISC, ARRAY
  9858.  
  9859. # Wandelt Integer in Signed Longword um.
  9860. # I_to_L(obj)
  9861. # > obj: ein Objekt, sollte ein Integer >=-2^31, <2^31 sein
  9862. # < ergebnis: der Wert des Integer als Longword.
  9863.   extern sintL I_to_L (object obj);
  9864. # wird verwendet von STDWIN
  9865.  
  9866. #if defined(HAVE_FFI) && defined(HAVE_LONGLONG)
  9867.  
  9868. # Wandelt Integer >=0 in Unsigned Quadword um.
  9869. # I_to_UQ(obj)
  9870. # > obj: ein Objekt, sollte ein Integer >=0, <2^64 sein
  9871. # < ergebnis: der Wert des Integer als Unsigned Quadword.
  9872.   extern uint64 I_to_UQ (object obj);
  9873. # wird verwendet vom FFI
  9874.  
  9875. # Wandelt Integer in Signed Quadword um.
  9876. # I_to_Q(obj)
  9877. # > obj: ein Objekt, sollte ein Integer >=-2^63, <2^63 sein
  9878. # < ergebnis: der Wert des Integer als Quadword.
  9879.   extern sint64 I_to_Q (object obj);
  9880. # wird verwendet vom FFI
  9881.  
  9882. #endif
  9883.  
  9884. #ifdef HAVE_FFI
  9885. # Wandelt ein Integer in ein C-Integer gegebenen Typs um.
  9886. # I_to_xintyy(obj) setzt voraus, da▀ xintyy_p(obj) schon abgeprⁿft wurde.
  9887.   #define I_to_uint8(obj)  (uint8)(as_oint(obj) >> oint_data_shift)
  9888.   #define I_to_sint8(obj)  (sint8)(as_oint(obj) >> oint_data_shift)
  9889.   #define I_to_uint16(obj)  (uint16)(as_oint(obj) >> oint_data_shift)
  9890.   #define I_to_sint16(obj)  (sint16)(as_oint(obj) >> oint_data_shift)
  9891.   #if (oint_data_len>=32)
  9892.     #define I_to_uint32(obj)  (uint32)(as_oint(obj) >> oint_data_shift)
  9893.   #else
  9894.     #define I_to_uint32(obj)  I_to_UL(obj)
  9895.   #endif
  9896.   #if (oint_data_len>=31)
  9897.     #define I_to_sint32(obj)  (sint32)(as_oint(obj) >> oint_data_shift)
  9898.   #else
  9899.     #define I_to_sint32(obj)  I_to_L(obj)
  9900.   #endif
  9901.   #define I_to_uint64(obj)  I_to_UQ(obj)
  9902.   #define I_to_sint64(obj)  I_to_Q(obj)
  9903.   #if (int_bitsize==16)
  9904.     #define I_to_uint  I_to_uint16
  9905.     #define I_to_sint  I_to_sint16
  9906.   #else # (int_bitsize==32)
  9907.     #define I_to_uint  I_to_uint32
  9908.     #define I_to_sint  I_to_sint32
  9909.   #endif
  9910.   #if (long_bitsize==32)
  9911.     #define I_to_ulong  I_to_uint32
  9912.     #define I_to_slong  I_to_sint32
  9913.   #else # (long_bitsize==64)
  9914.     #define I_to_ulong  I_to_uint64
  9915.     #define I_to_slong  I_to_sint64
  9916.   #endif
  9917. # wird verwendet vom FFI
  9918. #endif
  9919.  
  9920. # I_I_comp(x,y) vergleicht zwei Integers x und y.
  9921. # Ergebnis: 0 falls x=y, +1 falls x>y, -1 falls x<y.
  9922.   extern signean I_I_comp (object x, object y);
  9923. # wird verwendet von SEQUENCE
  9924.  
  9925. # (1+ x), wo x ein Integer ist. Ergebnis Integer.
  9926. # I_1_plus_I(x)
  9927. # kann GC ausl÷sen
  9928.   extern object I_1_plus_I (object x);
  9929. # wird verwendet von SEQUENCE, SPVW, SYMBOL
  9930.  
  9931. # (1- x), wo x ein Integer ist. Ergebnis Integer.
  9932. # I_minus1_plus_I(x)
  9933. # kann GC ausl÷sen
  9934.   extern object I_minus1_plus_I (object x);
  9935. # wird verwendet von SEQUENCE
  9936.  
  9937. # (+ x y), wo x und y Integers sind. Ergebnis Integer.
  9938. # I_I_plus_I(x,y)
  9939. # kann GC ausl÷sen
  9940.   extern object I_I_plus_I (object x, object y);
  9941. # wird verwendet von SEQUENCE
  9942.  
  9943. # (- x y), wo x und y Integers sind. Ergebnis Integer.
  9944. # I_I_minus_I(x,y)
  9945. # kann GC ausl÷sen
  9946.   extern object I_I_minus_I (object x, object y);
  9947. # wird verwendet von SEQUENCE
  9948.  
  9949. # (ASH x y), wo x und y Integers sind. Ergebnis Integer.
  9950. # I_I_ash_I(x,y)
  9951. # kann GC ausl÷sen
  9952.   extern object I_I_ash_I (object x, object y);
  9953. # wird verwendet von SEQUENCE
  9954.  
  9955. # (INTEGER-LENGTH x), wo x ein Integer ist. Ergebnis uintL.
  9956. # I_integer_length(x)
  9957.   extern uintL I_integer_length (object x);
  9958. # wird verwendet von ARRAY
  9959.  
  9960. #ifdef HAVE_FFI
  9961.  
  9962. # c_float_to_FF(&val) wandelt ein IEEE-Single-Float val in ein Single-Float um.
  9963. # kann GC ausl÷sen
  9964.   extern object c_float_to_FF (ffloatjanus* val_);
  9965.  
  9966. # FF_to_c_float(obj,&val);
  9967. # wandelt ein Single-Float obj in ein IEEE-Single-Float val um.
  9968.   extern void FF_to_c_float (object obj, ffloatjanus* val_);
  9969.  
  9970. # c_double_to_DF(&val) wandelt ein IEEE-Double-Float val in ein Double-Float um.
  9971. # kann GC ausl÷sen
  9972.   extern object c_double_to_DF (dfloatjanus* val_);
  9973.  
  9974. # DF_to_c_double(obj,&val);
  9975. # wandelt ein Double-Float obj in ein IEEE-Double-Float val um.
  9976.   extern void DF_to_c_double (object obj, dfloatjanus* val_);
  9977.  
  9978. #endif
  9979.  
  9980. # UP: Wandelt eine Zeichenkette mit Integer-Syntax in ein Integer um.
  9981. # Punkte werden ⁿberlesen.
  9982. # read_integer(base,sign,string,index1,index2)
  9983. # > base: Lesebasis (>=2, <=36)
  9984. # > sign: Vorzeichen (/=0 falls negativ)
  9985. # > string: Simple-String (enthΣlt Ziffern mit Wert <base und evtl. Punkt)
  9986. # > index1: Index der ersten Ziffer
  9987. # > index2: Index nach der letzten Ziffer
  9988. #   (also index2-index1 Ziffern, incl. evtl. Dezimalpunkt am Schlu▀)
  9989. # < ergebnis: Integer
  9990. # kann GC ausl÷sen
  9991.   extern object read_integer (uintWL base,
  9992.          signean sign, object string, uintL index1, uintL index2);
  9993. # wird verwendet von IO
  9994.  
  9995. # UP: Wandelt eine Zeichenkette mit Rational-Syntax in eine rationale Zahl um.
  9996. # read_rational(base,sign,string,index1,index3,index2)
  9997. # > base: Lesebasis (>=2, <=36)
  9998. # > sign: Vorzeichen (/=0 falls negativ)
  9999. # > string: Simple-String (enthΣlt Ziffern mit Wert <base und Bruchstrich)
  10000. # > index1: Index der ersten Ziffer
  10001. # > index3: Index von '/'
  10002. # > index2: Index nach der letzten Ziffer
  10003. #   (also index3-index1 ZΣhler-Ziffern, index2-index3-1 Nenner-Ziffern)
  10004. # < ergebnis: rationale Zahl
  10005. # kann GC ausl÷sen
  10006.   extern object read_rational (uintWL base,
  10007.          signean sign, object string, uintL index1, uintL index3, uintL index2);
  10008. # wird verwendet von IO
  10009.  
  10010. # UP: Wandelt eine Zeichenkette mit Float-Syntax in ein Float um.
  10011. # read_float(base,sign,string,index1,index4,index2,index3)
  10012. # > base: Lesebasis (=10)
  10013. # > sign: Vorzeichen (/=0 falls negativ)
  10014. # > string: Simple-String (enthΣlt Ziffern und evtl. Punkt und Exponentmarker)
  10015. # > index1: Index vom Mantissenanfang (excl. Vorzeichen)
  10016. # > index4: Index nach dem Mantissenende
  10017. # > index2: Index beim Ende der Characters
  10018. # > index3: Index nach dem Dezimalpunkt (=index4 falls keiner da)
  10019. #   (also Mantisse mit index4-index1 Characters: Ziffern und max. 1 '.')
  10020. #   (also index4-index3 Nachkommaziffern)
  10021. #   (also bei index4<index2: index4 = Index des Exponent-Markers,
  10022. #    index4+1 = Index des Exponenten-Vorzeichens oder der ersten
  10023. #    Exponenten-Ziffer)
  10024. # < ergebnis: Float
  10025. # kann GC ausl÷sen
  10026.   extern object read_float (uintWL base,
  10027.          signean sign, object string, uintL index1, uintL index4, uintL index2, uintL index3);
  10028. # wird verwendet von IO
  10029.  
  10030. # UP: Gibt ein Integer aus.
  10031. # print_integer(z,base,&stream);
  10032. # > z: Integer
  10033. # > base: Basis (>=2, <=36)
  10034. # > stream: Stream
  10035. # < stream: Stream
  10036. # kann GC ausl÷sen
  10037.   extern void print_integer (object z, uintWL base, object* stream_);
  10038. # wird verwendet von IO
  10039.  
  10040. # UP: Gibt ein Float aus.
  10041. # print_float(z,&stream);
  10042. # > z: Float
  10043. # > stream: Stream
  10044. # < stream: Stream
  10045. # kann GC ausl÷sen
  10046.   extern void print_float (object z, object* stream_);
  10047. # wird verwendet von IO
  10048.  
  10049. # UP: Multipliziert ein Integer mit 10 und addiert eine weitere Ziffer.
  10050. # mal_10_plus_x(y,x)
  10051. # > y: Integer Y (>=0)
  10052. # > x: Ziffernwert X (>=0,<10)
  10053. # < ergebnis: Integer Y*10+X (>=0)
  10054. # kann GC ausl÷sen
  10055.   extern object mal_10_plus_x (object y, uintB x);
  10056. # wird verwendet von IO
  10057.  
  10058. # UP: entscheidet auf Zahlgleichheit
  10059. # number_gleich(x,y)
  10060. # > x,y: zwei Zahlen
  10061. # < ergebnis: TRUE, falls (= x y) gilt
  10062. # kann GC ausl÷sen
  10063.   extern boolean number_gleich (object x, object y);
  10064. # wird verwendet von PREDTYPE
  10065.  
  10066. # UP: Wandelt ein Objekt in ein Float von gegebenem Typ um.
  10067. # coerce_float(obj,type)
  10068. # > obj: Objekt
  10069. # > type: Eines der Symbole
  10070. #         FLOAT, SHORT-FLOAT, SINGLE-FLOAT, DOUBLE-FLOAT, LONG-FLOAT
  10071. # > subr_self: Aufrufer (ein SUBR)
  10072. # < ergebnis: (coerce obj type)
  10073. # kann GC ausl÷sen
  10074.   extern object coerce_float (object obj, object type);
  10075. # wird verwendet von PREDTYPE
  10076.  
  10077. # ####################### REXXBIBL zu REXX.D ############################## #
  10078.  
  10079. #ifdef REXX
  10080.  
  10081. # Initialisiert die Rexx-Schnittstelle.
  10082. # init_rexx();
  10083. # < ergebnis: Flag, ob erfolgreich initialisiert.
  10084.   extern boolean init_rexx (void);
  10085. # wird verwendet von SPVW
  10086.  
  10087. # Schlie▀t die Rexx-Schnittstelle.
  10088. # close_rexx();
  10089.   extern void close_rexx (void);
  10090. # wird verwendet von SPVW
  10091.  
  10092. #endif
  10093.  
  10094. # ######################## GRAPHBIBL zu GRAPH.D ########################### #
  10095.  
  10096. #ifdef GRAPHICS_SWITCH
  10097.  
  10098. # Schaltet die Grafik auf Text-Modus zurⁿck.
  10099. # switch_text_mode();
  10100.   extern void switch_text_mode (void);
  10101.  
  10102. #endif
  10103.  
  10104. # ######################################################################### #
  10105.  
  10106. #if defined(AMIGAOS) && defined(GNU_INLINES) && defined(GNU_INLINES_LATE)
  10107.   # Inline-Deklarationen der Betriebssystem-Funktionen nach Markus Wild
  10108.   # (dⁿrfen erst nach globalen Register-Deklarationen kommen!)
  10109.   #include <inline/exec.h>
  10110.   #include <inline/dos.h>
  10111. #endif
  10112.  
  10113. # ######################################################################### #
  10114.  
  10115.