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
|
(in-package "BCOMP")
(provide 'FASDMACROS)
(defstruct (fasd (:type vector))
stream
table
eof
direction
package
index
filepos
table_length
macro
)
(defvar *fasd-ops*
'( d_nil ;/* dnil: nil */
d_eval_skip ; /* deval o1: evaluate o1 after reading it */
d_delimiter ;/* occurs after d_listd_general and d_new_indexed_items */
d_enter_vector ; /* d_enter_vector o1 o2 .. on d_delimiter make a cf_data with
; this length. Used internally by akcl. Just make
; an array in other lisps */
d_cons ; /* d_cons o1 o2: (o1 . o2) */
d_dot ;
d_list ;/* list* delimited by d_delimiter d_list,o1,o2, ... ,d_dot,on
;for (o1 o2 . on)
;or d_list,o1,o2, ... ,on,d_delimiter for (o1 o2 ... on)
;*/
d_list1 ;/* nil terminated length 1 d_list1o1 */
d_list2 ; /* nil terminated length 2 */
d_list3
d_list4
d_eval
d_short_symbol
d_short_string
d_short_fixnum
d_short_symbol_and_package
d_bignum
d_fixnum
d_string
d_objnull
d_structure
d_package
d_symbol
d_symbol_and_package
d_end_of_file
d_standard_character
d_vector
d_array
d_begin_dump
d_general_type
d_sharp_equals ; /* define a sharp */
d_sharp_value
d_sharp_value2
d_new_indexed_item
d_new_indexed_items
d_reset_index
d_macro
d_reserve1
d_reserve2
d_reserve3
d_reserve4
d_indexed_item3 ; /* d_indexed_item3 followed by 3bytes to give index */
d_indexed_item2 ; /* d_indexed_item2 followed by 2bytes to give index */
d_indexed_item1
d_indexed_item0 ; /* This must occur last ! */
))
(defmacro put-op (op str)
`(write-byte ,(or (position op *fasd-ops*)
(error "illegal op")) ,str))
(defmacro putd (n str)
`(write-byte ,n ,str))
(defmacro put2 (n str)
`(progn (write-bytei ,n 0 ,str)
(write-bytei ,n 1 ,str)))
(defmacro put4 (n str)
`(progn (write-bytei ,n 0 ,str)
(write-bytei ,n 1 ,str)
(write-bytei ,n 2 ,str)
(write-bytei ,n 3 ,str)
))
(defmacro write-bytei (n i str)
`(write-byte (the fixnum (ash (the fixnum ,n) >> ,(* i 8))) ,str))
|
