- Moved utility functions from the "runes" package to the "cxml" package to

avoid name conflicts with functions from "glisp" of the same name.
- Renamed defsubst to definline for the same reason.

(This is a commit to the cxml repository, not the main closure repository.
If you don't want cxml commit messages on the closure list, please complain
to me and I'll change it.)

characters.lisp

@@ -24,35 +24,35 @@
 
 (in-package :runes)
 
-(deftype rune () 'base-char)
+(deftype rune () 'character)
-(deftype rod () 'base-string)
+(deftype rod () '(vector character))
-(deftype simple-rod () 'simple-string)
+(deftype simple-rod () '(simple-array character))
 
-(defsubst rune (rod index)
+(definline rune (rod index)
   (char rod index))
 
 (defun (setf rune) (new rod index)
   (setf (char rod index) new))
 
-(defsubst %rune (rod index)
+(definline %rune (rod index)
   (aref (the simple-string rod) (the fixnum index)))
 
-(defsubst (setf %rune) (new rod index)
+(definline (setf %rune) (new rod index)
   (setf (aref (the simple-string rod) (the fixnum index)) new))
 
 (defun rod-capitalize (rod)
   (string-upcase rod))
 
-(defsubst code-rune (x) (code-char x))
+(definline code-rune (x) (code-char x))
-(defsubst rune-code (x) (char-code x))
+(definline rune-code (x) (char-code x))
 
-(defsubst rune= (x y) 
+(definline rune= (x y) 
   (char= x y))
 
 (defun rune-downcase (rune)
   (char-downcase rune))
 
-(defsubst rune-upcase (rune)
+(definline rune-upcase (rune)
   (char-upcase rune))
 
 (defun rune-upper-case-letter-p (rune)
@@ -70,13 +70,13 @@
 (defun rod-upcase (rod)
   (string-upcase rod))
 
-(defsubst white-space-rune-p (char)
+(definline white-space-rune-p (char)
   (or (char= char #\tab)
       (char= char #.(code-char 10))     ;Linefeed
       (char= char #.(code-char 13))     ;Carriage Return
       (char= char #\space)))
 
-(defsubst digit-rune-p (char &optional (radix 10))
+(definline digit-rune-p (char &optional (radix 10))
   (digit-char-p char radix))
 
 (defun rod (x)
@@ -100,7 +100,7 @@
 (defun rod-equal (x y)
   (string-equal x y))
 
-(defsubst make-rod (size)
+(definline make-rod (size)
   (make-string size))
 
 (defun char-rune (char)
@@ -134,9 +134,6 @@
 (defun rodp (object)
   (stringp object))
 
-(defun really-rod-p (object)
-  (stringp object))
-
 (defun rod-subseq (source start &optional (end (length source)))
   (unless (stringp source)
     (error "~S is not of type ~S." source 'rod))

dep-acl.lisp

@@ -28,13 +28,13 @@
 ;; Unfortunately it is also incapable to declaim such functions inline.
 ;; So we revoke the DEFUN hack from dep-gcl here.
 
-(defmacro runes::defsubst (fun args &body body)
+(defmacro runes::definline (fun args &body body)
   (if (and (consp fun) (eq (car fun) 'setf))
       (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
                           (symbol-package (cadr fun)))))
         `(progn
            (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
-           (runes::defsubst ,fnam ,args .,body)))
+           (runes::definline ,fnam ,args .,body)))
     `(progn
        (defun ,fun ,args .,body)
        (define-compiler-macro ,fun (&rest .args.)

dep-acl5.lisp

@@ -40,13 +40,13 @@
 ;; Unfortunately it is also incapable to declaim such functions inline.
 ;; So we revoke the DEFUN hack from dep-gcl here.
 
-(defmacro runes::defsubst (fun args &body body)
+(defmacro runes::definline (fun args &body body)
   (if (and (consp fun) (eq (car fun) 'setf))
       (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
                           (symbol-package (cadr fun)))))
         `(progn
            (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
-           (runes::defsubst ,fnam ,args .,body)))
+           (runes::definline ,fnam ,args .,body)))
     (labels ((declp (x)
                (and (consp x) (eq (car x) 'declare))))
       `(progn

dep-clisp.lisp

@@ -30,30 +30,30 @@
   (if (fboundp 'cl::define-compiler-macro)
       (pushnew 'define-compiler-macro *features*)))
 
-(setq lisp:*load-paths* '(#P"./"))
+;;;(setq lisp:*load-paths* '(#P"./"))
+;;;
+;;;#+DEFINE-COMPILER-MACRO
+;;;(cl:define-compiler-macro ldb (bytespec value &whole whole)
+;;;  (let (pos size)
+;;;    (cond ((and (consp bytespec)
+;;;                (= (length bytespec) 3)
+;;;                (eq (car bytespec) 'byte)
+;;;                (constantp (setq size (second bytespec)))
+;;;                (constantp (setq pos (third bytespec))))
+;;;           `(logand ,(if (eql pos 0) value `(ash ,value (- ,pos)))
+;;;                    (1- (ash 1 ,size))))
+;;;          (t
+;;;           whole))))
+;;;
+;;;#-DEFINE-COMPILER-MACRO
+;;;(progn
+;;;  (export 'runes::define-compiler-macro :runes)
+;;;  (defmacro runes::define-compiler-macro (name args &body body)
+;;;    (declare (ignore args body))
+;;;    `(progn
+;;;       ',name)))
 
-#+DEFINE-COMPILER-MACRO
+(defmacro runes::definline (name args &body body)
-(cl:define-compiler-macro ldb (bytespec value &whole whole)
-  (let (pos size)
-    (cond ((and (consp bytespec)
-                (= (length bytespec) 3)
-                (eq (car bytespec) 'byte)
-                (constantp (setq size (second bytespec)))
-                (constantp (setq pos (third bytespec))))
-           `(logand ,(if (eql pos 0) value `(ash ,value (- ,pos)))
-                    (1- (ash 1 ,size))))
-          (t
-           whole))))
-
-#-DEFINE-COMPILER-MACRO
-(progn
-  (export 'runes::define-compiler-macro :runes)
-  (defmacro runes::define-compiler-macro (name args &body body)
-    (declare (ignore args body))
-    `(progn
-       ',name)))
-
-(defmacro runes::defsubst (name args &body body)
   `(progn
      (declaim (inline ,name))
      (defun ,name ,args .,body)))

dep-cmucl-dtc.lisp

@@ -24,7 +24,7 @@
 ;;; superseded by a newer version) or write to the Free Software
 ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-(defmacro runes::defsubst (name args &body body)
+(defmacro runes::definline (name args &body body)
   `(progn
      (declaim (inline ,name))
      (defun ,name ,args .,body)))

dep-cmucl.lisp

@@ -24,7 +24,7 @@
 ;;; superseded by a newer version) or write to the Free Software
 ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-(defmacro runes::defsubst (name args &body body)
+(defmacro runes::definline (name args &body body)
   `(progn
      (declaim (inline ,name))
      (defun ,name ,args .,body)))

dep-openmcl.lisp

@@ -5,7 +5,7 @@
 ;;;;
 ;;;; (c) copyright 1999 by Gilbert Baumann
 
-(defmacro runes::defsubst (fun args &body body)
+(defmacro runes::definline (fun args &body body)
   (if (consp fun)
       `(defun ,fun ,args
          ,@body)

dep-sbcl.lisp

@@ -24,7 +24,7 @@
 ;;; superseded by a newer version) or write to the Free Software
 ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-(defmacro runes::defsubst (name args &body body)
+(defmacro runes::definline (name args &body body)
   `(progn
      (declaim (inline ,name))
      (defun ,name ,args .,body)))

package.lisp

@@ -10,15 +10,8 @@
 
 (defpackage :runes
   (:use :cl)
-  (:export #:defsubst
+  (:export #:definline
 
-           ;; util.lisp :
-           #:compose
-           #:curry
-           #:rcurry
-           #:until
-           #:while
-    
            ;; runes.lisp
            #:rune
            #:rod
@@ -47,4 +40,29 @@
            #:rod-string
            #:string-rod
            #:rod-subseq
-           #:rod<))
+           #:rod<
+
+           ;; xstream.lisp
+           #:make-xstream
+           #:make-rod-xstream
+           #:close-xstream
+           #:xstream-p
+           #:read-rune
+           #:peek-rune
+           #:fread-rune
+           #:fpeek-rune
+           #:consume-rune
+           #:unread-rune
+           #:xstream-position
+           #:xstream-line-number
+           #:xstream-column-number
+           #:xstream-plist
+           #:xstream-encoding
+           #:set-to-full-speed
+           #:xstream-name))
+
+(defpackage :encoding
+  (:use :cl :runes)
+  (:export
+   #:find-encoding
+   #:decode-sequence))

runes.lisp

@@ -42,26 +42,26 @@
 (deftype rod () '(array rune (*)))
 (deftype simple-rod () '(simple-array rune (*)))
 
-(defsubst rune (rod index)
+(definline rune (rod index)
   (aref rod index))
 
 (defun (setf rune) (new rod index)
   (setf (aref rod index) new))
 
-(defsubst %rune (rod index)
+(definline %rune (rod index)
   (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index)))
 
-(defsubst (setf %rune) (new rod index)
+(definline (setf %rune) (new rod index)
   (setf (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index)) new))
 
 (defun rod-capitalize (rod)
   (warn "~S is not implemented." 'rod-capitalize)
   rod)
 
-(defsubst code-rune (x) x)
+(definline code-rune (x) x)
-(defsubst rune-code (x) x)
+(definline rune-code (x) x)
 
-(defsubst rune= (x y) 
+(definline rune= (x y) 
   (= x y))
 
 (defun rune-downcase (rune)
@@ -70,7 +70,7 @@
         ((<= #x00c0 rune #x00de) (+ rune #x20))
         (t rune)))
 
-(defsubst rune-upcase (rune)
+(definline rune-upcase (rune)
   (cond ((<= #x0061 rune #x007a) (- rune #x20))
         ((= rune #x00f7) rune)
         ((<= #x00e0 rune #x00fe) (- rune #x20))
@@ -89,21 +89,19 @@
 
 (defun rod-downcase (rod)
   ;; FIXME
-  (register-rod
+  (map '(simple-array (unsigned-byte 16) (*)) #'rune-downcase rod))
-   (map '(simple-array (unsigned-byte 16) (*)) #'rune-downcase rod)))
 
 (defun rod-upcase (rod)
   ;; FIXME
-  (register-rod
+  (map '(simple-array (unsigned-byte 16) (*)) #'rune-upcase rod))
-   (map '(simple-array (unsigned-byte 16) (*)) #'rune-upcase rod)))
 
-(defsubst white-space-rune-p (char)
+(definline white-space-rune-p (char)
   (or (= char 9)        ;TAB
       (= char 10)       ;Linefeed
       (= char 13)       ;Carriage Return
       (= char 32)))     ;Space
 
-(defsubst digit-rune-p (char &optional (radix 10))
+(definline digit-rune-p (char &optional (radix 10))
   (cond ((<= #.(char-code #\0) char #.(char-code #\9))
          (and (< (- char #.(char-code #\0)) radix)
               (- char #.(char-code #\0))))
@@ -115,11 +113,11 @@
               (- char #.(char-code #\a) -10))) ))
 
 (defun rod (x)
-  (cond ((stringp x)    (register-rod (map 'rod #'char-code x)))
+  (cond ((stringp x)    (map 'rod #'char-code x))
         ((symbolp x)    (rod (string x)))
         ((characterp x) (rod (string x)))
-        ((vectorp x)    (register-rod (coerce x 'rod)))
+        ((vectorp x)    (coerce x 'rod))
-        ((integerp x)   (register-rod (map 'rod #'identity (list x))))
+        ((integerp x)   (map 'rod #'identity (list x)))
         (t              (error "Cannot convert ~S to a ~S" x 'rod))))
 
 (defun runep (x)
@@ -143,19 +141,16 @@
          (unless (rune-equal (rune x i) (rune y i))
            (return nil)))))
 
-(defsubst make-rod (size)
+(definline make-rod (size)
-  (let ((res (make-array size :element-type 'rune)))
+  (make-array size :element-type 'rune))
-    (register-rod res)
-    res))
 
 (defun char-rune (char)
   (code-rune (char-code char)))
 
 (defun rune-char (rune &optional (default #\?))
-  #+CMU
+  (if (>= rune char-code-limit)
-  (if (< rune 256) (code-char rune) default)
+      default
-  #-CMU
+      (or (code-char rune) default)))
-  (or (code-char rune) default))
 
 (defun rod-string (rod &optional (default-char #\?))
   (map 'string (lambda (x) (rune-char x default-char)) rod))
@@ -178,10 +173,6 @@
 (defun rodp (object)
   (typep object 'rod))
 
-(defun really-rod-p (object)
-  (and (typep object 'rod)
-       (really-really-rod-p object)))
-
 (defun rod-subseq (source start &optional (end (length source)))
   (unless (rodp source)
     (error "~S is not of type ~S." source 'rod))
@@ -221,45 +212,6 @@
         (declare (type fixnum i))
         (setf (%rune res i) (aref source (the fixnum (+ i start))))))))
 
-;;; Support for telling ROD and arrays apart:
-
-#+CMU
-(progn
-  (defvar *rod-hash-table*
-    (make-array 5003 :initial-element nil)))
-
-(defun register-rod (rod)
-  #+CMU
-  (unless (really-really-rod-p rod)
-    (push (ext:make-weak-pointer rod)
-          (aref *rod-hash-table* (mod (cl::pointer-hash rod)
-                                      (length *rod-hash-table*)))))
-  rod)
-
-(defun really-really-rod-p (rod)
-  #+CMU
-  (find rod (aref *rod-hash-table* (mod (cl::pointer-hash rod)
-                                        (length *rod-hash-table*)))
-        :key #'ext:weak-pointer-value))
-
-#+CMU
-(progn
-  (defun rod-hash-table-rehash ()
-    (let* ((n 5003)
-           (new (make-array n :initial-element nil)))
-      (loop for bucket across *rod-hash-table* do
-            (loop for item in bucket do
-                  (let ((v (ext:weak-pointer-value item)))
-                    (when v
-                      (push item (aref new (mod (cl::pointer-hash v) n)))))))
-      (setf *rod-hash-table* new)))
-
-  (defun rod-hash-after-gc-hook ()
-    ;; hmm interesting question: should we rehash?
-    (rod-hash-table-rehash))
-
-  (pushnew 'rod-hash-after-gc-hook extensions:*after-gc-hooks*) )
-
 (defun rod< (rod1 rod2)
   (do ((i 0 (+ i 1)))
       (nil)

util.lisp

@@ -1,73 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*-
-;;; ---------------------------------------------------------------------------
-;;;     Title: Some common utilities for the Closure browser
-;;;   Created: 1997-12-27
-;;;    Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
-;;;   License: LLGPL (See file COPYING for details).
-;;; ---------------------------------------------------------------------------
-;;;  (c) copyright 1997-1999 by Gilbert Baumann
-
-;;; This code is free software; you can redistribute it and/or modify it
-;;; under the terms of the version 2.1 of the GNU Lesser General Public
-;;; License as published by the Free Software Foundation, as clarified
-;;; by the "Preamble to the Gnu Lesser General Public License" found in
-;;; the file COPYING.
-;;;
-;;; This code is distributed in the hope that it will be useful,
-;;; but without any warranty; without even the implied warranty of
-;;; merchantability or fitness for a particular purpose.  See the GNU
-;;; Lesser General Public License for more details.
-;;;
-;;; Version 2.1 of the GNU Lesser General Public License is in the file
-;;; COPYING that was distributed with this file.  If it is not present,
-;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
-;;; superseded by a newer version) or write to the Free Software
-;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-;; Changes
-;;
-;;  When        Who     What
-;; ----------------------------------------------------------------------------
-;;  1999-08-24  GB      = fixed MULTIPLE-VALUE-OR it now takes any number of
-;;                        subforms
-;;
-
-(in-package :runes)
-
-;;; --------------------------------------------------------------------------------
-;;;  Meta functions
-
-(defun curry (fun &rest args)
-  #'(lambda (&rest more)
-      (apply fun (append args more))))
-
-(defun rcurry (fun &rest args)
-  #'(lambda (&rest more)
-      (apply fun (append more args))))
-
-(defun compose (f g)
-  #'(lambda (&rest args)
-      (funcall f (apply g args))))
-
-;;; --------------------------------------------------------------------------------
-;;;  while and until
-
-(defmacro while (test &body body)
-  `(until (not ,test) ,@body))
-
-(defmacro until (test &body body)
-  `(do () (,test) ,@body))
-
-;; prime numbers
-
-(defun primep (n)
-  "Returns true, iff `n' is prime."
-  (and (> n 2)
-       (do ((i 2 (+ i 1)))
-           ((> (* i i) n) t)
-         (cond ((zerop (mod n i)) (return nil))))))
-
-(defun nearest-greater-prime (n)
-  "Returns the smallest prime number no less than `n'."
-  (cond ((primep n) n)
-        ((nearest-greater-prime (+ n 1)))))

xstream.lisp

@@ -65,7 +65,7 @@
 ;; XSTREAM/CLOSE os-stream
 ;;
 
-(eval-when (eval compile load)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defparameter *fast* '(optimize (speed 3) (safety 0)))
   ;;(defparameter *fast* '(optimize (speed 2) (safety 3)))
   )
@@ -154,6 +154,10 @@
   ;; `buffer-start'.
   )
 
+(defun print-xstream (self sink depth)
+  (declare (ignore depth))
+  (format sink "#<~S ~S>" (type-of self) (xstream-name self)))
+
 (defmacro read-rune (input)
   "Read a single rune off the xstream `input'. In case of end of file :EOF 
    is returned."
@@ -213,7 +217,7 @@
       nil)
     ,input))
 
-(defsubst unread-rune (rune input)
+(definline unread-rune (rune input)
   "Unread the last recently read rune; if there wasn't such a rune, you
    deserve to lose."
   (declare (ignore rune))
@@ -376,10 +380,20 @@
 ;;; controller implementations
 
 (defmethod read-octets (sequence (stream stream) start end)
-  (#+CLISP lisp:read-byte-sequence
+  (#+CLISP ext:read-byte-sequence
    #-CLISP read-sequence
            sequence stream :start start :end end))
 
+#+cmu
+(defmethod read-octets :around (sequence (stream stream) start end)
+  ;; CMUCL <= 19a on non-SunOS accidentally triggers EFAULT in read(2)
+  ;; if SEQUENCE has been write protected by GC.  Workaround: Touch all pages
+  ;; in SEQUENCE and make sure no GC happens between that and the read(2).
+  (ext::without-gcing
+   (loop for i from start below end
+         do (setf (elt sequence i) (elt sequence i)))
+   (call-next-method)))
+
 (defmethod read-octets (sequence (stream null) start end)
   (declare (ignore sequence start end))
   0)