/* $Id: ml_raw.c,v 1.16 2007-04-13 02:48:43 garrigue Exp $ */ #include <string.h>#include <caml/misc.h>#include <caml/mlvalues.h>#include <caml/memory.h>#include <caml/alloc.h>#include <caml/config.h>#include "raw_tags.h"#include "ml_raw.h" #define SIZE_BYTE	sizeof(char)#define SIZE_SHORT	sizeof(short)#define SIZE_INT	sizeof(int)#define SIZE_LONG	sizeof(long)#define SIZE_FLOAT	sizeof(float)#define SIZE_DOUBLE	sizeof(double) extern void caml_invalid_argument (char *) Noreturn; static int raw_sizeof (value kind){    switch (kind) {    case MLTAG_bitmap:    case MLTAG_byte:    case MLTAG_ubyte:	return SIZE_BYTE;    case MLTAG_short:    case MLTAG_ushort:	return SIZE_SHORT;    case MLTAG_int:    case MLTAG_uint:	return SIZE_INT;    case MLTAG_long:    case MLTAG_ulong:	return SIZE_LONG;    case MLTAG_float:	return SIZE_FLOAT;    case MLTAG_double:	return SIZE_DOUBLE;    }    return 0;} CAMLprim value ml_raw_sizeof (value kind)  /* ML */{    return Val_int(raw_sizeof(kind));} static void check_size (value raw, long pos, char *msg){    if (pos < 0 ||	(pos+1) * raw_sizeof(Kind_raw(raw)) > Int_val(Size_raw(raw)))	caml_invalid_argument (msg);} CAMLprim value ml_raw_get (value raw, value pos)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.get");    switch (Kind_raw(raw)) {    case MLTAG_bitmap:    case MLTAG_ubyte:	return Val_long ((unsigned char) Byte_raw(raw)[i]);    case MLTAG_byte:	return Val_long (Byte_raw(raw)[i]);    case MLTAG_short:	return Val_long (Short_raw(raw)[i]);    case MLTAG_ushort:	return Val_long ((unsigned short) Short_raw(raw)[i]);    case MLTAG_int:	return Val_long (Int_raw(raw)[i]);    case MLTAG_uint:	return Val_long ((unsigned int) Int_raw(raw)[i]);    case MLTAG_long:	return Val_long (Long_raw(raw)[i]);    case MLTAG_ulong:	return Val_long ((unsigned long) Long_raw(raw)[i]);    }    return Val_unit;} CAMLprim value ml_raw_read (value raw, value pos, value len)  /* ML */{    int s = Int_val(pos);    int i, l = Int_val(len);    value ret;     check_size (raw,s+l-1,"Raw.read");    if (l<0 || s<0) caml_invalid_argument("Raw.read");    ret = caml_alloc_shr (l, 0);    switch (Kind_raw(raw)) {    case MLTAG_bitmap:    case MLTAG_ubyte:    {	unsigned char *byte_raw = (unsigned char *)Byte_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*byte_raw++);	break;    }    case MLTAG_byte:    {	char *byte_raw = Byte_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*byte_raw++);	break;    }    case MLTAG_short:    {	short *short_raw = Short_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*short_raw++);	break;    }    case MLTAG_ushort:    {	unsigned short *short_raw = (unsigned short *)Short_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*short_raw++);	break;    }    case MLTAG_int:    {	int *int_raw = Int_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*int_raw++);	break;    }    case MLTAG_uint:    {	unsigned int *int_raw = (unsigned int *)Int_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*int_raw++);	break;    }    case MLTAG_long:    {	long *long_raw = Long_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*long_raw++);	break;    }    case MLTAG_ulong:    {	unsigned long *long_raw = (unsigned long *)Long_raw(raw)+s;	for (i = 0; i < l; i++)	    Field(ret,i) = Val_long (*long_raw++);	break;    }    }    return ret;} CAMLprim value ml_raw_read_string (value raw, value pos, value len)  /* ML */{    CAMLparam1(raw);    int s = Int_val(pos);    int l = Int_val(len);    value ret;     if (l<0 || s<0 || s+l > Int_val(Size_raw(raw)))	caml_invalid_argument("Raw.read_string");    ret = caml_alloc_string (l);    memcpy (Bp_val(ret), Bp_val(Addr_raw(raw))+s, l);    CAMLreturn(ret);} CAMLprim value ml_raw_write_string (value raw, value pos, value data)  /* ML */{    int s = Int_val(pos);    int l = caml_string_length(data);     if (s<0 || s+l > Int_val(Size_raw(raw)))	caml_invalid_argument("Raw.write_string");    memcpy (Bp_val(Addr_raw(raw))+s, String_val(data), l);    return Val_unit;} CAMLprim value ml_raw_set (value raw, value pos, value data)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.set");    switch (Kind_raw(raw)) {    case MLTAG_bitmap:    case MLTAG_ubyte:    case MLTAG_byte:	Byte_raw(raw)[i] = Long_val(data);	break;    case MLTAG_short:    case MLTAG_ushort:	Short_raw(raw)[i] = Long_val(data);	break;    case MLTAG_int:	Int_raw(raw)[i] = Long_val(data);	break;    case MLTAG_uint:	Int_raw(raw)[i] = Long_val((unsigned long) data);	break;    case MLTAG_long:	Long_raw(raw)[i] = Long_val(data);	break;    case MLTAG_ulong:	Long_raw(raw)[i] = Long_val((unsigned long) data);	break;    }    return Val_unit;} CAMLprim value ml_raw_write (value raw, value pos, value data)  /* ML */{    int s = Int_val(pos);    int i, l = Wosize_val(data);     check_size (raw,s+l-1,"Raw.write");    if (s<0) caml_invalid_argument("Raw.write");     switch (Kind_raw(raw)) {    case MLTAG_bitmap:    case MLTAG_ubyte:    case MLTAG_byte:    {	char *byte_raw = Byte_raw(raw)+s;	for (i = 0; i < l; i++)	    *byte_raw++ = Long_val(Field(data,i));	break;    }    case MLTAG_short:    case MLTAG_ushort:    {	short *short_raw = Short_raw(raw)+s;	for (i = 0; i < l; i++)	    *short_raw++ = Long_val(Field(data,i));	break;    }    case MLTAG_int:    {	int *int_raw = Int_raw(raw)+s;	for (i = 0; i < l; i++)	    *int_raw++ = Long_val(Field(data,i));	break;    }    case MLTAG_uint:    {	int *int_raw = Int_raw(raw)+s;	for (i = 0; i < l; i++)	    *int_raw++ = Long_val((unsigned long) Field(data,i));	break;    }    case MLTAG_long:    {	long *long_raw = Long_raw(raw)+s;	for (i = 0; i < l; i++)	    *long_raw++ = Long_val(Field(data,i));	break;    }    case MLTAG_ulong:    {	long *long_raw = Long_raw(raw)+s;	for (i = 0; i < l; i++)	    *long_raw++ = Long_val((unsigned long) Field(data,i));	break;    }    }    return Val_unit;} CAMLprim value ml_raw_get_float (value raw, value pos)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.get_float");    if (Kind_raw(raw) == MLTAG_float)	return caml_copy_double ((double) Float_raw(raw)[i]);    else	return caml_copy_double (Double_raw(raw)[i]);} CAMLprim value ml_raw_read_float (value raw, value pos, value len)  /* ML */{    int s = Int_val(pos);    int i, l = Int_val(len);    value ret = Val_unit;     check_size (raw,s+l-1,"Raw.read_float");    if (l<0 || s<0) caml_invalid_argument("Raw.read_float");    ret = caml_alloc_shr (l*sizeof(double)/sizeof(value), Double_array_tag);    if (Kind_raw(raw) == MLTAG_float) {	float *float_raw = Float_raw(raw)+s;	for (i = 0; i < l; i++)	    Store_double_field(ret, i, (double) *float_raw++);    } else {	double *double_raw = Double_raw(raw)+s;	for (i = 0; i < l; i++)	    Store_double_field(ret, i, *double_raw++);    }    return ret;} CAMLprim value ml_raw_set_float (value raw, value pos, value data)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.set_float");    if (Kind_raw(raw) == MLTAG_float)	Float_raw(raw)[i] = (float) Double_val(data);    else	Double_raw(raw)[i] = Double_val(data);    return Val_unit;} CAMLprim value ml_raw_write_float (value raw, value pos, value data)  /* ML */{    int s = Int_val(pos);    int i, l = Wosize_val(data)*sizeof(value)/sizeof(double);     check_size (raw,s+l-1,"Raw.write_float");    if (s<0) caml_invalid_argument("Raw.write_float");    if (Kind_raw(raw) == MLTAG_float) {	float *float_raw = Float_raw(raw)+s;	for (i = 0; i < l; i++)	    *float_raw++ = (float) Double_field(data,i);    } else {	double *double_raw = Double_raw(raw)+s;	for (i = 0; i < l; i++)	    *double_raw++ = Double_field(data,i);    }    return Val_unit;} #ifdef ARCH_BIG_ENDIAN#define HI_OFFSET 1#define LO_OFFSET 0#else#define HI_OFFSET 0#define LO_OFFSET 1#endif /* Here we suppose that: *    sizeof(int)  == 2*sizeof(short) *    sizeof(long) == 2*sizeof(int)   (64-bit architectures) *    sizeof(long) == 2*sizeof(short) (otherwise) */ #define Hint_raw(raw) ((unsigned short *) Short_raw(raw)) #ifdef ARCH_SIXTYFOUR#define Hlong_raw(raw) ((unsigned int *) Int_raw(raw))#else#define Hlong_raw(raw) ((unsigned short *) Short_raw(raw))#endif CAMLprim value ml_raw_get_hi (value raw, value pos)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.get_hi");    switch (Kind_raw(raw)) {    case MLTAG_int:    case MLTAG_uint:	return Val_long (Hint_raw(raw)[2*i+HI_OFFSET]);    case MLTAG_long:    case MLTAG_ulong:	return Val_long (Hlong_raw(raw)[2*i+HI_OFFSET]);    }    return Val_unit;} CAMLprim value ml_raw_get_lo (value raw, value pos)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.get_lo");    switch (Kind_raw(raw)) {    case MLTAG_int:    case MLTAG_uint:	return Val_long ((unsigned long) Hint_raw(raw)[2*i+LO_OFFSET]);    case MLTAG_long:    case MLTAG_ulong:	return Val_long ((unsigned long) Hlong_raw(raw)[2*i+LO_OFFSET]);    }    return Val_unit;} CAMLprim value ml_raw_set_hi (value raw, value pos, value data)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.set_hi");    switch (Kind_raw(raw)) {    case MLTAG_int:    case MLTAG_uint:	Hint_raw(raw)[2*i+HI_OFFSET] = Long_val(data);	break;    case MLTAG_long:    case MLTAG_ulong:	Hlong_raw(raw)[2*i+HI_OFFSET] = Long_val(data);	break;    }    return Val_unit;} CAMLprim value ml_raw_set_lo (value raw, value pos, value data)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.set_lo");    switch (Kind_raw(raw)) {    case MLTAG_int:    case MLTAG_uint:	Hint_raw(raw)[2*i+LO_OFFSET] = Long_val(data);	break;    case MLTAG_long:    case MLTAG_ulong:	Hlong_raw(raw)[2*i+LO_OFFSET] = Long_val(data);	break;    }    return Val_unit;} CAMLprim value ml_raw_get_long (value raw, value pos)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.get_long");    switch (Kind_raw(raw)) {    case MLTAG_int:    case MLTAG_uint:        return caml_copy_nativeint (Int_raw(raw)[i]);    case MLTAG_long:    case MLTAG_ulong:        return caml_copy_nativeint (Long_raw(raw)[i]);    }    return Val_unit;} CAMLprim value ml_raw_set_long (value raw, value pos, value data)  /* ML */{    long i = Long_val(pos);     check_size (raw,i,"Raw.set_long");    switch (Kind_raw(raw)) {    case MLTAG_int:    case MLTAG_uint:	Int_raw(raw)[i] = Nativeint_val(data);	break;    case MLTAG_long:    case MLTAG_ulong:	Long_raw(raw)[i] = Nativeint_val(data);	break;    }    return Val_unit;} CAMLprim value ml_raw_alloc (value kind, value len)  /* ML */{    CAMLparam0();    CAMLlocal1(data);    value raw;    int size = raw_sizeof(kind) * Int_val(len);    int offset = 0;     if (kind == MLTAG_double && sizeof(double) > sizeof(value)) {	data = caml_alloc_shr ((size-1)/sizeof(value)+2, Abstract_tag);	offset = (data % sizeof(double) ? sizeof(value) : 0);    } else data = caml_alloc_shr ((size-1)/sizeof(value)+1, Abstract_tag);    raw = caml_alloc_small (SIZE_RAW,0);    Kind_raw(raw) = kind;    Size_raw(raw) = Val_int(size);    Base_raw(raw) = data;    Offset_raw(raw) = Val_int(offset);    Static_raw(raw) = Val_false;    CAMLreturn(raw);} CAMLprim value ml_raw_alloc_static (value kind, value len)  /* ML */{    value raw;    void  *data;    int size = raw_sizeof(kind) * Int_val(len);    int offset = 0;     if (kind == MLTAG_double && sizeof(double) > sizeof(long)) {	data = caml_stat_alloc (size+sizeof(long));	offset = ((long)data % sizeof(double) ? sizeof(value) : 0);    } else data = caml_stat_alloc (size);    raw = caml_alloc_small (SIZE_RAW, 0);    Kind_raw(raw) = kind;    Size_raw(raw) = Val_int(size);    Base_raw(raw) = (value) data;    Offset_raw(raw) = Val_int(offset);    Static_raw(raw) = Val_true;    return raw;} CAMLprim value ml_raw_free_static (value raw)  /* ML */{    if (Static_raw(raw) != Val_int(1)) caml_invalid_argument ("Raw.free_static");    caml_stat_free (Void_raw(raw));

Lines 1–500 of 506. Load more