1 /* $Id: ml_raw.c,v 1.16 2007-04-13 02:48:43 garrigue Exp $ */
5 #include <caml/mlvalues.h>
6 #include <caml/memory.h>
7 #include <caml/alloc.h>
8 #include <caml/config.h>
12 #define SIZE_BYTE sizeof(char)
13 #define SIZE_SHORT sizeof(short)
14 #define SIZE_INT sizeof(int)
15 #define SIZE_LONG sizeof(long)
16 #define SIZE_FLOAT sizeof(float)
17 #define SIZE_DOUBLE sizeof(double)
19 extern void invalid_argument (char *) Noreturn
;
20 extern void raise_out_of_memory (void) Noreturn
;
22 static int raw_sizeof (value kind
)
46 CAMLprim value
ml_raw_sizeof (value kind
) /* ML */
48 return Val_int(raw_sizeof(kind
));
51 static void check_size (value raw
, long pos
, char *msg
)
54 (pos
+1) * raw_sizeof(Kind_raw(raw
)) > Int_val(Size_raw(raw
)))
55 invalid_argument (msg
);
58 CAMLprim value
ml_raw_get (value raw
, value pos
) /* ML */
60 long i
= Long_val(pos
);
62 check_size (raw
,i
,"Raw.get");
63 switch (Kind_raw(raw
)) {
66 return Val_long ((unsigned char) Byte_raw(raw
)[i
]);
68 return Val_long (Byte_raw(raw
)[i
]);
70 return Val_long (Short_raw(raw
)[i
]);
72 return Val_long ((unsigned short) Short_raw(raw
)[i
]);
74 return Val_long (Int_raw(raw
)[i
]);
76 return Val_long ((unsigned int) Int_raw(raw
)[i
]);
78 return Val_long (Long_raw(raw
)[i
]);
80 return Val_long ((unsigned long) Long_raw(raw
)[i
]);
85 CAMLprim value
ml_raw_read (value raw
, value pos
, value len
) /* ML */
88 int i
, l
= Int_val(len
);
91 check_size (raw
,s
+l
-1,"Raw.read");
92 if (l
<0 || s
<0) invalid_argument("Raw.read");
93 ret
= alloc_shr (l
, 0);
94 switch (Kind_raw(raw
)) {
98 unsigned char *byte_raw
= (unsigned char *)Byte_raw(raw
)+s
;
99 for (i
= 0; i
< l
; i
++)
100 Field(ret
,i
) = Val_long (*byte_raw
++);
105 char *byte_raw
= Byte_raw(raw
)+s
;
106 for (i
= 0; i
< l
; i
++)
107 Field(ret
,i
) = Val_long (*byte_raw
++);
112 short *short_raw
= Short_raw(raw
)+s
;
113 for (i
= 0; i
< l
; i
++)
114 Field(ret
,i
) = Val_long (*short_raw
++);
119 unsigned short *short_raw
= (unsigned short *)Short_raw(raw
)+s
;
120 for (i
= 0; i
< l
; i
++)
121 Field(ret
,i
) = Val_long (*short_raw
++);
126 int *int_raw
= Int_raw(raw
)+s
;
127 for (i
= 0; i
< l
; i
++)
128 Field(ret
,i
) = Val_long (*int_raw
++);
133 unsigned int *int_raw
= (unsigned int *)Int_raw(raw
)+s
;
134 for (i
= 0; i
< l
; i
++)
135 Field(ret
,i
) = Val_long (*int_raw
++);
140 long *long_raw
= Long_raw(raw
)+s
;
141 for (i
= 0; i
< l
; i
++)
142 Field(ret
,i
) = Val_long (*long_raw
++);
147 unsigned long *long_raw
= (unsigned long *)Long_raw(raw
)+s
;
148 for (i
= 0; i
< l
; i
++)
149 Field(ret
,i
) = Val_long (*long_raw
++);
156 CAMLprim value
ml_raw_read_string (value raw
, value pos
, value len
) /* ML */
159 int s
= Int_val(pos
);
160 int l
= Int_val(len
);
163 if (l
<0 || s
<0 || s
+l
> Int_val(Size_raw(raw
)))
164 invalid_argument("Raw.read_string");
165 ret
= alloc_string (l
);
166 memcpy (Bp_val(ret
), Bp_val(Addr_raw(raw
))+s
, l
);
170 CAMLprim value
ml_raw_write_string (value raw
, value pos
, value data
) /* ML */
172 int s
= Int_val(pos
);
173 int l
= string_length(data
);
175 if (s
<0 || s
+l
> Int_val(Size_raw(raw
)))
176 invalid_argument("Raw.write_string");
177 memcpy (Bp_val(Addr_raw(raw
))+s
, String_val(data
), l
);
181 CAMLprim value
ml_raw_set (value raw
, value pos
, value data
) /* ML */
183 long i
= Long_val(pos
);
185 check_size (raw
,i
,"Raw.set");
186 switch (Kind_raw(raw
)) {
190 Byte_raw(raw
)[i
] = Long_val(data
);
194 Short_raw(raw
)[i
] = Long_val(data
);
197 Int_raw(raw
)[i
] = Long_val(data
);
200 Int_raw(raw
)[i
] = Long_val((unsigned long) data
);
203 Long_raw(raw
)[i
] = Long_val(data
);
206 Long_raw(raw
)[i
] = Long_val((unsigned long) data
);
212 CAMLprim value
ml_raw_write (value raw
, value pos
, value data
) /* ML */
214 int s
= Int_val(pos
);
215 int i
, l
= Wosize_val(data
);
217 check_size (raw
,s
+l
-1,"Raw.write");
218 if (s
<0) invalid_argument("Raw.write");
220 switch (Kind_raw(raw
)) {
225 char *byte_raw
= Byte_raw(raw
)+s
;
226 for (i
= 0; i
< l
; i
++)
227 *byte_raw
++ = Long_val(Field(data
,i
));
233 short *short_raw
= Short_raw(raw
)+s
;
234 for (i
= 0; i
< l
; i
++)
235 *short_raw
++ = Long_val(Field(data
,i
));
240 int *int_raw
= Int_raw(raw
)+s
;
241 for (i
= 0; i
< l
; i
++)
242 *int_raw
++ = Long_val(Field(data
,i
));
247 int *int_raw
= Int_raw(raw
)+s
;
248 for (i
= 0; i
< l
; i
++)
249 *int_raw
++ = Long_val((unsigned long) Field(data
,i
));
254 long *long_raw
= Long_raw(raw
)+s
;
255 for (i
= 0; i
< l
; i
++)
256 *long_raw
++ = Long_val(Field(data
,i
));
261 long *long_raw
= Long_raw(raw
)+s
;
262 for (i
= 0; i
< l
; i
++)
263 *long_raw
++ = Long_val((unsigned long) Field(data
,i
));
270 CAMLprim value
ml_raw_get_float (value raw
, value pos
) /* ML */
272 long i
= Long_val(pos
);
274 check_size (raw
,i
,"Raw.get_float");
275 if (Kind_raw(raw
) == MLTAG_float
)
276 return copy_double ((double) Float_raw(raw
)[i
]);
278 return copy_double (Double_raw(raw
)[i
]);
281 CAMLprim value
ml_raw_read_float (value raw
, value pos
, value len
) /* ML */
283 int s
= Int_val(pos
);
284 int i
, l
= Int_val(len
);
285 value ret
= Val_unit
;
287 check_size (raw
,s
+l
-1,"Raw.read_float");
288 if (l
<0 || s
<0) invalid_argument("Raw.read_float");
289 ret
= alloc_shr (l
*sizeof(double)/sizeof(value
), Double_array_tag
);
290 if (Kind_raw(raw
) == MLTAG_float
) {
291 float *float_raw
= Float_raw(raw
)+s
;
292 for (i
= 0; i
< l
; i
++)
293 Store_double_field(ret
, i
, (double) *float_raw
++);
295 double *double_raw
= Double_raw(raw
)+s
;
296 for (i
= 0; i
< l
; i
++)
297 Store_double_field(ret
, i
, *double_raw
++);
302 CAMLprim value
ml_raw_set_float (value raw
, value pos
, value data
) /* ML */
304 long i
= Long_val(pos
);
306 check_size (raw
,i
,"Raw.set_float");
307 if (Kind_raw(raw
) == MLTAG_float
)
308 Float_raw(raw
)[i
] = (float) Double_val(data
);
310 Double_raw(raw
)[i
] = Double_val(data
);
314 CAMLprim value
ml_raw_write_float (value raw
, value pos
, value data
) /* ML */
316 int s
= Int_val(pos
);
317 int i
, l
= Wosize_val(data
)*sizeof(value
)/sizeof(double);
319 check_size (raw
,s
+l
-1,"Raw.write_float");
320 if (s
<0) invalid_argument("Raw.write_float");
321 if (Kind_raw(raw
) == MLTAG_float
) {
322 float *float_raw
= Float_raw(raw
)+s
;
323 for (i
= 0; i
< l
; i
++)
324 *float_raw
++ = (float) Double_field(data
,i
);
326 double *double_raw
= Double_raw(raw
)+s
;
327 for (i
= 0; i
< l
; i
++)
328 *double_raw
++ = Double_field(data
,i
);
333 #ifdef ARCH_BIG_ENDIAN
341 /* Here we suppose that:
342 * sizeof(int) == 2*sizeof(short)
343 * sizeof(long) == 2*sizeof(int) (64-bit architectures)
344 * sizeof(long) == 2*sizeof(short) (otherwise)
347 #define Hint_raw(raw) ((unsigned short *) Short_raw(raw))
349 #ifdef ARCH_SIXTYFOUR
350 #define Hlong_raw(raw) ((unsigned int *) Int_raw(raw))
352 #define Hlong_raw(raw) ((unsigned short *) Short_raw(raw))
355 CAMLprim value
ml_raw_get_hi (value raw
, value pos
) /* ML */
357 long i
= Long_val(pos
);
359 check_size (raw
,i
,"Raw.get_hi");
360 switch (Kind_raw(raw
)) {
363 return Val_long (Hint_raw(raw
)[2*i
+HI_OFFSET
]);
366 return Val_long (Hlong_raw(raw
)[2*i
+HI_OFFSET
]);
371 CAMLprim value
ml_raw_get_lo (value raw
, value pos
) /* ML */
373 long i
= Long_val(pos
);
375 check_size (raw
,i
,"Raw.get_lo");
376 switch (Kind_raw(raw
)) {
379 return Val_long ((unsigned long) Hint_raw(raw
)[2*i
+LO_OFFSET
]);
382 return Val_long ((unsigned long) Hlong_raw(raw
)[2*i
+LO_OFFSET
]);
387 CAMLprim value
ml_raw_set_hi (value raw
, value pos
, value data
) /* ML */
389 long i
= Long_val(pos
);
391 check_size (raw
,i
,"Raw.set_hi");
392 switch (Kind_raw(raw
)) {
395 Hint_raw(raw
)[2*i
+HI_OFFSET
] = Long_val(data
);
399 Hlong_raw(raw
)[2*i
+HI_OFFSET
] = Long_val(data
);
405 CAMLprim value
ml_raw_set_lo (value raw
, value pos
, value data
) /* ML */
407 long i
= Long_val(pos
);
409 check_size (raw
,i
,"Raw.set_lo");
410 switch (Kind_raw(raw
)) {
413 Hint_raw(raw
)[2*i
+LO_OFFSET
] = Long_val(data
);
417 Hlong_raw(raw
)[2*i
+LO_OFFSET
] = Long_val(data
);
423 CAMLprim value
ml_raw_get_long (value raw
, value pos
) /* ML */
425 long i
= Long_val(pos
);
427 check_size (raw
,i
,"Raw.get_long");
428 switch (Kind_raw(raw
)) {
431 return copy_nativeint (Int_raw(raw
)[i
]);
434 return copy_nativeint (Long_raw(raw
)[i
]);
439 CAMLprim value
ml_raw_set_long (value raw
, value pos
, value data
) /* ML */
441 long i
= Long_val(pos
);
443 check_size (raw
,i
,"Raw.set_long");
444 switch (Kind_raw(raw
)) {
447 Int_raw(raw
)[i
] = Nativeint_val(data
);
451 Long_raw(raw
)[i
] = Nativeint_val(data
);
457 CAMLprim value
ml_raw_alloc (value kind
, value len
) /* ML */
462 int size
= raw_sizeof(kind
) * Int_val(len
);
465 if (kind
== MLTAG_double
&& sizeof(double) > sizeof(value
)) {
466 data
= alloc_shr ((size
-1)/sizeof(value
)+2, Abstract_tag
);
467 offset
= (data
% sizeof(double) ? sizeof(value
) : 0);
468 } else data
= alloc_shr ((size
-1)/sizeof(value
)+1, Abstract_tag
);
469 raw
= alloc_small (SIZE_RAW
,0);
470 Kind_raw(raw
) = kind
;
471 Size_raw(raw
) = Val_int(size
);
472 Base_raw(raw
) = data
;
473 Offset_raw(raw
) = Val_int(offset
);
474 Static_raw(raw
) = Val_false
;
478 CAMLprim value
ml_raw_alloc_static (value kind
, value len
) /* ML */
482 int size
= raw_sizeof(kind
) * Int_val(len
);
485 if (kind
== MLTAG_double
&& sizeof(double) > sizeof(long)) {
486 data
= stat_alloc (size
+sizeof(long));
487 offset
= ((long)data
% sizeof(double) ? sizeof(value
) : 0);
488 } else data
= stat_alloc (size
);
489 raw
= alloc_small (SIZE_RAW
, 0);
490 Kind_raw(raw
) = kind
;
491 Size_raw(raw
) = Val_int(size
);
492 Base_raw(raw
) = (value
) data
;
493 Offset_raw(raw
) = Val_int(offset
);
494 Static_raw(raw
) = Val_true
;
498 CAMLprim value
ml_raw_free_static (value raw
) /* ML */
500 if (Static_raw(raw
) != Val_int(1)) invalid_argument ("Raw.free_static");
501 stat_free (Void_raw(raw
));
502 Base_raw(raw
) = Val_unit
;
503 Size_raw(raw
) = Val_unit
;
504 Offset_raw(raw
) = Val_unit
;
505 Static_raw(raw
) = Val_false
;