The unpac monorepo manager self-hosting as a monorepo using unpac
Move the functions that use ZSTD compression to a separate zstd.c file
These functions used to be in extern.c and intern.c.
Now, they are in zstd.c and connect themselves to extern.c and intern.c
via hooks activated by a new primitive `caml_zstd_initialize`.
(cherry picked from commit aae3ad5757c4661d806f0a7d5a8350039216f485)
+179
-122
+2
-1
Makefile
+2
-1
Makefile
+14
runtime/caml/intext.h
+14
runtime/caml/intext.h
···
118
118
#define ENTRIES_PER_TRAIL_BLOCK 1025
119
119
#define SIZE_EXTERN_OUTPUT_BLOCK 8100
120
120
121
+
struct caml_output_block {
122
+
struct caml_output_block * next;
123
+
char * end;
124
+
char data[SIZE_EXTERN_OUTPUT_BLOCK];
125
+
};
126
+
121
127
void caml_free_extern_state (void);
122
128
123
129
/* The entry points */
···
126
132
/* Output [v] with flags [flags] on the channel [chan]. */
127
133
128
134
void caml_free_intern_state (void);
135
+
136
+
/* Compression hooks */
137
+
138
+
CAMLextern _Bool (*caml_extern_compress_output)(struct caml_output_block **);
139
+
CAMLextern size_t (*caml_intern_decompress_input)(unsigned char *,
140
+
uintnat,
141
+
const unsigned char *,
142
+
uintnat);
129
143
130
144
#endif /* CAML_INTERNALS */
131
145
+17
-92
runtime/extern.c
+17
-92
runtime/extern.c
···
33
33
#include "caml/mlvalues.h"
34
34
#include "caml/reverse.h"
35
35
#include "caml/shared_heap.h"
36
-
#ifdef HAS_ZSTD
37
-
#include <zstd.h>
38
-
#endif
39
36
40
37
/* Flags affecting marshaling */
41
38
···
85
82
86
83
#define POS_TABLE_INIT_SIZE_LOG2 8
87
84
#define POS_TABLE_INIT_SIZE (1 << POS_TABLE_INIT_SIZE_LOG2)
88
-
89
-
struct output_block {
90
-
struct output_block * next;
91
-
char * end;
92
-
char data[SIZE_EXTERN_OUTPUT_BLOCK];
93
-
};
94
85
95
86
struct caml_extern_state {
96
87
···
116
107
char * extern_ptr;
117
108
char * extern_limit;
118
109
119
-
struct output_block * extern_output_first;
120
-
struct output_block * extern_output_block;
110
+
struct caml_output_block * extern_output_first;
111
+
struct caml_output_block * extern_output_block;
121
112
};
122
113
123
114
static void init_extern_stack(struct caml_extern_state* s)
···
167
158
Caml_state->extern_state = NULL;
168
159
}
169
160
}
161
+
162
+
/* Hook for compression */
163
+
164
+
_Bool (*caml_extern_compress_output)(struct caml_output_block **) = NULL;
170
165
171
166
/* Forward declarations */
172
167
···
368
363
static void init_extern_output(struct caml_extern_state* s)
369
364
{
370
365
s->extern_userprovided_output = NULL;
371
-
s->extern_output_first = caml_stat_alloc_noexc(sizeof(struct output_block));
366
+
s->extern_output_first =
367
+
caml_stat_alloc_noexc(sizeof(struct caml_output_block));
372
368
if (s->extern_output_first == NULL) caml_raise_out_of_memory();
373
369
s->extern_output_block = s->extern_output_first;
374
370
s->extern_output_block->next = NULL;
···
385
381
386
382
static void free_extern_output(struct caml_extern_state* s)
387
383
{
388
-
struct output_block * blk, * nextblk;
384
+
struct caml_output_block * blk, * nextblk;
389
385
390
386
if (s->extern_userprovided_output == NULL) {
391
387
for (blk = s->extern_output_first; blk != NULL; blk = nextblk) {
···
400
396
401
397
static void grow_extern_output(struct caml_extern_state *s, intnat required)
402
398
{
403
-
struct output_block * blk;
399
+
struct caml_output_block * blk;
404
400
intnat extra;
405
401
406
402
if (s->extern_userprovided_output != NULL) {
···
411
407
extra = 0;
412
408
else
413
409
extra = required;
414
-
blk = caml_stat_alloc_noexc(sizeof(struct output_block) + extra);
410
+
blk = caml_stat_alloc_noexc(sizeof(struct caml_output_block) + extra);
415
411
if (blk == NULL) extern_out_of_memory(s);
416
412
s->extern_output_block->next = blk;
417
413
s->extern_output_block = blk;
···
423
419
424
420
static intnat extern_output_length(struct caml_extern_state* s)
425
421
{
426
-
struct output_block * blk;
422
+
struct caml_output_block * blk;
427
423
intnat len;
428
424
429
425
if (s->extern_userprovided_output != NULL) {
···
480
476
dst[4] = n >> 24; dst[5] = n >> 16; dst[6] = n >> 8; dst[7] = n;
481
477
}
482
478
483
-
#ifdef HAS_ZSTD
484
479
static int storevlq(char * dst, uintnat n)
485
480
{
486
481
/* Find number of base-128 digits (always at least one) */
···
493
488
/* Return length of number */
494
489
return ndigits;
495
490
}
496
-
#endif
497
491
498
492
/* Write characters, integers, and blocks in the output buffer */
499
493
···
915
909
/* Never reached as function leaves with return */
916
910
}
917
911
918
-
/* Compress the output */
919
-
920
-
#ifdef HAS_ZSTD
921
-
922
-
static void extern_compress_output(struct caml_extern_state* s)
923
-
{
924
-
ZSTD_CCtx * ctx;
925
-
ZSTD_inBuffer in;
926
-
ZSTD_outBuffer out;
927
-
struct output_block * input, * output, * output_head;
928
-
int rc;
929
-
930
-
ctx = ZSTD_createCCtx();
931
-
if (ctx == NULL) extern_out_of_memory(s);
932
-
input = s->extern_output_first;
933
-
output_head = caml_stat_alloc_noexc(sizeof(struct output_block));
934
-
if (output_head == NULL) goto oom1;
935
-
output = output_head;
936
-
output->next = NULL;
937
-
in.src = input->data; in.size = input->end - input->data; in.pos = 0;
938
-
out.dst = output->data; out.size = SIZE_EXTERN_OUTPUT_BLOCK; out.pos = 0;
939
-
do {
940
-
if (out.pos == out.size) {
941
-
output->end = output->data + out.pos;
942
-
/* Allocate fresh output block */
943
-
struct output_block * next =
944
-
caml_stat_alloc_noexc(sizeof(struct output_block));
945
-
if (next == NULL) goto oom2;
946
-
output->next = next;
947
-
output = next;
948
-
output->next = NULL;
949
-
out.dst = output->data; out.size = SIZE_EXTERN_OUTPUT_BLOCK; out.pos = 0;
950
-
}
951
-
if (in.pos == in.size && input != NULL) {
952
-
/* Move to next input block and free current input block */
953
-
struct output_block * next = input->next;
954
-
caml_stat_free(input);
955
-
input = next;
956
-
if (input != NULL) {
957
-
in.src = input->data; in.size = input->end - input->data;
958
-
} else {
959
-
in.src = NULL; in.size = 0;
960
-
}
961
-
in.pos = 0;
962
-
}
963
-
rc = ZSTD_compressStream2(ctx, &out, &in,
964
-
input == NULL ? ZSTD_e_end : ZSTD_e_continue);
965
-
} while (! (input == NULL && rc == 0));
966
-
output->end = output->data + out.pos;
967
-
s->extern_output_first = output_head;
968
-
ZSTD_freeCCtx(ctx);
969
-
return;
970
-
oom2:
971
-
/* The old output blocks that remain to be freed */
972
-
s->extern_output_first = input;
973
-
/* Free the new output blocks */
974
-
for (output = output_head; output != NULL; ) {
975
-
struct output_block * next = output->next;
976
-
caml_stat_free(output);
977
-
output = next;
978
-
}
979
-
oom1:
980
-
ZSTD_freeCCtx(ctx);
981
-
extern_out_of_memory(s);
982
-
}
983
-
984
-
#endif
985
-
986
912
static const int extern_flag_values[] = {
987
913
NO_SHARING, CLOSURES, COMPAT_32, COMPRESSED
988
914
};
···
1010
936
/* Record end of output */
1011
937
close_extern_output(s);
1012
938
/* Compress if requested */
1013
-
#ifdef HAS_ZSTD
1014
939
if (s->extern_flags & COMPRESSED) {
1015
940
uintnat uncompressed_len = extern_output_length(s);
1016
-
extern_compress_output(s);
941
+
if (!caml_extern_compress_output(&(s->extern_output_first)))
942
+
extern_out_of_memory(s);
1017
943
res_len = extern_output_length(s);
1018
944
/* Check lengths if compat32 mode is requested */
1019
945
#ifdef ARCH_SIXTYFOUR
···
1039
965
*header_len = pos;
1040
966
return res_len;
1041
967
}
1042
-
#endif
1043
968
/* Write the header */
1044
969
res_len = extern_output_length(s);
1045
970
#ifdef ARCH_SIXTYFOUR
···
1075
1000
{
1076
1001
char header[MAX_INTEXT_HEADER_SIZE];
1077
1002
int header_len;
1078
-
struct output_block * blk, * nextblk;
1003
+
struct caml_output_block * blk, * nextblk;
1079
1004
struct caml_extern_state* s = init_extern_state ();
1080
1005
1081
1006
if (! caml_channel_binary_mode(chan))
···
1113
1038
int header_len;
1114
1039
intnat data_len, ofs;
1115
1040
value res;
1116
-
struct output_block * blk, * nextblk;
1041
+
struct caml_output_block * blk, * nextblk;
1117
1042
struct caml_extern_state* s = init_extern_state ();
1118
1043
1119
1044
init_extern_output(s);
···
1183
1108
int header_len;
1184
1109
intnat data_len;
1185
1110
char * res;
1186
-
struct output_block * blk, * nextblk;
1111
+
struct caml_output_block * blk, * nextblk;
1187
1112
struct caml_extern_state* s = init_extern_state ();
1188
1113
1189
1114
init_extern_output(s);
+26
-21
runtime/intern.c
+26
-21
runtime/intern.c
···
37
37
#include "caml/reverse.h"
38
38
#include "caml/shared_heap.h"
39
39
#include "caml/signals.h"
40
-
#ifdef HAS_ZSTD
41
-
#include <zstd.h>
42
-
#endif
43
40
44
41
/* Item on the stack with defined operation */
45
42
struct intern_item {
···
815
812
when the memory block for the compressed input can be freed
816
813
before more memory is allocated. */
817
814
815
+
size_t (*caml_intern_decompress_input)(unsigned char *,
816
+
uintnat,
817
+
const unsigned char *,
818
+
uintnat) = NULL;
819
+
818
820
static void intern_decompress_input(struct caml_intern_state * s,
819
821
const char * fun_name,
820
822
struct marshal_header * h)
821
823
{
822
824
s->compressed = h->compressed;
823
825
if (! h->compressed) return;
824
-
#ifdef HAS_ZSTD
825
-
unsigned char * blk = malloc(h->uncompressed_data_len);
826
-
if (blk == NULL) {
827
-
intern_cleanup(s);
828
-
caml_raise_out_of_memory();
829
-
}
830
-
size_t res =
831
-
ZSTD_decompress(blk, h->uncompressed_data_len, s->intern_src, h->data_len);
832
-
if (res != h->uncompressed_data_len) {
833
-
free(blk);
826
+
if (caml_intern_decompress_input != NULL) {
827
+
unsigned char * blk = malloc(h->uncompressed_data_len);
828
+
if (blk == NULL) {
829
+
intern_cleanup(s);
830
+
caml_raise_out_of_memory();
831
+
}
832
+
size_t res =
833
+
caml_intern_decompress_input(blk,
834
+
h->uncompressed_data_len,
835
+
s->intern_src,
836
+
h->data_len);
837
+
if (res != h->uncompressed_data_len) {
838
+
free(blk);
839
+
intern_cleanup(s);
840
+
intern_failwith2(fun_name, "decompression error");
841
+
}
842
+
if (s->intern_input != NULL) free(s->intern_input);
843
+
s->intern_input = blk; /* to be freed at end of demarshaling */
844
+
s->intern_src = blk;
845
+
} else {
834
846
intern_cleanup(s);
835
-
intern_failwith2(fun_name, "decompression error");
847
+
intern_failwith2(fun_name, "compressed object, cannot decompress");
836
848
}
837
-
if (s->intern_input != NULL) free(s->intern_input);
838
-
s->intern_input = blk; /* to be freed at end of demarshaling */
839
-
s->intern_src = blk;
840
-
#else
841
-
intern_cleanup(s);
842
-
intern_failwith2(fun_name, "compressed object, cannot decompress");
843
-
#endif
844
849
}
845
850
846
851
/* Reading from a channel */
+115
runtime/zstd.c
+115
runtime/zstd.c
···
1
+
/**************************************************************************/
2
+
/* */
3
+
/* OCaml */
4
+
/* */
5
+
/* Xavier Leroy, Collège de France and Inria */
6
+
/* David Allsopp, Tarides */
7
+
/* */
8
+
/* Copyright 2023 Institut National de Recherche en Informatique et */
9
+
/* en Automatique. */
10
+
/* Copyright 2023 David Allsopp Ltd. */
11
+
/* */
12
+
/* All rights reserved. This file is distributed under the terms of */
13
+
/* the GNU Lesser General Public License version 2.1, with the */
14
+
/* special exception on linking described in the file LICENSE. */
15
+
/* */
16
+
/**************************************************************************/
17
+
18
+
#define CAML_INTERNALS
19
+
20
+
#include <stdbool.h>
21
+
#include "caml/intext.h"
22
+
#include "caml/memory.h"
23
+
#include "caml/mlvalues.h"
24
+
25
+
#ifdef HAS_ZSTD
26
+
27
+
#include <zstd.h>
28
+
29
+
/* Compress the output */
30
+
31
+
static bool caml_zstd_compress(struct caml_output_block **extern_output_first)
32
+
{
33
+
ZSTD_CCtx * ctx;
34
+
ZSTD_inBuffer in;
35
+
ZSTD_outBuffer out;
36
+
struct caml_output_block * input, * output, * output_head;
37
+
int rc;
38
+
39
+
ctx = ZSTD_createCCtx();
40
+
if (ctx == NULL) return false;
41
+
input = *extern_output_first;
42
+
output_head = caml_stat_alloc_noexc(sizeof(struct caml_output_block));
43
+
if (output_head == NULL) goto oom1;
44
+
output = output_head;
45
+
output->next = NULL;
46
+
in.src = input->data; in.size = input->end - input->data; in.pos = 0;
47
+
out.dst = output->data; out.size = SIZE_EXTERN_OUTPUT_BLOCK; out.pos = 0;
48
+
do {
49
+
if (out.pos == out.size) {
50
+
output->end = output->data + out.pos;
51
+
/* Allocate fresh output block */
52
+
struct caml_output_block * next =
53
+
caml_stat_alloc_noexc(sizeof(struct caml_output_block));
54
+
if (next == NULL) goto oom2;
55
+
output->next = next;
56
+
output = next;
57
+
output->next = NULL;
58
+
out.dst = output->data; out.size = SIZE_EXTERN_OUTPUT_BLOCK; out.pos = 0;
59
+
}
60
+
if (in.pos == in.size && input != NULL) {
61
+
/* Move to next input block and free current input block */
62
+
struct caml_output_block * next = input->next;
63
+
caml_stat_free(input);
64
+
input = next;
65
+
if (input != NULL) {
66
+
in.src = input->data; in.size = input->end - input->data;
67
+
} else {
68
+
in.src = NULL; in.size = 0;
69
+
}
70
+
in.pos = 0;
71
+
}
72
+
rc = ZSTD_compressStream2(ctx, &out, &in,
73
+
input == NULL ? ZSTD_e_end : ZSTD_e_continue);
74
+
} while (! (input == NULL && rc == 0));
75
+
output->end = output->data + out.pos;
76
+
*extern_output_first = output_head;
77
+
ZSTD_freeCCtx(ctx);
78
+
return true;
79
+
oom2:
80
+
/* The old uncompressed blocks that remain to be freed */
81
+
*extern_output_first = input;
82
+
/* Free the newly-allocated compressed blocks */
83
+
for (output = output_head; output != NULL; ) {
84
+
struct caml_output_block * next = output->next;
85
+
caml_stat_free(output);
86
+
output = next;
87
+
}
88
+
oom1:
89
+
ZSTD_freeCCtx(ctx);
90
+
return false;
91
+
}
92
+
93
+
static size_t caml_zstd_decompress(unsigned char * blk,
94
+
uintnat uncompressed_data_len,
95
+
const unsigned char * intern_src,
96
+
uintnat data_len)
97
+
{
98
+
return ZSTD_decompress(blk, uncompressed_data_len, intern_src, data_len);
99
+
}
100
+
101
+
CAMLprim value caml_zstd_initialize(value vunit)
102
+
{
103
+
caml_extern_compress_output = caml_zstd_compress;
104
+
caml_intern_decompress_input = caml_zstd_decompress;
105
+
return Val_true;
106
+
}
107
+
108
+
#else
109
+
110
+
CAMLprim value caml_zstd_initialize(value vunit)
111
+
{
112
+
return Val_false;
113
+
}
114
+
115
+
#endif
-2
stdlib/.depend
-2
stdlib/.depend
···
513
513
stdlib__Map.cmi : map.mli \
514
514
stdlib__Seq.cmi
515
515
stdlib__Marshal.cmo : marshal.ml \
516
-
stdlib__String.cmi \
517
516
stdlib__Bytes.cmi \
518
517
stdlib__Marshal.cmi
519
518
stdlib__Marshal.cmx : marshal.ml \
520
-
stdlib__String.cmx \
521
519
stdlib__Bytes.cmx \
522
520
stdlib__Marshal.cmi
523
521
stdlib__Marshal.cmi : marshal.mli
+5
-6
stdlib/marshal.ml
+5
-6
stdlib/marshal.ml
···
67
67
sequence is never mutated *)
68
68
from_bytes (Bytes.unsafe_of_string buff) ofs
69
69
70
-
let compression_supported () =
71
-
let s = to_string () [Compression] in
72
-
match s.[3] with
73
-
| '\xBD' -> true
74
-
| '\xBE' -> false
75
-
| _ -> assert false
70
+
external zstd_initialize: unit -> bool = "caml_zstd_initialize"
71
+
72
+
let compr_supp = zstd_initialize()
73
+
74
+
let compression_supported () = compr_supp