diff -r -c3 clisp-1993-11-08/src/CHANGES.LOG clisp/src/CHANGES.LOG
*** clisp-1993-11-08/src/CHANGES.LOG	Sun Nov  7 22:32:16 1993
--- clisp/src/CHANGES.LOG	Mon Nov 15 02:16:51 1993
***************
*** 1,4 ****
--- 1,35 ----
  
+ 14 November 1993
+ ================
+ 
+ Important note
+ --------------
+ 
+ * Changed bytecode format. All .fas files generated by previous CLISP versions
+   are invalid and must be recompiled.
+ 
+ User visible changes
+ --------------------
+ 
+ * X3J13 vote <40> is partially implemented: New variable *PRINT-READABLY*.
+ 
+ * X3J13 vote <34> is implemented: Arrays and packages may now appear as
+   constants in compiled code.
+ 
+ Portability
+ -----------
+ 
+ * Fixed five bugs in the number crunching routines that appeared on
+   64-bit processors or in combination with the WIDE tagging scheme.
+ 
+ * More support for 64-bit processors like DEC Alpha.
+ 
+ Other modifications
+ -------------------
+ 
+ * Miscellaneous documentation updates.
+ 
+ 
  8 November 1993
  ===============
  
diff -r -c3 clisp-1993-11-08/src/_impnotes.txt clisp/src/_impnotes.txt
*** clisp-1993-11-08/src/_impnotes.txt	Mon Nov  8 01:18:16 1993
--- clisp/src/_impnotes.txt	Sun Nov 14 15:08:36 1993
***************
*** 1,6 ****
                  Implementation Notes for CLISP
                  ==============================
!                 Last modified: 7 November 1993.
  
  This implementation is mostly compatible to the standard reference
  
--- 1,6 ----
                  Implementation Notes for CLISP
                  ==============================
!                 Last modified: 14 November 1993.
  
  This implementation is mostly compatible to the standard reference
  
***************
*** 1000,1005 ****
--- 1000,1013 ----
    times it was called recursively.)
  * The value of *PRINT-LENGTH* must be respected, especially if you are
    outputting an arbitrary number of components.
+ * The value of *PRINT-READABLY* must be respected. Remember that the values
+   of *PRINT-ESCAPE*, *PRINT-LEVEL*, *PRINT-LENGTH* don't matter if
+   *PRINT-READABLY* is true.
+   The value of *PRINT-READABLY* is respected by PRINT-UNREADABLE-OBJECT,
+   WRITE, PRIN1, PRINC, PRINT, PPRINT, FORMAT ~A, FORMAT ~S, FORMAT ~W and
+   FORMAT ~D,~B,~O,~X,~R,~F,~E,~G,~$ with not-numerical arguments.
+   Therefore *PRINT-READABLY* will be respected automatically if only these
+   functions are used for outputting objects.
  * You need not bother about the values of *PRINT-BASE*, *PRINT-RADIX*,
    *PRINT-CASE*, *PRINT-GENSYM*, *PRINT-ARRAY*, *PRINT-CLOSURE*, *PRINT-RPARS*.
  
***************
*** 1164,1169 ****
--- 1172,1180 ----
  
  In absence of SYS::WRITE-FLOAT, floating point numbers are output in radix 2.
  
+ If *PRINT-READABLY* is true, *READ-DEFAULT-FLOAT-FORMAT* has no influence on
+ the way floating point numbers are printed.
+ 
  Pathnames are written according to the syntax #"namestring" if
  *PRINT-ESCAPE* /= NIL. If *PRINT-ESCAPE* = NIL, only the namestring is
  printed.
***************
*** 1208,1213 ****
--- 1219,1227 ----
  
  FORMAT ~:@C does not output the character itself, only the instruction how
  to type the character.
+ 
+ For FORMAT ~E and FORMAT ~G, the value of *READ-DEFAULT-FLOAT-FORMAT* doesn't
+ matter if *PRINT-READABLY* is true.
  
  FORMAT ~T can determine the current column of any stream.
  
diff -r -c3 clisp-1993-11-08/src/aridecl.d clisp/src/aridecl.d
*** clisp-1993-11-08/src/aridecl.d	Tue Oct 19 11:57:18 1993
--- clisp/src/aridecl.d	Sun Nov 14 14:25:09 1993
***************
*** 155,161 ****
  # Baut ein Float aus Vorzeichen (0 oder -1), Exponent und Mantisse zusammen:
    #define make_FF(sign,exp,mant)  \
      type_data_object(FF_type | (bit(vorz_bit_t) & (sign)), \
!       (((exp) & (bit(FF_exp_len)-1)) << FF_mant_len) | ((mant) & (bit(FF_mant_len)-1)) \
        )
  # Single Float 0.0 :
    #define FF_0  make_FF(0,0,0)
--- 155,163 ----
  # Baut ein Float aus Vorzeichen (0 oder -1), Exponent und Mantisse zusammen:
    #define make_FF(sign,exp,mant)  \
      type_data_object(FF_type | (bit(vorz_bit_t) & (sign)), \
!       (sign) << (FF_exp_len+FF_mant_len)                   \
!       | (((exp) & (bit(FF_exp_len)-1)) << FF_mant_len)     \
!       | ((mant) & (bit(FF_mant_len)-1))                    \
        )
  # Single Float 0.0 :
    #define FF_0  make_FF(0,0,0)
diff -r -c3 clisp-1993-11-08/src/cltl2.txt clisp/src/cltl2.txt
*** clisp-1993-11-08/src/cltl2.txt	Mon Oct 25 03:03:03 1993
--- clisp/src/cltl2.txt	Wed Nov 10 04:10:56 1993
***************
*** 1,5 ****
  ; List of X3J13 votes and their current status in CLISP
! ; Bruno Haible 24.10.1993
  ;
  ; Number: from CLtL2, Index of X3J13 Votes.
  ; Status: indicates whether CLISP supports code that makes use of this vote.
--- 1,5 ----
  ; List of X3J13 votes and their current status in CLISP
! ; Bruno Haible 9.11.1993
  ;
  ; Number: from CLtL2, Index of X3J13 Votes.
  ; Status: indicates whether CLISP supports code that makes use of this vote.
***************
*** 42,55 ****
  ;  <31>  condition restarts                  no              user1.lsp
  ;  <32>  constant circular compilation       yes             compiler.lsp
  ;  <33>  constant collapsing                 yes             compiler.lsp
! ;  <34>  constant compilable types           no for packages
! ;                                            yes for anything else
  ;  <35>  constant function compilation       yes
  ;  <36>  constant modification               yes
  ;  <37>  contagion on numerical comparisons  yes             realelem.d, flo_rest.d
  ;  <38>  COPY-SYMBOL copy plist              yes             defs1.lsp
  ;  <39>  COPY-SYMBOL print name              yes             defs1.lsp, package.d
! ;  <40>  data I/O                            no              io.d
  ;  <41>  data types hierarchy unspecified    yes             lispbibl.d
  ;  <42>  declaration scope                   no
  ;  <43>  declare array type & element references
--- 42,55 ----
  ;  <31>  condition restarts                  no              user1.lsp
  ;  <32>  constant circular compilation       yes             compiler.lsp
  ;  <33>  constant collapsing                 yes             compiler.lsp
! ;  <34>  constant compilable types           yes             io.d
  ;  <35>  constant function compilation       yes
  ;  <36>  constant modification               yes
  ;  <37>  contagion on numerical comparisons  yes             realelem.d, flo_rest.d
  ;  <38>  COPY-SYMBOL copy plist              yes             defs1.lsp
  ;  <39>  COPY-SYMBOL print name              yes             defs1.lsp, package.d
! ;  <40>  data I/O                            yes for *print-readably*  io.d
! ;                                            no for anything else
  ;  <41>  data types hierarchy unspecified    yes             lispbibl.d
  ;  <42>  declaration scope                   no
  ;  <43>  declare array type & element references
