-
Notifications
You must be signed in to change notification settings - Fork 0
/
ohdr.lisp
104 lines (93 loc) · 4.15 KB
/
ohdr.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
(in-package #:alcove)
(defun read-ohdr (input-stream address file)
"--------------------------------------------------------------[function-doc]
READ-OHDR
Args: (INPUT-STREAM ADDRESS FILE)
Read an object header (OHDR) from INPUT-STREAM at ADDRESS.
Return an association list.
------------------------------------------------------------------------------"
(assert (file-position input-stream address))
(let ((peek (read-byte input-stream)))
(cond
;; version 1 OHDR
((= peek 1)
(let* ((result (read-v1-ohdr-prefix input-stream file))
(message-count (cdr (assoc 'message-count result))))
(nconc result
`((messages
.
,(loop for m from 1 to message-count
collect
(let ((pos (file-position input-stream)))
;; in v1 header messages are 8-byte aligned
(file-position input-stream
(incf pos (mod pos 8)))
(read-ohdr-message input-stream result file))))))
result))
;; version 2+ OHDR
((= peek 79)
(let* ((h (read-byte input-stream))
(d (read-byte input-stream))
(r (read-byte input-stream))
(version (read-byte input-stream)))
(when (and (= h 72) (= d 68) (= r 82))
(cond
;; version 2 OHDR
((= version 2)
(let* ((result (read-v2-ohdr-prefix input-stream file))
(size-of-chunk0 (cdr (assoc 'size-of-chunk0 result)))
(messages nil)
(checksum nil))
(when (< 0 size-of-chunk0)
(do* ((processed 0)
(rem size-of-chunk0 (- size-of-chunk0 processed)))
((< rem 6)
(when (< 0 rem)
(nconc result
`((gap . ,(read-bytes input-stream rem)))))
(setq checksum (read-bytes input-stream 4))
result)
(let ((msg (read-ohdr-message input-stream result file)))
(incf processed (+ 6 (cdr (assoc 'msg-data-size msg))))
(setf messages (cons msg messages)))))
(nconc result `((messages . ,messages)))
(nconc result `((checksum . ,checksum)))
result))
;; unknown version
(t `((signature . "OHDR") (version . ,version)))))))
(t nil))))
(defun read-v1-ohdr-prefix (input-stream file)
(let* ((reserved (read-byte input-stream))
(message-count (read-uinteger input-stream 2)))
`((ohdr-version . 1)
(message-count . ,message-count)
(reference-count . ,(read-uinteger input-stream 4))
(header-size . ,(read-uinteger input-stream 4)))))
(defun read-v2-ohdr-prefix (input-stream file)
(let* ((result (list '(signature . "OHDR")
'(ohdr-version . 2)))
(flags (read-byte input-stream))
(size-of-chunk0 (ash 1 (ldb (byte 2 0) flags)))
(track-attr-crt-order (ldb-test (byte 1 2) flags))
(index-attr-crt-order (ldb-test (byte 1 3) flags))
(cust-attr-stor-phase-change (ldb-test (byte 1 4) flags))
(amcb-times-stored (ldb-test (byte 1 5) flags)))
(nconc result
`((flags . ,flags)))
;; timestamps
(when amcb-times-stored
(nconc result
`((access-time . ,(read-uinteger input-stream 4))
(modification-time . ,(read-uinteger input-stream 4))
(change-time . ,(read-uinteger input-stream 4))
(birth-time . ,(read-uinteger input-stream 4)))))
;; attribute storage phase change
(when cust-attr-stor-phase-change
(nconc result
`((max-compact-attr . ,(read-uinteger input-stream 2))
(min-dense-attr . ,(read-uinteger input-stream 2)))))
;; magic chunk0 size
(nconc result
`((size-of-chunk0 . ,(read-uinteger input-stream size-of-chunk0))))
result))