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 caml_invalid_argument (char *) Noreturn
;
21 static int raw_sizeof (value kind
)
45 CAMLprim value
ml_raw_sizeof (value kind
) /* ML */
47 return Val_int(raw_sizeof(kind
));
50 static void check_size (value raw
, long pos
, char *msg
)
53 (pos
+1) * raw_sizeof(Kind_raw(raw
)) > Int_val(Size_raw(raw
)))
54 caml_invalid_argument (msg
);
57 CAMLprim value
ml_raw_get (value raw
, value pos
) /* ML */
59 long i
= Long_val(pos
);
61 check_size (raw
,i
,"Raw.get");
62 switch (Kind_raw(raw
)) {
65 return Val_long ((unsigned char) Byte_raw(raw
)[i
]);
67 return Val_long (Byte_raw(raw
)[i
]);
69 return Val_long (Short_raw(raw
)[i
]);
71 return Val_long ((unsigned short) Short_raw(raw
)[i
]);
73 return Val_long (Int_raw(raw
)[i
]);
75 return Val_long ((unsigned int) Int_raw(raw
)[i
]);
77 return Val_long (Long_raw(raw
)[i
]);
79 return Val_long ((unsigned long) Long_raw(raw
)[i
]);
84 CAMLprim value
ml_raw_read (value raw
, value pos
, value len
) /* ML */
87 int i
, l
= Int_val(len
);
90 check_size (raw
,s
+l
-1,"Raw.read");
91 if (l
<0 || s
<0) caml_invalid_argument("Raw.read");
92 ret
= caml_alloc_shr (l
, 0);
93 switch (Kind_raw(raw
)) {
97 unsigned char *byte_raw
= (unsigned char *)Byte_raw(raw
)+s
;
98 for (i
= 0; i
< l
; i
++)
99 Field(ret
,i
) = Val_long (*byte_raw
++);
104 char *byte_raw
= Byte_raw(raw
)+s
;
105 for (i
= 0; i
< l
; i
++)
106 Field(ret
,i
) = Val_long (*byte_raw
++);
111 short *short_raw
= Short_raw(raw
)+s
;
112 for (i
= 0; i
< l
; i
++)
113 Field(ret
,i
) = Val_long (*short_raw
++);
118 unsigned short *short_raw
= (unsigned short *)Short_raw(raw
)+s
;
119 for (i
= 0; i
< l
; i
++)
120 Field(ret
,i
) = Val_long (*short_raw
++);
125 int *int_raw
= Int_raw(raw
)+s
;
126 for (i
= 0; i
< l
; i
++)
127 Field(ret
,i
) = Val_long (*int_raw
++);
132 unsigned int *int_raw
= (unsigned int *)Int_raw(raw
)+s
;
133 for (i
= 0; i
< l
; i
++)
134 Field(ret
,i
) = Val_long (*int_raw
++);
139 long *long_raw
= Long_raw(raw
)+s
;
140 for (i
= 0; i
< l
; i
++)
141 Field(ret
,i
) = Val_long (*long_raw
++);
146 unsigned long *long_raw
= (unsigned long *)Long_raw(raw
)+s
;
147 for (i
= 0; i
< l
; i
++)
148 Field(ret
,i
) = Val_long (*long_raw
++);
155 CAMLprim value
ml_raw_read_string (value raw
, value pos
, value len
) /* ML */
158 int s
= Int_val(pos
);
159 int l
= Int_val(len
);
162 if (l
<0 || s
<0 || s
+l
> Int_val(Size_raw(raw
)))
163 caml_invalid_argument("Raw.read_string");
164 ret
= caml_alloc_string (l
);
165 memcpy (Bp_val(ret
), Bp_val(Addr_raw(raw
))+s
, l
);
169 CAMLprim value
ml_raw_write_string (value raw
, value pos
, value data
) /* ML */
171 int s
= Int_val(pos
);
172 int l
= caml_string_length(data
);
174 if (s
<0 || s
+l
> Int_val(Size_raw(raw
)))
175 caml_invalid_argument("Raw.write_string");
176 memcpy (Bp_val(Addr_raw(raw
))+s
, String_val(data
), l
);
180 CAMLprim value
ml_raw_set (value raw
, value pos
, value data
) /* ML */
182 long i
= Long_val(pos
);
184 check_size (raw
,i
,"Raw.set");
185 switch (Kind_raw(raw
)) {
189 Byte_raw(raw
)[i
] = Long_val(data
);
193 Short_raw(raw
)[i
] = Long_val(data
);
196 Int_raw(raw
)[i
] = Long_val(data
);
199 Int_raw(raw
)[i
] = Long_val((unsigned long) data
);
202 Long_raw(raw
)[i
] = Long_val(data
);
205 Long_raw(raw
)[i
] = Long_val((unsigned long) data
);
211 CAMLprim value
ml_raw_write (value raw
, value pos
, value data
) /* ML */
213 int s
= Int_val(pos
);
214 int i
, l
= Wosize_val(data
);
216 check_size (raw
,s
+l
-1,"Raw.write");
217 if (s
<0) caml_invalid_argument("Raw.write");
219 switch (Kind_raw(raw
)) {
224 char *byte_raw
= Byte_raw(raw
)+s
;
225 for (i
= 0; i
< l
; i
++)
226 *byte_raw
++ = Long_val(Field(data
,i
));
232 short *short_raw
= Short_raw(raw
)+s
;
233 for (i
= 0; i
< l
; i
++)
234 *short_raw
++ = Long_val(Field(data
,i
));
239 int *int_raw
= Int_raw(raw
)+s
;
240 for (i
= 0; i
< l
; i
++)
241 *int_raw
++ = Long_val(Field(data
,i
));
246 int *int_raw
= Int_raw(raw
)+s
;
247 for (i
= 0; i
< l
; i
++)
248 *int_raw
++ = Long_val((unsigned long) Field(data
,i
));
253 long *long_raw
= Long_raw(raw
)+s
;
254 for (i
= 0; i
< l
; i
++)
255 *long_raw
++ = Long_val(Field(data
,i
));
260 long *long_raw
= Long_raw(raw
)+s
;
261 for (i
= 0; i
< l
; i
++)
262 *long_raw
++ = Long_val((unsigned long) Field(data
,i
));
269 CAMLprim value
ml_raw_get_float (value raw
, value pos
) /* ML */
271 long i
= Long_val(pos
);
273 check_size (raw
,i
,"Raw.get_float");
274 if (Kind_raw(raw
) == MLTAG_float
)
275 return caml_copy_double ((double) Float_raw(raw
)[i
]);
277 return caml_copy_double (Double_raw(raw
)[i
]);
280 CAMLprim value
ml_raw_read_float (value raw
, value pos
, value len
) /* ML */
282 int s
= Int_val(pos
);
283 int i
, l
= Int_val(len
);
284 value ret
= Val_unit
;
286 check_size (raw
,s
+l
-1,"Raw.read_float");
287 if (l
<0 || s
<0) caml_invalid_argument("Raw.read_float");
288 ret
= caml_alloc_shr (l
*sizeof(double)/sizeof(value
), Double_array_tag
);
289 if (Kind_raw(raw
) == MLTAG_float
) {
290 float *float_raw
= Float_raw(raw
)+s
;
291 for (i
= 0; i
< l
; i
++)
292 Store_double_field(ret
, i
, (double) *float_raw
++);
294 double *double_raw
= Double_raw(raw
)+s
;
295 for (i
= 0; i
< l
; i
++)
296 Store_double_field(ret
, i
, *double_raw
++);
301 CAMLprim value
ml_raw_set_float (value raw
, value pos
, value data
) /* ML */
303 long i
= Long_val(pos
);
305 check_size (raw
,i
,"Raw.set_float");
306 if (Kind_raw(raw
) == MLTAG_float
)
307 Float_raw(raw
)[i
] = (float) Double_val(data
);
309 Double_raw(raw
)[i
] = Double_val(data
);
313 CAMLprim value
ml_raw_write_float (value raw
, value pos
, value data
) /* ML */
315 int s
= Int_val(pos
);
316 int i
, l
= Wosize_val(data
)*sizeof(value
)/sizeof(double);
318 check_size (raw
,s
+l
-1,"Raw.write_float");
319 if (s
<0) caml_invalid_argument("Raw.write_float");
320 if (Kind_raw(raw
) == MLTAG_float
) {
321 float *float_raw
= Float_raw(raw
)+s
;
322 for (i
= 0; i
< l
; i
++)
323 *float_raw
++ = (float) Double_field(data
,i
);
325 double *double_raw
= Double_raw(raw
)+s
;
326 for (i
= 0; i
< l
; i
++)
327 *double_raw
++ = Double_field(data
,i
);
332 #ifdef ARCH_BIG_ENDIAN
340 /* Here we suppose that:
341 * sizeof(int) == 2*sizeof(short)
342 * sizeof(long) == 2*sizeof(int) (64-bit architectures)
343 * sizeof(long) == 2*sizeof(short) (otherwise)
346 #define Hint_raw(raw) ((unsigned short *) Short_raw(raw))
348 #ifdef ARCH_SIXTYFOUR
349 #define Hlong_raw(raw) ((unsigned int *) Int_raw(raw))
351 #define Hlong_raw(raw) ((unsigned short *) Short_raw(raw))
354 CAMLprim value
ml_raw_get_hi (value raw
, value pos
) /* ML */
356 long i
= Long_val(pos
);
358 check_size (raw
,i
,"Raw.get_hi");
359 switch (Kind_raw(raw
)) {
362 return Val_long (Hint_raw(raw
)[2*i
+HI_OFFSET
]);
365 return Val_long (Hlong_raw(raw
)[2*i
+HI_OFFSET
]);
370 CAMLprim value
ml_raw_get_lo (value raw
, value pos
) /* ML */
372 long i
= Long_val(pos
);
374 check_size (raw
,i
,"Raw.get_lo");
375 switch (Kind_raw(raw
)) {
378 return Val_long ((unsigned long) Hint_raw(raw
)[2*i
+LO_OFFSET
]);
381 return Val_long ((unsigned long) Hlong_raw(raw
)[2*i
+LO_OFFSET
]);
386 CAMLprim value
ml_raw_set_hi (value raw
, value pos
, value data
) /* ML */
388 long i
= Long_val(pos
);
390 check_size (raw
,i
,"Raw.set_hi");
391 switch (Kind_raw(raw
)) {
394 Hint_raw(raw
)[2*i
+HI_OFFSET
] = Long_val(data
);
398 Hlong_raw(raw
)[2*i
+HI_OFFSET
] = Long_val(data
);
404 CAMLprim value
ml_raw_set_lo (value raw
, value pos
, value data
) /* ML */
406 long i
= Long_val(pos
);
408 check_size (raw
,i
,"Raw.set_lo");
409 switch (Kind_raw(raw
)) {
412 Hint_raw(raw
)[2*i
+LO_OFFSET
] = Long_val(data
);
416 Hlong_raw(raw
)[2*i
+LO_OFFSET
] = Long_val(data
);
422 CAMLprim value
ml_raw_get_long (value raw
, value pos
) /* ML */
424 long i
= Long_val(pos
);
426 check_size (raw
,i
,"Raw.get_long");
427 switch (Kind_raw(raw
)) {
430 return caml_copy_nativeint (Int_raw(raw
)[i
]);
433 return caml_copy_nativeint (Long_raw(raw
)[i
]);
438 CAMLprim value
ml_raw_set_long (value raw
, value pos
, value data
) /* ML */
440 long i
= Long_val(pos
);
442 check_size (raw
,i
,"Raw.set_long");
443 switch (Kind_raw(raw
)) {
446 Int_raw(raw
)[i
] = Nativeint_val(data
);
450 Long_raw(raw
)[i
] = Nativeint_val(data
);
456 CAMLprim value
ml_raw_alloc (value kind
, value len
) /* ML */
461 int size
= raw_sizeof(kind
) * Int_val(len
);
464 if (kind
== MLTAG_double
&& sizeof(double) > sizeof(value
)) {
465 data
= caml_alloc_shr ((size
-1)/sizeof(value
)+2, Abstract_tag
);
466 offset
= (data
% sizeof(double) ? sizeof(value
) : 0);
467 } else data
= caml_alloc_shr ((size
-1)/sizeof(value
)+1, Abstract_tag
);
468 raw
= caml_alloc_small (SIZE_RAW
,0);
469 Kind_raw(raw
) = kind
;
470 Size_raw(raw
) = Val_int(size
);
471 Base_raw(raw
) = data
;
472 Offset_raw(raw
) = Val_int(offset
);
473 Static_raw(raw
) = Val_false
;
477 CAMLprim value
ml_raw_alloc_static (value kind
, value len
) /* ML */
481 int size
= raw_sizeof(kind
) * Int_val(len
);
484 if (kind
== MLTAG_double
&& sizeof(double) > sizeof(long)) {
485 data
= caml_stat_alloc (size
+sizeof(long));
486 offset
= ((long)data
% sizeof(double) ? sizeof(value
) : 0);
487 } else data
= caml_stat_alloc (size
);
488 raw
= caml_alloc_small (SIZE_RAW
, 0);
489 Kind_raw(raw
) = kind
;
490 Size_raw(raw
) = Val_int(size
);
491 Base_raw(raw
) = (value
) data
;
492 Offset_raw(raw
) = Val_int(offset
);
493 Static_raw(raw
) = Val_true
;
497 CAMLprim value
ml_raw_free_static (value raw
) /* ML */
499 if (Static_raw(raw
) != Val_int(1)) caml_invalid_argument ("Raw.free_static");
500 caml_stat_free (Void_raw(raw
));
501 Base_raw(raw
) = Val_unit
;
502 Size_raw(raw
) = Val_unit
;
503 Offset_raw(raw
) = Val_unit
;
504 Static_raw(raw
) = Val_false
;