diff -r -c3 clisp-1993-11-08/src/compelem.d clisp/src/compelem.d
*** clisp-1993-11-08/src/compelem.d	Thu May 13 22:31:19 1993
--- clisp/src/compelem.d	Sun Nov 14 19:48:52 1993
***************
*** 354,366 ****
      { var reg5 sintWL a_exp;
        var reg6 sintWL b_exp;
        {# Exponenten von a holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(a)->float_value.semhi);
         if (uexp==0) # a=0.0 -> liefere (complex a (- (/ b))) :
           { pushSTACK(a); pushSTACK(DF_minus_DF(DF_durch_DF(b))); return; }
         a_exp = (sintWL)(uexp - DF_exp_mid);
        }
        {# Exponenten von b holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(b)->float_value.semhi);
         if (uexp==0) # b=0.0 -> liefere (complex (/ a) b) :
           { pushSTACK(DF_durch_DF(a)); pushSTACK(DF_0); return; }
         b_exp = (sintWL)(uexp - DF_exp_mid);
--- 354,366 ----
      { var reg5 sintWL a_exp;
        var reg6 sintWL b_exp;
        {# Exponenten von a holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(a)->float_value_semhi);
         if (uexp==0) # a=0.0 -> liefere (complex a (- (/ b))) :
           { pushSTACK(a); pushSTACK(DF_minus_DF(DF_durch_DF(b))); return; }
         a_exp = (sintWL)(uexp - DF_exp_mid);
        }
        {# Exponenten von b holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(b)->float_value_semhi);
         if (uexp==0) # b=0.0 -> liefere (complex (/ a) b) :
           { pushSTACK(DF_durch_DF(a)); pushSTACK(DF_0); return; }
         b_exp = (sintWL)(uexp - DF_exp_mid);
***************
*** 612,624 ****
      { var reg5 sintWL a_exp;
        var reg6 sintWL b_exp;
        {# Exponenten von a holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(a)->float_value.semhi);
         if (uexp==0) # a=0.0 -> liefere (abs b) :
           { return (R_minusp(b) ? DF_minus_DF(b) : b); }
         a_exp = (sintWL)(uexp - DF_exp_mid);
        }
        {# Exponenten von b holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(b)->float_value.semhi);
         if (uexp==0) # b=0.0 -> liefere (abs a) :
           { return (R_minusp(a) ? DF_minus_DF(a) : a); }
         b_exp = (sintWL)(uexp - DF_exp_mid);
--- 612,624 ----
      { var reg5 sintWL a_exp;
        var reg6 sintWL b_exp;
        {# Exponenten von a holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(a)->float_value_semhi);
         if (uexp==0) # a=0.0 -> liefere (abs b) :
           { return (R_minusp(b) ? DF_minus_DF(b) : b); }
         a_exp = (sintWL)(uexp - DF_exp_mid);
        }
        {# Exponenten von b holen:
!        var reg3 uintWL uexp = DF_uexp(TheDfloat(b)->float_value_semhi);
         if (uexp==0) # b=0.0 -> liefere (abs a) :
           { return (R_minusp(a) ? DF_minus_DF(a) : a); }
         b_exp = (sintWL)(uexp - DF_exp_mid);
diff -r -c3 clisp-1993-11-08/src/compiler.lsp clisp/src/compiler.lsp
*** clisp-1993-11-08/src/compiler.lsp	Tue Oct 26 14:26:53 1993
--- clisp/src/compiler.lsp	Wed Nov 10 13:52:32 1993
***************
*** 357,363 ****
      (write (closure-name closure) :stream stream)
      (write-char #\space stream)
      (write-char #\# stream)
!     (write (length (closure-codevec closure)) :stream stream :base 10. :radix nil)
      (write-char #\Y stream)
      ;(write (closure-codevec closure) :stream stream :base 16.) ; stattdessen:
      (write-char #\( stream)
--- 357,363 ----
      (write (closure-name closure) :stream stream)
      (write-char #\space stream)
      (write-char #\# stream)
!     (write (length (closure-codevec closure)) :stream stream :base 10. :radix nil :readably nil)
      (write-char #\Y stream)
      ;(write (closure-codevec closure) :stream stream :base 16.) ; stattdessen:
      (write-char #\( stream)
***************
*** 366,372 ****
          ((endp L))
        (when (zerop i) (write-char #\newline stream) (setq i 25))
        (write-char #\space stream)
!       (write (car L) :stream stream :base 16. :radix nil)
      )
      (write-char #\) stream)
      (write-char #\newline stream)
--- 366,372 ----
          ((endp L))
        (when (zerop i) (write-char #\newline stream) (setq i 25))
        (write-char #\space stream)
!       (write (car L) :stream stream :base 16. :radix nil :readably nil)
      )
      (write-char #\) stream)
      (write-char #\newline stream)
***************
*** 1337,1343 ****
         room
         make-hash-table gethash system::puthash remhash maphash clrhash
         hash-table-count system::hash-table-iterator system::hash-table-iterate
!        sxhash
         copy-readtable set-syntax-from-char set-macro-character
         get-macro-character make-dispatch-macro-character
         set-dispatch-macro-character get-dispatch-macro-character read
--- 1337,1343 ----
         room
         make-hash-table gethash system::puthash remhash maphash clrhash
         hash-table-count system::hash-table-iterator system::hash-table-iterate
!        clos::class-gethash sxhash
         copy-readtable set-syntax-from-char set-macro-character
         get-macro-character make-dispatch-macro-character
         set-dispatch-macro-character get-dispatch-macro-character read
***************
*** 1363,1371 ****
         make-symbol find-package package-name package-nicknames rename-package
         package-use-list package-used-by-list package-shadowing-symbols
         list-all-packages intern find-symbol unintern export unexport import
!        shadowing-import shadow use-package unuse-package make-package in-package
!        find-all-symbols system::map-symbols system::map-external-symbols
!        system::map-all-symbols
         parse-namestring pathname pathname-host pathname-device
         pathname-directory pathname-name pathname-type pathname-version
         file-namestring directory-namestring host-namestring merge-pathnames
--- 1363,1371 ----
         make-symbol find-package package-name package-nicknames rename-package
         package-use-list package-used-by-list package-shadowing-symbols
         list-all-packages intern find-symbol unintern export unexport import
!        shadowing-import shadow use-package unuse-package make-package
!        system::%in-package in-package find-all-symbols system::map-symbols
!        system::map-external-symbols system::map-all-symbols
         parse-namestring pathname pathname-host pathname-device
         pathname-directory pathname-name pathname-type pathname-version
         file-namestring directory-namestring host-namestring merge-pathnames
***************
*** 1379,1385 ****
         realp complexp streamp random-state-p readtablep hash-table-p pathnamep
         characterp functionp clos::generic-function-p packagep arrayp
         system::simple-array-p bit-vector-p vectorp simple-vector-p
!        simple-string-p simple-bit-vector-p commonp type-of clos:class-of coerce
         system::%record-ref system::%record-store system::%record-length
         system::%structure-ref system::%structure-store system::%make-structure
         system::%copy-structure system::%structure-type-p system::closure-name
--- 1379,1386 ----
         realp complexp streamp random-state-p readtablep hash-table-p pathnamep
         characterp functionp clos::generic-function-p packagep arrayp
         system::simple-array-p bit-vector-p vectorp simple-vector-p
!        simple-string-p simple-bit-vector-p commonp type-of clos:class-of
!        clos:find-class coerce
         system::%record-ref system::%record-store system::%record-length
         system::%structure-ref system::%structure-store system::%make-structure
         system::%copy-structure system::%structure-type-p system::closure-name
***************
*** 1413,1427 ****
         ldb ldb-test mask-field dpb deposit-field random make-random-state !
         exquo long-float-digits system::%set-long-float-digits system::log2
         system::log10
-        clos::class-gethash clos:find-class system::%in-package
         vector aref system::store array-in-bounds-p array-row-major-index bit
         sbit char= char/= char< char> char<= char>= char-equal char-not-equal
         char-lessp char-greaterp char-not-greaterp char-not-lessp string-concat
         apply system::%funcall funcall mapcar maplist mapc mapl mapcan mapcon
!        values list list* append nconc error concatenate map some every notany
!        notevery make-broadcast-stream make-concatenated-stream = /= < > <= >=
!        max min + - * / gcd lcm logior logxor logand logeqv
!        clos::class-tuple-gethash
    )   )
    (defun %funtabref (index)
      (if (and (<= 0 index) (< index (length funtab))) (svref funtab index) nil)
--- 1414,1427 ----
         ldb ldb-test mask-field dpb deposit-field random make-random-state !
         exquo long-float-digits system::%set-long-float-digits system::log2
         system::log10
         vector aref system::store array-in-bounds-p array-row-major-index bit
         sbit char= char/= char< char> char<= char>= char-equal char-not-equal
         char-lessp char-greaterp char-not-greaterp char-not-lessp string-concat
         apply system::%funcall funcall mapcar maplist mapc mapl mapcan mapcon
!        values clos::class-tuple-gethash list list* append nconc error
!        concatenate map some every notany notevery make-broadcast-stream
!        make-concatenated-stream = /= < > <= >= max min + - * / gcd lcm logior
!        logxor logand logeqv
    )   )
    (defun %funtabref (index)
      (if (and (<= 0 index) (< index (length funtab))) (svref funtab index) nil)
***************
*** 2089,2100 ****
            (system::vector-upd 2 0 nil nil nil)
            (vectorp 1 0 nil nil nil)
            (system::version 0 1 nil nil nil)
!           (write 1 0 nil (:case :level :length :gensym :escape :radix :base :array :circle :pretty :closure :stream) nil)
            (write-byte 2 0 nil nil nil)
            (write-char 1 1 nil nil nil)
            (write-line 1 1 nil (:start :end) nil)
            (write-string 1 1 nil (:start :end) nil)
!           (write-to-string 1 0 nil (:case :level :length :gensym :escape :radix :base :array :circle :pretty :closure) nil)
            #-CLISP1 (xgcd 0 0 t nil nil)
            (zerop 1 0 nil nil nil)
  ) ) ) )  )
--- 2089,2100 ----
            (system::vector-upd 2 0 nil nil nil)
            (vectorp 1 0 nil nil nil)
            (system::version 0 1 nil nil nil)
!           (write 1 0 nil (:case :level :length :gensym :escape :radix :base :array :circle :pretty :closure :readably :stream) nil)
            (write-byte 2 0 nil nil nil)
            (write-char 1 1 nil nil nil)
            (write-line 1 1 nil (:start :end) nil)
            (write-string 1 1 nil (:start :end) nil)
!           (write-to-string 1 0 nil (:case :level :length :gensym :escape :radix :base :array :circle :pretty :closure :readably) nil)
            #-CLISP1 (xgcd 0 0 t nil nil)
            (zerop 1 0 nil nil nil)
  ) ) ) )  )
***************
*** 3110,3116 ****
        ; suffix in einen String umwandeln:
        (cond ((symbolp suffix) (setq suffix (symbol-name suffix)))
              ((not (stringp suffix))
!              (setq suffix (write-to-string suffix :escape nil :base 10 :radix nil))
        )     )
        ; neues Symbol bilden:
        (let ((new-name (concatenate 'string name "-" suffix)))
--- 3110,3116 ----
        ; suffix in einen String umwandeln:
        (cond ((symbolp suffix) (setq suffix (symbol-name suffix)))
              ((not (stringp suffix))
!              (setq suffix (write-to-string suffix :escape nil :base 10 :radix nil :readably nil))
        )     )
        ; neues Symbol bilden:
        (let ((new-name (concatenate 'string name "-" suffix)))
***************
*** 3173,3180 ****
      ; Form auf den Liboutput-Stream schreiben:
      (terpri *liboutput-stream*)
      (write form :stream *liboutput-stream* :pretty t
!                 :closure t :circle t :array t :gensym t
!                 :escape t :level nil :length nil :radix t
    ) )
    ; Form evaluieren:
    (eval form)
--- 3173,3181 ----
      ; Form auf den Liboutput-Stream schreiben:
      (terpri *liboutput-stream*)
      (write form :stream *liboutput-stream* :pretty t
!                 :readably t
!                 ; :closure t :circle t :array t :gensym t
!                 ; :escape t :level nil :length nil :radix t
    ) )
    ; Form evaluieren:
    (eval form)
***************
*** 11731,11738 ****
        (when *fasoutput-stream*
          (terpri *fasoutput-stream*)
          (write form :stream *fasoutput-stream* :pretty t
!                     :closure t :circle t :array t :gensym t
!                     :escape t :level nil :length nil :radix t
        ) )
        (when *package-tasks*
          (c-eval-when-compile `(PROGN ,@(nreverse *package-tasks*)))
--- 11732,11740 ----
        (when *fasoutput-stream*
          (terpri *fasoutput-stream*)
          (write form :stream *fasoutput-stream* :pretty t
!                     :readably t
!                     ; :closure t :circle t :array t :gensym t
!                     ; :escape t :level nil :length nil :radix t
        ) )
        (when *package-tasks*
          (c-eval-when-compile `(PROGN ,@(nreverse *package-tasks*)))
***************
*** 11844,11850 ****
                  (when *fasoutput-stream*
                    (let ((*package* *keyword-package*))
                      (write `(SYSTEM::VERSION ',(version)) :stream *fasoutput-stream*
!                            :escape t :level nil :length nil :radix t
                  ) ) )
                  (loop
                    (let ((form (read istream nil eof-value)))
--- 11846,11853 ----
                  (when *fasoutput-stream*
                    (let ((*package* *keyword-package*))
                      (write `(SYSTEM::VERSION ',(version)) :stream *fasoutput-stream*
!                            :readably t
!                            ; :escape t :level nil :length nil :radix t
                  ) ) )
                  (loop
                    (let ((form (read istream nil eof-value)))
diff -r -c3 clisp-1993-11-08/src/constobj.d clisp/src/constobj.d
*** clisp-1993-11-08/src/constobj.d	Mon Nov  1 13:24:06 1993
--- clisp/src/constobj.d	Tue Nov  9 03:08:49 1993
***************
*** 1,5 ****
  # Liste aller dem C-Programm bekannten Objekte ("Programmkonstanten")
! # Bruno Haible 1.11.1993
  
  # Die Symbole sind bereits speziell abgehandelt.
  # Es wird eine Tabelle aller sonstigen dem C-Programm bekannten Objekte
--- 1,5 ----
  # Liste aller dem C-Programm bekannten Objekte ("Programmkonstanten")
! # Bruno Haible 8.11.1993
  
  # Die Symbole sind bereits speziell abgehandelt.
  # Es wird eine Tabelle aller sonstigen dem C-Programm bekannten Objekte
***************
*** 480,493 ****
    LISPOBJ(version,"( #.(fifth *features*)" # Symbol SYS::CLISP2 bzw. SYS::CLISP3
                     " #.sys::*jmpbuf-size*" # Zahl *jmpbuf-size*
                     " #.sys::*big-endian*"  # Flag *big-endian*
!                    " 241093" # Datum der letzten nderung des Bytecode-Interpreters
                    ")"
-          )
-   LISPOBJ(oldversion,"( #.(fifth *features*)" # Symbol SYS::CLISP2 bzw. SYS::CLISP3
-                       " #.sys::*jmpbuf-size*" # Zahl *jmpbuf-size*
-                       " #.sys::*big-endian*"  # Flag *big-endian*
-                       " 290893" # Datum der vorletzten nderung des Bytecode-Interpreters
-                      ")"
           )
    #ifdef MACHINE_KNOWN
     #ifndef VMS
--- 480,487 ----
    LISPOBJ(version,"( #.(fifth *features*)" # Symbol SYS::CLISP2 bzw. SYS::CLISP3
                     " #.sys::*jmpbuf-size*" # Zahl *jmpbuf-size*
                     " #.sys::*big-endian*"  # Flag *big-endian*
!                    " 091193" # Datum der letzten nderung des Bytecode-Interpreters
                    ")"
           )
    #ifdef MACHINE_KNOWN
     #ifndef VMS
diff -r -c3 clisp-1993-11-08/src/constsym.d clisp/src/constsym.d
*** clisp-1993-11-08/src/constsym.d	Sun Oct 24 19:09:24 1993
--- clisp/src/constsym.d	Tue Nov  9 03:51:00 1993
***************
*** 1,5 ****
  # Liste aller dem C-Programm bekannten Symbole ("Programmkonstanten")
! # Bruno Haible 24.10.1993
  
  # Der Macro LISPSYM deklariert ein LISP-Symbol.
  # LISPSYM(name,printname,package)
--- 1,5 ----
  # Liste aller dem C-Programm bekannten Symbole ("Programmkonstanten")
! # Bruno Haible 8.11.1993
  
  # Der Macro LISPSYM deklariert ein LISP-Symbol.
  # LISPSYM(name,printname,package)
***************
*** 455,460 ****
--- 455,461 ----
  LISPSYM(use_package_aux,"USE-PACKAGE-AUX",system)
  LISPSYM(make_symbol,"MAKE-SYMBOL",lisp)
  LISPSYM(find_package,"FIND-PACKAGE",lisp)
+ LISPSYM(pfind_package,"%FIND-PACKAGE",system)
  LISPSYM(package_name,"PACKAGE-NAME",lisp)
  LISPSYM(package_nicknames,"PACKAGE-NICKNAMES",lisp)
  LISPSYM(rename_package,"RENAME-PACKAGE",lisp)
***************
*** 923,928 ****
--- 924,930 ----
  LISPSYM(Kcircle,"CIRCLE",keyword)
  LISPSYM(Kpretty,"PRETTY",keyword)
  LISPSYM(Kclosure,"CLOSURE",keyword)
+ LISPSYM(Kreadably,"READABLY",keyword)
  LISPSYM(Kstream,"STREAM",keyword)
  LISPSYM(Kidentity,"IDENTITY",keyword)
  LISPSYM(Ktest,"TEST",keyword)
***************
*** 1054,1070 ****
  LISPSYM(Kupcase,"UPCASE",keyword) # als *PRINT-CASE* - Wert in IO
  LISPSYM(Kdowncase,"DOWNCASE",keyword) # als *PRINT-CASE* - Wert in IO
  LISPSYM(Kcapitalize,"CAPITALIZE",keyword) # als *PRINT-CASE* - Wert in IO
! LISPSYM(print_case,"*PRINT-CASE*",lisp) # als Variable in IO       --+
! LISPSYM(print_level,"*PRINT-LEVEL*",lisp) # als Variable in IO       |
! LISPSYM(print_length,"*PRINT-LENGTH*",lisp) # als Variable in IO     |
! LISPSYM(print_gensym,"*PRINT-GENSYM*",lisp) # als Variable in IO     |
! LISPSYM(print_escape,"*PRINT-ESCAPE*",lisp) # als Variable in IO     | Reihenfolge
! LISPSYM(print_radix,"*PRINT-RADIX*",lisp) # als Variable in IO       | mit IO.D abgestimmt!
! LISPSYM(print_base,"*PRINT-BASE*",lisp) # als Variable in IO         |
! LISPSYM(print_array,"*PRINT-ARRAY*",lisp) # als Variable in IO       |
! LISPSYM(print_circle,"*PRINT-CIRCLE*",lisp) # als Variable in IO     |
! LISPSYM(print_pretty,"*PRINT-PRETTY*",lisp) # als Variable in IO     |
! LISPSYM(print_closure,"*PRINT-CLOSURE*",lisp) # als Variable in IO --+
  LISPSYM(print_rpars,"*PRINT-RPARS*",lisp) # als Variable in IO
  LISPSYM(print_circle_table,"*PRINT-CIRCLE-TABLE*",system) # als Variable in IO
  LISPSYM(prin_level,"*PRIN-LEVEL*",system) # als Variable in IO
--- 1056,1073 ----
  LISPSYM(Kupcase,"UPCASE",keyword) # als *PRINT-CASE* - Wert in IO
  LISPSYM(Kdowncase,"DOWNCASE",keyword) # als *PRINT-CASE* - Wert in IO
  LISPSYM(Kcapitalize,"CAPITALIZE",keyword) # als *PRINT-CASE* - Wert in IO
! LISPSYM(print_case,"*PRINT-CASE*",lisp) # als Variable in IO         --+
! LISPSYM(print_level,"*PRINT-LEVEL*",lisp) # als Variable in IO         |
! LISPSYM(print_length,"*PRINT-LENGTH*",lisp) # als Variable in IO       |
! LISPSYM(print_gensym,"*PRINT-GENSYM*",lisp) # als Variable in IO       |
! LISPSYM(print_escape,"*PRINT-ESCAPE*",lisp) # als Variable in IO       |
! LISPSYM(print_radix,"*PRINT-RADIX*",lisp) # als Variable in IO         | Reihenfolge
! LISPSYM(print_base,"*PRINT-BASE*",lisp) # als Variable in IO           | mit IO.D abgestimmt!
! LISPSYM(print_array,"*PRINT-ARRAY*",lisp) # als Variable in IO         |
! LISPSYM(print_circle,"*PRINT-CIRCLE*",lisp) # als Variable in IO       |
! LISPSYM(print_pretty,"*PRINT-PRETTY*",lisp) # als Variable in IO       |
! LISPSYM(print_closure,"*PRINT-CLOSURE*",lisp) # als Variable in IO     |
! LISPSYM(print_readably,"*PRINT-READABLY*",lisp) # als Variable in IO --+
  LISPSYM(print_rpars,"*PRINT-RPARS*",lisp) # als Variable in IO
  LISPSYM(print_circle_table,"*PRINT-CIRCLE-TABLE*",system) # als Variable in IO
  LISPSYM(prin_level,"*PRIN-LEVEL*",system) # als Variable in IO
diff -r -c3 clisp-1993-11-08/src/defs1.lsp clisp/src/defs1.lsp
*** clisp-1993-11-08/src/defs1.lsp	Wed Sep 15 21:33:39 1993
--- clisp/src/defs1.lsp	Tue Nov  9 02:31:06 1993
***************
*** 27,33 ****
        (multiple-value-bind (sym flag)
          (intern
            (string-concat prefix
!             (write-to-string gentemp-count :base 10 :radix nil)
            )
            package
          )
--- 27,33 ----
        (multiple-value-bind (sym flag)
          (intern
            (string-concat prefix
!             (write-to-string gentemp-count :base 10 :radix nil :readably nil)
            )
            package
          )
diff -r -c3 clisp-1993-11-08/src/defs3.lsp clisp/src/defs3.lsp
*** clisp-1993-11-08/src/defs3.lsp	Wed Oct 27 14:29:59 1993
--- clisp/src/defs3.lsp	Tue Nov  9 02:24:16 1993
***************
*** 50,61 ****
  *macroexpand-hook* *package* *modules* *random-state* *evalhook* *applyhook*
  + ++ +++ - * ** *** / // /// *standard-input* *standard-output* *error-output*
  *query-io* *debug-io* *terminal-io* *trace-output* *read-base* *read-suppress*
! *readtable* *print-escape* *print-pretty* *print-circle* *print-base*
! *print-radix* *print-case* *print-gensym* *print-level* *print-length*
! *print-array* *read-default-float-format* *default-pathname-defaults*
! *load-verbose* *load-print* *load-pathname* *load-truename*
! *break-on-warnings* *compile-verbose* *compile-print* *compile-file-pathname*
! *compile-file-truename* *features*
  ;; Funktionen:
  coerce type-of upgraded-array-element-type typep subtypep null symbolp
  atom consp listp numberp integerp rationalp floatp realp complexp characterp
--- 50,61 ----
  *macroexpand-hook* *package* *modules* *random-state* *evalhook* *applyhook*
  + ++ +++ - * ** *** / // /// *standard-input* *standard-output* *error-output*
  *query-io* *debug-io* *terminal-io* *trace-output* *read-base* *read-suppress*
! *readtable* *print-readably* *print-escape* *print-pretty* *print-circle*
! *print-base* *print-radix* *print-case* *print-gensym* *print-level*
! *print-length* *print-array* *read-default-float-format*
! *default-pathname-defaults* *load-verbose* *load-print* *load-pathname*
! *load-truename* *break-on-warnings* *compile-verbose* *compile-print*
! *compile-file-pathname* *compile-file-truename* *features*
  ;; Funktionen:
  coerce type-of upgraded-array-element-type typep subtypep null symbolp
  atom consp listp numberp integerp rationalp floatp realp complexp characterp
diff -r -c3 clisp-1993-11-08/src/dfloat.d clisp/src/dfloat.d
*** clisp-1993-11-08/src/dfloat.d	Sat Aug 21 02:49:47 1993
--- clisp/src/dfloat.d	Mon Nov 15 01:08:20 1993
***************
*** 1,6 ****
--- 1,26 ----
  # Grundfunktionen fr Double-Floats
  
  # Entpacken eines Double-Float:
+ #ifdef intQsize
+ # DF_decode(obj, zero_statement, sign=,exp=,mant=);
+ # zerlegt ein Double-Float obj.
+ # Ist obj=0.0, wird zero_statement ausgefhrt.
+ # Sonst: signean sign = Vorzeichen (0 = +, -1 = -),
+ #        sintWL exp = Exponent (vorzeichenbehaftet),
+ #        uintQ mant = Mantisse (>= 2^DF_mant_len, < 2^(DF_mant_len+1))
+   #define float_value_semhi  float_value
+   #define DF_uexp(x)  (((x) >> DF_mant_len) & (bit(DF_exp_len)-1))
+   #define DF_decode(obj, zero_statement, sign_zuweisung,exp_zuweisung,mant_zuweisung)  \
+     { var reg1 dfloat _x = TheDfloat(obj)->float_value;                    \
+       var reg2 uintWL uexp = DF_uexp(_x);                                  \
+       if (uexp==0)                                                         \
+         { zero_statement } # e=0 -> Zahl 0.0                               \
+         else                                                               \
+         { exp_zuweisung (sintWL)(uexp - DF_exp_mid); # Exponent            \
+           sign_zuweisung ((sint64)_x >> 63);         # Vorzeichen          \
+           mant_zuweisung (bit(DF_mant_len) | (_x & (bit(DF_mant_len)-1))); \
+     }   }
+ #else
  # DF_decode(obj, zero_statement, sign=,exp=,manthi=,mantlo=);
  # zerlegt ein Double-Float obj.
  # Ist obj=0.0, wird zero_statement ausgefhrt.
***************
*** 8,13 ****
--- 28,34 ----
  #        sintWL exp = Exponent (vorzeichenbehaftet),
  #        uintL manthi,mantlo = Mantisse 2^32*manthi+mantlo
  #                              (>= 2^DF_mant_len, < 2^(DF_mant_len+1))
+   #define float_value_semhi  float_value.semhi
    #define DF_uexp(semhi)  (((semhi) >> (DF_mant_len-32)) & (bit(DF_exp_len)-1))
    #define DF_decode(obj, zero_statement, sign_zuweisung,exp_zuweisung,manthi_zuweisung,mantlo_zuweisung)  \
      { var reg1 uint32 semhi = TheDfloat(obj)->float_value.semhi;       \
***************
*** 21,28 ****
--- 42,69 ----
            manthi_zuweisung (bit(DF_mant_len-32) | (semhi & (bit(DF_mant_len-32)-1))); \
            mantlo_zuweisung mlo;                                        \
      }   }
+ #endif
  
  # Einpacken eines Double-Float:
+ #ifdef intQsize
+ # encode_DF(sign,exp,mant, ergebnis=);
+ # liefert ein Double-Float.
+ # > signean sign: Vorzeichen, 0 fr +, -1 fr negativ.
+ # > sintWL exp: Exponent
+ # > uintQ mant: Mantisse, sollte >= 2^DF_mant_len und < 2^(DF_mant_len+1) sein.
+ # < object ergebnis: ein Double-Float
+ # Der Exponent wird auf berlauf/Unterlauf getestet.
+ # kann GC auslsen
+   #define encode_DF(sign,exp,mant, erg_zuweisung)  \
+     { if ((exp) < (sintWL)(DF_exp_low-DF_exp_mid)) { fehler_underflow(); } \
+       if ((exp) > (sintWL)(DF_exp_high-DF_exp_mid)) { fehler_overflow(); } \
+       erg_zuweisung allocate_dfloat                                        \
+         (  ((sint64)(sign) & bit(63))                  # Vorzeichen        \
+          | ((uint64)((exp)+DF_exp_mid) << DF_mant_len) # Exponent          \
+          | ((uint64)(mant) & (bit(DF_mant_len)-1))     # Mantisse          \
+         );                                                                 \
+     }
+ #else
  # encode_DF(sign,exp,manthi,mantlo, ergebnis=);
  # liefert ein Double-Float.
  # > signean sign: Vorzeichen, 0 fr +, -1 fr negativ.
***************
*** 42,47 ****
--- 83,89 ----
           , mantlo                                                          \
          );                                                                 \
      }
+ #endif
  
  #ifdef FAST_DOUBLE
  # Auspacken eines Double:
***************
*** 60,65 ****
--- 102,133 ----
  #   maybe_underflow: Ergebnis sehr klein und /=0, liefert IEEE-Null
  #   maybe_divide_0: Ergebnis unbestimmt, liefert IEEE-Infinity
  #   maybe_nan: Ergebnis unbestimmt, liefert IEEE-NaN
+ #ifdef intQsize
+   #define double_to_DF(expr,ergebnis_zuweisung,maybe_overflow,maybe_subnormal,maybe_underflow,maybe_divide_0,maybe_nan)  \
+     { var dfloatjanus _erg; _erg.machine_double = (expr);                \
+       if ((_erg.explicit & (bit(DF_exp_len+DF_mant_len)-bit(DF_mant_len))) == 0) # e=0 ? \
+         { if (maybe_underflow                                            \
+               || (maybe_subnormal && !((_erg.explicit << 1) == 0))       \
+              )                                                           \
+             { fehler_underflow(); } # subnormal oder noch kleiner -> Underflow \
+             else                                                         \
+             { ergebnis_zuweisung DF_0; } # +/- 0.0 -> 0.0                \
+         }                                                                \
+       elif ((maybe_overflow || maybe_divide_0)                           \
+             && (((~_erg.explicit) & (bit(DF_exp_len+DF_mant_len)-bit(DF_mant_len))) == 0) # e=2047 ? \
+            )                                                             \
+         { if (maybe_nan && ((_erg.explicit<<(64-DF_mant_len)) == 0))     \
+             { divide_0(); } # NaN, also Singularitt -> "Division durch 0" \
+           else # Infinity                                                \
+           if (!maybe_overflow || maybe_divide_0)                         \
+             { divide_0(); } # Infinity, Division durch 0                 \
+             else                                                         \
+             { fehler_overflow(); } # Infinity, Overflow                  \
+         }                                                                \
+       else                                                               \
+         { ergebnis_zuweisung allocate_dfloat(_erg.explicit); }           \
+     }
+ #else
    #define double_to_DF(expr,ergebnis_zuweisung,maybe_overflow,maybe_subnormal,maybe_underflow,maybe_divide_0,maybe_nan)  \
      { var dfloatjanus _erg; _erg.machine_double = (expr);                \
        if ((_erg.explicit.semhi & (bit(DF_exp_len+DF_mant_len-32)-bit(DF_mant_len-32))) == 0) # e=0 ? \
***************
*** 85,94 ****
          { ergebnis_zuweisung allocate_dfloat(_erg.explicit.semhi,_erg.explicit.mlo); }  \
      }
  #endif
  
  # DF_zerop(x) stellt fest, ob ein Double-Float x = 0.0 ist.
!   # define DF_zerop(x)  (DF_uexp(TheDfloat(x)->float_value.semhi) == 0)
!   #define DF_zerop(x)  (TheDfloat(x)->float_value.semhi == 0)
  
  # Liefert zu einem Double-Float x : (ftruncate x), ein DF.
  # DF_ftruncate_DF(x)
--- 153,163 ----
          { ergebnis_zuweisung allocate_dfloat(_erg.explicit.semhi,_erg.explicit.mlo); }  \
      }
  #endif
+ #endif
  
  # DF_zerop(x) stellt fest, ob ein Double-Float x = 0.0 ist.
!   # define DF_zerop(x)  (DF_uexp(TheDfloat(x)->float_value_semhi) == 0)
!   #define DF_zerop(x)  (TheDfloat(x)->float_value_semhi == 0)
  
  # Liefert zu einem Double-Float x : (ftruncate x), ein DF.
  # DF_ftruncate_DF(x)
***************
*** 100,105 ****
--- 169,192 ----
  # 1<=e<=52 -> letzte (53-e) Bits der Mantisse auf 0 setzen,
  #             Exponent und Vorzeichen beibehalten
  # e>=53 -> Ergebnis x
+ #ifdef intQsize
+   local object DF_ftruncate_DF(x)
+     var reg3 object x;
+     { var reg2 dfloat x_ = TheDfloat(x)->float_value;
+       var reg1 uintWL uexp = DF_uexp(x_); # e + DF_exp_mid
+       if (uexp <= DF_exp_mid) # 0.0 oder e<=0 ?
+         { return DF_0; }
+         else
+         { if (uexp > DF_exp_mid+DF_mant_len) # e > 52 ?
+             { return x; }
+             else
+             # 1<=e<=52
+             { return allocate_dfloat
+                 ( x_ & # Bitmaske: Bits 52-e..0 gelscht, alle anderen gesetzt
+                   ~(bit(DF_mant_len+1+DF_exp_mid-uexp)-1)
+                 );
+     }   }   }
+ #else
    local object DF_ftruncate_DF(x)
      var reg3 object x;
      { var reg2 uint32 semhi = TheDfloat(x)->float_value.semhi;
***************
*** 126,131 ****
--- 213,219 ----
                      0
                    );
      }   }     }
+ #endif
  
  # Liefert zu einem Double-Float x : (futruncate x), ein DF.
  # DF_futruncate_DF(x)
***************
*** 142,147 ****
--- 230,260 ----
  #             Sonst (Ergebnis eine Zweierpotenz): Mantisse := .1000...000,
  #               e:=e+1. (Test auf berlauf wegen e<=53 berflssig)
  # e>=53 -> Ergebnis x.
+ #ifdef intQsize
+   local object DF_futruncate_DF(x)
+     var reg3 object x;
+     { var reg2 dfloat x_ = TheDfloat(x)->float_value;
+       var reg1 uintWL uexp = DF_uexp(x_); # e + DF_exp_mid
+       if (uexp==0) # 0.0 ?
+         { return x; }
+       if (uexp <= DF_exp_mid) # e<=0 ?
+         { # Exponent auf 1, Mantisse auf .1000...000 setzen.
+           return ((x_ & bit(63))==0 ? DF_1 : DF_minus1);
+         }
+         else
+         { if (uexp > DF_exp_mid+DF_mant_len) # e > 52 ?
+             { return x; }
+             else
+             { var reg1 uint64 mask = # Bitmaske: Bits 52-e..0 gesetzt, alle anderen gelscht
+                 bit(DF_mant_len+1+DF_exp_mid-uexp)-1;
+               if ((x_ & mask)==0) # alle diese Bits =0 ?
+                 { return x; }
+               return allocate_dfloat
+                 ((x_ | mask) # alle diese Bits setzen
+                  + 1 # letzte Stelle erhhen, dabei evtl. Exponenten incrementieren
+                 );
+     }   }   }
+ #else
    local object DF_futruncate_DF(x)
      var reg3 object x;
      { var reg2 uint32 semhi = TheDfloat(x)->float_value.semhi;
***************
*** 178,183 ****
--- 291,297 ----
                     0
                    );
      }   }     }
+ #endif
  
  # Liefert zu einem Double-Float x : (fround x), ein DF.
  # DF_fround_DF(x)
***************
*** 189,194 ****
--- 303,369 ----
  # 0<=e<=52 -> letzte (53-e) Bits der Mantisse wegrunden,
  #             Exponent und Vorzeichen beibehalten.
  # e>52 -> Ergebnis x
+ #ifdef intQsize
+   local object DF_fround_DF(x)
+     var reg3 object x;
+     { var reg2 dfloat x_ = TheDfloat(x)->float_value;
+       var reg1 uintWL uexp = DF_uexp(x_); # e + DF_exp_mid
+       if (uexp < DF_exp_mid) # x = 0.0 oder e<0 ?
+         { return DF_0; }
+         else
+         { if (uexp > DF_exp_mid+DF_mant_len) # e > 52 ?
+             { return x; }
+             else
+             if (uexp > DF_exp_mid+1) # e>1 ?
+               { var reg4 uint64 bitmask = # Bitmaske: Bit 52-e gesetzt, alle anderen gelscht
+                   bit(DF_mant_len+DF_exp_mid-uexp);
+                 var reg3 uint64 mask = # Bitmaske: Bits 51-e..0 gesetzt, alle anderen gelscht
+                   bitmask-1;
+                 if ( ((x_ & bitmask) ==0) # Bit 52-e =0 -> abrunden
+                      || ( ((x_ & mask) ==0) # Bit 52-e =1 und Bits 51-e..0 >0 -> aufrunden
+                           # round-to-even, je nach Bit 53-e :
+                           && ((x_ & (bitmask<<1)) ==0)
+                    )    )
+                   # abrunden
+                   { mask |= bitmask; # Bitmaske: Bits 52-e..0 gesetzt, alle anderen gelscht
+                     return allocate_dfloat( x_ & ~mask );
+                   }
+                   else
+                   # aufrunden
+                   { return allocate_dfloat
+                       ((x_ | mask) # alle diese Bits 51-e..0 setzen (Bit 52-e schon gesetzt)
+                        + 1 # letzte Stelle erhhen, dabei evtl. Exponenten incrementieren
+                       );
+                   }
+               }
+             elif (uexp == DF_exp_mid+1) # e=1 ?
+               # Wie bei 1 < e <= 52, nur da Bit 53-e stets gesetzt ist.
+               { if ((x_ & bit(DF_mant_len-1)) ==0) # Bit 52-e =0 -> abrunden
+                   # abrunden
+                   { return allocate_dfloat( x_ & ~(bit(DF_mant_len)-1) ); }
+                   else
+                   # aufrunden
+                   { return allocate_dfloat
+                       ((x_ | (bit(DF_mant_len)-1)) # alle diese Bits 52-e..0 setzen
+                        + 1 # letzte Stelle erhhen, dabei evtl. Exponenten incrementieren
+                       );
+                   }
+               }
+             else # e=0 ?
+               # Wie bei 1 < e <= 52, nur da Bit 52-e stets gesetzt
+               # und Bit 53-e stets gelscht ist.
+               { if ((x_ & (bit(DF_mant_len)-1)) ==0)
+                   # abrunden von +-0.5 zu 0.0
+                   { return DF_0; }
+                   else
+                   # aufrunden
+                   { return allocate_dfloat
+                       ((x_ | (bit(DF_mant_len)-1)) # alle Bits 51-e..0 setzen
+                        + 1 # letzte Stelle erhhen, dabei Exponenten incrementieren
+                       );
+               }   }
+     }   }
+ #else
    local object DF_fround_DF(x)
      var reg3 object x;
      { var reg2 uint32 semhi = TheDfloat(x)->float_value.semhi;
***************
*** 278,283 ****
--- 453,459 ----
                        );
                }   }
      }   }
+ #endif
  
  # Liefert zu einem Double-Float x : (- x), ein DF.
  # DF_minus_DF(x)
***************
*** 285,290 ****
--- 461,476 ----
    local object DF_minus_DF (object x);
  # Methode:
  # Falls x=0.0, fertig. Sonst Vorzeichenbit umdrehen.
+ #ifdef intQsize
+   local object DF_minus_DF(x)
+     var reg2 object x;
+     { var reg1 dfloat x_ = TheDfloat(x)->float_value;
+       return (DF_uexp(x_) == 0
+               ? x
+               : allocate_dfloat( x_ ^ bit(63) )
+              );
+     }
+ #else
    local object DF_minus_DF(x)
      var reg2 object x;
      { var reg1 uint32 semhi = TheDfloat(x)->float_value.semhi;
***************
*** 294,299 ****
--- 480,486 ----
                : allocate_dfloat( semhi ^ bit(31), mlo )
               );
      }
+ #endif
  
  # DF_DF_comp(x,y) vergleicht zwei Double-Floats x und y.
  # Ergebnis: 0 falls x=y, +1 falls x>y, -1 falls x<y.
***************
*** 305,310 ****
--- 492,528 ----
  # x und y haben gleiches Vorzeichen ->
  #    x >=0 -> vergleiche x und y (die rechten 53 Bits)
  #    x <0 -> vergleiche y und x (die rechten 53 Bits)
+ #ifdef intQsize
+   local signean DF_DF_comp(x,y)
+     var reg3 object x;
+     var reg4 object y;
+     { var reg1 dfloat x_ = TheDfloat(x)->float_value;
+       var reg2 dfloat y_ = TheDfloat(y)->float_value;
+       if ((sint64)y_ >= 0)
+         # y>=0
+         { if ((sint64)x_ >= 0)
+             # y>=0, x>=0
+             { if (x_ < y_) return signean_minus; # x<y
+               if (x_ > y_) return signean_plus; # x>y
+               return signean_null;
+             }
+             else
+             # y>=0, x<0
+             { return signean_minus; } # x<y
+         }
+         else
+         { if ((sint64)x_ >= 0)
+             # y<0, x>=0
+             { return signean_plus; } # x>y
+             else
+             # y<0, x<0
+             { if (x_ > y_) return signean_minus; # |x|>|y| -> x<y
+               if (x_ < y_) return signean_plus; # |x|<|y| -> x>y
+               return signean_null;
+             }
+         }
+     }
+ #else
    local signean DF_DF_comp(x,y)
      var reg3 object x;
      var reg4 object y;
***************
*** 340,345 ****
--- 558,564 ----
              }
          }
      }
+ #endif
  
  # Liefert zu zwei Double-Float x und y : (+ x y), ein DF.
  # DF_DF_plus_DF(x)
***************
*** 363,369 ****
  #                    =0 -> Ergebnis 0.0
  # Exponent ist e1.
  # Normalisiere, fertig.
!  #ifdef FAST_DOUBLE
    local object DF_DF_plus_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
--- 582,588 ----
  #                    =0 -> Ergebnis 0.0
  # Exponent ist e1.
  # Normalisiere, fertig.
! #ifdef FAST_DOUBLE
    local object DF_DF_plus_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
***************
*** 374,380 ****
                     FALSE, FALSE # keine Singularitt, kein NaN als Ergebnis mglich
                    );
      }
!  #else
    local object DF_DF_plus_DF(x1,x2)
      var reg7 object x1;
      var reg8 object x2;
--- 593,692 ----
                     FALSE, FALSE # keine Singularitt, kein NaN als Ergebnis mglich
                    );
      }
! #else
! #ifdef intQsize
!   local object DF_DF_plus_DF(x1,x2)
!     var reg7 object x1;
!     var reg8 object x2;
!     { # x1,x2 entpacken:
!       var reg9 signean sign1;
!       var reg5 sintWL exp1;
!       var reg1 uint64 mant1;
!       var reg9 signean sign2;
!       var reg10 sintWL exp2;
!       var reg4 uint64 mant2;
!       DF_decode(x1, { return x2; }, sign1=,exp1=,mant1=);
!       DF_decode(x2, { return x1; }, sign2=,exp2=,mant2=);
!       if (exp1 < exp2)
!         { swap(reg9 object,  x1   ,x2   );
!           swap(reg9 signean, sign1,sign2);
!           swap(reg9 sintWL,  exp1 ,exp2 );
!           swap(reg9 uint64,   mant1,mant2);
!         }
!       # Nun ist exp1>=exp2.
!      {var reg3 uintL expdiff = exp1 - exp2; # Exponentendifferenz
!       if (expdiff >= DF_mant_len+3) # >= 52+3 ?
!         { return x1; }
!       mant1 = mant1 << 3; mant2 = mant2 << 3;
!       # Nun 2^(DF_mant_len+3) <= mant1,mant2 < 2^(DF_mant_len+4).
!       {var reg2 uint64 mant2_last = mant2 & (bit(expdiff)-1); # letzte expdiff Bits von mant2
!        mant2 = mant2 >> expdiff; if (!(mant2_last==0)) { mant2 |= bit(0); }
!       }
!       # mant2 = um expdiff Bits nach rechts geschobene und gerundete Mantisse
!       # von x2.
!       if (!(sign1==sign2))
!         # verschiedene Vorzeichen -> Mantissen subtrahieren
!         { if (mant1 > mant2) { mant1 = mant1 - mant2; goto norm_2; }
!           if (mant1 == mant2) # Ergebnis 0 ?
!             { return DF_0; }
!           # negatives Subtraktionsergebnis
!           mant1 = mant2 - mant1; sign1 = sign2; goto norm_2;
!         }
!         else
!         # gleiche Vorzeichen -> Mantissen addieren
!         { mant1 = mant1 + mant2; }
!       # mant1 = Ergebnis-Mantisse >0, sign1 = Ergebnis-Vorzeichen,
!       # exp1 = Ergebnis-Exponent.
!       # Auerdem: Bei expdiff=0,1 sind die zwei letzten Bits von mant1 Null,
!       # bei expdiff>=2 ist mant1 >= 2^(DF_mant_len+2).
!       # Stets ist mant1 < 2^(DF_mant_len+5). (Daher werden die 2 Rundungsbits
!       # nachher um hchstens eine Position nach links geschoben werden.)
!       # [Knuth, S.201, leicht modifiziert:
!       #   N1. m>=1 -> goto N4.
!       #   N2. [Hier m<1] m>=1/2 -> goto N5.
!       #       N3. m:=2*m, e:=e-1, goto N2.
!       #   N4. [Hier 1<=m<2] m:=m/2, e:=e+1.
!       #   N5. [Hier 1/2<=m<1] Runde m auf 53 Bits hinterm Komma.
!       #       Falls hierdurch m=1 geworden, setze m:=m/2, e:=e+1.
!       # ]
!       # Bei uns ist m=mant1/2^(DF_mant_len+4),
!       # ab Schritt N5 ist m=mant1/2^(DF_mant_len+1).
!       norm_1: # [Knuth, S.201, Schritt N1]
!       if (mant1 >= bit(DF_mant_len+4)) goto norm_4;
!       norm_2: # [Knuth, S.201, Schritt N2]
!               # Hier ist mant1 < 2^(DF_mant_len+4)
!       if (mant1 >= bit(DF_mant_len+3)) goto norm_5;
!       # [Knuth, S.201, Schritt N3]
!       mant1 = mant1 << 1; exp1 = exp1-1; # Mantisse links schieben
!       goto norm_2;
!       norm_4: # [Knuth, S.201, Schritt N4]
!               # Hier ist 2^(DF_mant_len+4) <= mant1 < 2^(DF_mant_len+5)
!       exp1 = exp1+1;
!       mant1 = (mant1>>1) | (mant1 & bit(0)); # Mantisse rechts schieben
!       norm_5: # [Knuth, S.201, Schritt N5]
!               # Hier ist 2^(DF_mant_len+3) <= mant1 < 2^(DF_mant_len+4)
!       # Auf DF_mant_len echte Mantissenbits runden, d.h. rechte 3 Bits
!       # wegrunden, und dabei mant1 um 3 Bits nach rechts schieben:
!       {var reg2 uint64 rounding_bits = mant1 & (bit(3)-1);
!        mant1 = mant1 >> 3;
!        if ( (rounding_bits < bit(2)) # 000,001,010,011 werden abgerundet
!             || ( (rounding_bits == bit(2)) # 100 (genau halbzahlig)
!                  && ((mant1 & bit(0)) ==0) # -> round-to-even
!           )    )
!          # abrunden
!          {}
!          else
!          # aufrunden
!          { mant1 = mant1+1;
!            if (mant1 >= bit(DF_mant_len+1))
!              # Bei berlauf whrend der Rundung nochmals rechts schieben
!              # (Runden ist hier berflssig):
!              { mant1 = mant1>>1; exp1 = exp1+1; } # Mantisse rechts schieben
!          }
!       }# Runden fertig
!       encode_DF(sign1,exp1,mant1, return);
!     }}
! #else
    local object DF_DF_plus_DF(x1,x2)
      var reg7 object x1;
      var reg8 object x2;
***************
*** 500,506 ****
        }# Runden fertig
        encode_DF(sign1,exp1,manthi1,mantlo1, return);
      }}
!  #endif
  
  # Liefert zu zwei Double-Float x und y : (- x y), ein DF.
  # DF_DF_minus_DF(x)
--- 812,819 ----
        }# Runden fertig
        encode_DF(sign1,exp1,manthi1,mantlo1, return);
      }}
! #endif
! #endif
  
  # Liefert zu zwei Double-Float x und y : (- x y), ein DF.
  # DF_DF_minus_DF(x)
***************
*** 508,514 ****
    local object DF_DF_minus_DF (object x, object y);
  # Methode:
  # (- x1 x2) = (+ x1 (- x2))
!  #ifdef FAST_DOUBLE
    local object DF_DF_minus_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
--- 821,827 ----
    local object DF_DF_minus_DF (object x, object y);
  # Methode:
  # (- x1 x2) = (+ x1 (- x2))
! #ifdef FAST_DOUBLE
    local object DF_DF_minus_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
***************
*** 519,525 ****
                     FALSE, FALSE # keine Singularitt, kein NaN als Ergebnis mglich
                    );
      }
!  #else
    local object DF_DF_minus_DF(x1,x2)
      var reg3 object x1;
      var reg1 object x2;
--- 832,849 ----
                     FALSE, FALSE # keine Singularitt, kein NaN als Ergebnis mglich
                    );
      }
! #else
! #ifdef intQsize
!   local object DF_DF_minus_DF(x1,x2)
!     var reg3 object x1;
!     var reg1 object x2;
!     { var reg2 dfloat x2_ = TheDfloat(x2)->float_value;
!       if (DF_uexp(x2_) == 0)
!         { return x1; }
!         else
!         { return DF_DF_plus_DF(x1, allocate_dfloat(x2_ ^ bit(63)) ); }
!     }
! #else
    local object DF_DF_minus_DF(x1,x2)
      var reg3 object x1;
      var reg1 object x2;
***************
*** 530,536 ****
          else
          { return DF_DF_plus_DF(x1, allocate_dfloat(x2_semhi ^ bit(31), x2_mlo) ); }
      }
!  #endif
  
  # Liefert zu zwei Double-Float x und y : (* x y), ein DF.
  # DF_DF_mal_DF(x)
--- 854,861 ----
          else
          { return DF_DF_plus_DF(x1, allocate_dfloat(x2_semhi ^ bit(31), x2_mlo) ); }
      }
! #endif
! #endif
  
  # Liefert zu zwei Double-Float x und y : (* x y), ein DF.
  # DF_DF_mal_DF(x)
***************
*** 551,557 ****
  #            Bits 50..0 alle Null, round-to-even; sonst aufrunden. Nach
  #            Aufrunden: Falls =2^53, um 1 Bit nach rechts schieben. Sonst
  #            Exponenten um 1 erniedrigen.
!  #ifdef FAST_DOUBLE
    local object DF_DF_mal_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
--- 876,882 ----
  #            Bits 50..0 alle Null, round-to-even; sonst aufrunden. Nach
  #            Aufrunden: Falls =2^53, um 1 Bit nach rechts schieben. Sonst
  #            Exponenten um 1 erniedrigen.
! #ifdef FAST_DOUBLE
    local object DF_DF_mal_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
***************
*** 562,568 ****
                     FALSE, FALSE # keine Singularitt, kein NaN als Ergebnis mglich
                    );
      }
!  #else
    local object DF_DF_mal_DF(x1,x2)
      var reg7 object x1;
      var reg8 object x2;
--- 887,893 ----
                     FALSE, FALSE # keine Singularitt, kein NaN als Ergebnis mglich
                    );
      }
! #else
    local object DF_DF_mal_DF(x1,x2)
      var reg7 object x1;
      var reg8 object x2;
***************
*** 575,582 ****
--- 900,918 ----
        var reg9 sintWL exp2;
        var reg5 uintL manthi2;
        var reg5 uintL mantlo2;
+       #ifdef intQsize
+       { var reg1 uint64 mant1;
+         DF_decode(x1, { return x1; }, sign1=,exp1=,mant1=);
+         manthi1 = (uint32)(mant1>>32); mantlo1 = (uint32)mant1;
+       }
+       { var reg1 uint64 mant2;
+         DF_decode(x2, { return x2; }, sign2=,exp2=,mant2=);
+         manthi2 = (uint32)(mant2>>32); mantlo2 = (uint32)mant2;
+       }
+       #else
        DF_decode(x1, { return x1; }, sign1=,exp1=,manthi1=,mantlo1=);
        DF_decode(x2, { return x2; }, sign2=,exp2=,manthi2=,mantlo2=);
+       #endif
        exp1 = exp1 + exp2; # Summe der Exponenten
        sign1 = sign1 ^ sign2; # Ergebnis-Vorzeichen
       {# Mantissen mant1 und mant2 multiplizieren (64x64-Bit-Multiplikation):
***************
*** 602,615 ****
                        &mant2[64/intDsize],64/intDsize,
                        &mant[128/intDsize]
                       );
