バイナリデータを読み込む(CL)

C++でFDCとお話しする事に疲れたから、逃避するためにLispプログラミング。

実践CommonLispに、バイナリファイルのパースという章があったかと思うが、自分の脳みそで考えるのが大事だろうということで書いてみる。

読み込みのみ。

(defmethod read-binary ((type (eql :u8)) stream)
  (read-byte stream))
(defmethod read-binary ((type (eql :u16)) stream)
  (let ((n 0))
    ;;リトルエンディアン
    (setf (ldb (byte 8 0) n) (read-byte stream))
    (setf (ldb (byte 8 8) n) (read-byte stream))
    n))
(defmethod read-binary ((type (eql :u32)) stream)
  (let ((n 0))
    ;;リトルエンディアン
    (setf (ldb (byte 8 0) n) (read-byte stream))
    (setf (ldb (byte 8 8) n) (read-byte stream))
    (setf (ldb (byte 8 16) n) (read-byte stream))
    (setf (ldb (byte 8 24) n) (read-byte stream))
    n))

(defmacro define-binary (name &body body)
  (let ((obj (gensym)))
  `(progn
     (defclass ,name ()
       ,(mapcar
	 #'(lambda (clause)
	     `(,(first clause)
		:accessor ,(first clause)))
	 body))
     (defmethod read-binary ((type (eql ',name)) stream)
       (let ((,obj (make-instance ',name)))
	 ,@(mapcar
	   #'(lambda (clause)
	       `(setf (,(first clause) ,obj)
		      ,(if (third clause)
			   `(loop :repeat ,(third clause)
			      :collect (read-binary ,(second clause) stream))
			   `(read-binary ,(second clause) stream))))
	   body)
	 ,obj))
     )))

;;;定義
(define-binary bpb ;Bios Parameter Block
  (jmp :u8 2)
  (nop :u8)
  (oem-id :u8 8)
  (bytes-per-sector :u16) ;一般に512byteか1024byte
  (sectors-per-cluster :u8) ;1クラスタが何セクタか
  (reserved-sectors :u16) ;bpbからみたFAT開始位置(相対セクタ)
  (total-fats :u8) ;FATはいくつかるか。普通2つ。
  (max-root-entries :u16) ;ルートディレクトリエントリがいくつあるか
  (total-sectors :u16) ;全セクタ数
  (media-descriptor :u8)
  (sectors-per-fat :u16) ;1つのFATが何セクタか
  (sectors-per-track :u16) ;1トラックは何セクタか
  (num-heads :u16) ;ヘッドはいくつあるか
  (hidden-sector :u32)
  (total-sectors-large :u32))

(define-binary fat12-boot-record
  (bpb-record 'bpb)
  (drive-number :u8) ;0x00=Floppy 0x80=HardDisk
  (flags :u8)
  (signature :u8) ;0x29
  (volume-id :u32)
  (volume-label :u8 11)
  (system-id :u8 8)
  (boot-code :u8 448)
  (bootable-partition-signature :u16))

試しに読み込んでみる。

>(with-open-file (s "/home/kurohuku/floppy.img"
                   :direction :input :element-type '(unsigned-byte 8))
	   (read-binary 'fat12-boot-record s))
>(describe *)
#<FAT12-BOOT-RECORD {BBE68B1}>
  [standard-object]

Slots with :INSTANCE allocation:
  BPB-RECORD                   = #<BPB {BCA4689}>
  DRIVE-NUMBER                 = 0
  FLAGS                        = 0
  SIGNATURE                    = 41
  VOLUME-ID                    = 1252133017
  VOLUME-LABEL                 = (32 32 32 32 32 32 32 32 32 32 32)
  SYSTEM-ID                    = (70 65 84 49 50 32 32 32)
  BOOT-CODE                    = (3 2 255 0 0 128 37 0 0 0 0 8 250 235 7 246 194 128 117 2 178 128 234..
  BOOTABLE-PARTITION-SIGNATURE  = 43605

>(map 'string #'code-char (oem-id (bpb-record **)))
"mkdosfs^@" ;^@は#\nul

>(format nil "~X" (bootable-partition-signature ***))
"AA55"