2 * This software is part of the SBCL system. See the README file for
5 * This software is derived from the CMU CL system, which was
6 * written at Carnegie Mellon University and released into the
7 * public domain. The software is in the public domain and is
8 * provided with absolutely no warranty. See the COPYING and CREDITS
9 * files for more information.
12 #include "gc-assert.h"
14 #include "genesis/number-types.h"
15 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
17 # include "genesis/vector.h"
18 # include "genesis/cons.h"
19 # include "genesis/compiled-debug-info.h"
23 // Read a variable-length encoded 32-bit integer from SOURCE and
26 // If OFFSET is not NULL, start decoding at OFFSET bytes from SOURCE
27 // and increment the value pointed to by OFFSET by the length of the
28 // encoded representation.
30 // Keep in sync with {READ,WRITE}-VAR-INTEGER in
31 // src/code/debug-var-io.lisp
32 int read_var_integer(unsigned char *source
, int *offset
) {
33 unsigned char *start
= source
+ (offset
? *offset
: 0);
34 unsigned char *ptr
= start
;
40 result
|= (octet
& 0x7f) << k
;
41 if (!(octet
& 0x80)) {
46 *offset
+= (ptr
- start
);
51 void skip_var_string(unsigned char* source
, int *offset
) {
52 int len
= read_var_integer(source
, offset
);
54 for (i
= 0; i
< len
; i
++) {
55 read_var_integer(source
, offset
);
59 void varint_unpacker_init(struct varint_unpacker
* unpacker
, lispobj integer
)
61 if (fixnump(integer
)) {
62 unpacker
->word
= fixnum_value(integer
);
63 unpacker
->limit
= N_WORD_BYTES
;
64 unpacker
->data
= (char*)&unpacker
->word
;
66 gc_assert(lowtag_of(integer
) == OTHER_POINTER_LOWTAG
67 && widetag_of(native_pointer(integer
)) == BIGNUM_WIDETAG
);
68 struct bignum
* bignum
= (struct bignum
*)(integer
- OTHER_POINTER_LOWTAG
);
70 unpacker
->limit
= HeaderValue(bignum
->header
) * N_WORD_BYTES
;
71 unpacker
->data
= (char*)bignum
->digits
;
76 // Fetch the next varint from 'unpacker' into 'result'.
77 // Because there is no length prefix on the number of varints encoded,
78 // spurious trailing zeros might be observed. The data consumer can
79 // circumvent that by storing a count as the first value in the series.
80 // Return 1 for success, 0 for EOF.
81 int varint_unpack(struct varint_unpacker
* unpacker
, int* result
)
83 if (unpacker
->index
>= unpacker
->limit
) return 0;
87 #ifdef LISP_FEATURE_LITTLE_ENDIAN
88 int byte
= unpacker
->data
[unpacker
->index
];
90 // bignums are little-endian in word order,
91 // but machine-native within each word.
92 // We could pack bytes MSB-to-LSB in the bigdigits,
93 // but that seems less intuitive on the Lisp side.
94 int word_index
= unpacker
->index
/ N_WORD_BYTES
;
95 int byte_index
= unpacker
->index
% N_WORD_BYTES
;
96 int byte
= (((uword_t
*)unpacker
->data
)[word_index
] >> (byte_index
* 8)) & 0xFF;
99 accumulator
|= (byte
& 0x7F) << shift
;
100 if (!(byte
& 0x80)) break;
101 gc_assert(unpacker
->index
< unpacker
->limit
);
104 *result
= accumulator
;
108 void skip_data_stream(struct varint_unpacker
* unpacker
)
110 // Read elements until seeing a 0
112 while (varint_unpack(unpacker
, &val
) && val
!= 0) { }
114 #ifdef LISP_FEATURE_SB_CORE_COMPRESSION
115 int compress_vector(lispobj vector
, lispobj end
) {
116 struct vector
*v
= VECTOR(vector
);
117 size_t current_length
= (size_t) vector_len(v
);
119 size_t buf_size
= ZSTD_compressBound(end
);
120 char* buf
= successful_malloc(buf_size
);
121 size_t new_length
= ZSTD_compress(buf
, buf_size
, v
->data
, end
, 22);
122 if (ZSTD_isError(new_length
)) {
127 if (new_length
< current_length
) {
128 assign_widetag(&v
->header
, SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
);
129 memcpy(&v
->data
, buf
, new_length
);
130 memset(((char*)&v
->data
)+new_length
, 0, current_length
-new_length
);
131 v
->length_
= make_fixnum(new_length
);
135 /* Shrink the data vector from an adjustable vector. */
136 memset(((char*)&v
->data
)+end
, 0, current_length
-end
);
137 v
->length_
= make_fixnum(end
);
142 unsigned char* decompress_vector(lispobj vector
, size_t *result_size
) {
144 struct vector
*v
= VECTOR(vector
);
149 input
.size
= vector_len(v
);
151 size_t out_increment
= ZSTD_CStreamOutSize();
154 unsigned char* buf
= NULL
;
157 ZSTD_DStream
*stream
= ZSTD_createDStream();
159 lose("unable to create zstd decompression context");
160 ret
= ZSTD_initDStream(stream
);
161 if (ZSTD_isError(ret
))
162 lose("ZSTD_initDStream failed with error: %s", ZSTD_getErrorName(ret
));
164 while (input
.pos
< input
.size
) {
165 buf
= realloc(buf
, buf_size
+ out_increment
);
167 ZSTD_outBuffer output
= { buf
+buf_size
, out_increment
, 0 };
169 size_t const ret
= ZSTD_decompressStream(stream
, &output
, &input
);
170 if (ZSTD_isError(ret
))
171 lose("ZSTD_decompressStream failed with error: %s",
172 ZSTD_getErrorName(ret
));
173 buf_size
+= output
.pos
;
176 ZSTD_freeDStream(stream
);
178 *result_size
= buf_size
;
182 void compress_debug_info(lispobj
* code_ptr
) {
183 struct code
* code
= (struct code
*)code_ptr
;
185 struct compiled_debug_info
*di
;
187 if (instancep(code
->debug_info
))
188 di
= (void*)native_pointer(code
->debug_info
);
189 else if (listp(code
->debug_info
) && instancep(CONS(code
->debug_info
)->car
))
190 di
= (void*)native_pointer(CONS(code
->debug_info
)->car
);
193 struct vector
*v
= VECTOR(di
->fun_map
);
194 if (widetag_of(&v
->header
) != SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG
)
197 compress_vector(di
->fun_map
, vector_len(v
));