!       { var reg1 uintL manthi;
          var reg2 uintL mantlo;
          # Produkt mant = mant1 * mant2 ist >= 2^104, < 2^106. Bit 105 abtesten:
          #define mant_bit(k)  (mant[128/intDsize - 1 - floor(k,intDsize)] & bit((k)%intDsize))
          if (mant_bit(2*DF_mant_len+1))
            # mant>=2^(2*DF_mant_len+1), um DF_mant_len+1 Bits nach rechts schieben:
            { # Bits 105..53 holen:
!             #if (intDsize==32)
                manthi = ((uint32)mant[0] << 11) | ((uint32)mant[1] >> 21); # Bits 116..85
                mantlo = ((uint32)mant[1] << 11) | ((uint32)mant[2] >> 21); # Bits 84..53
                #define mantrest() ((mant[2] & (bit(21)-1)) || mant[3])
--- 938,959 ----
                        &mant2[64/intDsize],64/intDsize,
                        &mant[128/intDsize]
                       );
!       {
!         #ifdef intQsize
!         var reg1 uint64 manterg;
!         #else
!         var reg1 uintL manthi;
          var reg2 uintL mantlo;
+         #endif
          # Produkt mant = mant1 * mant2 ist >= 2^104, < 2^106. Bit 105 abtesten:
          #define mant_bit(k)  (mant[128/intDsize - 1 - floor(k,intDsize)] & bit((k)%intDsize))
          if (mant_bit(2*DF_mant_len+1))
            # mant>=2^(2*DF_mant_len+1), um DF_mant_len+1 Bits nach rechts schieben:
            { # Bits 105..53 holen:
!             #if defined(intQsize) # && (intDsize==32)
!               manterg = ((uint64)mant[0] << 43) | ((uint64)mant[1] << 11) | ((uint64)mant[2] >> 21); # Bits 116..53
!               #define mantrest() ((mant[2] & (bit(21)-1)) || mant[3])
!             #elif (intDsize==32)
                manthi = ((uint32)mant[0] << 11) | ((uint32)mant[1] >> 21); # Bits 116..85
                mantlo = ((uint32)mant[1] << 11) | ((uint32)mant[2] >> 21); # Bits 84..53
                #define mantrest() ((mant[2] & (bit(21)-1)) || mant[3])
***************
*** 640,646 ****
            # mant<2^(2*DF_mant_len+1), um DF_mant_len Bits nach rechts schieben:
            { exp1 = exp1-1; # Exponenten decrementieren
              # Bits 104..52 holen:
!             #if (intDsize==32)
                manthi = ((uint32)mant[0] << 12) | ((uint32)mant[1] >> 20); # Bits 115..84
                mantlo = ((uint32)mant[1] << 12) | ((uint32)mant[2] >> 20); # Bits 83..52
                #define mantrest() ((mant[2] & (bit(20)-1)) || mant[3])
--- 984,993 ----
            # mant<2^(2*DF_mant_len+1), um DF_mant_len Bits nach rechts schieben:
            { exp1 = exp1-1; # Exponenten decrementieren
              # Bits 104..52 holen:
!             #if defined(intQsize) # && (intDsize==32)
!               manterg = ((uint64)mant[0] << 44) | ((uint64)mant[1] << 12) | ((uint64)mant[2] >> 20); # Bits 115..52
!               #define mantrest() ((mant[2] & (bit(20)-1)) || mant[3])
!             #elif (intDsize==32)
                manthi = ((uint32)mant[0] << 12) | ((uint32)mant[1] >> 20); # Bits 115..84
                mantlo = ((uint32)mant[1] << 12) | ((uint32)mant[2] >> 20); # Bits 83..52
                #define mantrest() ((mant[2] & (bit(20)-1)) || mant[3])
***************
*** 669,686 ****
            }
          #undef mant_bit
          auf:
          mantlo = mantlo+1;
          if (mantlo==0)
            { manthi = manthi+1;
!             # Hier ist 2^DF_mant_len <= manthi <= 2^(DF_mant_len+1)
              if (manthi >= bit(DF_mant_len-32+1)) # rounding overflow?
                { manthi = manthi>>1; exp1 = exp1+1; } # Shift nach rechts
            }
          ab:
!         # Runden fertig, 2^DF_mant_len <= manthi < 2^(DF_mant_len+1)
          encode_DF(sign1,exp1,manthi,mantlo, return);
      }}}
!  #endif
  
  # Liefert zu zwei Double-Float x und y : (/ x y), ein DF.
  # DF_DF_durch_DF(x)
--- 1016,1044 ----
            }
          #undef mant_bit
          auf:
+         #ifdef intQsize
+         manterg = manterg+1;
+         # Hier ist 2^DF_mant_len <= manterg <= 2^(DF_mant_len+1)
+         if (manterg >= bit(DF_mant_len+1)) # rounding overflow?
+           { manterg = manterg>>1; exp1 = exp1+1; } # Shift nach rechts
+         #else
          mantlo = mantlo+1;
          if (mantlo==0)
            { manthi = manthi+1;
!             # Hier ist 2^(DF_mant_len-32) <= manthi <= 2^(DF_mant_len-32+1)
              if (manthi >= bit(DF_mant_len-32+1)) # rounding overflow?
                { manthi = manthi>>1; exp1 = exp1+1; } # Shift nach rechts
            }
+         #endif
          ab:
!         # Runden fertig, 2^DF_mant_len <= manterg < 2^(DF_mant_len+1)
!         #ifdef intQsize
!         encode_DF(sign1,exp1,manterg, return);
!         #else
          encode_DF(sign1,exp1,manthi,mantlo, return);
+         #endif
      }}}
! #endif
  
  # Liefert zu zwei Double-Float x und y : (/ x y), ein DF.
  # DF_DF_durch_DF(x)
***************
*** 704,710 ****
  #     erhhe den Exponenten um 1.
  #   Falls der Quotient <2^54 ist, runde das letzte Bit weg. Bei rounding
  #     overflow schiebe um ein weiteres Bit nach rechts, incr. Exponenten.
!  #ifdef FAST_DOUBLE
    local object DF_DF_durch_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
--- 1062,1068 ----
  #     erhhe den Exponenten um 1.
  #   Falls der Quotient <2^54 ist, runde das letzte Bit weg. Bei rounding
  #     overflow schiebe um ein weiteres Bit nach rechts, incr. Exponenten.
! #ifdef FAST_DOUBLE
    local object DF_DF_durch_DF(x1,x2)
      var reg1 object x1;
      var reg2 object x2;
***************
*** 716,722 ****
                     FALSE # kein NaN als Ergebnis mglich
                    );
      }
!  #else
    local object DF_DF_durch_DF(x1,x2)
      var reg8 object x1;
      var reg9 object x2;
--- 1074,1080 ----
                     FALSE # kein NaN als Ergebnis mglich
                    );
      }
! #else
    local object DF_DF_durch_DF(x1,x2)
      var reg8 object x1;
      var reg9 object x2;
***************
*** 729,745 ****
        var reg10 sintWL exp2;
        var reg6 uintL manthi2;
        var reg6 uintL mantlo2;
        DF_decode(x2, { divide_0(); }, sign2=,exp2=,manthi2=,mantlo2=);
        DF_decode(x1, { return x1; }, sign1=,exp1=,manthi1=,mantlo1=);
        exp1 = exp1 - exp2; # Differenz der Exponenten
        sign1 = sign1 ^ sign2; # Ergebnis-Vorzeichen
        # Dividiere 2^54*mant1 durch mant2 oder (quivalent)
        # 2^i*2^54*mant1 durch 2^i*mant2 fr irgendein i mit 0 <= i <= 64-53 :
        # whle i = 64-(DF_mant_len+1), also i+(DF_mant_len+2) = 65.
!      {var uintD mant1 [128/intDsize];
!       var uintD mant2 [64/intDsize];
        manthi1 = (manthi1 << 1) | (mantlo1 >> 31); mantlo1 = mantlo1 << 1;
        manthi2 = (manthi2 << (64-(DF_mant_len+1))) | (mantlo2 >> ((DF_mant_len+1)-32)); mantlo2 = mantlo2 << (64-(DF_mant_len+1));
        #if (intDsize==32) || (intDsize==16) || (intDsize==8)
        set_32_Dptr(mant1,manthi1); set_32_Dptr(&mant1[32/intDsize],mantlo1);
          set_32_Dptr(&mant1[2*32/intDsize],0); set_32_Dptr(&mant1[3*32/intDsize],0);
--- 1087,1117 ----
        var reg10 sintWL exp2;
        var reg6 uintL manthi2;
        var reg6 uintL mantlo2;
+       #ifdef intQsize
+       var reg5 uint64 mant1;
+       var reg6 uint64 mant2;
+       DF_decode(x2, { divide_0(); }, sign2=,exp2=,mant2=);
+       DF_decode(x1, { return x1; }, sign1=,exp1=,mant1=);
+       #else
        DF_decode(x2, { divide_0(); }, sign2=,exp2=,manthi2=,mantlo2=);
        DF_decode(x1, { return x1; }, sign1=,exp1=,manthi1=,mantlo1=);
+       #endif
        exp1 = exp1 - exp2; # Differenz der Exponenten
        sign1 = sign1 ^ sign2; # Ergebnis-Vorzeichen
        # Dividiere 2^54*mant1 durch mant2 oder (quivalent)
        # 2^i*2^54*mant1 durch 2^i*mant2 fr irgendein i mit 0 <= i <= 64-53 :
        # whle i = 64-(DF_mant_len+1), also i+(DF_mant_len+2) = 65.
!       #ifdef intQsize
!       mant1 = mant1 << 1;
!       mant2 = mant2 << (64-(DF_mant_len+1));
!       manthi1 = (uint32)(mant1>>32); mantlo1 = (uint32)mant1;
!       manthi2 = (uint32)(mant2>>32); mantlo2 = (uint32)mant2;
!       #else
        manthi1 = (manthi1 << 1) | (mantlo1 >> 31); mantlo1 = mantlo1 << 1;
        manthi2 = (manthi2 << (64-(DF_mant_len+1))) | (mantlo2 >> ((DF_mant_len+1)-32)); mantlo2 = mantlo2 << (64-(DF_mant_len+1));
+       #endif
+      {var uintD mant1 [128/intDsize];
+       var uintD mant2 [64/intDsize];
        #if (intDsize==32) || (intDsize==16) || (intDsize==8)
        set_32_Dptr(mant1,manthi1); set_32_Dptr(&mant1[32/intDsize],mantlo1);
          set_32_Dptr(&mant1[2*32/intDsize],0); set_32_Dptr(&mant1[3*32/intDsize],0);
***************
*** 757,764 ****
         doconsttimes(32/intDsize, { *--ptr = (uintD)manthi2; manthi2 = manthi2>>intDsize; } );
        }
        #endif
!       {var reg1 uintL manthi;
!        var reg2 uintL mantlo;
         {SAVE_NUM_STACK # num_stack retten
          var DS q;
          var DS r;
--- 1129,1140 ----
         doconsttimes(32/intDsize, { *--ptr = (uintD)manthi2; manthi2 = manthi2>>intDsize; } );
        }
        #endif
!       {var reg2 uintL mantlo;
!        #ifdef intQsize
!        var reg1 uint64 manthi;
!        #else
!        var reg1 uintL manthi;
!        #endif
         {SAVE_NUM_STACK # num_stack retten
          var DS q;
          var DS r;
***************
*** 775,780 ****
--- 1151,1191 ----
           mantlo = get_32_Dptr(&ptr[ceiling(23,intDsize)]);
          }
          # q = 2^32*manthi+mantlo.
+         #ifdef intQsize
+         manthi = (manthi<<32) | (uint64)mantlo;
+         if (manthi >= bit(DF_mant_len+2))
+           # Quotient >=2^54 -> 2 Bits wegrunden
+           { var reg2 uint64 rounding_bits = manthi & (bit(2)-1);
+             exp1 += 1; # Exponenten incrementieren
+             manthi = manthi >> 2;
+             if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
+                  || ( (rounding_bits == bit(1)) # 10
+                       && (r.len == 0) # und genau halbzahlig
+                       && ((manthi & bit(0)) ==0) # -> round-to-even
+                )    )
+               # abrunden
+               {}
+               else
+               # aufrunden
+               { manthi += 1; }
+           }
+           else
+           # Quotient <2^54 -> 1 Bit wegrunden
+           { var reg2 uint64 rounding_bit = manthi & bit(0);
+             manthi = manthi >> 1;
+             if ( (rounding_bit == 0) # 0 wird abgerundet
+                  || ( (r.len == 0) # genau halbzahlig
+                       && ((manthi & bit(0)) ==0) # -> round-to-even
+                )    )
+               # abrunden
+               {}
+               else
+               # aufrunden
+               { manthi += 1;
+                 if (manthi >= bit(DF_mant_len+1)) # rounding overflow?
+                   { manthi = manthi>>1; exp1 = exp1+1; }
+           }   }
+         #else
          if (manthi >= bit(DF_mant_len-32+2))
            # Quotient >=2^54 -> 2 Bits wegrunden
            { var reg2 uintL rounding_bits = mantlo & (bit(2)-1);
***************
*** 809,818 ****
                      if (manthi >= bit(DF_mant_len-32+1)) # rounding overflow?
                        { manthi = manthi>>1; exp1 = exp1+1; }
            }   }   }
         }
         encode_DF(sign1,exp1,manthi,mantlo, return);
      }}}
!  #endif
  
  # Liefert zu einem Double-Float x>=0 : (sqrt x), ein DF.
  # DF_sqrt_DF(x)
--- 1220,1234 ----
                      if (manthi >= bit(DF_mant_len-32+1)) # rounding overflow?
                        { manthi = manthi>>1; exp1 = exp1+1; }
            }   }   }
+         #endif
         }
+        #ifdef intQsize
+        encode_DF(sign1,exp1,manthi, return);
+        #else
         encode_DF(sign1,exp1,manthi,mantlo, return);
+        #endif
      }}}
! #endif
  
  # Liefert zu einem Double-Float x>=0 : (sqrt x), ein DF.
  # DF_sqrt_DF(x)
***************
*** 833,838 ****
--- 1249,1302 ----
  #   Dabei um ein Bit nach rechts schieben.
  #   Bei Aufrundung auf 2^53 (rounding overflow) Mantisse um 1 Bit nach rechts
  #     schieben und Exponent incrementieren.
+ #ifdef intQsize # && (intDsize==32)
+   local object DF_sqrt_DF(x)
+     var reg5 object x;
+     { # x entpacken:
+       var reg4 sintWL exp;
+       var reg1 uint64 mantx;
+       DF_decode(x, { return x; }, ,exp=,mantx=);
+       # Um die 128-Bit-Ganzzahl-Wurzel ausnutzen zu knnen, fgen wir beim
+       # Radikanden 74 bzw. 75 statt 54 bzw. 55 Nullbits an.
+       if (exp & bit(0))
+         # e ungerade
+         { mantx = mantx << (63-(DF_mant_len+1)); exp = exp+1; }
+         else
+         # e gerade
+         { mantx = mantx << (64-(DF_mant_len+1)); }
+       exp = exp >> 1; # exp := exp/2
+      {var uintD mant [128/intDsize];
+       set_32_Dptr(mant,(uint32)(mantx>>32)); set_32_Dptr(&mant[32/intDsize],(uint32)mantx);
+         set_32_Dptr(&mant[2*32/intDsize],0); set_32_Dptr(&mant[3*32/intDsize],0);
+       {SAVE_NUM_STACK # num_stack retten
+        var DS wurzel;
+        var reg6 boolean exactp;
+        UDS_sqrt(&mant[0],128/intDsize,&mant[128/intDsize], &wurzel, exactp=);
+        # wurzel = isqrt(2^74_75 * mant), eine 64-Bit-Zahl.
+        RESTORE_NUM_STACK # num_stack zurck
+        {var reg3 uintD* ptr = wurzel.MSDptr;
+         mantx = ((uint64)get_32_Dptr(ptr) << 32) | (uint64)get_32_Dptr(&ptr[32/intDsize]);
+        }
+        # Die hinteren 63-DF_mant_len Bits wegrunden:
+        if ( ((mantx & bit(62-DF_mant_len)) ==0) # Bit 10 =0 -> abrunden
+             || ( ((mantx & (bit(62-DF_mant_len)-1)) ==0) # Bit 10 =1 und Bits 9..0 >0 -> aufrunden
+                  && exactp                   # Bit 10 =1 und Bits 9..0 =0, aber Rest -> aufrunden
+                  # round-to-even, je nach Bit 11 :
+                  && ((mantx & bit(63-DF_mant_len)) ==0)
+           )    )
+          # abrunden
+          { mantx = mantx >> (63-DF_mant_len); }
+          else
+          # aufrunden
+          { mantx = mantx >> (63-DF_mant_len);
+            mantx += 1;
+            if (mantx >= bit(DF_mant_len+1)) # rounding overflow?
+              { mantx = mantx>>1; exp = exp+1; }
+          }
+       }}
+       encode_DF(0,exp,mantx, return);
+     }
+ #else
    local object DF_sqrt_DF(x)
      var reg5 object x;
      { # x entpacken:
***************
*** 899,904 ****
--- 1363,1369 ----
        }}
        encode_DF(0,exp,manthi,mantlo, return);
      }
+ #endif
  
  # DF_to_I(x) wandelt ein Double-Float x, das eine ganze Zahl darstellt,
  # in ein Integer um.
***************
*** 907,912 ****
--- 1372,1392 ----
  # Methode:
  # Falls x=0.0, Ergebnis 0.
  # Sonst (ASH Vorzeichen*Mantisse (e-53)).
+ #ifdef intQsize
+   local object DF_to_I(x)
+     var reg3 object x;
+     { # x entpacken:
+       var reg4 signean sign;
+       var reg2 sintWL exp;
+       var reg1 uint64 mant;
+       DF_decode(x, { return Fixnum_0; }, sign=,exp=,mant=);
+       exp = exp-(DF_mant_len+1);
+       # mant mit Vorzeichen versehen:
+       if (!(sign==0)) { mant = -mant; }
+       # in ein Bignum umwandeln und shiften:
+       return I_I_ash_I( Q_to_I(mant), L_to_FN(exp) );
+     }
+ #else
    local object DF_to_I(x)
      var reg4 object x;
      { # x entpacken:
***************
*** 922,927 ****
--- 1402,1408 ----
        # in ein Bignum umwandeln und shiften:
        return I_I_ash_I( L2_to_I(manthi,mantlo), L_to_FN(exp) );
      }
+ #endif
  
  # I_to_DF(x) wandelt ein Integer x in ein Double-Float um und rundet dabei.
  # kann GC auslsen
***************
*** 973,978 ****
--- 1454,1484 ----
            # Das hchste in 2^64*msd+2^32*msdd+msddf gesetzte Bit ist Bit Nummer
            # 63 + (exp mod intDsize).
           {var reg6 uintL shiftcount = exp % intDsize;
+           #ifdef intQsize
+           var reg3 uint64 mant = # fhrende 64 Bits
+             (shiftcount==0
+               ? (((uint64)msdd << 32) | (uint64)msddf)
+               : (((uint64)msd << (64-shiftcount)) | ((uint64)msdd << (32-shiftcount)) | ((uint64)msddf >> shiftcount))
+             );
+           # Das hchste in mant gesetzte Bit ist Bit Nummer 63.
+           if ( ((mant & bit(62-DF_mant_len)) ==0) # Bit 10 =0 -> abrunden
+                || ( ((mant & (bit(62-DF_mant_len)-1)) ==0) # Bit 10 =1 und Bits 9..0 =0
+                     && ((msddf & (bit(shiftcount)-1)) ==0) # und weitere Bits aus msddf =0
+                     && (!test_loop_up(MSDptr,len)) # und alle weiteren Digits =0
+                     # round-to-even, je nach Bit 11 :
+                     && ((mant & bit(63-DF_mant_len)) ==0)
+              )    )
+             # abrunden
+             { mant = mant >> (63-DF_mant_len); }
+             else
+             # aufrunden
+             { mant = mant >> (63-DF_mant_len);
+               mant += 1;
+               if (mant >= bit(DF_mant_len+1)) # rounding overflow?
+                 { mant = mant>>1; exp = exp+1; }
+             }
+           encode_DF(sign,(sintL)exp,mant, return);
+           #else
            var reg3 uint32 manthi; # fhrende 32 Bits
            var reg3 uint32 mantlo; # nchste 32 Bits
            if (shiftcount==0)
***************
*** 1004,1009 ****
--- 1510,1516 ----
                      { manthi = manthi>>1; exp = exp+1; }
              }   }
            encode_DF(sign,(sintL)exp,manthi,mantlo, return);
+           #endif
      }}}}}}
  
  # RA_to_DF(x) wandelt eine rationale Zahl x in ein Double-Float um
***************
*** 1055,1069 ****
           I_I_divide_I_I(zaehler,nenner);
           # Stackaufbau: q, r.
           # 2^53 <= q < 2^55, also ist q Bignum mit ceiling(55/intDsize) Digits.
!         {var reg1 uint32 manthi;
!          var reg1 uint32 mantlo;
!          {var reg3 uintD* ptr = &TheBignum(STACK_1)->data[0];
!           manthi = get_max32_Dptr(23,ptr);
!           mantlo = get_32_Dptr(&ptr[ceiling(23,intDsize)]);
!          }
           if (manthi >= bit(DF_mant_len-32+2))
             # 2^54 <= q < 2^55, schiebe um 2 Bits nach rechts
!            { var reg2 uint32 rounding_bits = mantlo & (bit(2)-1);
               lendiff = lendiff+1; # Exponent := n-m+1
               mantlo = (mantlo >> 2) | (manthi << 30); manthi = manthi >> 2;
               if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
--- 1562,1615 ----
           I_I_divide_I_I(zaehler,nenner);
           # Stackaufbau: q, r.
           # 2^53 <= q < 2^55, also ist q Bignum mit ceiling(55/intDsize) Digits.
!         {var reg3 uintD* ptr = &TheBignum(STACK_1)->data[0];
!          #ifdef intQsize
!          var reg1 uint64 mant =
!            ((uint64)get_max32_Dptr(23,ptr) << 32)
!            | (uint64)get_32_Dptr(&ptr[ceiling(23,intDsize)]);
!          if (mant >= bit(DF_mant_len+2))
!            # 2^54 <= q < 2^55, schiebe um 2 Bits nach rechts
!            { var reg2 uint64 rounding_bits = mant & (bit(2)-1);
!              lendiff = lendiff+1; # Exponent := n-m+1
!              mant = mant >> 2;
!              if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
!                   || ( (rounding_bits == bit(1)) # 10
!                        && (eq(STACK_0,Fixnum_0)) # und genau halbzahlig (r=0)
!                        && ((mant & bit(0)) ==0) # -> round-to-even
!                 )    )
!                # abrunden
!                goto ab;
!                else
!                # aufrunden
!                goto auf;
!            }
!            else
!            { var reg2 uint64 rounding_bit = mant & bit(0);
!              mant = mant >> 1;
!              if ( (rounding_bit == 0) # 0 wird abgerundet
!                   || ( (eq(STACK_0,Fixnum_0)) # genau halbzahlig (r=0)
!                        && ((mant & bit(0)) ==0) # -> round-to-even
!                 )    )
!                # abrunden
!                goto ab;
!                else
!                # aufrunden
!                goto auf;
!            }
!          auf:
!          mant += 1;
!          if (mant >= bit(DF_mant_len+1)) # rounding overflow?
!            { mant = mant>>1; lendiff = lendiff+1; }
!          ab:
!          skipSTACK(2);
!          # Fertig.
!          encode_DF(sign,lendiff,mant, return);
!          #else
!          var reg1 uint32 manthi = get_max32_Dptr(23,ptr);
!          var reg1 uint32 mantlo = get_32_Dptr(&ptr[ceiling(23,intDsize)]);
           if (manthi >= bit(DF_mant_len-32+2))
             # 2^54 <= q < 2^55, schiebe um 2 Bits nach rechts
!            { var reg2 uintL rounding_bits = mantlo & (bit(2)-1);
               lendiff = lendiff+1; # Exponent := n-m+1
               mantlo = (mantlo >> 2) | (manthi << 30); manthi = manthi >> 2;
               if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
***************
*** 1101,1105 ****
--- 1647,1652 ----
           skipSTACK(2);
           # Fertig.
           encode_DF(sign,lendiff,manthi,mantlo, return);
+          #endif
      }}}}}
  
diff -r -c3 clisp-1993-11-08/src/eval.d clisp/src/eval.d
*** clisp-1993-11-08/src/eval.d	Mon Nov  1 14:03:04 1993
--- clisp/src/eval.d	Sun Dec  5 14:14:43 1993
***************
*** 1,5 ****
  # Evaluator, Applyer und Bytecode-Interpreter fr CLISP
! # Bruno Haible 1.11.1993
  
  #include "lispbibl.c"
  
--- 1,5 ----
  # Evaluator, Applyer und Bytecode-Interpreter fr CLISP
! # Bruno Haible 10.11.1993
  
  #include "lispbibl.c"
  
***************
*** 65,74 ****
      _(constantp), _(parse_body), _(keyword_test),
      # DEBUG : 1 SUBR
      _(room),
!     # HASHTABL : 10 SUBRs
      _(make_hash_table), _(gethash), _(puthash), _(remhash), _(maphash),
      _(clrhash), _(hash_table_count), _(hash_table_iterator),
!     _(hash_table_iterate), _(sxhash),
      # IO : 36 SUBRs
      _(copy_readtable), _(set_syntax_from_char), _(set_macro_character),
      _(get_macro_character), _(make_dispatch_macro_character),
--- 65,74 ----
      _(constantp), _(parse_body), _(keyword_test),
      # DEBUG : 1 SUBR
      _(room),
!     # HASHTABL : 11 SUBRs
      _(make_hash_table), _(gethash), _(puthash), _(remhash), _(maphash),
      _(clrhash), _(hash_table_count), _(hash_table_iterator),
!     _(hash_table_iterate), _(class_gethash), _(sxhash),
      # IO : 36 SUBRs
      _(copy_readtable), _(set_syntax_from_char), _(set_macro_character),
      _(get_macro_character), _(make_dispatch_macro_character),
***************
*** 99,112 ****
      _(lisp_implementation_type), _(lisp_implementation_version),
      _(software_type), _(software_version), _(identity), _(get_universal_time),
      _(get_internal_run_time), _(get_internal_real_time), _(sleep), _(time),
!     # PACKAGE : 25 SUBRs
      _(make_symbol), _(find_package), _(package_name), _(package_nicknames),
      _(rename_package), _(package_use_list), _(package_used_by_list),
      _(package_shadowing_symbols), _(list_all_packages), _(intern),
      _(find_symbol), _(unintern), _(export), _(unexport), _(import),
      _(shadowing_import), _(shadow), _(use_package), _(unuse_package),
!     _(make_package), _(in_package), _(find_all_symbols), _(map_symbols),
!     _(map_external_symbols), _(map_all_symbols),
      # PATHNAME : 27 SUBRs
      _(parse_namestring), _(pathname), _(pathnamehost), _(pathnamedevice),
      _(pathnamedirectory), _(pathnamename), _(pathnametype),
--- 99,112 ----
      _(lisp_implementation_type), _(lisp_implementation_version),
      _(software_type), _(software_version), _(identity), _(get_universal_time),
      _(get_internal_run_time), _(get_internal_real_time), _(sleep), _(time),
!     # PACKAGE : 26 SUBRs
      _(make_symbol), _(find_package), _(package_name), _(package_nicknames),
      _(rename_package), _(package_use_list), _(package_used_by_list),
      _(package_shadowing_symbols), _(list_all_packages), _(intern),
      _(find_symbol), _(unintern), _(export), _(unexport), _(import),
      _(shadowing_import), _(shadow), _(use_package), _(unuse_package),
!     _(make_package), _(pin_package), _(in_package), _(find_all_symbols),
!     _(map_symbols), _(map_external_symbols), _(map_all_symbols),
      # PATHNAME : 27 SUBRs
      _(parse_namestring), _(pathname), _(pathnamehost), _(pathnamedevice),
      _(pathnamedirectory), _(pathnamename), _(pathnametype),
***************
*** 116,122 ****
      _(delete_file), _(rename_file), _(open), _(directory), _(cd),
      _(make_dir), _(delete_dir), _(file_write_date), _(file_author),
      _(savemem),
!     # PREDTYPE : 44-3 SUBRs
      /* _(eq), */ _(eql), _(equal), _(equalp), _(consp), _(atom), _(symbolp),
      _(stringp), _(numberp), _(compiled_function_p), /* _(null), _(not), */
      _(closurep), _(listp), _(integerp), _(fixnump), _(rationalp), _(floatp),
--- 116,122 ----
      _(delete_file), _(rename_file), _(open), _(directory), _(cd),
      _(make_dir), _(delete_dir), _(file_write_date), _(file_author),
      _(savemem),
!     # PREDTYPE : 45-3 SUBRs
      /* _(eq), */ _(eql), _(equal), _(equalp), _(consp), _(atom), _(symbolp),
      _(stringp), _(numberp), _(compiled_function_p), /* _(null), _(not), */
      _(closurep), _(listp), _(integerp), _(fixnump), _(rationalp), _(floatp),
***************
*** 125,131 ****
      _(hash_table_p), _(pathnamep), _(characterp), _(functionp),
      _(generic_function_p), _(packagep), _(arrayp), _(simple_array_p),
      _(bit_vector_p), _(vectorp), _(simple_vector_p), _(simple_string_p),
!     _(simple_bit_vector_p), _(commonp), _(type_of), _(class_of), _(coerce),
      # RECORD : 21 SUBRs
      _(record_ref), _(record_store), _(record_length), _(structure_ref),
      _(structure_store), _(make_structure), _(copy_structure),
--- 125,132 ----
      _(hash_table_p), _(pathnamep), _(characterp), _(functionp),
      _(generic_function_p), _(packagep), _(arrayp), _(simple_array_p),
      _(bit_vector_p), _(vectorp), _(simple_vector_p), _(simple_string_p),
!     _(simple_bit_vector_p), _(commonp), _(type_of), _(class_of),
!     _(find_class), _(coerce),
      # RECORD : 21 SUBRs
      _(record_ref), _(record_store), _(record_length), _(structure_ref),
      _(structure_store), _(make_structure), _(copy_structure),
***************
*** 172,181 ****
      _(ldb), _(ldb_test), _(mask_field), _(dpb), _(deposit_field), _(random),
      _(make_random_state), _(fakultaet), _(exquo), _(long_float_digits),
      _(set_long_float_digits), _(log2), _(log10),
-     # Nachtrge:
-     _(class_gethash), # zu HASHTABL
-     _(find_class), # zu PREDTYPE
-     _(pin_package), # zu PACKAGE
      };
    # Das waren 517-43 SUBRs.
    # Nun FUNTABR :
--- 173,178 ----
***************
*** 194,200 ****
      _(apply), _(pfuncall), _(funcall), _(mapcar), _(maplist), _(mapc),
      _(mapl), _(mapcan), _(mapcon), _(values),
      # DEBUG : 0 SUBRs
