OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- use trivial-gray-streams

Browse Source 
- replaced dep-* files, since most of them were identical
This commit is contained in:
dlichteblau
2005-11-26 21:48:15 +00:00
parent b5230358fa
commit 241b24ac25
15 changed files with 112 additions and 358 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
README.html
View File

@ -86,6 +86,10 @@
<a name="changes"/>
<h2>Recent Changes</h2>
<p class="nomargin"><tt>rel-2005-xx-yy</tt></p>
<ul class="nomargin">
<li>Use trivial-gray-streams.</li>
</ul>
<p class="nomargin"><tt>rel-2005-06-25</tt></p>
<ul class="nomargin">
<li>Port to OpenMCL (thanks to Rudi Schlatte).</li>

42
cxml.asd
View File

@ -5,10 +5,6 @@
(:use :asdf :cl))
(in-package :cxml-system)
;; XXX das sollte natuerlich erst beim laden stattfinden
#+cmu
(require :gray-streams)
(defclass closure-source-file (cl-source-file) ())
#+sbcl
@ -18,7 +14,7 @@
(let (#+sbcl (*compile-print* nil))
(call-next-method))))
#-(or rune-is-character rune-is-octet)
#-(or rune-is-character rune-is-integer)
(progn
(format t "~&;;; Checking for wide character support...")
(force-output)
@ -28,7 +24,7 @@
:rune-is-character))
(unless (and (< x char-code-limit) (code-char x))
(format t " no, reverting to octet strings.~%")
(return :rune-is-octet)))
(return :rune-is-integer)))
*features*))
#-rune-is-character
@ -37,38 +33,26 @@
#+rune-is-character
(format t "~&;;; Building cxml with CHARACTER RUNES~%")
(defsystem runes
(defsystem :cxml-runes
:default-component-class closure-source-file
:pathname (merge-pathnames
"runes/"
(make-pathname :name nil :type nil :defaults *load-truename*))
:components
((:file "package")
(:file dependent
:pathname
#+CLISP "dep-clisp"
#+(AND :CMU (NOT :PTHREAD)) "dep-cmucl"
#+sbcl "dep-sbcl"
#+(AND :CMU :PTHREAD) "dep-cmucl-dtc"
#+(and allegro-version>= (version>= 5.0)) "dep-acl5"
#+(and allegro-version>= (not (version>= 5.0))) "dep-acl"
#+openmcl "dep-openmcl"
#+lispworks "dep-lw"
#-(or sbcl CLISP CMU allegro openmcl lispworks)
#.(error "unsupported lisp implementation!")
:depends-on ("package"))
(:file "definline" :depends-on ("package"))
(:file runes
:pathname
#-rune-is-character "runes"
#+rune-is-character "characters"
:depends-on ("package" dependent))
(:file "syntax" :depends-on ("package" dependent runes))
:depends-on ("package" "definline"))
(:file "syntax" :depends-on ("package" "definline" runes))
(:file "encodings" :depends-on ("package"))
(:file "encodings-data" :depends-on ("package" "encodings"))
(:file "xstream"
:depends-on ("package" dependent "syntax" "encodings-data"))))
:depends-on ("package" "definline" "syntax" "encodings-data"))))
(asdf:defsystem :xml
(asdf:defsystem :cxml-xml
:default-component-class closure-source-file
:pathname (merge-pathnames
"xml/"
@ -86,9 +70,9 @@
(:file "recoder" :depends-on ("xml-parse"))
(:file "catalog" :depends-on ("xml-parse"))
(:file "sax-proxy" :depends-on ("xml-parse")))
:depends-on (:runes :puri))
:depends-on (:cxml-runes :puri :trivial-gray-streams))
(asdf:defsystem :dom
(asdf:defsystem :cxml-dom
:default-component-class closure-source-file
:pathname (merge-pathnames
"dom/"
@ -99,7 +83,7 @@
(:file "dom-builder" :depends-on ("dom-impl"))
(:file "unparse" :depends-on ("package"))
(:file "dom-sax" :depends-on ("package")))
:depends-on (:xml))
:depends-on (:cxml-xml))
(asdf:defsystem :cxml-test
:default-component-class closure-source-file
@ -107,6 +91,6 @@
"test/"
(make-pathname :name nil :type nil :defaults *load-truename*))
:components ((:file "domtest") (:file "xmlconf"))
:depends-on (:xml :dom))
:depends-on (:cxml-xml :cxml-dom))
(asdf:defsystem :cxml :components () :depends-on (:dom :cxml-test))
(asdf:defsystem :cxml :components () :depends-on (:cxml-dom :cxml-test))

