Changeset 12885


Ignore:
Timestamp:
08/09/10 15:16:05 (12 years ago)
Author:
ehuelsmann
Message:

Move byte-sequence writing routines to jvm-class-file.lisp.

Location:
branches/generic-class-file/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12884 r12885  
    786786
    787787
    788 
    789 
    790 (declaim (inline write-u1))
    791 (defun write-u1 (n stream)
    792   (declare (optimize speed))
    793   (declare (type (unsigned-byte 8) n))
    794   (declare (type stream stream))
    795   (write-8-bits n stream))
    796 
    797 (defknown write-u2 (t t) t)
    798 (defun write-u2 (n stream)
    799   (declare (optimize speed))
    800   (declare (type (unsigned-byte 16) n))
    801   (declare (type stream stream))
    802   (write-8-bits (logand (ash n -8) #xFF) stream)
    803   (write-8-bits (logand n #xFF) stream))
    804 
    805 (defknown write-u4 (integer stream) t)
    806 (defun write-u4 (n stream)
    807   (declare (optimize speed))
    808   (declare (type (unsigned-byte 32) n))
    809   (write-u2 (logand (ash n -16) #xFFFF) stream)
    810   (write-u2 (logand n #xFFFF) stream))
    811 
    812 (declaim (ftype (function (t t) t) write-s4))
    813 (defun write-s4 (n stream)
    814   (declare (optimize speed))
    815   (cond ((minusp n)
    816          (write-u4 (1+ (logxor (- n) #xFFFFFFFF)) stream))
    817         (t
    818          (write-u4 n stream))))
    819 
    820 (declaim (ftype (function (t t t) t) write-ascii))
    821 (defun write-ascii (string length stream)
    822   (declare (type string string))
    823   (declare (type (unsigned-byte 16) length))
    824   (declare (type stream stream))
    825   (write-u2 length stream)
    826   (dotimes (i length)
    827     (declare (type (unsigned-byte 16) i))
    828     (write-8-bits (char-code (char string i)) stream)))
    829 
    830 (declaim (ftype (function (t t) t) write-utf8))
    831 (defun write-utf8 (string stream)
    832   (declare (optimize speed))
    833   (declare (type string string))
    834   (declare (type stream stream))
    835   (let ((length (length string))
    836         (must-convert nil))
    837     (declare (type fixnum length))
    838     (dotimes (i length)
    839       (declare (type fixnum i))
    840       (unless (< 0 (char-code (char string i)) #x80)
    841         (setf must-convert t)
    842         (return)))
    843     (if must-convert
    844         (let ((octets (make-array (* length 2)
    845                                   :element-type '(unsigned-byte 8)
    846                                   :adjustable t
    847                                   :fill-pointer 0)))
    848           (declare (type (vector (unsigned-byte 8)) octets))
    849           (dotimes (i length)
    850             (declare (type fixnum i))
    851             (let* ((c (char string i))
    852                    (n (char-code c)))
    853               (cond ((zerop n)
    854                      (vector-push-extend #xC0 octets)
    855                      (vector-push-extend #x80 octets))
    856                     ((< 0 n #x80)
    857                      (vector-push-extend n octets))
    858                     (t
    859                      (let ((char-octets (char-to-utf8 c)))
    860                        (dotimes (j (length char-octets))
    861                          (declare (type fixnum j))
    862                          (vector-push-extend (svref char-octets j) octets)))))))
    863           (write-u2 (length octets) stream)
    864           (dotimes (i (length octets))
    865             (declare (type fixnum i))
    866             (write-8-bits (aref octets i) stream)))
    867         (write-ascii string length stream))))
    868788
    869789(defstruct (java-method (:include method)
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r12884 r12885  
    580580  (finalize-attributes (class-file-attributes class) nil class))
    581581
     582
     583(declaim (inline write-u1 write-u2 write-u4 write-s4))
     584(defun write-u1 (n stream)
     585  (declare (optimize speed))
     586  (declare (type (unsigned-byte 8) n))
     587  (declare (type stream stream))
     588  (write-8-bits n stream))
     589
     590(defknown write-u2 (t t) t)
     591(defun write-u2 (n stream)
     592  (declare (optimize speed))
     593  (declare (type (unsigned-byte 16) n))
     594  (declare (type stream stream))
     595  (write-8-bits (logand (ash n -8) #xFF) stream)
     596  (write-8-bits (logand n #xFF) stream))
     597
     598(defknown write-u4 (integer stream) t)
     599(defun write-u4 (n stream)
     600  (declare (optimize speed))
     601  (declare (type (unsigned-byte 32) n))
     602  (write-u2 (logand (ash n -16) #xFFFF) stream)
     603  (write-u2 (logand n #xFFFF) stream))
     604
     605(declaim (ftype (function (t t) t) write-s4))
     606(defun write-s4 (n stream)
     607  (declare (optimize speed))
     608  (cond ((minusp n)
     609         (write-u4 (1+ (logxor (- n) #xFFFFFFFF)) stream))
     610        (t
     611         (write-u4 n stream))))
     612
     613(declaim (ftype (function (t t t) t) write-ascii))
     614(defun write-ascii (string length stream)
     615  (declare (type string string))
     616  (declare (type (unsigned-byte 16) length))
     617  (declare (type stream stream))
     618  (write-u2 length stream)
     619  (dotimes (i length)
     620    (declare (type (unsigned-byte 16) i))
     621    (write-8-bits (char-code (char string i)) stream)))
     622
     623
     624(declaim (ftype (function (t t) t) write-utf8))
     625(defun write-utf8 (string stream)
     626  (declare (optimize speed))
     627  (declare (type string string))
     628  (declare (type stream stream))
     629  (let ((length (length string))
     630        (must-convert nil))
     631    (declare (type fixnum length))
     632    (dotimes (i length)
     633      (declare (type fixnum i))
     634      (unless (< 0 (char-code (char string i)) #x80)
     635        (setf must-convert t)
     636        (return)))
     637    (if must-convert
     638        (let ((octets (make-array (* length 2)
     639                                  :element-type '(unsigned-byte 8)
     640                                  :adjustable t
     641                                  :fill-pointer 0)))
     642          (declare (type (vector (unsigned-byte 8)) octets))
     643          (dotimes (i length)
     644            (declare (type fixnum i))
     645            (let* ((c (char string i))
     646                   (n (char-code c)))
     647              (cond ((zerop n)
     648                     (vector-push-extend #xC0 octets)
     649                     (vector-push-extend #x80 octets))
     650                    ((< 0 n #x80)
     651                     (vector-push-extend n octets))
     652                    (t
     653                     (let ((char-octets (char-to-utf8 c)))
     654                       (dotimes (j (length char-octets))
     655                         (declare (type fixnum j))
     656                         (vector-push-extend (svref char-octets j) octets)))))))
     657          (write-u2 (length octets) stream)
     658          (dotimes (i (length octets))
     659            (declare (type fixnum i))
     660            (write-8-bits (aref octets i) stream)))
     661        (write-ascii string length stream))))
     662
     663
    582664(defun !write-class-file (class stream)
    583665  "Serializes `class' to `stream', after it has been finalized."
Note: See TracChangeset for help on using the changeset viewer.