Changeset 8627


Ignore:
Timestamp:
02/23/05 14:32:46 (16 years ago)
Author:
piso
Message:

WRITE-UTF8

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r8621 r8627  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.402 2005-02-21 18:26:52 piso Exp $
     4;;; $Id: jvm.lisp,v 1.403 2005-02-23 14:32:46 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    19171917         (write-u4 n stream))))
    19181918
     1919(defun write-ascii (string length stream)
     1920  (write-u2 length stream)
     1921  (dotimes (i length)
     1922    (sys:write-8-bits (char-code (schar string i)) stream)))
     1923
    19191924(defun write-utf8 (string stream)
    19201925  (declare (optimize speed))
    1921   (dotimes (i (length string))
    1922     (declare (type fixnum i))
    1923     (let ((c (schar string i)))
    1924       (if (eql c #\null)
    1925           (progn
    1926             (sys::write-8-bits #xC0 stream)
    1927             (sys::write-8-bits #x80 stream))
    1928           (sys::write-8-bits (char-int c) stream)))))
    1929 
    1930 (defun utf8-length (string)
    1931   (declare (optimize speed))
    1932   (let ((length (length string)))
     1926  (let ((length (length string))
     1927        (must-convert nil))
    19331928    (declare (type fixnum length))
    19341929    (dotimes (i length)
    19351930      (declare (type fixnum i))
    1936       (when (eql (schar string i) #\null)
    1937         (incf length)))
    1938     length))
     1931      (unless (< 0 (char-code (schar string i)) #x80)
     1932        (setf must-convert t)
     1933        (return)))
     1934    (if must-convert
     1935        (let ((octets (make-array (* length 2)
     1936                                  :element-type '(unsigned-byte 8)
     1937                                  :adjustable t
     1938                                  :fill-pointer 0)))
     1939          (dotimes (i length)
     1940            (declare (type fixnum i))
     1941            (let* ((c (schar string i))
     1942                   (n (char-code c)))
     1943              (cond ((zerop n)
     1944                     (vector-push-extend #xC0 octets)
     1945                     (vector-push-extend #x80 octets))
     1946                    ((< 0 n #x80)
     1947                     (vector-push-extend n octets))
     1948                    (t
     1949                     (let ((char-octets (char-to-utf8 c)))
     1950                       (dotimes (j (length char-octets))
     1951                         (vector-push-extend (svref char-octets j) octets)))))))
     1952          (write-u2 (length octets) stream)
     1953          (dotimes (i (length octets))
     1954            (sys:write-8-bits (aref octets i) stream)))
     1955        (write-ascii string length stream))))
    19391956
    19401957(defun write-constant-pool-entry (entry stream)
     
    19441961    (case tag
    19451962      (1 ; UTF8
    1946        (write-u2 (utf8-length (third entry)) stream)
    19471963       (write-utf8 (third entry) stream))
    19481964      (3 ; int
Note: See TracChangeset for help on using the changeset viewer.