7
doc/installation.html
View File

@ -88,11 +88,8 @@ $ cvs co cxml</pre>
implemented as an array of character codes. CXML will auto-detect
at compile-time which string representation to use. To override
the auto-detection, you can set one of the features
<tt>:rune-is-character</tt> and <tt>:rune-is-octet</tt> before
loading <tt>cxml.asd</tt>. (<tt>fixme</tt>: feature
<tt>:rune-is-octet</tt> is of course misnamed, since it uses 16bit
runes, not 8bit runes. It will probably be renamed
to <tt>:rune-is-integer</tt> at some point.)
<tt>:rune-is-character</tt> and <tt>:rune-is-integer</tt> before
loading <tt>cxml.asd</tt>.
</p>
-->

85
dom/dom-builder.lisp
View File

@ -1,25 +1,12 @@
;;; XXX this DOM builder knows too much about the specifics of the DOM
;;; implementation for my taste. While document creation is not specified
;;; by the DOM Level 1 spec, we shouldn't really be manually setting slots
;;; in other nodes IMHO.
;;;
;;; As a follow-up to that, the children list is created in the wrong order
;;; and then reversed. Is it really worth the improved speed to do this?
;;; Calling APPEND-NODE would be portable.
;;;
;;; In particular, that design choice has lead to other bugs, for example the
;;; PARENT slot has to be set manually, too. A DOM test finally showed
;;; that this had been forgotten for Text nodes and PIs.
;;;
;;; Opinions?
;;;
;;; -- David
;;; Now at least the children list isn't reversed anymore, because I changed
;;; the representation to be an extensible vector. Still its not clear to
;;; me whether the DOM Builder should be affected by such changes at all.
;;;
;;; -- David
;;;; dom-builder.lisp -- DOM-building SAX handler
;;;;
;;;; This file is part of the CXML parser, released under (L)LGPL.
;;;; See file COPYING for details.
;;;;
;;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;;; Author: Henrik Motakef <hmot@henrik-motakef.de>
;;;; Author: David Lichteblau <david@lichteblau.com>
;;;; Author: knowledgeTools Int. GmbH
(in-package :dom-impl)
@ -41,13 +28,16 @@
(push document (element-stack handler))))
(defmethod sax:end-document ((handler dom-builder))
(setf (slot-value (document handler) 'entities) xml::*entities*)
(setf (slot-value (document handler) 'dtd) (cxml::dtd cxml::*ctx*))
(let ((doctype (dom:doctype (document handler))))
(when doctype
(setf (slot-value (dom:entities doctype) 'read-only-p) t)
(setf (slot-value (dom:notations doctype) 'read-only-p) t)))
(document handler))
(defmethod sax:entity-resolver ((handler dom-builder) resolver)
(setf (slot-value (document handler) 'entity-resolver) resolver))
(defmethod sax:start-dtd ((handler dom-builder) name publicid systemid)
(declare (ignore publicid systemid))
(let* ((document (document handler))
@ -62,17 +52,36 @@
(setf (slot-value doctype 'dom-impl::owner) document
(slot-value document 'dom-impl::doc-type) doctype)))
(defmethod sax:start-element ((handler dom-builder) namespace-uri local-name qname attributes)
(defmethod sax:start-element
((handler dom-builder) namespace-uri local-name qname attributes)
(declare (ignore namespace-uri local-name))
(with-slots (document element-stack) handler
(let ((element (dom:create-element document qname))
(parent (car element-stack)))
(let ((element (make-instance 'element
:tag-name qname
:owner document))
(parent (car element-stack))
(anodes '()))
(dolist (attr attributes)
(dom:set-attribute element (xml::attribute-qname attr) (xml::attribute-value attr)))
(let ((anode
(dom:create-attribute document (sax:attribute-qname attr)))
(text
(dom:create-text-node document (sax:attribute-value attr))))
(setf (slot-value anode 'dom-impl::specified-p)
(sax:attribute-specified-p attr))
(dom:append-child anode text)
(push anode anodes)))
(setf (slot-value element 'dom-impl::parent) parent)
(fast-push element (slot-value parent 'dom-impl::children))
(setf (slot-value element 'dom-impl::attributes)
(make-instance 'attribute-node-map
:items anodes
:element-type :attribute
:element element
:owner document))
(push element element-stack))))
(defmethod sax:end-element ((handler dom-builder) namespace-uri local-name qname)
(declare (ignore namespace-uri local-name qname))
(pop (element-stack handler)))
(defmethod sax:characters ((handler dom-builder) data)
@ -121,13 +130,29 @@
(defmethod sax:unparsed-entity-declaration
((handler dom-builder) name public-id system-id notation-name)
(set-entity handler name public-id system-id notation-name))
(defmethod sax:external-entity-declaration
((handler dom-builder) kind name public-id system-id)
(ecase kind
(:general (set-entity handler name public-id system-id nil))
(:parameter)))
(defmethod sax:internal-entity-declaration
((handler dom-builder) kind name value)
(declare (ignore value))
(ecase kind
(:general (set-entity handler name nil nil nil))
(:parameter)))
(defun set-entity (handler name pid sid notation)
(dom:set-named-item (dom:entities (dom:doctype (document handler)))
(make-instance 'dom-impl::entity
:owner (document handler)
:name name
:public-id public-id
:system-id system-id
:notation-name notation-name)))
:public-id pid
:system-id sid
:notation-name notation)))
(defmethod sax:notation-declaration
((handler dom-builder) name public-id system-id)

40
runes/dep-acl5.lisp → runes/definline.lisp
View File

@ -1,11 +1,11 @@
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; Encoding: utf-8; -*-
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: ACL-5.0 dependent stuff + fixups
;;; Title: definline
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1998,1999 by Gilbert Baumann
;;; (c) copyright 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
@ -24,29 +24,33 @@
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Changes
;;; =======
(in-package :runes)
;;; When Who What
;;; ---------------------------------------------------------------------------
;;; 2002-01-04 GB spend BLOCK for DEFSUBST
;;; 1999-08-31 SES Stig Erik Sandø <stig@ii.uib.no>
;;;
;;; Changed #+allegro-v5.0 to
;;; #+(and allegro-version>= (version>= 5))
;;;
;; ACL is incapable to define compiler macros on (setf foo)
;; Unfortunately it is also incapable to declaim such functions inline.
;; So we revoke the DEFUN hack from dep-gcl here.
#-(or allegro openmcl)
(defmacro definline (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))
#+openmcl
(defmacro runes::definline (fun args &body body)
(if (consp fun)
`(defun ,fun ,args
,@body)
`(progn
(defun ,fun ,args .,body)
(define-compiler-macro ,fun (&rest .args.)
(cons '(lambda ,args .,body)
.args.)))))
#+allegro
(defmacro 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::definline ,fnam ,args .,body)))
(definline ,fnam ,args .,body)))
(labels ((declp (x)
(and (consp x) (eq (car x) 'declare))))
`(progn

42
runes/dep-acl.lisp
View File

@ -1,42 +0,0 @@
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*-
;;; ---------------------------------------------------------------------------
;;; Title: ACL-4.3 dependent stuff + fixups
;;; Created: 1999-05-25 22:33
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1998,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
;; ACL is incapable to define compiler macros on (setf foo)
;; Unfortunately it is also incapable to declaim such functions inline.
;; So we revoke the DEFUN hack from dep-gcl here.
(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::definline ,fnam ,args .,body)))
`(progn
(defun ,fun ,args .,body)
(define-compiler-macro ,fun (&rest .args.)
(cons '(lambda ,args .,body)
.args.)))))

59
runes/dep-clisp.lisp
View File

@ -1,59 +0,0 @@
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: CLISP dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 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
(in-package :CL-USER)
(eval-when (compile load eval)
(if (fboundp 'cl::define-compiler-macro)
(pushnew 'define-compiler-macro *features*)))
;;;(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)))
(defmacro runes::definline (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))

30
runes/dep-cmucl-dtc.lisp
View File

@ -1,30 +0,0 @@
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: CMUCL dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 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
(defmacro runes::definline (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))

30
runes/dep-cmucl.lisp
View File

@ -1,30 +0,0 @@
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: CMUCL dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 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
(defmacro runes::definline (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))

30
runes/dep-lw.lisp
View File

@ -1,30 +0,0 @@
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: LispWorks dependent stuff + fixups
;;; Created: 2005-01-28 09:43
;;; Author: Edi Weitz <edi@agharta.de> (Copied from dep-cmucl.lisp)
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 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
(defmacro runes::definline (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))

16
runes/dep-openmcl.lisp
View File

@ -1,16 +0,0 @@
;;;; dep-openmcl.lisp
;;;;
;;;; This file is part of the CXML parser, released under (L)LGPL.
;;;; See file COPYING for details.
;;;;
;;;; (c) copyright 1999 by Gilbert Baumann
(defmacro runes::definline (fun args &body body)
(if (consp fun)
`(defun ,fun ,args
,@body)
`(progn
(defun ,fun ,args .,body)
(define-compiler-macro ,fun (&rest .args.)
(cons '(lambda ,args .,body)
.args.)))))

30
runes/dep-sbcl.lisp
View File

@ -1,30 +0,0 @@
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: SBCL dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 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
(defmacro runes::definline (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))

12
xml/package.lisp
View File

@ -6,17 +6,7 @@
(in-package :cl-user)
(defpackage :cxml
(:use :cl :runes :encoding)
(:import-from #+sbcl :sb-gray
#+allegro :excl
#+cmu :ext
#+clisp :gray
#+openmcl :ccl
#+lispworks :stream
#-(or sbcl allegro cmu clisp openmcl lispworks) ...
#:fundamental-binary-input-stream
#-(or clisp openmcl) #:stream-read-sequence
stream-read-byte)
(:use :cl :runes :encoding :trivial-gray-streams)
(:export
;; xstreams
#:make-xstream

8
xml/xml-name-rune-p.lisp
View File

@ -11,7 +11,7 @@
(compile
nil
'(lambda ()
(let ((*max* #xD800))
(let ((.max. #xD800))
(labels
((name-start-rune-p (rune)
(or (letter-rune-p rune)
@ -207,7 +207,7 @@
(predicate-to-bv (p)
(let ((r (make-array *max* :element-type 'bit :initial-element 0)))
(let ((r (make-array .max. :element-type 'bit :initial-element 0)))
(dotimes (i #x10000 r)
(when (funcall p i)
(setf (aref r i) 1))))) )
@ -215,13 +215,13 @@
`(progn
(DEFINLINE NAME-RUNE-P (RUNE)
(SETF RUNE (RUNE-CODE RUNE))
(AND (<= 0 RUNE ,*max*)
(AND (<= 0 RUNE ,.max.)
(LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
(= 1 (SBIT ',(predicate-to-bv #'name-rune-p)
(THE FIXNUM RUNE))))))
(DEFINLINE NAME-START-RUNE-P (RUNE)
(SETF RUNE (RUNE-CODE RUNE))
(AND (<= 0 RUNE ,*MAX*)
(AND (<= 0 RUNE ,.MAX.)
(LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
(= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p)
(THE FIXNUM RUNE)))))))) ))))

35
xml/xml-parse.lisp
View File

@ -2608,7 +2608,7 @@
(if sax:*namespace-processing*
(p/element-ns input)
(p/element-no-ns input)))
(defun p/element-no-ns (input)
;; [39] element ::= EmptyElemTag | STag content ETag
(error "sorry, bitrot")
@ -2660,14 +2660,16 @@
(error "Expecting element, got ~S." cat)))))
(undeclare-namespaces ns-decls))
(validate-end-element *ctx* name)))
(defun perror (stream format-string &rest format-args)
(when (zstream-p stream)
(setf stream (car (zstream-input-stack stream))))
(error "Parse error at line ~D column ~D: ~A"
(xstream-line-number stream)
(xstream-column-number stream)
(apply #'format nil format-string format-args)))
(if stream
(error "Parse error at line ~D column ~D: ~?"
(xstream-line-number stream)
(xstream-column-number stream)
format-string format-args)
(apply #'error format-string format-args)))
(defun p/content (input)
;; [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
@ -2988,7 +2990,8 @@
;; XXX encoding is mis-handled by this kind of stream
(make-rod-xstream (string-rod string)))
(defclass octet-input-stream (fundamental-binary-input-stream)
(defclass octet-input-stream
(trivial-gray-stream fundamental-binary-input-stream)
((octets :initarg :octets)
(pos :initform 0)))
@ -3005,9 +3008,7 @@
(incf pos)))))
(defmethod stream-read-sequence
#-lispworks ((stream octet-input-stream) sequence
&optional (start 0) (end (length sequence)))
#+lispworks ((stream octet-input-stream) sequence start end)
((stream octet-input-stream) sequence start end &key &allow-other-keys)
(with-slots (octets pos) stream
(let* ((length (min (- end start) (- (length octets) pos)))
(end1 (+ start length))
@ -3024,20 +3025,6 @@
;;;;
#+allegro
(defmacro sp (&body body)
`(progn
(prof:with-profiling (:type :space) .,body)
(prof:show-flat-profile)))
#+allegro
(defmacro tm (&body body)
`(progn
(prof:with-profiling (:type :time) .,body)
(prof:show-flat-profile)))
;;;;
(defun zstream-push (new-xstream zstream)
(cond ((find-if (lambda (x)
(and (xstream-p x)