!     # HASHTABL : 0 SUBRs
      # IO : 0 SUBRs
      # LIST : 4 SUBRs
      _(list), _(liststern), _(append), _(nconc),
--- 191,198 ----
      _(apply), _(pfuncall), _(funcall), _(mapcar), _(maplist), _(mapc),
      _(mapl), _(mapcan), _(mapcon), _(values),
      # DEBUG : 0 SUBRs
!     # HASHTABL : 1 SUBR
!     _(class_tuple_gethash),
      # IO : 0 SUBRs
      # LIST : 4 SUBRs
      _(list), _(liststern), _(append), _(nconc),
***************
*** 213,220 ****
      _(gleich), _(ungleich), _(kleiner), _(groesser), _(klgleich),
      _(grgleich), _(max), _(min), _(plus), _(minus), _(mal), _(durch), _(gcd),
      _(lcm), _(logior), _(logxor), _(logand), _(logeqv),
-     # Nachtrge:
-     _(class_tuple_gethash), # zu HASHTABL
      };
    # Das waren 62 SUBRs.
    #undef _
--- 211,216 ----
***************
*** 5948,5954 ****
                      { where = where << 8;                              \
                        where |= *byteptr++; # nchstes Byte dazunehmen  \
                        # Sign-Extend von 15 auf 32 Bits:                \
!                       where = (sintL)((sintL)((sintWL)where << (intWLsize-15)) >> (intWLsize-15)); \
                        if (where == 0)                                  \
                          # Sonderfall: 2-Byte-Operand = 0 -> 6-Byte-Operand \
                          { where = (uintL)( ((uintWL)(byteptr[0]) << 8) \
--- 5944,5950 ----
                      { where = where << 8;                              \
                        where |= *byteptr++; # nchstes Byte dazunehmen  \
                        # Sign-Extend von 15 auf 32 Bits:                \
!                       where = (sintL)((sintL)(sintWL)((sintWL)where << (intWLsize-15)) >> (intWLsize-15)); \
                        if (where == 0)                                  \
                          # Sonderfall: 2-Byte-Operand = 0 -> 6-Byte-Operand \
                          { where = (uintL)( ((uintWL)(byteptr[0]) << 8) \
***************
*** 5962,5968 ****
                      else                                               \
                      # Bit 7 war gelscht                               \
                      { # Sign-Extend von 7 auf 32 Bits:                 \
!                       where = (sintL)((sintL)((sintBWL)where << (intBWLsize-7)) >> (intBWLsize-7)); \
                      }                                                  \
                  }
              #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM)
--- 5958,5964 ----
                      else                                               \
                      # Bit 7 war gelscht                               \
                      { # Sign-Extend von 7 auf 32 Bits:                 \
!                       where = (sintL)((sintL)(sintBWL)((sintBWL)where << (intBWLsize-7)) >> (intBWLsize-7)); \
                      }                                                  \
                  }
              #if defined(GNU) && defined(MC680X0) && !defined(NO_ASM)
***************
*** 6521,6527 ****
                  if (eq(hashvalue,nullobj))
                    goto jmp; # nicht gefunden -> zu label springen
                    else # gefundenes Fixnum als Label interpretieren:
!                   { byteptr += fixnum_to_L(hashvalue); }
                }}
                goto next_byte;
              case (uintB)cod_jmphashv:        # (JMPHASHV n label)
--- 6517,6523 ----
                  if (eq(hashvalue,nullobj))
                    goto jmp; # nicht gefunden -> zu label springen
                    else # gefundenes Fixnum als Label interpretieren:
!                   { byteptr += (sintL)fixnum_to_L(hashvalue); }
                }}
                goto next_byte;
              case (uintB)cod_jmphashv:        # (JMPHASHV n label)
***************
*** 6532,6538 ****
                  if (eq(hashvalue,nullobj))
                    goto jmp; # nicht gefunden -> zu label springen
                    else # gefundenes Fixnum als Label interpretieren:
!                   { byteptr += fixnum_to_L(hashvalue); }
                }}
                goto next_byte;
              # Fhrt einen (JSR label)-Befehl aus.
--- 6528,6534 ----
                  if (eq(hashvalue,nullobj))
                    goto jmp; # nicht gefunden -> zu label springen
                    else # gefundenes Fixnum als Label interpretieren:
!                   { byteptr += (sintL)fixnum_to_L(hashvalue); }
                }}
                goto next_byte;
              # Fhrt einen (JSR label)-Befehl aus.
diff -r -c3 clisp-1993-11-08/src/ffloat.d clisp/src/ffloat.d
*** clisp-1993-11-08/src/ffloat.d	Tue Oct 19 11:58:54 1993
--- clisp/src/ffloat.d	Sun Nov 14 04:37:08 1993
***************
*** 56,62 ****
  # Angabe der mglicherweise auftretenden Sonderflle:
  #   maybe_overflow: Operation luft ber, liefert IEEE-Infinity
  #   maybe_subnormal: Ergebnis sehr klein, liefert IEEE-subnormale Zahl
! #   maybe_underflow: Ergebnis sehr klein, liefert IEEE-Null
  #   maybe_divide_0: Ergebnis unbestimmt, liefert IEEE-Infinity
  #   maybe_nan: Ergebnis unbestimmt, liefert IEEE-NaN
    #define float_to_FF(expr,ergebnis_zuweisung,maybe_overflow,maybe_subnormal,maybe_underflow,maybe_divide_0,maybe_nan)  \
--- 56,62 ----
  # Angabe der mglicherweise auftretenden Sonderflle:
  #   maybe_overflow: Operation luft ber, liefert IEEE-Infinity
  #   maybe_subnormal: Ergebnis sehr klein, liefert IEEE-subnormale Zahl
! #   maybe_underflow: Ergebnis sehr klein und /=0, liefert IEEE-Null
  #   maybe_divide_0: Ergebnis unbestimmt, liefert IEEE-Infinity
  #   maybe_nan: Ergebnis unbestimmt, liefert IEEE-NaN
    #define float_to_FF(expr,ergebnis_zuweisung,maybe_overflow,maybe_subnormal,maybe_underflow,maybe_divide_0,maybe_nan)  \
***************
*** 425,433 ****
      }
   #else
    local object FF_FF_minus_FF(x1,x2)
!     var reg2 object x1;
      var reg1 object x2;
!     { var reg1 ffloat x2_ = ffloat_value(x2);
        if (FF_uexp(x2_) == 0)
          { return x1; }
          else
--- 425,433 ----
      }
   #else
    local object FF_FF_minus_FF(x1,x2)
!     var reg3 object x1;
      var reg1 object x2;
!     { var reg2 ffloat x2_ = ffloat_value(x2);
        if (FF_uexp(x2_) == 0)
          { return x1; }
          else
***************
*** 511,516 ****
--- 511,517 ----
              # abrunden
              goto ab;
              else
+             # aufrunden
              goto auf;
          }
        auf:
***************
*** 688,694 ****
        return I_I_ash_I(
          # mant >0, <2^(FF_mant_len+1) in ein Fixnum umwandeln:
          #if (FF_mant_len+1 <= oint_data_len)
!           (sign==0 ? posfixnum(mant) : negfixnum(-mant))
          #else
            L_to_I(sign==0 ? mant : -mant)
          #endif
--- 689,695 ----
        return I_I_ash_I(
          # mant >0, <2^(FF_mant_len+1) in ein Fixnum umwandeln:
          #if (FF_mant_len+1 <= oint_data_len)
!           (sign==0 ? posfixnum(mant) : negfixnum(-(oint)mant))
          #else
            L_to_I(sign==0 ? mant : -mant)
          #endif
***************
*** 819,825 ****
                                  );
           if (mant >= bit(FF_mant_len+2))
             # 2^25 <= q < 2^26, schiebe um 2 Bits nach rechts
!            { var reg2 uint32 rounding_bits = mant & (bit(2)-1);
               lendiff = lendiff+1; # Exponent := n-m+1
               mant = mant >> 2;
               if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
--- 820,826 ----
                                  );
           if (mant >= bit(FF_mant_len+2))
             # 2^25 <= q < 2^26, schiebe um 2 Bits nach rechts
!            { var reg2 uintL rounding_bits = mant & (bit(2)-1);
               lendiff = lendiff+1; # Exponent := n-m+1
               mant = mant >> 2;
               if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
diff -r -c3 clisp-1993-11-08/src/flo_konv.d clisp/src/flo_konv.d
*** clisp-1993-11-08/src/flo_konv.d	Thu Apr  1 11:16:47 1993
--- clisp/src/flo_konv.d	Mon Nov 15 01:24:20 1993
***************
*** 44,50 ****
--- 44,54 ----
        var reg2 uint32 mant;
        SF_decode(x, { return DF_0; }, sign=,exp=,mant=);
        # Mantisse um 52-16=36 Nullbits erweitern:
+       #ifdef intQsize
+       encode_DF(sign,exp,(uint64)mant<<(DF_mant_len-SF_mant_len), return);
+       #else
        encode_DF(sign,exp,mant<<(DF_mant_len-SF_mant_len-32),0, return);
+       #endif
      }
  
  # SF_to_LF(x,len) wandelt ein Short-Float x in ein Long-Float mit len Digits um.
***************
*** 81,87 ****
--- 85,95 ----
        var reg2 uint32 mant;
        FF_decode(x, { return DF_0; }, sign=,exp=,mant=);
        # Mantisse um 52-23=29 Nullbits erweitern:
+       #ifdef intQsize
+       encode_DF(sign,exp,(uint64)mant<<(DF_mant_len-FF_mant_len), return);
+       #else
        encode_DF(sign,exp,mant>>(32-(DF_mant_len-FF_mant_len)),mant<<(DF_mant_len-FF_mant_len), return);
+       #endif
      }
  
  # FF_to_LF(x,len) wandelt ein Single-Float x in ein Long-Float mit len Digits um.
***************
*** 119,133 ****
--- 127,151 ----
        var reg4 sintL exp;
        var reg3 uint32 manthi;
        var reg3 uint32 mantlo;
+       #ifdef intQsize
+       var reg3 uint64 mant;
+       DF_decode(x, { encode_LF0(len, return); }, sign=,exp=(sintL),mant=);
+       #else
        DF_decode(x, { encode_LF0(len, return); }, sign=,exp=(sintL),manthi=,mantlo=);
+       #endif
        # Long-Float allozieren,
        # Mantisse mit intDsize*len-DF_mant_len-1 Nullbits auffllen:
       {var reg6 object y = allocate_lfloat(len,exp+LF_exp_mid,sign);
        var reg1 uintD* ptr = &TheLfloat(y)->data[0];
        # erste k := ceiling(DF_mant_len+1,intDsize) Digits mit mant fllen:
        #define shiftcount  (ceiling(DF_mant_len+1,intDsize)*intDsize-(DF_mant_len+1))
+       #ifdef intQsize
+       mant = mant<<shiftcount;
+       manthi = (uint32)(mant>>32); mantlo = (uint32)mant;
+       #else
        manthi = (manthi<<shiftcount) | (mantlo>>(32-shiftcount));
        mantlo = mantlo<<shiftcount;
+       #endif
        #undef shiftcount
        set_max32_Dptr(DF_mant_len+1-32,ptr,manthi);
        set_32_Dptr(&ptr[ceiling(DF_mant_len+1-32,intDsize)],mantlo);
***************
*** 174,179 ****
--- 192,220 ----
      { # x entpacken:
        var reg4 signean sign;
        var reg3 sintWL exp;
+       #ifdef intQsize
+       var reg2 uint64 mant;
+       DF_decode(x, { return SF_0; }, sign=,exp=,mant=);
+       # 52-16=36 Bits wegrunden:
+       #define shiftcount  (DF_mant_len-SF_mant_len)
+       if ( ((mant & bit(shiftcount-1)) ==0) # Bit 35 war 0 -> abrunden
+            || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 34..0 >0 -> aufrunden
+                 # round-to-even
+                 && ((mant & bit(shiftcount)) ==0)
+          )    )
+         # abrunden
+         { mant = mant >> shiftcount; }
+         else
+         # aufrunden
+         { mant = mant >> shiftcount;
+           mant = mant+1;
+           if (mant >= bit(SF_mant_len+1))
+             # berlauf durchs Runden
+             { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
+         }
+       #undef shiftcount
+       encode_SF(sign,exp,mant, return);
+       #else
        var reg2 uint32 manthi;
        var reg2 uint32 mantlo;
        DF_decode(x, { return SF_0; }, sign=,exp=,manthi=,mantlo=);
***************
*** 197,202 ****
--- 238,244 ----
          }
        #undef shiftcount
        encode_SF(sign,exp,manthi, return);
+       #endif
      }
  
  # LF_to_SF(x) wandelt ein Long-Float x in ein Short-Float um.
***************
*** 243,248 ****
--- 285,313 ----
      { # x entpacken:
        var reg4 signean sign;
        var reg3 sintWL exp;
+       #ifdef intQsize
+       var reg2 uint64 mant;
+       DF_decode(x, { return FF_0; }, sign=,exp=,mant=);
+       # 52-23=29 Bits wegrunden:
+       #define shiftcount  (DF_mant_len-FF_mant_len)
+       if ( ((mant & bit(shiftcount-1)) ==0) # Bit 28 war 0 -> abrunden
+            || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 27..0 >0 -> aufrunden
+                 # round-to-even
+                 && ((mant & bit(shiftcount)) ==0)
+          )    )
+         # abrunden
+         { mant = mant >> shiftcount; }
+         else
+         # aufrunden
+         { mant = mant >> shiftcount;
+           mant = mant+1;
+           if (mant >= bit(FF_mant_len+1))
+             # berlauf durchs Runden
+             { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
+         }
+       #undef shiftcount
+       encode_FF(sign,exp,mant, return);
+       #else
        var reg2 uint32 manthi;
        var reg2 uint32 mantlo;
        DF_decode(x, { return FF_0; }, sign=,exp=,manthi=,mantlo=);
***************
*** 265,270 ****
--- 330,336 ----
          }
        #undef shiftcount
        encode_FF(sign,exp,manthi, return);
+       #endif
      }
  
  # LF_to_FF(x) wandelt ein Long-Float x in ein Single-Float um.
***************
*** 323,328 ****
--- 389,415 ----
        mantlo = get_32_Dptr(&ptr[ceiling(DF_mant_len+2-32,intDsize)]);
        ptr += ceiling(DF_mant_len+2,intDsize);
        #define shiftcount  (ceiling(DF_mant_len+2,intDsize)*intDsize-(DF_mant_len+1))
+       #ifdef intQsize
+       {var reg3 uint64 mant = ((uint64)manthi << 32) | (uint64)mantlo;
+        if ( ((mant & bit(shiftcount-1)) ==0) # Bit 10 war 0 -> abrunden
+             || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 9..0 >0 -> aufrunden
+                  && !test_loop_up(ptr,len-ceiling(DF_mant_len+2,intDsize)) # weitere Bits /=0 -> aufrunden
+                  # round-to-even
+                  && ((mant & bit(shiftcount)) ==0)
+           )    )
+          # abrunden
+          { mant = mant >> shiftcount; }
+          else
+          # aufrunden
+          { mant = mant >> shiftcount;
+            mant = mant+1;
+            if (mant >= bit(DF_mant_len+1))
+              # berlauf durchs Runden
+              { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
+          }
+        encode_DF(sign,exp,mant, return);
+       }
+       #else
        if ( ((mantlo & bit(shiftcount-1)) ==0) # Bit 10 war 0 -> abrunden
             || ( ((mantlo & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 9..0 >0 -> aufrunden
                  && !test_loop_up(ptr,len-ceiling(DF_mant_len+2,intDsize)) # weitere Bits /=0 -> aufrunden
***************
*** 344,350 ****
                  # berlauf durchs Runden
                  { manthi = manthi>>1; exp = exp+1; } # Mantisse rechts schieben
          }   }
-       #undef shiftcount
        encode_DF(sign,exp,manthi,mantlo, return);
      }
  
--- 431,438 ----
                  # berlauf durchs Runden
                  { manthi = manthi>>1; exp = exp+1; } # Mantisse rechts schieben
          }   }
        encode_DF(sign,exp,manthi,mantlo, return);
+       #endif
+       #undef shiftcount
      }
  
diff -r -c3 clisp-1993-11-08/src/flo_rest.d clisp/src/flo_rest.d
*** clisp-1993-11-08/src/flo_rest.d	Tue Oct 19 11:59:33 1993
--- clisp/src/flo_rest.d	Sun Nov 14 23:49:59 1993
***************
*** 16,21 ****
--- 16,27 ----
            else                                     \
            { LF_statement }                         \
      }
+ # DF_statement darf kein #if enthalten. Daher:
+   #ifdef intQsize
+     #define ifdef_intQsize(A,B)  A
+   #else
+     #define ifdef_intQsize(A,B)  B
+   #endif
  
  
  # Generiert eine Float-Operation F_op_F wie F_minus_F oder F_durch_F
***************
*** 772,785 ****
        /* x DF */ { # x entpacken:
                     var reg4 signean sign;
                     var reg3 sintWL exp;
!                    var reg2 uint32 manthi;
!                    var reg2 uint32 mantlo;
!                    DF_decode(x, { pushSTACK(DF_0); pushSTACK(Fixnum_0); pushSTACK(DF_1); return; },
!                                 sign=,exp=,manthi=,mantlo=
!                             );
!                    encode_DF(0,0,manthi,mantlo, x=); pushSTACK(x); # (-1)^0 * 2^0 * m erzeugen
!                    pushSTACK(L_to_FN((sintL)exp)); # e als Fixnum
!                    encode_DF(sign,1,bit(DF_mant_len-32),0, x=); pushSTACK(x); # (-1)^s erzeugen
                     return;
                   },
        /* x LF */ { # x entpacken:
--- 778,801 ----
        /* x DF */ { # x entpacken:
                     var reg4 signean sign;
                     var reg3 sintWL exp;
!                    ifdef_intQsize(
!                      { var reg2 uint64 mant;
!                        DF_decode(x, { pushSTACK(DF_0); pushSTACK(Fixnum_0); pushSTACK(DF_1); return; },
!                                     sign=,exp=,mant=
!                                 );
!                        encode_DF(0,0,mant, x=); pushSTACK(x); # (-1)^0 * 2^0 * m erzeugen
!                        pushSTACK(L_to_FN((sintL)exp)); # e als Fixnum
!                        encode_DF(sign,1,bit(DF_mant_len), x=); pushSTACK(x); # (-1)^s erzeugen
!                      },
!                      { var reg2 uint32 manthi;
!                        var reg2 uint32 mantlo;
!                        DF_decode(x, { pushSTACK(DF_0); pushSTACK(Fixnum_0); pushSTACK(DF_1); return; },
!                                     sign=,exp=,manthi=,mantlo=
!                                 );
!                        encode_DF(0,0,manthi,mantlo, x=); pushSTACK(x); # (-1)^0 * 2^0 * m erzeugen
!                        pushSTACK(L_to_FN((sintL)exp)); # e als Fixnum
!                        encode_DF(sign,1,bit(DF_mant_len-32),0, x=); pushSTACK(x); # (-1)^s erzeugen
!                      });
                     return;
                   },
        /* x LF */ { # x entpacken:
***************
*** 819,825 ****
                     if (uexp==0) { return 0; }
                     return (sintL)(sintWL)((uintWL)uexp - FF_exp_mid);
                   },
!       /* x DF */ { var reg2 uintWL uexp = DF_uexp(TheDfloat(x)->float_value.semhi);
                     if (uexp==0) { return 0; }
                     return (sintL)(sintWL)(uexp - DF_exp_mid);
                   },
--- 835,841 ----
                     if (uexp==0) { return 0; }
                     return (sintL)(sintWL)((uintWL)uexp - FF_exp_mid);
                   },
!       /* x DF */ { var reg2 uintWL uexp = DF_uexp(TheDfloat(x)->float_value_semhi);
                     if (uexp==0) { return 0; }
                     return (sintL)(sintWL)(uexp - DF_exp_mid);
                   },
***************
*** 926,934 ****
--- 942,955 ----
      { # x entpacken:
        var reg5 signean sign;
        var reg4 sintWL exp;
+       #ifdef intQsize
+       var reg6 uint64 mant;
+       DF_decode(x, { return x; }, sign=,exp=,mant=);
+       #else
        var reg6 uint32 manthi;
        var reg7 uint32 mantlo;
        DF_decode(x, { return x; }, sign=,exp=,manthi=,mantlo=);
+       #endif
        if (!R_minusp(delta))
          # delta>=0
          { var reg3 uintL udelta;
***************
*** 936,942 ****
--- 957,967 ----
                && ((udelta = posfixnum_to_L(delta)) <= (uintL)(DF_exp_high-DF_exp_low))
               )
              { exp = exp+udelta;
+               #ifdef intQsize
+               encode_DF(sign,exp,mant, return);
+               #else
                encode_DF(sign,exp,manthi,mantlo, return);
+               #endif
              }
              else
              { fehler_overflow(); }
***************
*** 949,955 ****
--- 974,984 ----
                && ((oint_data_len<intLsize) || !(udelta==0))
               )
              { exp = exp-udelta;
+               #ifdef intQsize
+               encode_DF(sign,exp,mant, return);
+               #else
                encode_DF(sign,exp,manthi,mantlo, return);
+               #endif
              }
              else
              { fehler_underflow(); }
***************
*** 1088,1094 ****
        /* x SF */ { encode_SF(R_sign(x),1,bit(SF_mant_len), return); },
        /* x FF */ # { encode_FF(R_sign(x),1,bit(FF_mant_len), return); }, # besser:
                   { return (!R_minusp(x) ? FF_1 : FF_minus1); },
!       /* x DF */ # { encode_DF(R_sign(x),1,bit(DF_mant_len-32),0, return); }, # besser:
                   { return (!R_minusp(x) ? DF_1 : DF_minus1); },
        /* x LF */ { encode_LF1s(R_sign(x),TheLfloat(x)->len, return); }
                 );
--- 1117,1127 ----
        /* x SF */ { encode_SF(R_sign(x),1,bit(SF_mant_len), return); },
        /* x FF */ # { encode_FF(R_sign(x),1,bit(FF_mant_len), return); }, # besser:
                   { return (!R_minusp(x) ? FF_1 : FF_minus1); },
!       /* x DF */ # { ifdef_intQsize(
!                  #     encode_DF(R_sign(x),1,bit(DF_mant_len), return); ,
!                  #     encode_DF(R_sign(x),1,bit(DF_mant_len-32),0, return); )
!                  # }
!                  # besser:
                   { return (!R_minusp(x) ? DF_1 : DF_minus1); },
        /* x LF */ { encode_LF1s(R_sign(x),TheLfloat(x)->len, return); }
                 );
***************
*** 1193,1202 ****
                   },
        /* x DF */ { # x entpacken:
                     var reg3 sintWL exp;
!                    var reg2 uint32 manthi;
!                    var reg2 uint32 mantlo;
!                    DF_decode(x, { goto zero; }, ,exp=,manthi=,mantlo=);
!                    pushSTACK(L2_to_I(manthi,mantlo)); # Mantisse (>0, <2^53) als Bignum
                     pushSTACK(L_to_FN((sintL)(exp-(DF_mant_len+1)))); # e-53 als Fixnum
                   },
        /* x LF */ { var reg6 uintL uexp = TheLfloat(x)->expo;
--- 1226,1241 ----
                   },
        /* x DF */ { # x entpacken:
                     var reg3 sintWL exp;
!                    ifdef_intQsize(
!                      { var reg2 uint64 mant;
!                        DF_decode(x, { goto zero; }, ,exp=,mant=);
!                        pushSTACK(Q_to_I(mant)); # Mantisse (>0, <2^53) als Bignum
!                      },
!                      { var reg2 uint32 manthi;
!                        var reg2 uint32 mantlo;
!                        DF_decode(x, { goto zero; }, ,exp=,manthi=,mantlo=);
!                        pushSTACK(L2_to_I(manthi,mantlo)); # Mantisse (>0, <2^53) als Bignum
!                      });
                     pushSTACK(L_to_FN((sintL)(exp-(DF_mant_len+1)))); # e-53 als Fixnum
                   },
        /* x LF */ { var reg6 uintL uexp = TheLfloat(x)->expo;
***************
*** 1214,1220 ****
                     }
                     # e-16n = uexp-LF_exp_mid-16n als Integer bilden:
                     {var reg2 uintL sub = LF_exp_mid + intDsize*(uintL)len;
!                     pushSTACK(L2_to_I( (uexp<sub ? -1L : 0), uexp-sub));
                   }}}
                 );
        pushSTACK(!R_minusp(x) ? Fixnum_1 : Fixnum_minus1); # Vorzeichen von x (nicht GC-gefhrdet!)
--- 1253,1259 ----
                     }
                     # e-16n = uexp-LF_exp_mid-16n als Integer bilden:
                     {var reg2 uintL sub = LF_exp_mid + intDsize*(uintL)len;
!                     pushSTACK(UL_UL_minus_I(uexp,sub));
                   }}}
                 );
        pushSTACK(!R_minusp(x) ? Fixnum_1 : Fixnum_minus1); # Vorzeichen von x (nicht GC-gefhrdet!)
diff -r -c3 clisp-1993-11-08/src/floatpri.lsp clisp/src/floatpri.lsp
*** clisp-1993-11-08/src/floatpri.lsp	Mon Oct 25 00:53:30 1993
--- clisp/src/floatpri.lsp	Sun Nov 14 14:57:20 1993
***************
*** 401,412 ****
        ) )
        ; Nun geht's zum Exponenten:
        (let ((e-marker
!               (cond ((case *READ-DEFAULT-FLOAT-FORMAT*
!                        (SHORT-FLOAT (short-float-p arg))
!                        (SINGLE-FLOAT (single-float-p arg))
!                        (DOUBLE-FLOAT (double-float-p arg))
!                        (LONG-FLOAT (long-float-p arg))
!                      ) #\E )
                      ((short-float-p arg) #\s)
                      ((single-float-p arg) #\f)
                      ((double-float-p arg) #\d)
--- 401,415 ----
        ) )
        ; Nun geht's zum Exponenten:
        (let ((e-marker
!               (cond ((and (not *PRINT-READABLY*)
!                           (case *READ-DEFAULT-FLOAT-FORMAT*
!                             (SHORT-FLOAT (short-float-p arg))
!                             (SINGLE-FLOAT (single-float-p arg))
!                             (DOUBLE-FLOAT (double-float-p arg))
!                             (LONG-FLOAT (long-float-p arg))
!                      )    )
!                      #\E
!                     )
                      ((short-float-p arg) #\s)
                      ((single-float-p arg) #\f)
                      ((double-float-p arg) #\d)
***************
*** 414,419 ****
             )) )
          (unless (and flag (eql e-marker #\E)) ; evtl. Exponent ganz weglassen
            (write-char e-marker stream)
!           (write expo :base 10 :radix nil :stream stream)
  ) ) ) ) )
  
--- 417,422 ----
             )) )
          (unless (and flag (eql e-marker #\E)) ; evtl. Exponent ganz weglassen
            (write-char e-marker stream)
!           (write expo :base 10 :radix nil :readably nil :stream stream)
  ) ) ) ) )
  
diff -r -c3 clisp-1993-11-08/src/format.lsp clisp/src/format.lsp
*** clisp-1993-11-08/src/format.lsp	Sun Oct 31 05:26:42 1993
--- clisp/src/format.lsp	Sun Nov 14 14:56:57 1993
***************
*** 651,657 ****
                         stream
                        )
    (let* ((*print-base* base)
!          (*print-radix* nil))
      (if (and (zerop mincol) (not commaflag) (not positive-sign-flag))
        (princ arg stream) ; normale Ausgabe tut's
        (let* ((oldstring (princ-to-string arg))
--- 651,658 ----
                         stream
                        )
    (let* ((*print-base* base)
!          (*print-radix* nil)
!          (*print-readably* nil))
      (if (and (zerop mincol) (not commaflag) (not positive-sign-flag))
        (princ arg stream) ; normale Ausgabe tut's
        (let* ((oldstring (princ-to-string arg))
***************
*** 690,696 ****
  ; was ~D bei non-Integer-Argument tut: Argument mit ~A, aber dezimal ausgeben
  (defun format-ascii-decimal (arg stream)
    (let ((*print-base* 10.)
!         (*print-radix* nil))
      (princ arg stream)
  ) )
  
--- 691,698 ----
  ; was ~D bei non-Integer-Argument tut: Argument mit ~A, aber dezimal ausgeben
  (defun format-ascii-decimal (arg stream)
    (let ((*print-base* 10.)
!         (*print-radix* nil)
!         (*print-readably* nil))
      (princ arg stream)
  ) )
  
***************
*** 705,711 ****
              (not (integerp arg))
          )
        (let ((*print-base* base)
!             (*print-radix* nil))
          (princ arg stream)
        )
        (format-integer base mincol padchar commachar
--- 707,714 ----
              (not (integerp arg))
          )
        (let ((*print-base* base)
!             (*print-radix* nil)
!             (*print-readably* nil))
          (princ arg stream)
        )
        (format-integer base mincol padchar commachar
***************
*** 1057,1063 ****
         overflowchar padchar exponentchar plus-sign-flag arg stream)
    (multiple-value-bind (mantissa oldexponent) (format-scale-exponent (abs arg))
      (let* ((exponent (if (zerop arg) 0 (- oldexponent k))) ; auszugebender Exponent
!            (expdigits (write-to-string (abs exponent) :base 10. :radix nil))
             (expdigitsneed (if e (max (length expdigits) e) (length expdigits)))
             ; expdigitsneed = Anzahl der Stellen, die fr die Ziffern des
             ; Exponenten ntig sind.
--- 1060,1066 ----
         overflowchar padchar exponentchar plus-sign-flag arg stream)
    (multiple-value-bind (mantissa oldexponent) (format-scale-exponent (abs arg))
      (let* ((exponent (if (zerop arg) 0 (- oldexponent k))) ; auszugebender Exponent
!            (expdigits (write-to-string (abs exponent) :base 10. :radix nil :readably nil))
             (expdigitsneed (if e (max (length expdigits) e) (length expdigits)))
             ; expdigitsneed = Anzahl der Stellen, die fr die Ziffern des
             ; Exponenten ntig sind.
***************
*** 1111,1117 ****
                  (if trailingpoint (write-char #\0 stream))
                  (write-char
                    (cond (exponentchar)
!                         ((typep arg *READ-DEFAULT-FLOAT-FORMAT*) #\E)
                          ((short-float-p arg) #\s)
                          ((single-float-p arg) #\f)
                          ((double-float-p arg) #\d)
--- 1114,1124 ----
                  (if trailingpoint (write-char #\0 stream))
                  (write-char
                    (cond (exponentchar)
!                         ((and (not *PRINT-READABLY*)
!                               (typep arg *READ-DEFAULT-FLOAT-FORMAT*)
!                          )
!                          #\E
!                         )
                          ((short-float-p arg) #\s)
                          ((single-float-p arg) #\f)
                          ((double-float-p arg) #\d)
diff -r -c3 clisp-1993-11-08/src/hashtabl.d clisp/src/hashtabl.d
*** clisp-1993-11-08/src/hashtabl.d	Sun Oct 24 15:11:44 1993
--- clisp/src/hashtabl.d	Sun Nov 14 18:53:25 1993
***************
*** 1,5 ****
  # Hash-Tabellen in CLISP
! # Bruno Haible 24.10.1993
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr Hashcode-Berechnung
--- 1,5 ----
  # Hash-Tabellen in CLISP
! # Bruno Haible 14.11.1993
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr Hashcode-Berechnung
***************
*** 160,166 ****
    local uint32 hashcode_dfloat (object obj);
    local uint32 hashcode_dfloat(obj)
      var reg1 object obj;
!     { return TheDfloat(obj)->float_value.semhi; }
    # Long-Float: Mischung aus Exponent, Lnge, erste 32 Bit
    extern uint32 hashcode_lfloat (object obj); # siehe LFLOAT.D
  # allgemein:
--- 160,172 ----
    local uint32 hashcode_dfloat (object obj);
    local uint32 hashcode_dfloat(obj)
      var reg1 object obj;
!     {
!       #ifdef intQsize
!       return (uint32)(TheDfloat(obj)->float_value >> 32);
!       #else
!       return TheDfloat(obj)->float_value.semhi;
!       #endif
!     }
    # Long-Float: Mischung aus Exponent, Lnge, erste 32 Bit
    extern uint32 hashcode_lfloat (object obj); # siehe LFLOAT.D
  # allgemein:
diff -r -c3 clisp-1993-11-08/src/init.lsp clisp/src/init.lsp
*** clisp-1993-11-08/src/init.lsp	Mon Nov  1 13:10:23 1993
--- clisp/src/init.lsp	Tue Nov  9 02:23:24 1993
***************
*** 35,46 ****
  *macroexpand-hook* *package* *modules* *random-state* *evalhook* *applyhook*
  + ++ +++ - * ** *** / // /// *standard-input* *standard-output* *error-output*
  *query-io* *debug-io* *terminal-io* *trace-output* *read-base* *read-suppress*
! *readtable* *print-escape* *print-pretty* *print-circle* *print-base*
! *print-radix* *print-case* *print-gensym* *print-level* *print-length*
! *print-array* *read-default-float-format* *default-pathname-defaults*
! *load-paths* *load-verbose* *load-print* *load-echo* *load-pathname*
! *load-truename* *break-on-warnings* *compile-warnings* *compile-verbose*
! *compile-print* *compile-file-pathname* *compile-file-truename* *features*
  ;; Funktionen:
  coerce type-of upgraded-array-element-type typep subtypep null symbolp
  atom consp listp numberp integerp rationalp floatp realp complexp characterp
--- 35,47 ----
  *macroexpand-hook* *package* *modules* *random-state* *evalhook* *applyhook*
  + ++ +++ - * ** *** / // /// *standard-input* *standard-output* *error-output*
  *query-io* *debug-io* *terminal-io* *trace-output* *read-base* *read-suppress*
! *readtable* *print-readably* *print-escape* *print-pretty* *print-circle*
! *print-base* *print-radix* *print-case* *print-gensym* *print-level*
! *print-length* *print-array* *read-default-float-format*
! *default-pathname-defaults* *load-paths* *load-verbose* *load-print*
! *load-echo* *load-pathname* *load-truename* *break-on-warnings*
! *compile-warnings* *compile-verbose* *compile-print* *compile-file-pathname*
! *compile-file-truename* *features*
  ;; Funktionen:
  coerce type-of upgraded-array-element-type typep subtypep null symbolp
  atom consp listp numberp integerp rationalp floatp realp complexp characterp
diff -r -c3 clisp-1993-11-08/src/intelem.d clisp/src/intelem.d
*** clisp-1993-11-08/src/intelem.d	Sat Oct 30 03:15:30 1993
--- clisp/src/intelem.d	Sun Nov 14 23:46:50 1993
***************
*** 145,150 ****
--- 145,159 ----
      #define FN_L_minusp(x,x_)  (R_minusp(x))
    #endif
  
+ #ifdef intQsize
+ # Wandelt Fixnum in Quadword um.
+ # FN_to_Q(obj)
+ # > obj: ein Fixnum
+ # < ergebnis: der Wert des Fixnum als 64-Bit-Zahl.
+   local sint64 FN_to_Q (object obj);
+   #define FN_to_Q(obj)  fixnum_to_Q(obj)
+ #endif
+ 
  # Wandelt Integer >=0 in Unsigned Longword um.
  # I_to_UL(obj)
  # > obj: ein Objekt, sollte ein Integer >=0, <2^32 sein
***************
*** 176,181 ****
--- 185,192 ----
                  return get_uint3D_Dptr(bn->data);
                IF_LENGTH(4)
                  return get_uint4D_Dptr(bn->data);
+               IF_LENGTH(5)
+                 return get_uint4D_Dptr(bn->data);
                #undef IF_LENGTH
              }
            default:
***************
*** 223,228 ****
--- 234,241 ----
                  return get_uint3D_Dptr(bn->data);
                IF_LENGTH(4)
                  return get_uint4D_Dptr(bn->data);
+               IF_LENGTH(5)
+                 return get_uint4D_Dptr(bn->data);
                #undef IF_LENGTH
                goto bad;
              }
***************
*** 252,257 ****
--- 265,272 ----
                  return get_sint3D_Dptr(bn->data);
                IF_LENGTH(4)
                  return get_sint4D_Dptr(bn->data);
+               IF_LENGTH(5)
+                 return get_sint4D_Dptr(bn->data);
                #undef IF_LENGTH
                goto bad;
              }
***************
*** 668,689 ****
      }
  #endif
  
  #ifdef WIDE_HARD
! # Wandelt Unsigned Double Longword in Integer >=0 um.
! # UL2_to_I(wert)
  # > wert: Wert des Integers, ein unsigned 64-Bit-Integer.
  # < ergebnis: Integer mit diesem Wert.
  # kann GC auslsen
!   global object UL2_to_I (uint64 wert);
!   global object UL2_to_I(wert)
      var reg2 uint64 wert;
      { if ((wert & ~ (FN_value_mask >> oint_data_shift)) == 0)
          # alle Bits, die nicht in den Fixnum-Wert reinpassen, =0 ?
          return as_object(((oint)fixnum_type<<oint_type_shift) | (wert<<oint_data_shift));
        # Bignum erzeugen:
        # (dessen Lnge  bn_minlength <= n <= ceiling((64+1)/intDsize)  erfllt)
!       #define UL2_maxlength  ceiling(64+1,intDsize)
!       #if (bn_minlength <= 1) && (UL2_maxlength >= 1)
        if ((1*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(1*intDsize-1)-1))
            : TRUE
--- 683,774 ----
      }
  #endif
  
+ #ifdef intQsize
+ # Wandelt Quadword in Integer um.
+ # Q_to_I(wert)
+ # > wert: Wert des Integers, ein signed 64-Bit-Integer.
+ # < ergebnis: Integer mit diesem Wert.
+ # kann GC auslsen
+   global object Q_to_I (sint64 wert);
+   global object Q_to_I(wert)
+     var reg2 sint64 wert;
+     {{var reg1 uint64 test = wert & ~(uint64)(FN_value_mask >> oint_data_shift);
+       # test enthlt die Bits, die nicht in den Fixnum-Wert reinpassen.
+       if (test == (uint64)0) # alle =0 ?
+         return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)wert<<oint_data_shift));
+       if (test == ~(uint64)(FN_value_mask >> oint_data_shift)) # alle =1 ?
+         return as_object(((((oint)fixnum_vz_type<<oint_type_shift)+FN_value_mask) & ((oint)wert<<oint_data_shift))
+                          |(((oint)fixnum_vz_type<<oint_type_shift) & (wbit(oint_data_shift)-1))
+                         );
+      }
+       # Bignum erzeugen:
+       # (dessen Lnge  bn_minlength <= n <= ceiling(64/intDsize) = 2  erfllt)
+       #define FILL_1_DIGIT(from)  \
+         *ptr-- = (uintD)from;
+       #define FILL_2_DIGITS(from)  \
+         *ptr-- = (uintD)from; from = from >> intDsize; \
+         *ptr-- = (uintD)from;
+       #define FILL_1  FILL_1_DIGIT(wert);
+       #define FILL_2  FILL_2_DIGITS(wert);
+       #define OK  return new;
+       if (wert >= 0)
+         {
+           #define ALLOC(i)  \
+             var reg2 object new = allocate_bignum(i,0); \
+             var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
+           #define IF_LENGTH(i)  \
+             if ((bn_minlength <= i) && (i*intDsize <= 64))      \
+               if (!((i+1)*intDsize <= 64)                       \
+                   || ((uint64)wert < (uint64)bit(i*intDsize-1)) \
+                  )
+           IF_LENGTH(1)
+             { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
+           IF_LENGTH(2)
+             { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
+           #undef IF_LENGTH
+           #undef ALLOC
+         }
+         else
+         {
+           #define ALLOC(i)  \
+             var reg2 object new = allocate_bignum(i,-1); \
+             var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
+           #define IF_LENGTH(i)  \
+             if ((bn_minlength <= i) && (i*intDsize <= 64))          \
+               if (!((i+1)*intDsize <= 64)                           \
+                   || ((uint64)wert >= (uint64)(-bit(i*intDsize-1))) \
+                  )
+           IF_LENGTH(1)
+             { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
+           IF_LENGTH(2)
+             { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
+           #undef IF_LENGTH
+           #undef ALLOC
+         }
+       #undef OK
+       #undef FILL_2
+       #undef FILL_1
+       #undef FILL_2_DIGITS
+       #undef FILL_1_DIGIT
+     }
+ #endif
+ 
  #ifdef WIDE_HARD
! # Wandelt Unsigned Quadword in Integer >=0 um.
! # UQ_to_I(wert)
  # > wert: Wert des Integers, ein unsigned 64-Bit-Integer.
  # < ergebnis: Integer mit diesem Wert.
  # kann GC auslsen
!   global object UQ_to_I (uint64 wert);
!   global object UQ_to_I(wert)
      var reg2 uint64 wert;
      { if ((wert & ~ (FN_value_mask >> oint_data_shift)) == 0)
          # alle Bits, die nicht in den Fixnum-Wert reinpassen, =0 ?
          return as_object(((oint)fixnum_type<<oint_type_shift) | (wert<<oint_data_shift));
        # Bignum erzeugen:
        # (dessen Lnge  bn_minlength <= n <= ceiling((64+1)/intDsize)  erfllt)
!       #define UQ_maxlength  ceiling(64+1,intDsize)
!       #if (bn_minlength <= 1) && (UQ_maxlength >= 1)
        if ((1*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(1*intDsize-1)-1))
            : TRUE
***************
*** 694,700 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 2) && (UL2_maxlength >= 2)
        if ((2*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(2*intDsize-1)-1))
            : TRUE
--- 779,785 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 2) && (UQ_maxlength >= 2)
        if ((2*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(2*intDsize-1)-1))
            : TRUE
***************
*** 711,717 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 3) && (UL2_maxlength >= 3)
        if ((3*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(3*intDsize-1)-1))
            : TRUE
--- 796,802 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 3) && (UQ_maxlength >= 3)
        if ((3*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(3*intDsize-1)-1))
            : TRUE
***************
*** 729,735 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 4) && (UL2_maxlength >= 4)
        if ((4*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(4*intDsize-1)-1))
            : TRUE
--- 814,820 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 4) && (UQ_maxlength >= 4)
        if ((4*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(4*intDsize-1)-1))
            : TRUE
***************
*** 748,754 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 5) && (UL2_maxlength >= 5)
        if ((5*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(5*intDsize-1)-1))
            : TRUE
--- 833,839 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 5) && (UQ_maxlength >= 5)
        if ((5*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(5*intDsize-1)-1))
            : TRUE
***************
*** 768,774 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 6) && (UL2_maxlength >= 6)
        if ((6*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(6*intDsize-1)-1))
            : TRUE
--- 853,859 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 6) && (UQ_maxlength >= 6)
        if ((6*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(6*intDsize-1)-1))
            : TRUE
***************
*** 789,795 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 7) && (UL2_maxlength >= 7)
        if ((7*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(7*intDsize-1)-1))
            : TRUE
--- 874,880 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 7) && (UQ_maxlength >= 7)
        if ((7*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(7*intDsize-1)-1))
            : TRUE
***************
*** 811,817 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 8) && (UL2_maxlength >= 8)
        if ((8*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(8*intDsize-1)-1))
            : TRUE
--- 896,902 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 8) && (UQ_maxlength >= 8)
        if ((8*intDsize-1 < 64)
            ? (wert <= (uint64)(bitc(8*intDsize-1)-1))
            : TRUE
***************
*** 834,840 ****
            return new;
          }
        #endif
!       #if (bn_minlength <= 9) && (UL2_maxlength >= 9)
        if (TRUE)
          # Bignum mit 9 Digits
          { var reg2 object new = allocate_bignum(9,0);
--- 919,925 ----
            return new;
          }
        #endif
!       #if (bn_minlength <= 9) && (UQ_maxlength >= 9)
        if (TRUE)
          # Bignum mit 9 Digits
          { var reg2 object new = allocate_bignum(9,0);
***************
*** 858,863 ****
--- 943,957 ----
      }
  #endif
  
+ # Liefert die Differenz x-y zweier Unsigned Longwords x,y als Integer.
+ # UL_UL_minus_I(x,y)
+   local object UL_UL_minus_I (object x, object y);
+   #ifdef intQsize
+     #define UL_UL_minus_I(x,y)  Q_to_I((sintQ)(uintQ)(x)-(sintQ)(uintQ)(y))
+   #else
+     #define UL_UL_minus_I(x,y)  L2_to_I( ((x)<(y) ? -1L : 0), (x)-(y) )
+   #endif
+ 
  # Umwandlungsroutinen Digit sequence --> Integer:
  
  # Normalized Digit sequence to Integer
***************
*** 876,882 ****
            if (bn_minlength>1 ? (len==0) : TRUE)
              # 0 Digits
              { return Fixnum_0; }
!          {var reg1 sint32 wert;
            if (bn_minlength>2 ? (len==1) : TRUE)
              # 1 Digit
              len_1:
--- 970,978 ----
            if (bn_minlength>1 ? (len==0) : TRUE)
              # 0 Digits
              { return Fixnum_0; }
!          {
!           #ifndef intQsize
!           var reg1 sint32 wert;
            if (bn_minlength>2 ? (len==1) : TRUE)
              # 1 Digit
              len_1:
***************
*** 885,911 ****
              # 2 Digits
              len_2:
              { wert = get_sint2D_Dptr(MSDptr); }
!           elif (TRUE)
              # 3 Digits
              len_3:
              { wert = get_sint3D_Dptr(MSDptr); }
!           elif (FALSE)
              # 4 Digits
              len_4:
              { wert = get_sint4D_Dptr(MSDptr); }
            return
!             #if (oint_data_shift <= vorz_bit_o)
              as_object((( (soint)wert
                           & (FN_value_vz_mask>>oint_data_shift) # Unntiges wegmaskieren
                         ) << oint_data_shift
                        )
                        | ((oint)fixnum_type<<oint_type_shift) # dafr Typinfo rein
                       )
!             #else # (oint_data_shift > vorz_bit_o)
              as_object((( (soint)wert << oint_data_shift )
                         & FN_value_mask # Unntiges wegmaskieren
                        )
!                       | ((soint)(sint32)sign_of_sintD(MSDptr[0]) & bit(vorz_bit_o))
                        | ((oint)fixnum_type<<oint_type_shift) # dafr Typinfo rein
                       )
              #endif
--- 981,1023 ----
              # 2 Digits
              len_2:
              { wert = get_sint2D_Dptr(MSDptr); }
!           elif (bn_minlength>4 ? (len==3) : TRUE)
              # 3 Digits
              len_3:
              { wert = get_sint3D_Dptr(MSDptr); }
!           elif (TRUE)
              # 4 Digits
              len_4:
              { wert = get_sint4D_Dptr(MSDptr); }
+           elif (FALSE)
+             # 5 Digits
+             len_5:
+             { wert = get_sint4D_Dptr(MSDptr); }
+           #else # defined(intQsize) && (intDsize==32)
+           var reg1 sint64 wert;
+           if (TRUE)
+             # 1 Digit
+             len_1:
+             { wert = (sint64)(sintD)MSDptr[0]; }
+           elif (TRUE)
+             # 2 Digits
+             len_2:
+             { wert = ((sint64)(sintD)MSDptr[0] << intDsize) | (uint64)(uintD)MSDptr[1]; }
+           #endif
            return
!             #if (oint_data_shift <= vorz_bit_o) && ((oint_data_len+1 <= intLsize) || defined(intQsize))
              as_object((( (soint)wert
                           & (FN_value_vz_mask>>oint_data_shift) # Unntiges wegmaskieren
                         ) << oint_data_shift
                        )
                        | ((oint)fixnum_type<<oint_type_shift) # dafr Typinfo rein
                       )
!             #else # Falls (oint_data_shift > vorz_bit_o)
!                   # oder falls das Vorzeichenbit nicht in wert steckt
              as_object((( (soint)wert << oint_data_shift )
                         & FN_value_mask # Unntiges wegmaskieren
                        )
!                       | ((soint)(sint32)sign_of_sintD(MSDptr[0]) & wbit(vorz_bit_o))
                        | ((oint)fixnum_type<<oint_type_shift) # dafr Typinfo rein
                       )
              #endif
***************
*** 930,935 ****
--- 1042,1050 ----
              #if (bn_minlength==4)
              goto len_4;
              #endif
+             #if (bn_minlength==5)
+             goto len_5;
+             #endif
          }
        # mindestens bn_minlength Digits, mache ein Bignum
        { var reg4 object new = allocate_bignum(len,sign_of_sintD(MSDptr[0]));
***************
*** 1162,1168 ****
        if (eq(as_object(fix_from_FN_to_NDS),Fixnum_0)) # mindestens 1 Digit ntig?                   \
          { len_from_FN_to_NDS=0; }                                                                   \
          else                                                                                        \
!         { var reg3 uint32 testMSD; # vordere Bits von fix_from_FN_to_NDS                            \
            if ((FN_maxlength<=1) ||                                                                  \
                (((testMSD = fix_from_FN_to_NDS & FN_MSD1_mask) == 0) || (testMSD == FN_MSD1_mask))   \
               )                                                                                      \
--- 1277,1283 ----
        if (eq(as_object(fix_from_FN_to_NDS),Fixnum_0)) # mindestens 1 Digit ntig?                   \
          { len_from_FN_to_NDS=0; }                                                                   \
          else                                                                                        \
!         { var reg3 oint testMSD; # vordere Bits von fix_from_FN_to_NDS                              \
            if ((FN_maxlength<=1) ||                                                                  \
                (((testMSD = fix_from_FN_to_NDS & FN_MSD1_mask) == 0) || (testMSD == FN_MSD1_mask))   \
               )                                                                                      \
diff -r -c3 clisp-1993-11-08/src/intgcd.d clisp/src/intgcd.d
*** clisp-1993-11-08/src/intgcd.d	Sun Oct 24 13:51:34 1993
--- clisp/src/intgcd.d	Wed Nov 10 01:45:04 1993
***************
*** 55,61 ****
  # (gcd a b) :==
  #   (prog ((j 0))
  #     1 {a,b >0}
! #       (when (oddp a) (go 4))
  #       (when (oddp b) (go 3))
  #       (incf j) (setq a (/ a 2)) (setq b (/ b 2))
  #       (go 1)
--- 55,61 ----
  # (gcd a b) :==
  #   (prog ((j 0))
  #     1 {a,b >0}
! #       (when (oddp a) (if (oddp b) (go 2) (go 4)))
  #       (when (oddp b) (go 3))
  #       (incf j) (setq a (/ a 2)) (setq b (/ b 2))
  #       (go 1)
***************
*** 83,89 ****
        var reg3 uintL bit_j = bit(0);
        loop
          { # a,b >0
!           if (!((a & bit_j) ==0)) goto odd_even;
            if (!((b & bit_j) ==0)) goto even_odd;
            # a,b >0 gerade
            bit_j = bit_j<<1;
--- 83,90 ----
        var reg3 uintL bit_j = bit(0);
        loop
          { # a,b >0
!           if (!((a & bit_j) ==0))
!             { if (!((b & bit_j) ==0)) goto odd_odd; else goto odd_even; }
            if (!((b & bit_j) ==0)) goto even_odd;
            # a,b >0 gerade
            bit_j = bit_j<<1;
***************
*** 91,101 ****
        #else # Trick von B. Degel:
        var reg3 uintL bit_j = (a | b); # endet mit einer 1 und j Nullen
        bit_j = bit_j ^ (bit_j - 1); # Maske = bit(j) | bit(j-1) | ... | bit(0)
!       if (!((a & bit_j) ==0)) goto odd_even;
        if (!((b & bit_j) ==0)) goto even_odd;
        #endif
        loop
!         { # a,b >0, beide ungerade
            # Vergleiche a und b:
            if (a == b) break; # a=b>0 -> fertig
            if (a > b) # a>b ?
--- 92,103 ----
        #else # Trick von B. Degel:
        var reg3 uintL bit_j = (a | b); # endet mit einer 1 und j Nullen
        bit_j = bit_j ^ (bit_j - 1); # Maske = bit(j) | bit(j-1) | ... | bit(0)
!       if (!((a & bit_j) ==0))
!         { if (!((b & bit_j) ==0)) goto odd_odd; else goto odd_even; }
        if (!((b & bit_j) ==0)) goto even_odd;
        #endif
        loop
!         { odd_odd: # a,b >0, beide ungerade
            # Vergleiche a und b:
            if (a == b) break; # a=b>0 -> fertig
            if (a > b) # a>b ?
***************
*** 233,239 ****
  #     {Stets |A|*ua-|B|*va=a*2^j, -|A|*ub+|B|*vb=b*2^j,
  #            ua>0, va>=0, ub>=0, vb>0.}
  #     1 {a,b >0}
! #       (when (oddp a) (setq Aj a Bj b) (go 4))
  #       (when (oddp b) (setq Aj a Bj b) (go 3))
  #       (incf j) (setq a (/ a 2)) (setq b (/ b 2))
  #       (go 1)
--- 235,241 ----
  #     {Stets |A|*ua-|B|*va=a*2^j, -|A|*ub+|B|*vb=b*2^j,
  #            ua>0, va>=0, ub>=0, vb>0.}
  #     1 {a,b >0}
! #       (when (oddp a) (setq Aj a Bj b) (if (oddp b) (go 2) (go 4)))
  #       (when (oddp b) (setq Aj a Bj b) (go 3))
  #       (incf j) (setq a (/ a 2)) (setq b (/ b 2))
  #       (go 1)
diff -r -c3 clisp-1993-11-08/src/intmal.d clisp/src/intmal.d
*** clisp-1993-11-08/src/intmal.d	Sun Oct 24 14:00:19 1993
--- clisp/src/intmal.d	Sun Nov 14 16:26:39 1993
***************
*** 422,428 ****
            var reg5 sint32 y_ = FN_to_L(y);
           #if (oint_data_len+1 > intLsize)
            # nur falls x und y Integers mit hchstens 32 Bit sind:
!           if (((sint32)R_sign(x) ^ x_ >= 0) && ((sint32)R_sign(y) ^ y_ >= 0))
           #endif
           {# Werte direkt multiplizieren:
            var reg3 uint32 hi;
--- 422,428 ----
            var reg5 sint32 y_ = FN_to_L(y);
           #if (oint_data_len+1 > intLsize)
            # nur falls x und y Integers mit hchstens 32 Bit sind:
!           if ((((sint32)R_sign(x) ^ x_) >= 0) && (((sint32)R_sign(y) ^ y_) >= 0))
           #endif
           {# Werte direkt multiplizieren:
            var reg3 uint32 hi;
diff -r -c3 clisp-1993-11-08/src/intplus.d clisp/src/intplus.d
*** clisp-1993-11-08/src/intplus.d	Sun Oct 24 14:59:55 1993
--- clisp/src/intplus.d	Sun Nov 14 19:26:28 1993
***************
*** 109,114 ****
--- 109,116 ----
              { # x,y sind Fixnums
                #if (oint_data_len+1 < intLsize)
                return L_to_I( FN_to_L(x) + FN_to_L(y) ); # als 32-Bit-Zahlen addieren
+               #elif defined(intQsize)
+               return Q_to_I( FN_to_Q(x) + FN_to_Q(y) ); # als 64-Bit-Zahlen addieren
                #else
                var reg2 sint32 xhi = R_sign(x);
                var reg1 uint32 xlo = FN_to_L(x);
***************
*** 210,215 ****
--- 212,219 ----
          { # Fixnum -> Long, negieren, -> Integer
            #if (oint_data_len+1 < intLsize)
            return L_to_I(- FN_to_L(x));
+           #elif defined(intQsize)
+           return Q_to_I(- FN_to_Q(x));
            #else
            var reg3 sint32 xhi = R_sign(x);
            var reg1 uint32 xlo = FN_to_L(x);
***************
*** 258,263 ****
--- 262,269 ----
              { # x,y sind Fixnums
                #if (oint_data_len+1 < intLsize)
                return L_to_I( FN_to_L(x) - FN_to_L(y) ); # als 32-Bit-Zahlen subtrahieren
+               #elif defined(intQsize)
+               return Q_to_I( FN_to_Q(x) - FN_to_Q(y) ); # als 64-Bit-Zahlen subtrahieren
                #else
                var reg2 sint32 xhi = R_sign(x);
                var reg1 uint32 xlo = FN_to_L(x);
diff -r -c3 clisp-1993-11-08/src/io.d clisp/src/io.d
*** clisp-1993-11-08/src/io.d	Sun Oct 24 14:03:56 1993
--- clisp/src/io.d	Mon Nov 15 00:36:02 1993
***************
*** 1,5 ****
  # Ein-/Ausgabe fr CLISP
! # Bruno Haible 24.10.1993
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr Division in pr_uint
--- 1,5 ----
  # Ein-/Ausgabe fr CLISP
! # Bruno Haible 14.11.1993
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr Division in pr_uint
***************
*** 683,689 ****
  # UP: Holt den Wert von *PRINT-BASE*
  # get_print_base()
  # < uintL ergebnis: >=2, <=36
!   #define get_print_base()  get_base(S(print_base))
  
  # UP: Holt den Wert von *READ-BASE*
  # get_read_base()
--- 683,690 ----
  # UP: Holt den Wert von *PRINT-BASE*
  # get_print_base()
  # < uintL ergebnis: >=2, <=36
!   #define get_print_base()  \
!     (test_value(S(print_readably)) ? 10 : get_base(S(print_base)))
  
  # UP: Holt den Wert von *READ-BASE*
  # get_read_base()
***************
*** 3186,3192 ****
  #       (if *read-suppress*
  #         (progn (read stream t nil t) nil)
  #         (if (null n)
! #           (make-array (read stream t nil t))
  #           (let* ((rank n)
  #                  (cont (let ((*backquote-level* nil)) (read stream t nil t)))
  #                  (dims '())
--- 3187,3197 ----
  #       (if *read-suppress*
  #         (progn (read stream t nil t) nil)
  #         (if (null n)
! #           (let ((h (read stream t nil t)))
! #             (if (and (consp h) (consp (cdr h)) (consp (cddr h)) (null (cdddr h)))
! #               (make-array (second h) :element-type (first h) :initial-contents (third h))
! #               (error "~: Falsche Syntax fr Array: #A~" 'read h)
! #           ) )
  #           (let* ((rank n)
  #                  (cont (let ((*backquote-level* nil)) (read stream t nil t)))
  #                  (dims '())
***************
*** 3212,3223 ****
        { read_recursive_no_dot(stream_);
          value1 = NIL; mv_count=1; skipSTACK(3); return;
        }
      if (nullp(STACK_0)) # n nicht angegeben?
!       # ja -> Dimensionsliste lesen:
        { var reg1 object obj = read_recursive_no_dot(stream_); # Liste lesen
          obj = make_references(obj); # Verweise entflechten
!         pushSTACK(obj); funcall(L(make_array),1); # MAKE-ARRAY aufrufen
!         mv_count=1; skipSTACK(3); return;
        }
      # n gibt den Rang des Arrays an.
      # Inhalt lesen:
--- 3217,3252 ----
        { read_recursive_no_dot(stream_);
          value1 = NIL; mv_count=1; skipSTACK(3); return;
        }
+    {
+     #ifdef IMMUTABLE_ARRAY
+     var reg5 uintB flags = TheStream(*stream_)->strmflags;
+     #endif
      if (nullp(STACK_0)) # n nicht angegeben?
!       # ja -> Liste (eltype dims contents) lesen:
        { var reg1 object obj = read_recursive_no_dot(stream_); # Liste lesen
          obj = make_references(obj); # Verweise entflechten
!         # (Das ist ungefhrlich, da wir diese #A-Syntax fr Arrays mit
!         # Elementtyp T nicht benutzen, und Byte-Arrays enthalten keine Verweise.)
!         if (!consp(obj)) goto bad;
!         { var reg3 object obj2 = Cdr(obj);
!           if (!consp(obj2)) goto bad;
!          {var reg4 object obj3 = Cdr(obj2);
!           if (!consp(obj3)) goto bad;
!           if (!nullp(Cdr(obj3))) goto bad;
!           # (MAKE-ARRAY dims :element-type eltype :initial-contents contents) aufrufen:
!           STACK_2 = Car(obj2); STACK_1 = S(Kelement_type); STACK_0 = Car(obj);
!           pushSTACK(S(Kinitial_contents)); pushSTACK(Car(obj3));
!           goto call_make_array;
!         }}
!         bad:
!           pushSTACK(obj); # Objekt
!           pushSTACK(*stream_); # Stream
!           pushSTACK(S(read));
!           fehler(
!                  DEUTSCH ? "~ von ~: Falsche Syntax fr Array: #A~" :
!                  ENGLISH ? "~ from ~: bad syntax for array: #A~" :
!                  ""
!                 );
        }
      # n gibt den Rang des Arrays an.
      # Inhalt lesen:
***************
*** 3226,3235 ****
        dynamic_unbind();
        pushSTACK(contents); pushSTACK(contents);
      }}
-    {
-     #ifdef IMMUTABLE_ARRAY
-     var reg4 uintB flags = TheStream(*stream_)->strmflags;
-     #endif
      STACK_4 = NIL; # dims := '()
      # Stackaufbau: dims, -, rank, subcontents, contents.
      # Dimensionen und Elementtyp bestimmen:
--- 3255,3260 ----
***************
*** 3263,3268 ****
--- 3288,3294 ----
      # Stackaufbau: dims, -, eltype, -, contents.
      # MAKE-ARRAY aufrufen:
      STACK_3 = S(Kelement_type); STACK_1 = S(Kinitial_contents);
+     call_make_array:
      funcall(L(make_array),5);
      #ifdef IMMUTABLE_ARRAY
      if (flags & strmflags_immut_B)
***************
*** 4653,4658 ****
--- 4679,4708 ----
        #undef pr_hexpart
      }
  
+ # *PRINT-READABLY* /= NIL bewirkt u.a. implizit dasselbe wie
+ # *PRINT-ESCAPE* = T, *PRINT-BASE* = 10, *PRINT-RADIX* = T,
+ # *PRINT-CIRCLE* = T, *PRINT-LEVEL* = NIL, *PRINT-LENGTH* = NIL,
+ # *PRINT-GENSYM* = T, *PRINT-ARRAY* = T, *PRINT-CLOSURE* = T.
+ 
+ # Fehlermeldung bei *PRINT-READABLY* /= NIL.
+ # fehler_print_readably(obj);
+   nonreturning_function(local, fehler_print_readably, (object obj));
+   local void fehler_print_readably(obj)
+     var reg1 object obj;
+     # (error "~: Trotz ~ kann ~ nicht wiedereinlesbar ausgegeben werden."
+     #        'print '*print-readably* obj
+     # )
+     { dynamic_bind(S(print_readably),NIL); # *PRINT-READABLY* an NIL binden
+       pushSTACK(obj);
+       pushSTACK(S(print_readably));
+       pushSTACK(S(print));
+       fehler(
+              DEUTSCH ? "~: Trotz ~ kann ~ nicht wiedereinlesbar ausgegeben werden." :
+              ENGLISH ? "~: Despite of ~, ~ cannot be printed readably." :
+              ""
+             );
+     }
+ 
  # Fehlermeldung bei unzulssigem Wert von *PRINT-CASE*.
  # fehler_print_case();
    nonreturning_function(local, fehler_print_case, (void));
***************
*** 5574,5580 ****
      var reg3 object* stream_;
      { var reg2 object level = Symbol_value(S(prin_level)); # SYS::*PRIN-LEVEL*, ein Fixnum >=0
        var reg1 object limit = Symbol_value(S(print_level)); # *PRINT-LEVEL*
!       if (posfixnump(limit) # Beschrnkung vorhanden?
            && (posfixnum_to_L(level) >= posfixnum_to_L(limit)) # und erreicht oder berschritten?
           )
          # ja -> '#' ausgeben und herausspringen:
--- 5624,5631 ----
      var reg3 object* stream_;
      { var reg2 object level = Symbol_value(S(prin_level)); # SYS::*PRIN-LEVEL*, ein Fixnum >=0
        var reg1 object limit = Symbol_value(S(print_level)); # *PRINT-LEVEL*
!       if (!test_value(S(print_readably))
!           && posfixnump(limit) # Beschrnkung vorhanden?
            && (posfixnum_to_L(level) >= posfixnum_to_L(limit)) # und erreicht oder berschritten?
           )
          # ja -> '#' ausgeben und herausspringen:
***************
*** 5606,5614 ****
    local uintL get_print_length (void);
    local uintL get_print_length()
      { var reg1 object limit = Symbol_value(S(print_length)); # *PRINT-LENGTH*
!       return (posfixnump(limit) # ein Fixnum >=0 ?
                ? posfixnum_to_L(limit) # ja
!               : ~0                    # nein -> Grenze "unendlich"
               );
      }
  
--- 5657,5666 ----
    local uintL get_print_length (void);
    local uintL get_print_length()
      { var reg1 object limit = Symbol_value(S(print_length)); # *PRINT-LENGTH*
!       return (!test_value(S(print_readably))
!               && posfixnump(limit) # ein Fixnum >=0 ?
                ? posfixnum_to_L(limit) # ja
!               : ~(uintL)0             # nein -> Grenze "unendlich"
               );
      }
  
***************
*** 5859,5865 ****
      var reg2 object* stream_;
      var reg1 object sym;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)))
          # mit Escape-Zeichen und evtl. Packagenamen:
          { if (!accessiblep(sym,get_current_package()))
              # Falls Symbol accessible und nicht verdeckt,
--- 5911,5917 ----
      var reg2 object* stream_;
      var reg1 object sym;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)) || test_value(S(print_readably)))
          # mit Escape-Zeichen und evtl. Packagenamen:
          { if (!accessiblep(sym,get_current_package()))
              # Falls Symbol accessible und nicht verdeckt,
***************
*** 5873,5879 ****
                if (nullp(home))
                  # uninterniertes Symbol ausgeben
                  { # *PRINT-GENSYM* abfragen:
!                   if (test_value(S(print_gensym)))
                      # Syntax #:name verwenden
                      { write_schar(stream_,'#'); goto one_marker; }
                      # sonst ohne Prfix ausgeben
--- 5925,5931 ----
                if (nullp(home))
                  # uninterniertes Symbol ausgeben
                  { # *PRINT-GENSYM* abfragen:
!                   if (test_value(S(print_gensym)) || test_value(S(print_readably)))
                      # Syntax #:name verwenden
                      { write_schar(stream_,'#'); goto one_marker; }
                      # sonst ohne Prfix ausgeben
***************
*** 6026,6032 ****
      var reg1 object* stream_;
      var reg2 object string;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)))
          { pr_symbol_part(stream_,string); } # mit Escape-Zeichen ausgeben
          else
          { write_sstring_case(stream_,string); } # ohne Escape-Zeichen ausgeben
--- 6078,6084 ----
      var reg1 object* stream_;
      var reg2 object string;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)) || test_value(S(print_readably)))
          { pr_symbol_part(stream_,string); } # mit Escape-Zeichen ausgeben
          else
          { write_sstring_case(stream_,string); } # ohne Escape-Zeichen ausgeben
***************
*** 6044,6050 ****
      var reg4 object* stream_;
      var reg6 object ch;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)))
          # Character mit Escape-Zeichen ausgeben.
          # Syntax:  # [font] \ char
          # bzw.     # [font] \ charname
--- 6096,6102 ----
      var reg4 object* stream_;
      var reg6 object ch;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)) || test_value(S(print_readably)))
          # Character mit Escape-Zeichen ausgeben.
          # Syntax:  # [font] \ char
          # bzw.     # [font] \ charname
***************
*** 6151,6157 ****
      var reg5 uintL start;
      var reg3 uintL len;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)))
          # mit Escape-Zeichen:
          { var reg2 uintL index = start;
            pushSTACK(string); # Simple-String retten
--- 6203,6209 ----
      var reg5 uintL start;
      var reg3 uintL len;
      { # *PRINT-ESCAPE* abfragen:
!       if (test_value(S(print_escape)) || test_value(S(print_readably)))
          # mit Escape-Zeichen:
          { var reg2 uintL index = start;
            pushSTACK(string); # Simple-String retten
***************
*** 6443,6449 ****
          # rationale Zahl
          { var reg3 uintWL base = get_print_base(); # Wert von *PRINT-BASE*
            # *PRINT-RADIX* abfragen:
!           if (test_value(S(print_radix)))
              # Radix-Specifier ausgeben:
              { pushSTACK(number); # number retten
                switch (base)
--- 6495,6501 ----
          # rationale Zahl
          { var reg3 uintWL base = get_print_base(); # Wert von *PRINT-BASE*
            # *PRINT-RADIX* abfragen:
!           if (test_value(S(print_radix)) || test_value(S(print_readably)))
              # Radix-Specifier ausgeben:
              { pushSTACK(number); # number retten
                switch (base)
***************
*** 6587,6593 ****
      var reg2 object* stream_;
      var reg1 object bv;
      { # *PRINT-ARRAY* abfragen:
!       if (test_value(S(print_array)))
          # bv elementweise ausgeben:
          { var reg3 uintL len = vector_length(bv); # Lnge
            var uintL offset = 0; # Offset vom Bit-Vektor in den Datenvektor
--- 6639,6645 ----
      var reg2 object* stream_;
      var reg1 object bv;
      { # *PRINT-ARRAY* abfragen:
!       if (test_value(S(print_array)) || test_value(S(print_readably)))
          # bv elementweise ausgeben:
          { var reg3 uintL len = vector_length(bv); # Lnge
            var uintL offset = 0; # Offset vom Bit-Vektor in den Datenvektor
***************
*** 6611,6620 ****
      var reg4 object* stream_;
      var reg7 object v;
      { # *PRINT-ARRAY* abfragen:
!       if (test_value(S(print_array)))
          # v elementweise ausgeben:
          { LEVEL_CHECK;
!           { var reg6 uintL length_limit = get_print_length(); # *PRINT-LENGTH*-Begrenzung
              var reg5 uintL length = 0; # bisherige Lnge := 0
              # Vektor elementweise abarbeiten:
              var reg3 uintL len = vector_length(v); # Vektor-Lnge
--- 6663,6674 ----
      var reg4 object* stream_;
      var reg7 object v;
      { # *PRINT-ARRAY* abfragen:
!       if (test_value(S(print_array)) || test_value(S(print_readably)))
          # v elementweise ausgeben:
          { LEVEL_CHECK;
!           { var reg8 boolean readable = # Flag, ob Lnge und Typ mit ausgegeben werden
!               (test_value(S(print_readably)) && !general_vector_p(v) ? TRUE : FALSE);
!             var reg6 uintL length_limit = get_print_length(); # *PRINT-LENGTH*-Begrenzung
              var reg5 uintL length = 0; # bisherige Lnge := 0
              # Vektor elementweise abarbeiten:
              var reg3 uintL len = vector_length(v); # Vektor-Lnge
***************
*** 6624,6632 ****
              }
             {var reg1 object* sv_ = &STACK_0; # und merken, wo er sitzt
              var reg2 uintL index = 0 + offset; # Startindex = 0 im Vektor
!             write_schar(stream_,'#');
!             KLAMMER_AUF; # '('
!             INDENT_START(2); # um 2 Zeichen einrcken, wegen '#('
              JUSTIFY_START;
              dotimesL(len,len,
                { # (auer vorm ersten Element) Space ausgeben:
--- 6678,6701 ----
              }
             {var reg1 object* sv_ = &STACK_0; # und merken, wo er sitzt
              var reg2 uintL index = 0 + offset; # Startindex = 0 im Vektor
!             if (readable)
!               { write_schar(stream_,'#'); write_schar(stream_,'A');
!                 KLAMMER_AUF; # '(' ausgeben
!                 INDENT_START(3); # um 3 Zeichen einrcken, wegen '#A('
!                 JUSTIFY_START;
!                 prin_object_dispatch(stream_,array_element_type(*sv_)); # Elementtyp ausgeben
!                 JUSTIFY_SPACE;
!                 pushSTACK(fixnum(len));
!                 pr_list(stream_,listof(1)); # Liste mit der Lnge ausgeben
!                 JUSTIFY_SPACE;
!                 KLAMMER_AUF; # '('
!                 INDENT_START(1); # um 1 Zeichen einrcken, wegen '('
!               }
!               else
!               { write_schar(stream_,'#');
!                 KLAMMER_AUF; # '('
!                 INDENT_START(2); # um 2 Zeichen einrcken, wegen '#('
!               }
              JUSTIFY_START;
              dotimesL(len,len,
                { # (auer vorm ersten Element) Space ausgeben:
***************
*** 6647,6652 ****
--- 6716,6726 ----
              JUSTIFY_END_ENG;
              INDENT_END;
              KLAMMER_ZU;
+             if (readable)
+               { JUSTIFY_END_ENG;
+                 INDENT_END;
+                 KLAMMER_ZU;
+               }
              skipSTACK(1);
            }}
            LEVEL_END;
***************
*** 6849,6925 ****
      var reg3 object* stream_;
      var reg2 object obj;
      { # *PRINT-ARRAY* abfragen:
!       if (test_value(S(print_array)))
!         if (TheArray(obj)->totalsize == 0)
!           # leerer Array -> nur Dimensionen ausgeben:
!           { LEVEL_CHECK;
              pushSTACK(obj); # Array retten
!            {var reg1 object* obj_ = &STACK_0; # und merken, wo er sitzt
!             write_schar(stream_,'#'); write_schar(stream_,'A');
!             INDENT_START(2); # um 2 Zeichen einrcken, wegen '#A'
!             pr_list(stream_,array_dimensions(*obj_)); # Dimensionsliste ausgeben
!             INDENT_END;
!             skipSTACK(1);
!             LEVEL_END;
!           }}
!           else
!           # obj elementweise ausgeben:
!           {   LEVEL_CHECK;
!            {  # Rang bestimmen und Dimensionen und Teilprodukte holen:
!               var reg4 uintL r = (uintL)(TheArray(obj)->rank); # Rang
!               var reg7 DYNAMIC_ARRAY(dims_sizes,array_dim_size,r); # dynamisch allozierter Array
!               array_dims_sizes(obj,dims_sizes); # fllen
!             { var reg5 uintL depth = r; # Tiefe der Rekursion
!               var pr_array_locals locals; # lokale Variablen
!               locals.stream_ = stream_;
!               locals.dims_sizes = dims_sizes;
!               locals.length_limit = get_print_length(); # Lngenbegrenzung
!               # Entscheidung ber zu verwendende Routine:
!               {var reg1 uintB atype = TheArray(obj)->flags & arrayflags_atype_mask;
!                if ((r>0) && (locals.length_limit >= dims_sizes[0].dim))
!                  { switch (atype)
!                      { case Atype_Bit:
!                          # ganze Bitvektoren statt einzelnen Bits ausgeben
!                          locals.pr_one_elt = &pr_array_elt_bvector;
!                          goto nicht_einzeln;
!                        case Atype_String_Char:
!                          # ganze Strings statt einzelnen Characters ausgeben
!                          locals.pr_one_elt = &pr_array_elt_string;
!                        nicht_einzeln:
!                          # Nicht einzelne Elemente, sondern eindimensionale
!                          # Teil-Arrays ausgeben.
!                          depth--; # dafr depth := r-1
!                          locals.info.count = dims_sizes[0].dim; # Dim_r als "Elementarlnge"
!                          locals.dims_sizes++; # betrachte nur noch Dim_1, ..., Dim_(r-1)
!                          goto routine_ok;
!                        default: ;
!                  }   }
!                locals.pr_one_elt = &pr_array_elt_t;
!                locals.info.count = 1; # 1 als "Elementarlnge"
!                routine_ok:
!                locals.info.index = 0; # Start-Index ist 0
                }
!              {# Datenvektor holen:
!               var reg6 uintL size = TheArray(obj)->totalsize;
!               obj = array1_displace_check(obj,size,&locals.info.index); # Datenvektor
!               # locals.info.index = Offset vom Array in den Datenvektor
!               pushSTACK(obj); locals.obj_ = &STACK_0; # obj im Stack unterbringen
!               # Los geht's.
!               # Erst Prfix #nA ausgeben:
!               INDENTPREP_START;
!               write_schar(stream_,'#');
!               pr_uint(stream_,r); # Rang dezimal ausgeben
!               write_schar(stream_,'A');
!               {var reg1 uintL indent = INDENTPREP_END;
!               # Dann die Array-Elemente ausgeben:
!                INDENT_START(indent);
                }
!               pr_array_rekursion(&locals,depth);
!               INDENT_END;
!               skipSTACK(1);
!               FREE_DYNAMIC_ARRAY(dims_sizes);
!               LEVEL_END;
!           }}}}
          else
          # *PRINT-ARRAY* = NIL -> in Kurzform ausgeben:
          { pr_array_nil(stream_,obj); }
--- 6923,7012 ----
      var reg3 object* stream_;
      var reg2 object obj;
      { # *PRINT-ARRAY* abfragen:
!       if (test_value(S(print_array)) || test_value(S(print_readably)))
!         # obj elementweise ausgeben:
!         {   LEVEL_CHECK;
!          {  # Rang bestimmen und Dimensionen und Teilprodukte holen:
!             var reg4 uintL r = (uintL)(TheArray(obj)->rank); # Rang
!             var reg7 DYNAMIC_ARRAY(dims_sizes,array_dim_size,r); # dynamisch allozierter Array
!             array_dims_sizes(obj,dims_sizes); # fllen
!           { var reg5 uintL depth = r; # Tiefe der Rekursion
!             var pr_array_locals locals; # lokale Variablen
!             var reg9 boolean readable = TRUE; # Flag, ob Dimensionen und Typ mit ausgegeben werden
!             locals.stream_ = stream_;
!             locals.dims_sizes = dims_sizes;
!             locals.length_limit = get_print_length(); # Lngenbegrenzung
!             # Entscheidung ber zu verwendende Routine:
!             {var reg1 uintB atype = TheArray(obj)->flags & arrayflags_atype_mask;
!              if ((r>0) && (locals.length_limit >= dims_sizes[0].dim))
!                { switch (atype)
!                    { case Atype_Bit:
!                        # ganze Bitvektoren statt einzelnen Bits ausgeben
!                        locals.pr_one_elt = &pr_array_elt_bvector;
!                        goto nicht_einzeln;
!                      case Atype_String_Char:
!                        # ganze Strings statt einzelnen Characters ausgeben
!                        locals.pr_one_elt = &pr_array_elt_string;
!                      nicht_einzeln:
!                        # Nicht einzelne Elemente, sondern eindimensionale
!                        # Teil-Arrays ausgeben.
!                        depth--; # dafr depth := r-1
!                        locals.info.count = dims_sizes[0].dim; # Dim_r als "Elementarlnge"
!                        locals.dims_sizes++; # betrachte nur noch Dim_1, ..., Dim_(r-1)
!                        readable = FALSE; # automatisch wiedereinlesbar
!                        goto routine_ok;
!                      default: ;
!                }   }
!              locals.pr_one_elt = &pr_array_elt_t;
!              locals.info.count = 1; # 1 als "Elementarlnge"
!              if (atype==Atype_T)
!                { readable = FALSE; } # automatisch wiedereinlesbar
!              routine_ok:
!              locals.info.index = 0; # Start-Index ist 0
!             }
!             if (!test_value(S(print_readably)))
!               { readable = FALSE; } # braucht nicht wiedereinlesbar zu sein
              pushSTACK(obj); # Array retten
!            {var reg8 object* obj_ = &STACK_0; # und merken, wo er sitzt
!             # Datenvektor holen:
!             var reg6 uintL size = TheArray(obj)->totalsize;
!             if (size == 0)
!               { readable = TRUE; } # sonst wei man nicht einmal die Dimensionen
!             obj = array1_displace_check(obj,size,&locals.info.index); # Datenvektor
!             # locals.info.index = Offset vom Array in den Datenvektor
!             pushSTACK(obj); locals.obj_ = &STACK_0; # obj im Stack unterbringen
!             # Los geht's.
!             if (readable)
!               { write_schar(stream_,'#'); write_schar(stream_,'A');
!                 KLAMMER_AUF; # '(' ausgeben
!                 INDENT_START(3); # um 3 Zeichen einrcken, wegen '#A('
!                 JUSTIFY_START;
!                 prin_object_dispatch(stream_,array_element_type(*obj_)); # Elementtyp (Symbol oder Liste) ausgeben
!                 JUSTIFY_SPACE;
!                 pr_list(stream_,array_dimensions(*obj_)); # Dimensionsliste ausgeben
!                 JUSTIFY_SPACE;
!                 pr_array_rekursion(&locals,depth); # Array-Elemente ausgeben
!                 JUSTIFY_END_ENG;
!                 INDENT_END;
!                 KLAMMER_ZU; # ')' ausgeben
                }
!               else
!               { # Erst Prfix #nA ausgeben:
!                 INDENTPREP_START;
!                 write_schar(stream_,'#');
!                 pr_uint(stream_,r); # Rang dezimal ausgeben
!                 write_schar(stream_,'A');
!                 {var reg1 uintL indent = INDENTPREP_END;
!                 # Dann die Array-Elemente ausgeben:
!                  INDENT_START(indent);
!                 }
!                 pr_array_rekursion(&locals,depth);
!                 INDENT_END;
                }
!             skipSTACK(2);
!             FREE_DYNAMIC_ARRAY(dims_sizes);
!             LEVEL_END;
!         }}}}
          else
          # *PRINT-ARRAY* = NIL -> in Kurzform ausgeben:
          { pr_array_nil(stream_,obj); }
***************
*** 6966,6975 ****
  # kann GC auslsen
    local void pr_structure_external (object* stream_, object structure, object function);
    local void pr_structure_external(stream_,structure,function)
!     var reg2 object* stream_;
!     var reg3 object structure;
!     var reg4 object function;
!     { var reg1 object stream = *stream_;
        # SYS::*PRIN-STREAM* an stream binden:
        dynamic_bind(S(prin_stream),stream);
        # (funcall fun Structure Stream SYS::*PRIN-LEVEL*) :
--- 7053,7095 ----
  # kann GC auslsen
    local void pr_structure_external (object* stream_, object structure, object function);
    local void pr_structure_external(stream_,structure,function)
!     var reg4 object* stream_;
!     var reg5 object structure;
!     var reg6 object function;
!     { var reg3 object stream = *stream_;
!       var reg2 uintC count = 1;
!       if (test_value(S(print_readably)))
!         { # Damit die benutzerdefinierten Print-Funktionen, die noch nichts
!           # von *PRINT-READABLY* wissen, sich trotzdem danach benehmen,
!           # binden wir die anderen Printer-Variablen passend:
!           # *PRINT-READABLY* erzwingt *PRINT-ESCAPE* = T :
!           if (!test_value(S(print_escape)))
!             { dynamic_bind(S(print_escape),T); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-BASE* = 10 :
!           if (!eq(Symbol_value(S(print_base)),fixnum(10)))
!             { dynamic_bind(S(print_base),fixnum(10)); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-RADIX* = T :
!           if (!test_value(S(print_radix)))
!             { dynamic_bind(S(print_radix),T); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-CIRCLE* = T :
!           if (!test_value(S(print_circle)))
!             { dynamic_bind(S(print_circle),T); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-LEVEL* = NIL :
!           if (test_value(S(print_level)))
!             { dynamic_bind(S(print_level),NIL); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-LENGTH* = NIL :
!           if (test_value(S(print_length)))
!             { dynamic_bind(S(print_length),NIL); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-GENSYM* = T :
!           if (!test_value(S(print_gensym)))
!             { dynamic_bind(S(print_gensym),T); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-ARRAY* = T :
!           if (!test_value(S(print_array)))
!             { dynamic_bind(S(print_array),T); count++; }
!           # *PRINT-READABLY* erzwingt *PRINT-CLOSURE* = T :
!           if (!test_value(S(print_closure)))
!             { dynamic_bind(S(print_closure),T); count++; }
!         }
        # SYS::*PRIN-STREAM* an stream binden:
        dynamic_bind(S(prin_stream),stream);
        # (funcall fun Structure Stream SYS::*PRIN-LEVEL*) :
***************
*** 6977,6983 ****
        pushSTACK(stream); # Stream als 2. Argument
        pushSTACK(Symbol_value(S(prin_level))); # Wert von SYS::*PRIN-LEVEL* als 3. Argument
        funcall(function,3);
!       dynamic_unbind();
      }
  
  # UP: Gibt eine Structure auf einen Stream aus.
--- 7097,7104 ----
        pushSTACK(stream); # Stream als 2. Argument
        pushSTACK(Symbol_value(S(prin_level))); # Wert von SYS::*PRIN-LEVEL* als 3. Argument
        funcall(function,3);
!       # Bindungen auflsen:
!       dotimespC(count,count, { dynamic_unbind(); } );
      }
  
  # UP: Gibt eine Structure auf einen Stream aus.
***************
*** 7052,7058 ****
                    }
                    else
                    # Structure nicht wiedereinlesbar ausgeben:
!                   { write_schar(stream_,'#'); write_schar(stream_,'<');
                      INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
                    }
                  JUSTIFY_START;
--- 7173,7180 ----
                    }
                    else
                    # Structure nicht wiedereinlesbar ausgeben:
!                   { if (test_value(S(print_readably))) { fehler_print_readably(*structure_); }
!                     write_schar(stream_,'#'); write_schar(stream_,'<');
                      INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
                    }
                  JUSTIFY_START;
***************
*** 7113,7119 ****
                }}
                else
                # Structure elementweise, ohne Komponenten-Namen ausgeben.
!               { write_schar(stream_,'#'); write_schar(stream_,'<');
                  INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
                  JUSTIFY_START;
                  prin_object(stream_,*(structure_ STACKop -1)); # name ausgeben
--- 7235,7242 ----
                }}
                else
                # Structure elementweise, ohne Komponenten-Namen ausgeben.
!               { if (test_value(S(print_readably))) { fehler_print_readably(*structure_); }
!                 write_schar(stream_,'#'); write_schar(stream_,'<');
                  INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
                  JUSTIFY_START;
                  prin_object(stream_,*(structure_ STACKop -1)); # name ausgeben
***************
*** 7182,7187 ****
--- 7305,7311 ----
      var reg1 object* stream_;
      var reg2 object obj;
      { # #<ADDRESS #x...>
+       if (test_value(S(print_readably))) { fehler_print_readably(obj); }
        pr_hex6_obj(stream_,obj,O(printstring_address));
      }
  
***************
*** 7196,7202 ****
    local void pr_system(stream_,obj)
      var reg2 object* stream_;
      var reg1 object obj;
!     { if (as_oint(obj) & wbit(oint_addr_len-1 + oint_addr_shift))
          if (as_oint(obj) & wbit(oint_addr_len-2 + oint_addr_shift))
            # System-Pointer
            { if (eq(obj,unbound)) # #<UNBOUND>
--- 7320,7327 ----
    local void pr_system(stream_,obj)
      var reg2 object* stream_;
      var reg1 object obj;
!     { if (test_value(S(print_readably))) { fehler_print_readably(obj); }
!       if (as_oint(obj) & wbit(oint_addr_len-1 + oint_addr_shift))
          if (as_oint(obj) & wbit(oint_addr_len-2 + oint_addr_shift))
            # System-Pointer
            { if (eq(obj,unbound)) # #<UNBOUND>
***************
*** 7337,7343 ****
          }
          else
          # obj nicht wiedereinlesbar ausgeben:
!         { write_schar(stream_,'#'); write_schar(stream_,'<');
            INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
          }
        JUSTIFY_START;
--- 7462,7469 ----
          }
          else
          # obj nicht wiedereinlesbar ausgeben:
!         { if (test_value(S(print_readably))) { fehler_print_readably(STACK_2); }
!           write_schar(stream_,'#'); write_schar(stream_,'<');
            INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
          }
        JUSTIFY_START;
***************
*** 7401,7407 ****
              # je nach *PRINT-ARRAY* :
              # #<HASH-TABLE #x...> oder
              # #S(HASH-TABLE test (Key_1 . Value_1) ... (Key_n . Value_n))
!             if (test_value(S(print_array)))
                { LEVEL_CHECK;
                  pushSTACK(obj); # Hash-Tabelle retten
                 {var reg7 object* obj_ = &STACK_0; # und merken, wo sie sitzt
--- 7527,7533 ----
              # je nach *PRINT-ARRAY* :
              # #<HASH-TABLE #x...> oder
              # #S(HASH-TABLE test (Key_1 . Value_1) ... (Key_n . Value_n))
!             if (test_value(S(print_array)) || test_value(S(print_readably)))
                { LEVEL_CHECK;
                  pushSTACK(obj); # Hash-Tabelle retten
                 {var reg7 object* obj_ = &STACK_0; # und merken, wo sie sitzt
***************
*** 7469,7496 ****
                { pr_hex6_obj(stream_,obj,O(printstring_hash_table)); }
              break;
            case Rectype_Package:
!             # #<PACKAGE name>
              { pushSTACK(obj); # Package retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo sie sitzt
!               write_schar(stream_,'#'); write_schar(stream_,'<');
!               INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
!               JUSTIFY_START;
!               write_sstring_case(stream_,O(printstring_package)); # "PACKAGE"
!               JUSTIFY_SPACE;
!               pr_like_symbol(stream_,ThePackage(*obj_)->pack_name); # Name ausgeben
!               JUSTIFY_END_ENG;
!               INDENT_END;
!               write_schar(stream_,'>');
                skipSTACK(1);
              }}break;
            case Rectype_Readtable:
              # #<READTABLE #x...>
              pr_hex6_obj(stream_,obj,O(printstring_readtable));
              break;
            case Rectype_Pathname:
              {
                #ifdef PATHNAME_NOEXT
!               if (test_value(S(print_escape))) # nur bei *PRINT-ESCAPE* /= NIL (sonst s.u.)
                  # Pathnames, deren Namestring als ein anderer Pathname interpretiert
                  # wrde, geben wir anders aus. Wegen der Regel der Aufspaltung in
                  # Name und Typ am letzten Punkt sind dies folgende Flle:
--- 7595,7639 ----
                { pr_hex6_obj(stream_,obj,O(printstring_hash_table)); }
              break;
            case Rectype_Package:
!             # je nach *PRINT-READABLY*:
!             # #<PACKAGE name> oder #.(SYSTEM::%FIND-PACKAGE "name")
              { pushSTACK(obj); # Package retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo sie sitzt
!               if (!test_value(S(print_readably)))
!                 { write_schar(stream_,'#'); write_schar(stream_,'<');
!                   INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
!                   JUSTIFY_START;
!                   write_sstring_case(stream_,O(printstring_package)); # "PACKAGE"
!                   JUSTIFY_SPACE;
!                   pr_like_symbol(stream_,ThePackage(*obj_)->pack_name); # Name ausgeben
!                   JUSTIFY_END_ENG;
!                   INDENT_END;
!                   write_schar(stream_,'>');
!                 }
!                 else
!                 { write_schar(stream_,'#'); write_schar(stream_,'.');
!                   KLAMMER_AUF; # '('
!                   INDENT_START(3); # um 3 Zeichen einrcken, wegen '#.('
!                   JUSTIFY_START;
!                   pr_symbol(stream_,S(pfind_package)); # SYSTEM::%FIND-PACKAGE
!                   JUSTIFY_SPACE;
!                   pr_string(stream_,ThePackage(*obj_)->pack_name); # Name ausgeben
!                   JUSTIFY_END_ENG;
!                   INDENT_END;
!                   KLAMMER_ZU;
!                 }
                skipSTACK(1);
              }}break;
            case Rectype_Readtable:
              # #<READTABLE #x...>
+             if (test_value(S(print_readably))) { fehler_print_readably(obj); }
              pr_hex6_obj(stream_,obj,O(printstring_readtable));
              break;
            case Rectype_Pathname:
              {
                #ifdef PATHNAME_NOEXT
!               # nur bei *PRINT-ESCAPE* /= NIL (sonst s.u.)
!               if (test_value(S(print_escape)) || test_value(S(print_readably)))
                  # Pathnames, deren Namestring als ein anderer Pathname interpretiert
                  # wrde, geben wir anders aus. Wegen der Regel der Aufspaltung in
                  # Name und Typ am letzten Punkt sind dies folgende Flle:
***************
*** 7505,7517 ****
                        dotimesL(count,count, { if (*ptr++ == '.') goto pathname_nonstring; } );
                  }   }
                #endif
                pushSTACK(obj); # Pathname retten
                # (NAMESTRING pathname) ausfhren:
                pushSTACK(obj); funcall(L(namestring),1);
                obj = value1;
                if (stringp(obj)) # sollte einen String liefern (liefert z.Zt. sogar immer einen Simple-String)
                  # Syntax #"namestring"
!                 { if (test_value(S(print_escape))) # *PRINT-ESCAPE* abfragen
                      { STACK_0 = obj; # String retten
                        write_schar(stream_,'#'); # '#' ausgeben
                        pr_string(stream_,STACK_0); # String (in Anfhrungszeichen) ausgeben
--- 7648,7663 ----
                        dotimesL(count,count, { if (*ptr++ == '.') goto pathname_nonstring; } );
                  }   }
                #endif
+               # Bei *PRINT-READABLY* komponentenweise ausgeben (sicher ist sicher):
+               if (test_value(S(print_readably))) goto pathname_nonstring;
                pushSTACK(obj); # Pathname retten
                # (NAMESTRING pathname) ausfhren:
                pushSTACK(obj); funcall(L(namestring),1);
                obj = value1;
                if (stringp(obj)) # sollte einen String liefern (liefert z.Zt. sogar immer einen Simple-String)
                  # Syntax #"namestring"
!                 { # *PRINT-ESCAPE* abfragen:
!                   if (test_value(S(print_escape)) || test_value(S(print_readably)))
                      { STACK_0 = obj; # String retten
                        write_schar(stream_,'#'); # '#' ausgeben
                        pr_string(stream_,STACK_0); # String (in Anfhrungszeichen) ausgeben
***************
*** 7558,7564 ****
            case Rectype_Byte:
              #if 0
              # #<BYTE size position>
!             { LEVEL_CHECK;
                pushSTACK(obj); # Byte retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
--- 7704,7711 ----
            case Rectype_Byte:
              #if 0
              # #<BYTE size position>
!             { if (test_value(S(print_readably))) { fehler_print_readably(obj); }
!               LEVEL_CHECK;
                pushSTACK(obj); # Byte retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
***************
*** 7591,7597 ****
              } break;
            case Rectype_Symbolmacro:
              # #<SYMBOL-MACRO expansion>
!             { LEVEL_CHECK;
                pushSTACK(obj); # Symbol-Macro retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
--- 7738,7745 ----
              } break;
            case Rectype_Symbolmacro:
              # #<SYMBOL-MACRO expansion>
!             { if (test_value(S(print_readably))) { fehler_print_readably(obj); }
!               LEVEL_CHECK;
                pushSTACK(obj); # Symbol-Macro retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
***************
*** 7609,7615 ****
            #ifdef ALIEN
            case Rectype_Alienfun:
              # #<ALIEN-FUNCTION address>
!             { LEVEL_CHECK;
                pushSTACK(obj); # Alienfun retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
--- 7757,7764 ----
            #ifdef ALIEN
            case Rectype_Alienfun:
              # #<ALIEN-FUNCTION address>
!             { if (test_value(S(print_readably))) { fehler_print_readably(obj); }
!               LEVEL_CHECK;
                pushSTACK(obj); # Alienfun retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
***************
*** 7634,7640 ****
              }}break;
            case Rectype_Alien:
              # #<ALIEN type address>
!             { LEVEL_CHECK;
                pushSTACK(obj); # Alien retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
--- 7783,7790 ----
              }}break;
            case Rectype_Alien:
              # #<ALIEN type address>
!             { if (test_value(S(print_readably))) { fehler_print_readably(obj); }
!               LEVEL_CHECK;
                pushSTACK(obj); # Alien retten
               {var reg1 object* obj_ = &STACK_0; # und merken, wo es sitzt
                write_schar(stream_,'#'); write_schar(stream_,'<');
***************
*** 7712,7717 ****
--- 7862,7868 ----
      var reg2 object* stream_;
      var reg1 object obj;
      { # #<SYSTEM-FUNCTION name>
+       if (test_value(S(print_readably))) { fehler_print_readably(obj); }
        pr_other_obj(stream_,TheSubr(obj)->name,O(printstring_subr));
      }
  
***************
*** 7725,7730 ****
--- 7876,7882 ----
      var reg2 object* stream_;
      var reg1 object obj;
      { # #<SPECIAL-FORM name>
+       if (test_value(S(print_readably))) { fehler_print_readably(obj); }
        pr_other_obj(stream_,TheFsubr(obj)->name,O(printstring_fsubr));
      }
  
***************
*** 7746,7751 ****
--- 7898,7904 ----
          # interpretierte Closure ausgeben: #<CLOSURE ...>
          { # Falls *PRINT-CLOSURE* /= NIL, alles, sonst den Namen und
            # (falls noch vorhanden) Lambdaliste und Formen, ausgeben:
+           if (test_value(S(print_readably))) { fehler_print_readably(obj); }
            LEVEL_CHECK;
            pushSTACK(obj); # Closure retten
           {var reg2 object* obj_ = &STACK_0; # und merken, wo sie sitzt
***************
*** 7780,7786 ****
    local void pr_cclosure(stream_,obj)
      var reg2 object* stream_;
      var reg1 object obj;
!     { if (test_value(S(print_closure))) # *PRINT-CLOSURE* abfragen
          # *PRINT-CLOSURE /= NIL -> in wiedereinlesbarer Form #Y(...) ausgeben
          { pr_cclosure_lang(stream_,obj); }
          else
--- 7933,7940 ----
    local void pr_cclosure(stream_,obj)
      var reg2 object* stream_;
      var reg1 object obj;
!     { # *PRINT-CLOSURE* abfragen:
!       if (test_value(S(print_closure)) || test_value(S(print_readably)))
          # *PRINT-CLOSURE /= NIL -> in wiedereinlesbarer Form #Y(...) ausgeben
          { pr_cclosure_lang(stream_,obj); }
          else
***************
*** 7911,7917 ****
    local void pr_stream(stream_,obj)
      var reg2 object* stream_;
      var reg4 object obj;
!     { pushSTACK(obj); # Stream retten
       {var reg1 object* obj_ = &STACK_0; # und merken, wo er sitzt
        write_schar(stream_,'#'); write_schar(stream_,'<');
        INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
--- 8065,8072 ----
    local void pr_stream(stream_,obj)
      var reg2 object* stream_;
      var reg4 object obj;
!     { if (test_value(S(print_readably))) { fehler_print_readably(obj); }
!       pushSTACK(obj); # Stream retten
       {var reg1 object* obj_ = &STACK_0; # und merken, wo er sitzt
        write_schar(stream_,'#'); write_schar(stream_,'<');
        INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
***************
*** 8079,8091 ****
      var reg3 object* stream_;
      var reg2 object obj;
      { # Falls *PRINT-CIRCLE* /= NIL, in obj nach Zirkularitten suchen.
!       if (test_value(S(print_circle)))
          # Zirkularitten suchen:
          { pushSTACK(obj);
           {var reg1 object circularities = # Zirkularittentabelle
              get_circularities(obj,
!                               test_value(S(print_array)), # /= 0 genau dann wenn *PRINT-ARRAY* /= NIL
!                               test_value(S(print_closure)) # /= 0 genau dann wenn *PRINT-CLOSURE* /= NIL
                               );
            obj = popSTACK();
            if (nullp(circularities))
--- 8234,8246 ----
      var reg3 object* stream_;
      var reg2 object obj;
      { # Falls *PRINT-CIRCLE* /= NIL, in obj nach Zirkularitten suchen.
!       if (test_value(S(print_circle)) || test_value(S(print_readably)))
          # Zirkularitten suchen:
          { pushSTACK(obj);
           {var reg1 object circularities = # Zirkularittentabelle
              get_circularities(obj,
!                               test_value(S(print_array)) || test_value(S(print_readably)), # /= 0 genau dann wenn *PRINT-ARRAY* /= NIL
!                               test_value(S(print_closure)) || test_value(S(print_readably)) # /= 0 genau dann wenn *PRINT-CLOSURE* /= NIL
                               );
            obj = popSTACK();
            if (nullp(circularities))
***************
*** 8110,8116 ****
              # Zirkularittenvektor
              { # Binde SYS::*PRINT-CIRCLE-TABLE* an den Simple-Vector:
                dynamic_bind(S(print_circle_table),circularities);
!               prin1a(stream_,obj);
                dynamic_unbind();
              }
          }}
--- 8265,8278 ----
              # Zirkularittenvektor
              { # Binde SYS::*PRINT-CIRCLE-TABLE* an den Simple-Vector:
                dynamic_bind(S(print_circle_table),circularities);
!               if (!test_value(S(print_circle)))
!                 # *PRINT-READABLY* erzwingt *PRINT-CIRCLE* = T
!                 { dynamic_bind(S(print_circle),T);
!                   prin1a(stream_,obj);
!                   dynamic_unbind();
!                 }
!                 else
!                 { prin1a(stream_,obj); }
                dynamic_unbind();
              }
          }}
***************
*** 8197,8217 ****
      }
  
  # Print-Variablen (siehe CONSTSYM.D):
! #   *PRINT-CASE*    --+
! #   *PRINT-LEVEL*     |
! #   *PRINT-LENGTH*    |
! #   *PRINT-GENSYM*    |
! #   *PRINT-ESCAPE*    | Reihenfolge fest!
! #   *PRINT-RADIX*     | Dieselbe Reihenfolge in CONSTSYM.D
! #   *PRINT-BASE*      | und bei den SUBRs WRITE, WRITE-TO-STRING
! #   *PRINT-ARRAY*     |
! #   *PRINT-CIRCLE*    |
! #   *PRINT-PRETTY*    |
! #   *PRINT-CLOSURE* --+
  # erste Print-Variable:
    #define first_print_var  S(print_case)
  # Anzahl der Print-Variablen:
!   #define print_vars_anz  11
  
  # UP fr WRITE und WRITE-TO-STRING
  # > STACK_(print_vars_anz+1): Objekt
--- 8359,8380 ----
      }
  
  # Print-Variablen (siehe CONSTSYM.D):
! #   *PRINT-CASE*     --+
! #   *PRINT-LEVEL*      |
! #   *PRINT-LENGTH*     |
! #   *PRINT-GENSYM*     |
! #   *PRINT-ESCAPE*     | Reihenfolge fest!
! #   *PRINT-RADIX*      | Dieselbe Reihenfolge in CONSTSYM.D
! #   *PRINT-BASE*       | und bei den SUBRs WRITE, WRITE-TO-STRING
! #   *PRINT-ARRAY*      |
! #   *PRINT-CIRCLE*     |
! #   *PRINT-PRETTY*     |
! #   *PRINT-CLOSURE*    |
! #   *PRINT-READABLY* --+
  # erste Print-Variable:
    #define first_print_var  S(print_case)
  # Anzahl der Print-Variablen:
!   #define print_vars_anz  12
  
  # UP fr WRITE und WRITE-TO-STRING
  # > STACK_(print_vars_anz+1): Objekt
***************
*** 8239,8249 ****
        dotimesC(bindcount,bindcount, { dynamic_unbind(); } );
      }
  
! LISPFUN(write,1,0,norest,key,12,\
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),\
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(stream)) )
  # (WRITE object [:stream] [:escape] [:radix] [:base] [:circle] [:pretty]
! #               [:level] [:length] [:case] [:gensym] [:array] [:closure]),
  # CLTL S. 382
    { # Stackaufbau: object, Print-Variablen-Argumente, Stream-Argument.
      test_ostream(); # Output-Stream berprfen
--- 8402,8414 ----
        dotimesC(bindcount,bindcount, { dynamic_unbind(); } );
      }
  
! LISPFUN(write,1,0,norest,key,13,\
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),\
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(readably),\
!          kw(stream)) )
  # (WRITE object [:stream] [:escape] [:radix] [:base] [:circle] [:pretty]
! #               [:level] [:length] [:case] [:gensym] [:array] [:closure]
! #               [:readably]),
  # CLTL S. 382
    { # Stackaufbau: object, Print-Variablen-Argumente, Stream-Argument.
      test_ostream(); # Output-Stream berprfen
***************
*** 8352,8367 ****
  
  # (defun write-to-string (object &rest args
  #                                &key escape radix base circle pretty level
! #                                     length case gensym array closure)
  #   (with-output-to-string (stream)
  #     (apply #'write object :stream stream args)
  # ) )
! LISPFUN(write_to_string,1,0,norest,key,11,\
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),\
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure)) )
  # (WRITE-TO-STRING object [:escape] [:radix] [:base] [:circle] [:pretty]
  #                         [:level] [:length] [:case] [:gensym] [:array]
! #                         [:closure]),
  # CLTL S. 383
    { pushSTACK(make_string_output_stream()); # String-Output-Stream
      write_up(); # WRITE durchfhren
--- 8517,8532 ----
  
  # (defun write-to-string (object &rest args
  #                                &key escape radix base circle pretty level
! #                                     length case gensym array closure readably)
  #   (with-output-to-string (stream)
  #     (apply #'write object :stream stream args)
  # ) )
! LISPFUN(write_to_string,1,0,norest,key,12,\
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),\
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(readably)) )
  # (WRITE-TO-STRING object [:escape] [:radix] [:base] [:circle] [:pretty]
  #                         [:level] [:length] [:case] [:gensym] [:array]
! #                         [:closure] [:readably]),
  # CLTL S. 383
    { pushSTACK(make_string_output_stream()); # String-Output-Stream
      write_up(); # WRITE durchfhren
***************
*** 8503,8508 ****
--- 8668,8674 ----
      }
      if (!nullp(STACK_2)) { flag_fun = TRUE; }
      test_ostream(); # Output-Stream berprfen
+     if (test_value(S(print_readably))) { fehler_print_readably(STACK_1); }
     {var reg1 object* stream_ = &STACK_0;
      write_schar(stream_,'#'); write_schar(stream_,'<');
      INDENT_START(2); # um 2 Zeichen einrcken, wegen '#<'
diff -r -c3 clisp-1993-11-08/src/lfloat.d clisp/src/lfloat.d
*** clisp-1993-11-08/src/lfloat.d	Sun Oct 24 14:08:38 1993
--- clisp/src/lfloat.d	Sat Nov 13 23:28:13 1993
***************
*** 1165,1171 ****
        RESTORE_NUM_STACK # num_stack zurck
        # e-16n = uexp-LF_exp_mid-16n als Integer bilden:
        {var reg6 uintL sub = LF_exp_mid + intDsize*(uintL)len;
!        var reg7 object shiftcount = L2_to_I( (uexp<sub ? -1L : 0), uexp-sub);
         # (ASH Vorzeichen*Mantisse (- e 16n)) durchfhren:
         return I_I_ash_I(popSTACK(),shiftcount);
      }}}
--- 1165,1171 ----
        RESTORE_NUM_STACK # num_stack zurck
        # e-16n = uexp-LF_exp_mid-16n als Integer bilden:
        {var reg6 uintL sub = LF_exp_mid + intDsize*(uintL)len;
!        var reg7 object shiftcount = UL_UL_minus_I(uexp,sub);
         # (ASH Vorzeichen*Mantisse (- e 16n)) durchfhren:
         return I_I_ash_I(popSTACK(),shiftcount);
      }}}
diff -r -c3 clisp-1993-11-08/src/lisparit.d clisp/src/lisparit.d
*** clisp-1993-11-08/src/lisparit.d	Fri Oct 15 12:11:45 1993
--- clisp/src/lisparit.d	Sun Nov 14 23:53:07 1993
***************
*** 1,5 ****
  # Arithmetik fr CLISP
! # Bruno Haible 15.10.1993
  
  #define LISPARIT      # im folgenden nicht nur die Macros, auch die Funktionen
  
--- 1,5 ----
  # Arithmetik fr CLISP
! # Bruno Haible 14.11.1993
  
  #define LISPARIT      # im folgenden nicht nur die Macros, auch die Funktionen
  
***************
*** 1947,1955 ****
--- 1947,1961 ----
        # encode_FF(0,1,bit(FF_mant_len), O(FF_one)=); # 1.0F0
        # encode_FF(-1,1,bit(FF_mant_len), O(FF_minusone)=); # -1.0F0
        #endif
+       #ifdef intQsize
+       O(DF_zero) = allocate_dfloat(0); # 0.0D0
+       # encode_DF(0,1,bit(DF_mant_len), O(DF_one)=); # 1.0D0
+       # encode_DF(-1,1,bit(DF_mant_len), O(DF_minusone)=); # -1.0D0
+       #else
        O(DF_zero) = allocate_dfloat(0,0); # 0.0D0
        # encode_DF(0,1,bit(DF_mant_len-32),0, O(DF_one)=); # 1.0D0
        # encode_DF(-1,1,bit(DF_mant_len-32),0, O(DF_minusone)=); # -1.0D0
+       #endif
        # variable Long-Floats:
        encode_LF(0,2,&pi_mantisse[0],2048/intDsize, O(LF_pi)=); # pi auf 2048 Bits
        encode_LF(0,0,&ln2_mantisse[0],64/intDsize, O(LF_ln2)=); # ln(2) auf 64 Bits
***************
*** 1978,1990 ****
        {var reg1 object obj; encode_FF(-1,FF_exp_high-FF_exp_mid,bit(FF_mant_len+1)-1, obj=);
         define_constant(S(most_negative_single_float),obj); }
        # MOST/LEAST-POSITIVE/NEGATIVE-DOUBLE-FLOAT:
!       {var reg1 object obj; encode_DF(0,DF_exp_high-DF_exp_mid,bit(DF_mant_len-32+1)-1,bitm(32)-1, obj=);
         define_constant(S(most_positive_double_float),obj); }
!       {var reg1 object obj; encode_DF(0,DF_exp_low-DF_exp_mid,bit(DF_mant_len-32),0, obj=);
         define_constant(S(least_positive_double_float),obj); }
!       {var reg1 object obj; encode_DF(-1,DF_exp_low-DF_exp_mid,bit(DF_mant_len-32),0, obj=);
         define_constant(S(least_negative_double_float),obj); }
!       {var reg1 object obj; encode_DF(-1,DF_exp_high-DF_exp_mid,bit(DF_mant_len-32+1)-1,bitm(32)-1, obj=);
         define_constant(S(most_negative_double_float),obj); }
        # Bei Floats mit d Bits (incl. Hiddem Bit, also d = ?F_mant_len+1)
        # ist ...-FLOAT-EPSILON = 2^-d*(1+2^(1-d))
--- 1984,2016 ----
        {var reg1 object obj; encode_FF(-1,FF_exp_high-FF_exp_mid,bit(FF_mant_len+1)-1, obj=);
         define_constant(S(most_negative_single_float),obj); }
        # MOST/LEAST-POSITIVE/NEGATIVE-DOUBLE-FLOAT:
!       {var reg1 object obj;
!        #ifdef intQsize
!        encode_DF(0,DF_exp_high-DF_exp_mid,bit(DF_mant_len+1)-1, obj=);
!        #else
!        encode_DF(0,DF_exp_high-DF_exp_mid,bit(DF_mant_len-32+1)-1,bitm(32)-1, obj=);
!        #endif
         define_constant(S(most_positive_double_float),obj); }
!       {var reg1 object obj;
!        #ifdef intQsize
!        encode_DF(0,DF_exp_low-DF_exp_mid,bit(DF_mant_len), obj=);
!        #else
!        encode_DF(0,DF_exp_low-DF_exp_mid,bit(DF_mant_len-32),0, obj=);
!        #endif
         define_constant(S(least_positive_double_float),obj); }
!       {var reg1 object obj;
!        #ifdef intQsize
!        encode_DF(-1,DF_exp_low-DF_exp_mid,bit(DF_mant_len), obj=);
!        #else
!        encode_DF(-1,DF_exp_low-DF_exp_mid,bit(DF_mant_len-32),0, obj=);
!        #endif
         define_constant(S(least_negative_double_float),obj); }
!       {var reg1 object obj;
!        #ifdef intQsize
!        encode_DF(-1,DF_exp_high-DF_exp_mid,bit(DF_mant_len+1)-1, obj=);
!        #else
!        encode_DF(-1,DF_exp_high-DF_exp_mid,bit(DF_mant_len-32+1)-1,bitm(32)-1, obj=);
!        #endif
         define_constant(S(most_negative_double_float),obj); }
        # Bei Floats mit d Bits (incl. Hiddem Bit, also d = ?F_mant_len+1)
        # ist ...-FLOAT-EPSILON = 2^-d*(1+2^(1-d))
***************
*** 1995,2003 ****
         define_constant(S(single_float_epsilon),obj); }
        {var reg1 object obj; encode_FF(0,-FF_mant_len-1,bit(FF_mant_len)+1, obj=);
         define_constant(S(single_float_negative_epsilon),obj); }
!       {var reg1 object obj; encode_DF(0,-DF_mant_len,bit(DF_mant_len-32),1, obj=);
         define_constant(S(double_float_epsilon),obj); }
!       {var reg1 object obj; encode_DF(0,-DF_mant_len-1,bit(DF_mant_len-32),1, obj=);
         define_constant(S(double_float_negative_epsilon),obj); }
        # weitere Variablen:
        define_variable(S(default_float_format),S(single_float)); # *DEFAULT-FLOAT-FORMAT* := 'SINGLE-FLOAT
--- 2021,2039 ----
         define_constant(S(single_float_epsilon),obj); }
        {var reg1 object obj; encode_FF(0,-FF_mant_len-1,bit(FF_mant_len)+1, obj=);
         define_constant(S(single_float_negative_epsilon),obj); }
!       {var reg1 object obj;
!        #ifdef intQsize
!        encode_DF(0,-DF_mant_len,bit(DF_mant_len)+1, obj=);
!        #else
!        encode_DF(0,-DF_mant_len,bit(DF_mant_len-32),1, obj=);
!        #endif
         define_constant(S(double_float_epsilon),obj); }
!       {var reg1 object obj;
!        #ifdef intQsize
!        encode_DF(0,-DF_mant_len-1,bit(DF_mant_len)+1, obj=);
!        #else
!        encode_DF(0,-DF_mant_len-1,bit(DF_mant_len-32),1, obj=);
!        #endif
         define_constant(S(double_float_negative_epsilon),obj); }
        # weitere Variablen:
        define_variable(S(default_float_format),S(single_float)); # *DEFAULT-FLOAT-FORMAT* := 'SINGLE-FLOAT
diff -r -c3 clisp-1993-11-08/src/lispbibl.d clisp/src/lispbibl.d
*** clisp-1993-11-08/src/lispbibl.d	Sun Nov  7 22:59:23 1993
--- clisp/src/lispbibl.d	Sun Nov 28 00:51:40 1993
***************
*** 1,5 ****
  # Haupt-Include-File fr CLISP
! # Bruno Haible 7.11.1993
  
  
  # Implementation ist auf folgende Rechner, Betriebssysteme und C-Compiler
--- 1,5 ----
  # Haupt-Include-File fr CLISP
! # Bruno Haible 13.11.1993
  
  
  # Implementation ist auf folgende Rechner, Betriebssysteme und C-Compiler
***************
*** 956,962 ****
      # verkraftet dynamisch allozierte Arrays im Maschinenstack
      # { var reg7 uintL my_array[n]; ... }
      #define DYNAMIC_ARRAY(arrayvar,arrayeltype,arraysize)  \
!       arrayeltype arrayvar[arraysize]
      #define FREE_DYNAMIC_ARRAY(arrayvar)
    #elif defined(UNIX) && (defined(HAVE_ALLOCA_H) || defined(_AIX) || !defined(NO_ALLOCA))
      # Platz im Maschinenstack reservieren.
--- 956,962 ----
      # verkraftet dynamisch allozierte Arrays im Maschinenstack
      # { var reg7 uintL my_array[n]; ... }
      #define DYNAMIC_ARRAY(arrayvar,arrayeltype,arraysize)  \
!       arrayeltype arrayvar[(arraysize)+1]
      #define FREE_DYNAMIC_ARRAY(arrayvar)
    #elif defined(UNIX) && (defined(HAVE_ALLOCA_H) || defined(_AIX) || !defined(NO_ALLOCA))
      # Platz im Maschinenstack reservieren.
***************
*** 1065,1071 ****
  # nur n Bits hat.
  
  # Ab hier bedeuten 'uintX' und 'sintX' unsigned bzw. signed integer -
! # Typen der Wortbreite X (X=B,W,L,L2).
    #define intBsize 8
    #ifdef ANSI
      typedef signed_int_with_n_bits(intBsize)    sintB;
--- 1065,1071 ----
  # nur n Bits hat.
  
  # Ab hier bedeuten 'uintX' und 'sintX' unsigned bzw. signed integer -
! # Typen der Wortbreite X (X=B,W,L,Q).
    #define intBsize 8
    #ifdef ANSI
      typedef signed_int_with_n_bits(intBsize)    sintB;
***************
*** 1092,1105 ****
    #endif
    #if defined(DECALPHA)
      # Maschine hat echte 64-Bit-Zahlen in Hardware.
!     #define intL2size 64
      #ifdef ANSI
!       typedef signed_int_with_n_bits(intL2size)    sintL2;
!       typedef unsigned_int_with_n_bits(intL2size)  uintL2;
      #else
!       typedef sint/**/intL2size  sintL2;
!       typedef uint/**/intL2size  uintL2;
      #endif
    #else
      # Emuliere 64-Bit-Zahlen mit Hilfe von zwei 32-Bit-Zahlen.
      typedef struct { sintL hi; uintL lo; } sintL2; # signed integer mit 64 Bit
--- 1092,1107 ----
    #endif
    #if defined(DECALPHA)
      # Maschine hat echte 64-Bit-Zahlen in Hardware.
!     #define intQsize 64
      #ifdef ANSI
!       typedef signed_int_with_n_bits(intQsize)    sintQ;
!       typedef unsigned_int_with_n_bits(intQsize)  uintQ;
      #else
!       typedef sint/**/intQsize  sintQ;
!       typedef uint/**/intQsize  uintQ;
      #endif
+     typedef sintQ  sintL2;
+     typedef uintQ  uintL2;
    #else
      # Emuliere 64-Bit-Zahlen mit Hilfe von zwei 32-Bit-Zahlen.
      typedef struct { sintL hi; uintL lo; } sintL2; # signed integer mit 64 Bit
***************
*** 3752,3757 ****
--- 3754,3774 ----
      #endif
    #endif
  
+ #ifdef intQsize
+ # Wert eines Fixnum, obj sollte eine Variable sein:
+ # fixnum_to_Q(obj)
+ # Ergebnis ist >= - 2^oint_data_len, < 2^oint_data_len.
+   #if (sign_bit_o == oint_data_len+oint_data_shift)
+     #define fixnum_to_Q(obj)  \
+       (((sintQ)as_oint(obj) << (intQsize-1-sign_bit_o)) >> (intQsize-1-sign_bit_o+oint_data_shift))
+   #else
+     #define fixnum_to_Q(obj)  \
+       ( ((((sintQ)as_oint(obj) >> sign_bit_o) << (intQsize-1)) >> (intQsize-1-oint_data_len)) \
+        |((uintQ)((as_oint(obj) & (wbitm(oint_data_len+oint_data_shift)-1)) >> oint_data_shift)) \
+       )
+   #endif
+ #endif
+ 
  # Zu einem nichtnegativen Fixnum eine Konstante addieren, vorausgesetzt,
  # das Ergebnis ist wieder ein nichtnegatives Fixnum:
  # fixnum_inc(obj,delta)
***************
*** 3765,3770 ****
--- 3782,3788 ----
    #define posfixnum(x)  fixnum_inc(Fixnum_0,x)
  
  # negfixnum(x) ist ein Fixnum mit Wert x<0.
+ # (Vorsicht, wenn x unsigned ist!)
    #define negfixnum(x)  fixnum_inc(fixnum_inc(Fixnum_minus1,1),x)
  
  # sfixnum(x) ist ein Fixnum mit Wert x,
***************
*** 3819,3829 ****
  
  # Double-Floats
  typedef # 64-Bit-Float im IEEE-Format:
!         # Sign/Exponent/MantisseHigh und MantisseLow
!         #if BIG_ENDIAN_P
!           struct {uint32 semhi,mlo;}
          #else
!           struct {uint32 mlo,semhi;}
          #endif
          dfloat;
  typedef union { dfloat explicit;       # Wert, explizit
--- 3837,3852 ----
  
  # Double-Floats
  typedef # 64-Bit-Float im IEEE-Format:
!         #ifdef intQsize
!           # Sign/Exponent/Mantisse
!           uint64
          #else
!           # Sign/Exponent/MantisseHigh und MantisseLow
!           #if BIG_ENDIAN_P
!             struct {uint32 semhi,mlo;}
!           #else
!             struct {uint32 mlo,semhi;}
!           #endif
          #endif
          dfloat;
  typedef union { dfloat explicit;       # Wert, explizit
***************
*** 5761,5771 ****
--- 5784,5802 ----
  # wird verwendet von LISPARIT
  
  # UP, beschafft Double-Float
+ #ifdef intQsize
+ # allocate_dfloat(value)
+ # > dfloat value: Zahlwert (Bit 63 = Vorzeichen)
+ # < ergebnis: neues Double-Float (LISP-Objekt)
+ # kann GC auslsen
+   extern object allocate_dfloat (dfloat value);
+ #else
  # allocate_dfloat(semhi,mlo)
  # > semhi,mlo: Zahlwert (Bit 31 von semhi = Vorzeichen)
  # < ergebnis: neues Double-Float (LISP-Objekt)
  # kann GC auslsen
    extern object allocate_dfloat (uint32 semhi, uint32 mlo);
+ #endif
  # wird verwendet von LISPARIT
  
  # UP, beschafft Long-Float
***************
*** 8773,8785 ****
    extern object L2_to_I (sint32 wert_hi, uint32 wert_lo);
  # wird verwendet von MISC
  
  #ifdef WIDE_HARD
! # Wandelt Unsigned Double Longword in Integer >=0 um.
! # UL2_to_I(wert)
  # > wert: Wert des Integers, ein unsigned 64-Bit-Integer.
  # < ergebnis: Integer mit diesem Wert.
  # kann GC auslsen
!   extern object UL2_to_I (uint64 wert);
  # wird verwendet von MISC
  #endif
  
--- 8804,8826 ----
    extern object L2_to_I (sint32 wert_hi, uint32 wert_lo);
  # wird verwendet von MISC
  
+ #ifdef intQsize
+ # Wandelt Quadword in Integer um.
+ # Q_to_I(wert)
+ # > wert: Wert des Integers, ein signed 64-Bit-Integer.
+ # < ergebnis: Integer mit diesem Wert.
+ # kann GC auslsen
+   extern object Q_to_I (sint64 wert);
+ # wird verwendet von MISC
+ #endif
+ 
  #ifdef WIDE_HARD
! # Wandelt Unsigned Quadword in Integer >=0 um.
! # UQ_to_I(wert)
  # > wert: Wert des Integers, ein unsigned 64-Bit-Integer.
  # < ergebnis: Integer mit diesem Wert.
  # kann GC auslsen
!   extern object UQ_to_I (uint64 wert);
  # wird verwendet von MISC
  #endif
  
diff -r -c3 clisp-1993-11-08/src/machine.c clisp/src/machine.c
*** clisp-1993-11-08/src/machine.c	Tue Oct 26 01:39:39 1993
--- clisp/src/machine.c	Tue Nov  9 00:40:25 1993
***************
*** 417,430 ****
        if (differences1==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr2,typestr1);                 \
        else                                                                                             \
!       if (differences1 == ~0)                                                                          \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr2,typestr1);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr2,typestr1,differences1); \
        if (differences2==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr1,typestr2);                 \
        else                                                                                             \
!       if (differences2 == ~0)                                                                          \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr1,typestr2);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr1,typestr2,differences2); \
--- 417,430 ----
        if (differences1==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr2,typestr1);                 \
        else                                                                                             \
!       if (differences1 == ~(ulong)0)                                                                   \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr2,typestr1);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr2,typestr1,differences1); \
        if (differences2==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr1,typestr2);                 \
        else                                                                                             \
!       if (differences2 == ~(ulong)0)                                                                   \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr1,typestr2);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr1,typestr2,differences2); \
diff -r -c3 clisp-1993-11-08/src/machine.d clisp/src/machine.d
*** clisp-1993-11-08/src/machine.d	Tue Oct 26 01:39:38 1993
--- clisp/src/machine.d	Tue Nov  9 00:40:24 1993
***************
*** 416,429 ****
        if (differences1==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr2,typestr1);                 \
        else                                                                                             \
!       if (differences1 == ~0)                                                                          \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr2,typestr1);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr2,typestr1,differences1); \
        if (differences2==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr1,typestr2);                 \
        else                                                                                             \
!       if (differences2 == ~0)                                                                          \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr1,typestr2);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr1,typestr2,differences2); \
--- 416,429 ----
        if (differences1==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr2,typestr1);                 \
        else                                                                                             \
!       if (differences1 == ~(ulong)0)                                                                   \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr2,typestr1);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr2,typestr1,differences1); \
        if (differences2==0)                                                                             \
          printf("/* Casts from %s to %s is OK (does nothing). */\n",typestr1,typestr2);                 \
        else                                                                                             \
!       if (differences2 == ~(ulong)0)                                                                   \
          printf("#error \"Casts from %s to %s work in an unknown way!!\"\n",typestr1,typestr2);         \
        else                                                                                             \
          printf("#error \"Casts from %s to %s modify part 0x%8X of pointer!!\"\n",typestr1,typestr2,differences2); \
diff -r -c3 clisp-1993-11-08/src/makemake.in clisp/src/makemake.in
*** clisp-1993-11-08/src/makemake.in	Wed Nov  3 13:58:32 1993
--- clisp/src/makemake.in	Tue Nov  9 00:21:06 1993
***************
*** 512,519 ****
    XCFLAGS=$XCFLAGS' -Dunix'
  fi
  
! if [ $TSYS = i386 -a "$TSYSOS" = "sinix-z" ] ; then
    XCFLAGS=$XCFLAGS' -DSNI -DSVR4 -DUSL'
    LIBS=$LIBS' -lnsl -lsocket'
  fi
  
--- 512,523 ----
    XCFLAGS=$XCFLAGS' -Dunix'
  fi
  
! if [ $TSYS = i386 -a "$TSYSOS" = "sinix-z" ] ; then # SINIX-Z V5.41
    XCFLAGS=$XCFLAGS' -DSNI -DSVR4 -DUSL'
+   LIBS=$LIBS' -lnsl -lsocket'
+ fi
+ if [ $TSYS = i386 -a "$TSYSOS" = "unix_sv" ] ; then # Onsite SVR4.2
+   XCFLAGS=$XCFLAGS' -DUSL'
    LIBS=$LIBS' -lnsl -lsocket'
  fi
  
diff -r -c3 clisp-1993-11-08/src/misc.d clisp/src/misc.d
*** clisp-1993-11-08/src/misc.d	Tue Nov  2 00:41:42 1993
--- clisp/src/misc.d	Sat Nov 13 17:28:17 1993
***************
*** 1,5 ****
  # Diverse Funktionen fr CLISP
! # Bruno Haible 1.11.1993
  
  #include "lispbibl.c"
  #include "arilev0.c"  # fr high16, low16 in %%TIME,
--- 1,5 ----
  # Diverse Funktionen fr CLISP
! # Bruno Haible 13.11.1993
  
  #include "lispbibl.c"
  #include "arilev0.c"  # fr high16, low16 in %%TIME,
***************
*** 25,31 ****
      if (eq(arg,unbound))
        { value1 = O(version); mv_count=1; }
        else
!       { if (equal(arg,O(version)) || equal(arg,O(oldversion)))
            { value1 = NIL; mv_count=0; }
            else
            { fehler(
--- 25,31 ----
      if (eq(arg,unbound))
        { value1 = O(version); mv_count=1; }
        else
!       { if (equal(arg,O(version)))
            { value1 = NIL; mv_count=0; }
            else
            { fehler(
***************
*** 255,261 ****
  # (SYS::ADDRESS-OF object) liefert die Adresse von object
    { var reg1 object arg = popSTACK();
      #if defined(WIDE_HARD)
!       value1 = UL2_to_I(untype(arg));
      #elif defined(WIDE_SOFT)
        value1 = UL_to_I(untype(arg));
      #else
--- 255,261 ----
  # (SYS::ADDRESS-OF object) liefert die Adresse von object
    { var reg1 object arg = popSTACK();
      #if defined(WIDE_HARD)
!       value1 = UQ_to_I(untype(arg));
      #elif defined(WIDE_SOFT)
        value1 = UL_to_I(untype(arg));
      #else
***************
*** 471,482 ****
     #ifdef TIME_2
      { var reg1 internal_time* tp = &tm.runtime; # Run-Time
        # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
!      {var reg3 uintL run_time_hi;
!       var reg2 uintL run_time_lo;
!       mulu32(tp->tv_sec,ticks_per_second, run_time_hi=,run_time_lo=);
!       if ((run_time_lo += tp->tv_usec) < tp->tv_usec) { run_time_hi += 1; }
!       value1 = L2_to_I(run_time_hi,run_time_lo); mv_count=1;
!     }}
     #endif
    }
  
--- 471,488 ----
     #ifdef TIME_2
      { var reg1 internal_time* tp = &tm.runtime; # Run-Time
        # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
!       #ifdef intQsize
!       value1 = Q_to_I((uintQ)(tp->tv_sec) * ticks_per_second + (uintQ)(tp->tv_usec));
!       #else
!       {var reg3 uintL run_time_hi;
!        var reg2 uintL run_time_lo;
!        mulu32(tp->tv_sec,ticks_per_second, run_time_hi=,run_time_lo=);
!        if ((run_time_lo += tp->tv_usec) < tp->tv_usec) { run_time_hi += 1; }
!        value1 = L2_to_I(run_time_hi,run_time_lo);
!       }
!       #endif
!       mv_count=1;
!     }
     #endif
    }
  
***************
*** 490,501 ****
  #ifdef TIME_2
    { var reg1 internal_time* tp = get_real_time(); # Real-Time absolut
      # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
!    {var reg3 uintL real_time_hi;
!     var reg2 uintL real_time_lo;
!     mulu32(tp->tv_sec,ticks_per_second, real_time_hi=,real_time_lo=);
!     if ((real_time_lo += tp->tv_usec) < tp->tv_usec) { real_time_hi += 1; }
!     value1 = L2_to_I(real_time_hi,real_time_lo); mv_count=1;
!   }}
  #endif
  
  #ifdef SLEEP_1
--- 496,513 ----
  #ifdef TIME_2
    { var reg1 internal_time* tp = get_real_time(); # Real-Time absolut
      # in Mikrosekunden umwandeln: tp->tv_sec * ticks_per_second + tp->tv_usec
!     #ifdef intQsize
!     value1 = Q_to_I((uintQ)(tp->tv_sec) * ticks_per_second + (uintQ)(tp->tv_usec));
!     #else
!     {var reg3 uintL real_time_hi;
!      var reg2 uintL real_time_lo;
!      mulu32(tp->tv_sec,ticks_per_second, real_time_hi=,real_time_lo=);
!      if ((real_time_lo += tp->tv_usec) < tp->tv_usec) { real_time_hi += 1; }
!      value1 = L2_to_I(real_time_hi,real_time_lo);
!     }
!     #endif
!     mv_count=1;
!   }
  #endif
  
  #ifdef SLEEP_1
***************
*** 675,681 ****
      # tm.gcfreed = von der GC bisher wieder verfgbar gemachter Platz
      {var reg1 uintL used = used_space(); # momentan belegter Platz
       # beides addieren:
!      #ifdef intL2size
       tm.gcfreed += used;
       #else
       if ((tm.gcfreed.lo += used) < used) { tm.gcfreed.hi += 1; }
--- 687,693 ----
      # tm.gcfreed = von der GC bisher wieder verfgbar gemachter Platz
      {var reg1 uintL used = used_space(); # momentan belegter Platz
       # beides addieren:
!      #ifdef intQsize
       tm.gcfreed += used;
       #else
       if ((tm.gcfreed.lo += used) < used) { tm.gcfreed.hi += 1; }
***************
*** 686,692 ****
        #error "Funktion SYS::%%TIME anpassen!"
      #endif
      # In 24-Bit-Stcke zerhacken:
!     #ifdef intL2size
      pushSTACK(fixnum( (tm.gcfreed>>24) & (bit(24)-1) ));
      pushSTACK(fixnum( tm.gcfreed & (bit(24)-1) ));
      #else
--- 698,704 ----
        #error "Funktion SYS::%%TIME anpassen!"
      #endif
      # In 24-Bit-Stcke zerhacken:
!     #ifdef intQsize
      pushSTACK(fixnum( (tm.gcfreed>>24) & (bit(24)-1) ));
      pushSTACK(fixnum( tm.gcfreed & (bit(24)-1) ));
      #else
diff -r -c3 clisp-1993-11-08/src/package.d clisp/src/package.d
*** clisp-1993-11-08/src/package.d	Sun Oct 24 19:07:53 1993
--- clisp/src/package.d	Tue Nov  9 03:50:11 1993
***************
*** 1,5 ****
  # Package-Verwaltung fr CLISP
! # Bruno Haible 24.10.1992
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr Hashcode-Berechnung
--- 1,5 ----
  # Package-Verwaltung fr CLISP
! # Bruno Haible 8.11.1993
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr Hashcode-Berechnung
***************
*** 1815,1820 ****
--- 1815,1825 ----
  LISPFUNN(find_package,1) # (FIND-PACKAGE name), CLTL S. 183
    { var reg1 object name = test_stringsym_arg(popSTACK()); # Argument als String
      value1 = find_package(name); # Package suchen
+     mv_count=1;
+   }
+ 
+ LISPFUNN(pfind_package,1) # (SYSTEM::%FIND-PACKAGE name)
+   { value1 = test_package_arg(popSTACK()); # Argument als Package
      mv_count=1;
    }
  
diff -r -c3 clisp-1993-11-08/src/predtype.d clisp/src/predtype.d
*** clisp-1993-11-08/src/predtype.d	Sat Oct 16 12:19:34 1993
--- clisp/src/predtype.d	Sun Nov 14 19:12:06 1993
***************
*** 1,5 ****
  # Prdikate fr Gleichheit und Typtests, Typen, Klassen in CLISP
! # Bruno Haible 16.10.1993
  
  #include "lispbibl.c"
  
--- 1,5 ----
  # Prdikate fr Gleichheit und Typtests, Typen, Klassen in CLISP
! # Bruno Haible 14.11.1993
  
  #include "lispbibl.c"
  
***************
*** 59,67 ****
--- 59,71 ----
              #endif
                goto no;
            case_dfloat: # Double-Floats
+             #ifdef intQsize
+             if (TheDfloat(obj1)->float_value == TheDfloat(obj2)->float_value)
+             #else
              if ((TheDfloat(obj1)->float_value.semhi == TheDfloat(obj2)->float_value.semhi)
                  && (TheDfloat(obj1)->float_value.mlo == TheDfloat(obj2)->float_value.mlo)
                 )
+             #endif
                return TRUE;
                else
                goto no;
diff -r -c3 clisp-1993-11-08/src/sfloat.d clisp/src/sfloat.d
*** clisp-1993-11-08/src/sfloat.d	Tue Oct 19 12:03:53 1993
--- clisp/src/sfloat.d	Sun Nov 14 04:35:13 1993
***************
*** 434,439 ****
--- 434,440 ----
              # abrunden
              goto ab;
              else
+             # aufrunden
              goto auf;
          }
        auf:
***************
*** 592,599 ****
        SF_decode(x, { return Fixnum_0; }, sign=,exp=,mant=);
        exp = exp-(SF_mant_len+1);
        return I_I_ash_I( (sign==0
!                           ? fixnum_inc(Fixnum_0,mant) # mant als Fixnum >0
!                           : fixnum_inc(fixnum_inc(Fixnum_minus1,1),-mant) # -mant als Fixnum <0
                          ),
                          L_to_FN(exp)
                        );
--- 593,600 ----
        SF_decode(x, { return Fixnum_0; }, sign=,exp=,mant=);
        exp = exp-(SF_mant_len+1);
        return I_I_ash_I( (sign==0
!                           ? posfixnum(mant) # mant als Fixnum >0
!                           : negfixnum(-(oint)mant) # -mant als Fixnum <0
                          ),
                          L_to_FN(exp)
                        );
***************
*** 719,725 ****
          {var reg1 uint32 mant = posfixnum_to_L(STACK_1);
           if (mant >= bit(SF_mant_len+2))
             # 2^18 <= q < 2^19, schiebe um 2 Bits nach rechts
!            { var reg2 uint32 rounding_bits = mant & (bit(2)-1);
               lendiff = lendiff+1; # Exponent := n-m+1
               mant = mant >> 2;
               if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
--- 720,726 ----
          {var reg1 uint32 mant = posfixnum_to_L(STACK_1);
           if (mant >= bit(SF_mant_len+2))
             # 2^18 <= q < 2^19, schiebe um 2 Bits nach rechts
!            { var reg2 uintL rounding_bits = mant & (bit(2)-1);
               lendiff = lendiff+1; # Exponent := n-m+1
               mant = mant >> 2;
               if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
diff -r -c3 clisp-1993-11-08/src/socket.d clisp/src/socket.d
*** clisp-1993-11-08/src/socket.d	Wed Nov  3 14:06:07 1993
--- clisp/src/socket.d	Mon Nov 15 22:29:49 1993
***************
*** 139,145 ****
    #ifdef HAVE_ARPA_INET_H
      #include <arpa/inet.h> # declares inet_addr()
    #endif
!   extern unsigned long inet_addr (INET_ADDR_CONST char* host);
    #ifdef HAVE_NETINET_TCP_H
      #if defined(__386BSD__) || defined(__NetBSD__)
        #include <machine/endian.h> # needed for <netinet/tcp.h>
--- 139,145 ----
    #ifdef HAVE_ARPA_INET_H
      #include <arpa/inet.h> # declares inet_addr()
    #endif
!   extern unsigned int inet_addr (INET_ADDR_CONST char* host);
    #ifdef HAVE_NETINET_TCP_H
      #if defined(__386BSD__) || defined(__NetBSD__)
        #include <machine/endian.h> # needed for <netinet/tcp.h>
diff -r -c3 clisp-1993-11-08/src/spvw.d clisp/src/spvw.d
*** clisp-1993-11-08/src/spvw.d	Sun Oct 31 05:28:27 1993
--- clisp/src/spvw.d	Sat Nov 13 16:27:40 1993
***************
*** 1,5 ****
  # Speicherverwaltung fr CLISP
! # Bruno Haible 30.10.1993
  
  # Inhalt:
  # Zeitmessungsfunktionen
--- 1,5 ----
  # Speicherverwaltung fr CLISP
! # Bruno Haible 13.11.1993
  
  # Inhalt:
  # Zeitmessungsfunktionen
***************
*** 72,78 ****
    local uintL  gc_count = 0;      # Zhler fr GC-Aufrufe
    local uintL2 gc_space =         # Gre des von der GC insgesamt bisher
                                    # wiederbeschafften Platzes (64-Bit-Akku)
!     #ifdef intL2size
        0
      #else
        {0,0}
--- 72,78 ----
    local uintL  gc_count = 0;      # Zhler fr GC-Aufrufe
    local uintL2 gc_space =         # Gre des von der GC insgesamt bisher
                                    # wiederbeschafften Platzes (64-Bit-Akku)
!     #ifdef intQsize
        0
      #else
        {0,0}
***************
*** 1139,1146 ****
            });
        }
      #define exitmap()  \
!       if (!(bigblock_ptr == &bigblock[0]))
!         close_mapid(bigblock[0].mm_mapid);
    #endif
  
  #endif # MULTIMAP_MEMORY_VIA_FILE
--- 1139,1147 ----
            });
        }
      #define exitmap()  \
!       { if (!(bigblock_ptr == &bigblock[0])) \
!           close_mapid(bigblock[0].mm_mapid); \
!       }
    #endif
  
  #endif # MULTIMAP_MEMORY_VIA_FILE
***************
*** 3235,3241 ****
        { var reg1 uintL freed = gcstart_space - gcend_space; # von dieser GC
                                         # wiederbeschaffter Speicherplatz
          # dies zum 64-Bit-Akku gc_space addieren:
!         #ifdef intL2size
          gc_space += freed;
          #else
          gc_space.lo += freed;
--- 3236,3242 ----
        { var reg1 uintL freed = gcstart_space - gcend_space; # von dieser GC
                                         # wiederbeschaffter Speicherplatz
          # dies zum 64-Bit-Akku gc_space addieren:
!         #ifdef intQsize
          gc_space += freed;
          #else
          gc_space.lo += freed;
***************
*** 4308,4313 ****
--- 4309,4328 ----
    #endif
  
  # UP, beschafft Double-Float
+ #ifdef intQsize
+ # allocate_dfloat(value)
+ # > dfloat value: Zahlwert (Bit 63 = Vorzeichen)
+ # < ergebnis: neues Double-Float (LISP-Objekt)
+ # kann GC auslsen
+   global object allocate_dfloat (dfloat value);
+   global object allocate_dfloat(value)
+     var reg3 dfloat value;
+     { allocate(dfloat_type | ((sint64)value<0 ? bit(sign_bit_t) : 0) # Vorzeichenbit aus value
+                ,TRUE,size_dfloat(),Dfloat,ptr,
+                { ptr->float_value = value; }
+               )
+     }
+ #else
  # allocate_dfloat(semhi,mlo)
  # > semhi,mlo: Zahlwert (Bit 31 von semhi = Vorzeichen)
  # < ergebnis: neues Double-Float (LISP-Objekt)
***************
*** 4321,4326 ****
--- 4336,4342 ----
                 { ptr->float_value.semhi = semhi; ptr->float_value.mlo = mlo; }
                )
      }
+ #endif
  
  # UP, beschafft Long-Float
  # allocate_lfloat(len,expo,sign)
***************
*** 5908,5918 ****
            s(read_from_string)
            v(4, (kw(start),kw(end),kw(radix),kw(junk_allowed)) )
            s(parse_integer)
!           v(12, (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!                  kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(stream)) )
            s(write)
!           v(11, (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!                  kw(base),kw(array),kw(circle),kw(pretty),kw(closure)) )
            s(write_to_string)
            v(2, (kw(type),kw(identity)) )
            s(write_unreadable)
--- 5924,5935 ----
            s(read_from_string)
            v(4, (kw(start),kw(end),kw(radix),kw(junk_allowed)) )
            s(parse_integer)
!           v(13, (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!                  kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(readably),
!                  kw(stream)) )
            s(write)
!           v(12, (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!                  kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(readably)) )
            s(write_to_string)
            v(2, (kw(type),kw(identity)) )
            s(write_unreadable)
***************
*** 6215,6220 ****
--- 6232,6238 ----
          define_variable(S(print_circle),NIL);           # *PRINT-CIRCLE* := NIL
          define_variable(S(print_pretty),NIL);           # *PRINT-PRETTY* := NIL
          define_variable(S(print_closure),NIL);          # *PRINT-CLOSURE* := NIL
+         define_variable(S(print_readably),NIL);         # *PRINT-READABLY* := NIL
          define_variable(S(print_rpars),T);              # *PRINT-RPARS* := T
          define_variable(S(print_circle_table),unbound); # SYS::*PRINT-CIRCLE-TABLE*
          define_variable(S(prin_level),unbound);         # SYS::*PRIN-LEVEL*
diff -r -c3 clisp-1993-11-08/src/stream.d clisp/src/stream.d
*** clisp-1993-11-08/src/stream.d	Tue Nov  2 01:03:49 1993
--- clisp/src/stream.d	Sun Nov 14 04:27:41 1993
***************
*** 1,5 ****
  # Streams fr CLISP
! # Bruno Haible 1.11.1993
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr R_sign
--- 1,5 ----
  # Streams fr CLISP
! # Bruno Haible 13.11.1993
  
  #include "lispbibl.c"
  #include "arilev0.c" # fr R_sign
***************
*** 7912,7918 ****
              # ja -> Fixnum >=0 bilden:
              { var reg3 uintL wert = 0;
                until (count==0) { wert = (wert<<8) | *bitbufferptr++; count--; }
!               return fixnum_inc(Fixnum_0,wert);
              }
          }
          else
--- 7912,7918 ----
              # ja -> Fixnum >=0 bilden:
              { var reg3 uintL wert = 0;
                until (count==0) { wert = (wert<<8) | *bitbufferptr++; count--; }
!               return posfixnum(wert);
              }
          }
          else
***************
*** 7930,7936 ****
              # ja -> Fixnum <0 bilden:
              { var reg3 uintL wert = -1;
                until (count==0) { wert = (wert<<8) | *bitbufferptr++; count--; }
!               return fixnum_inc(fixnum_inc(Fixnum_minus1,1),wert);
              }
          }
        # Bignum bilden:
--- 7930,7936 ----
              # ja -> Fixnum <0 bilden:
              { var reg3 uintL wert = -1;
                until (count==0) { wert = (wert<<8) | *bitbufferptr++; count--; }
!               return negfixnum(wbitm(intLsize)+(oint)wert);
              }
          }
        # Bignum bilden:
diff -r -c3 clisp-1993-11-08/src/subr.d clisp/src/subr.d
*** clisp-1993-11-08/src/subr.d	Sun Oct 24 19:08:51 1993
--- clisp/src/subr.d	Wed Nov 10 13:39:26 1993
***************
*** 1,5 ****
  # Liste aller SUBRs
! # Bruno Haible 24.10.1993
  
  # Eine C-compilierte LISP-Funktion wird definiert durch eine Deklaration
  #   LISPFUN(name,req_anz,opt_anz,rest_flag,key_flag,key_anz,keywords)
--- 1,5 ----
  # Liste aller SUBRs
! # Bruno Haible 10.11.1993
  
  # Eine C-compilierte LISP-Funktion wird definiert durch eine Deklaration
  #   LISPFUN(name,req_anz,opt_anz,rest_flag,key_flag,key_anz,keywords)
***************
*** 363,378 ****
          (kw(preserve_whitespace),kw(start),kw(end)) )
  LISPFUN(parse_integer,1,0,norest,key,4,
          (kw(start),kw(end),kw(radix),kw(junk_allowed)) )
! LISPFUN(write,1,0,norest,key,12,
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(stream)) )
  LISPFUN(prin1,1,1,norest,nokey,0,NIL)
  LISPFUN(print,1,1,norest,nokey,0,NIL)
  LISPFUN(pprint,1,1,norest,nokey,0,NIL)
  LISPFUN(princ,1,1,norest,nokey,0,NIL)
! LISPFUN(write_to_string,1,0,norest,key,11,
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure)) )
  LISPFUNN(prin1_to_string,1)
  LISPFUNN(princ_to_string,1)
  LISPFUN(write_char,1,1,norest,nokey,0,NIL)
--- 363,379 ----
          (kw(preserve_whitespace),kw(start),kw(end)) )
  LISPFUN(parse_integer,1,0,norest,key,4,
          (kw(start),kw(end),kw(radix),kw(junk_allowed)) )
! LISPFUN(write,1,0,norest,key,13,
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(readably),
!          kw(stream)) )
  LISPFUN(prin1,1,1,norest,nokey,0,NIL)
  LISPFUN(print,1,1,norest,nokey,0,NIL)
  LISPFUN(pprint,1,1,norest,nokey,0,NIL)
  LISPFUN(princ,1,1,norest,nokey,0,NIL)
! LISPFUN(write_to_string,1,0,norest,key,12,
          (kw(case),kw(level),kw(length),kw(gensym),kw(escape),kw(radix),
!          kw(base),kw(array),kw(circle),kw(pretty),kw(closure),kw(readably)) )
  LISPFUNN(prin1_to_string,1)
  LISPFUNN(princ_to_string,1)
  LISPFUN(write_char,1,1,norest,nokey,0,NIL)
***************
*** 517,522 ****
--- 518,524 ----
  LISPFUNN(use_package_aux,1)
  LISPFUNN(make_symbol,1)
  LISPFUNN(find_package,1)
+ LISPFUNN(pfind_package,1)
  LISPFUNN(package_name,1)
  LISPFUNN(package_nicknames,1)
  LISPFUN(rename_package,2,1,norest,nokey,0,NIL)
diff -r -c3 clisp-1993-11-08/src/user2.lsp clisp/src/user2.lsp
*** clisp-1993-11-08/src/user2.lsp	Wed Oct 27 14:48:18 1993
--- clisp/src/user2.lsp	Wed Nov 10 14:32:29 1993
***************
*** 195,213 ****
                          #+ENGLISH "is uninterned"
              ) )
              (let ((accessible-packs nil))
!               (let ((normal-printout ; externe Reprsentation ohne Package-Marker
!                       (if home
!                         (let ((*package* home)) (prin1-to-string obj))
!                         (let ((*print-gensym* nil)) (prin1-to-string obj))
!                    )) )
!                 (dolist (pack (list-all-packages))
!                   (when ; obj in pack accessible?
!                         (string=
!                           (let ((*package* pack)) (prin1-to-string obj))
!                           normal-printout
!                         )
!                     (push pack accessible-packs)
!               ) ) )
                (when accessible-packs
                  (format s #+DEUTSCH " und ist in ~:[der Package~;den Packages~] ~{~A~^, ~} accessible"
                            #+ENGLISH " and is accessible in the package~:[~;s~] ~{~A~^, ~}"
--- 195,215 ----
                          #+ENGLISH "is uninterned"
              ) )
              (let ((accessible-packs nil))
!               (let ((*print-escape* t)
!                     (*print-readably* nil))
!                 (let ((normal-printout ; externe Reprsentation ohne Package-Marker
!                         (if home
!                           (let ((*package* home)) (prin1-to-string obj))
!                           (let ((*print-gensym* nil)) (prin1-to-string obj))
!                      )) )
!                   (dolist (pack (list-all-packages))
!                     (when ; obj in pack accessible?
!                           (string=
!                             (let ((*package* pack)) (prin1-to-string obj))
!                             normal-printout
!                           )
!                       (push pack accessible-packs)
!               ) ) ) )
                (when accessible-packs
                  (format s #+DEUTSCH " und ist in ~:[der Package~;den Packages~] ~{~A~^, ~} accessible"
                            #+ENGLISH " and is accessible in the package~:[~;s~] ~{~A~^, ~}"
diff -r -c3 clisp-1993-11-08/unix/PLATFORMS clisp/unix/PLATFORMS
*** clisp-1993-11-08/unix/PLATFORMS	Thu Nov  4 19:18:03 1993
--- clisp/unix/PLATFORMS	Tue Nov  9 00:18:43 1993
***************
*** 89,95 ****
  20.3.1993 (UHC_2)       1182 s
  
  PC 486/33, 16 MB RAM  SINIX-Z V5.41  Manfred Weichel
! 29.7.1993 (ggc245)       383 s       <manfred.weichel@mchp.sni.de>
  
  PC                    386BSD 0.1     Charles Hannum
  26.3.1993                            <mycroft@gnu.ai.mit.edu>
--- 89,95 ----
  20.3.1993 (UHC_2)       1182 s
  
  PC 486/33, 16 MB RAM  SINIX-Z V5.41  Manfred Weichel
! 29.7.1993 (gcc245)       383 s       <manfred.weichel@mchp.sni.de>
  
  PC                    386BSD 0.1     Charles Hannum
  26.3.1993                            <mycroft@gnu.ai.mit.edu>
***************
*** 107,113 ****
  29.10.1993               177 s       <haible@ma2s2.mathematik.uni-karlsruhe.de>
  
  PC 486/50, 16 MB RAM  Onsite SysV R 4.2   Sebastian Feldmann
! 30.10.1993               429 s            <snfeldma@teebox.franken.de>
  
  
  When you install CLISP on a machine not mentioned here, please send us a short
--- 107,115 ----
  29.10.1993               177 s       <haible@ma2s2.mathematik.uni-karlsruhe.de>
  
  PC 486/50, 16 MB RAM  Onsite SysV R 4.2   Sebastian Feldmann
! 30.10.1993 (cc)          429 s            <snfeldma@teebox.franken.de>
! 7.11.1993 (gcc233)       348 s
! 7.11.1993 (gcc245)       345 s
  
  
  When you install CLISP on a machine not mentioned here, please send us a short
