CAMLprim void stub_init () {
CAMLparam0 ();
CAMLlocal3 (poll_in_list, poll_out_list, poll_in_out_list);
POLL_IN_HASH = caml_hash_variant("Poll_in");
POLL_OUT_HASH = caml_hash_variant("Poll_out");
ZMQ_EXCEPTION_NAME = caml_named_value("zmq exception");
POOL_LIST_CACHE[0] = EMPTY_LIST;
poll_out_list = caml_alloc_small(2, 0);
Field(poll_out_list, 0) = POLL_OUT_HASH;
Field(poll_out_list, 1) = EMPTY_LIST;
caml_register_generational_global_root(&POOL_LIST_CACHE[POLL_OUT]);
POOL_LIST_CACHE[POLL_OUT] = poll_out_list;
poll_in_out_list = caml_alloc_small(2, 0);
Field(poll_in_out_list, 0) = POLL_IN_HASH;
Field(poll_in_out_list, 1) = poll_out_list;
caml_register_generational_global_root(&POOL_LIST_CACHE[POLL_IN|POLL_OUT]);
POOL_LIST_CACHE[POLL_IN|POLL_OUT] = poll_in_out_list;
poll_in_list = caml_alloc_small(2, 0);
Field(poll_in_list, 0) = POLL_IN_HASH;
Field(poll_in_list, 1) = EMPTY_LIST;
caml_register_generational_global_root(&POOL_LIST_CACHE[POLL_IN]);
POOL_LIST_CACHE[POLL_IN] = poll_in_list;
CAMLreturn0;
}
CAMLprim value mmdb_ml_open(value s)
{
CAMLparam1(s);
CAMLlocal1(mmdb_handle);
if (polymorphic_variants.poly_bool == 0 ||
polymorphic_variants.poly_float == 0 ||
polymorphic_variants.poly_int == 0 ||
polymorphic_variants.poly_string == 0) {
polymorphic_variants.poly_bool = caml_hash_variant("Bool");
polymorphic_variants.poly_float = caml_hash_variant("Float");
polymorphic_variants.poly_int = caml_hash_variant("Int");
polymorphic_variants.poly_string = caml_hash_variant("String");
}
unsigned int len = caml_string_length(s);
char *copied = caml_strdup(String_val(s));
if (strlen(copied) != (size_t)len) {
caml_failwith("Could not open MMDB database");
}
MMDB_s *this_db = caml_stat_alloc(sizeof(*this_db));
int status = MMDB_open(copied, MMDB_MODE_MMAP, this_db);
mmdb_handle = caml_alloc_custom(&mmdb_custom_ops, sizeof(*this_db), 0, 1);
check_status(status);
memcpy(Data_custom_val(mmdb_handle), this_db, sizeof(*this_db));
caml_stat_free(this_db);
caml_stat_free(copied);
CAMLreturn(mmdb_handle);
}
value caml_QQmlPropertyMap_insert(value _map, value _propName, value _variant) {
CAMLparam3(_map, _propName, _variant);
// copy and paste from the generated file for QAbstractModel subclass
// TODO: move this conversion to the lablqml
QVariant newval;
if (Is_block(_variant)) {
if (caml_hash_variant("bool") == Field(_variant,0) )
// without cast it will create Qvariant of int
newval = QVariant::fromValue( (bool)Bool_val(Field(_variant,1)) );
else if (caml_hash_variant("string") == Field(_variant,0) )
newval = QVariant::fromValue(QString(String_val(Field(_variant,1))));
else if (caml_hash_variant("int") == Field(_variant,0) )
newval = QVariant::fromValue(Int_val(Field(_variant,1)));
else if (caml_hash_variant("float") == Field(_variant,0) )
newval = QVariant::fromValue(Double_val(Field(_variant,1)));
else if (caml_hash_variant("qobject") == Field(_variant,0) )
newval = QVariant::fromValue((QObject*) (Field(Field(_variant,1),0)));
else
Q_ASSERT_X(false, "While converting OCaml value to QVariant",
"Unknown variant tag");
} else { // empty QVariant
newval = QVariant();
}
CamlPropertyMap *map = (*(CamlPropertyMap**) (Data_custom_val(_map)));
Q_ASSERT_X(map != NULL, __func__, "Trying to use QQmlPropertyMap object which is NULL");
map->insert( QString(String_val(_propName)), newval);
CAMLreturn(Val_unit);
}
static inline int
SDL_TTF_STYLE_Flags_ml2c(v)
{
if (v == caml_hash_variant("normal")) return TTF_STYLE_NORMAL;
if (v == caml_hash_variant("bold")) return TTF_STYLE_BOLD;
if (v == caml_hash_variant("italic")) return TTF_STYLE_ITALIC;
if (v == caml_hash_variant("underline")) return TTF_STYLE_UNDERLINE;
if (v == caml_hash_variant("strikethrough")) return TTF_STYLE_STRIKETHROUGH;
}
int quota_command (value v_user_or_group, int command) {
if (v_user_or_group == caml_hash_variant("User"))
return QCMD(command, USRQUOTA);
if (v_user_or_group == caml_hash_variant("Group"))
return QCMD(command, GRPQUOTA);
caml_failwith("Unix.Quota: I only know about `User and `Group");
}
CAMLexport value caml_cairo_font_type_init(value unit)
{
/* noalloc */
caml_cairo_font_type[0] = caml_hash_variant("Toy");
caml_cairo_font_type[1] = caml_hash_variant("Ft");
caml_cairo_font_type[2] = caml_hash_variant("Win32");
caml_cairo_font_type[3] = caml_hash_variant("Quartz");
caml_cairo_font_type[4] = caml_hash_variant("User");
return(Val_unit);
}
static value c_to_mlvariant(variant *vtable, int val)
{
int size = vtable[0].val;
int i;
for(i=1; i <= size; i++)
if(val == vtable[i].val) {
LOG("DEBUG: hash_variant(%s)\n", vtable[i].name);
return caml_hash_variant(vtable[i].name);
}
LOG("no equals %d\n", val);
return caml_hash_variant(vtable[1].name);
}
static inline Uint32
sdlinit_val(value v)
{
if (v == caml_hash_variant("TIMER")) return SDL_INIT_TIMER;
if (v == caml_hash_variant("AUDIO")) return SDL_INIT_AUDIO;
if (v == caml_hash_variant("VIDEO")) return SDL_INIT_VIDEO;
if (v == caml_hash_variant("JOYSTICK")) return SDL_INIT_JOYSTICK;
if (v == caml_hash_variant("HAPTIC")) return SDL_INIT_HAPTIC;
if (v == caml_hash_variant("GAMECONTROLLER")) return SDL_INIT_GAMECONTROLLER;
if (v == caml_hash_variant("EVERYTHING")) return SDL_INIT_EVERYTHING;
if (v == caml_hash_variant("NOPARACHUTE")) return SDL_INIT_NOPARACHUTE;
return 0x00000000;
}
void QWidget_twin::acceptDrops() {
CAMLparam0();
CAMLlocal3(camlobj,_ans,meth);
printf("Calling QSpinBox::acceptDrops of object = %p\n",this);
GET_CAML_OBJECT(this,the_caml_object)
camlobj = (value) the_caml_object;
meth = caml_get_public_method( camlobj, caml_hash_variant("acceptDrops"));
assert(meth!=0);
_ans = caml_callback(meth, camlobj);;
bool ans = Bool_val(_ans);;
CAMLreturnT(bool,ans);
}
//onMouseClicked: string->unit
void Controller::onMouseClicked(QString x0) {
CAMLparam0();
CAMLlocal3(_ans,_meth,_x0);
CAMLlocalN(_args,2);
CAMLlocal1(_cca0);
value _camlobj = this->_camlobjHolder;
Q_ASSERT(Is_block(_camlobj));
Q_ASSERT(Tag_val(_camlobj) == Object_tag);
_meth = caml_get_public_method(_camlobj, caml_hash_variant("onMouseClicked"));
_args[0] = _camlobj;
_cca0 = caml_copy_string(x0.toLocal8Bit().data() );
_args[1] = _cca0;
caml_callbackN(_meth, 2, _args);
CAMLreturn0;
}
void QWidget_twin::keyPressEvent(QKeyEvent *ev) {
CAMLparam0();
CAMLlocal3(meth,camlobj,_ev);
GET_CAML_OBJECT(this,camlobj); // get ocaml object from QObject's property
printf ("inside QWidget_twin::keyPressedEvent, camlobj = %p, this=%p\n", (void*)camlobj, this);
meth = caml_get_public_method( camlobj, caml_hash_variant("keyPressEvent"));
if (meth==0)
printf ("total fail\n");
printf ("tag of meth is %d\n", Tag_val(meth) );
printf("calling callback of meth = %p\n",(void*)meth);
setAbstrClass(_ev,QKeyEvent,ev);
value *caller = caml_named_value("make_qKeyEvent");
_ev = caml_callback(*caller, _ev);
caml_callback2(meth, camlobj,_ev);
printf ("exit from QWidget_twin::keyPressedEvent\n");
CAMLreturn0;
}
/* Fetchs the named OCaml-values + caches them and
calculates + caches the variant hash values */
CAMLprim value pcre_ocaml_init(value __unused v_unit)
{
pcre_exc_Error = caml_named_value("Pcre.Error");
pcre_exc_Backtrack = caml_named_value("Pcre.Backtrack");
var_Start_only = caml_hash_variant("Start_only");
var_ANCHORED = caml_hash_variant("ANCHORED");
var_Char = caml_hash_variant("Char");
var_Not_studied = caml_hash_variant("Not_studied");
var_Studied = caml_hash_variant("Studied");
var_Optimal = caml_hash_variant("Optimal");
pcre_callout = &pcre_callout_handler;
return Val_unit;
}
/* Fetchs the named OCaml-values + caches them and
calculates + caches the variant hash values */
CAMLprim value pcre_ocaml_init(value __unused v_unit)
{
pcre_exc_Not_found = caml_named_value("Pcre.Not_found");
pcre_exc_Partial = caml_named_value("Pcre.Partial");
pcre_exc_BadPartial = caml_named_value("Pcre.BadPartial");
pcre_exc_BadPattern = caml_named_value("Pcre.BadPattern");
pcre_exc_BadUTF8 = caml_named_value("Pcre.BadUTF8");
pcre_exc_InternalError = caml_named_value("Pcre.InternalError");
pcre_exc_MatchLimit = caml_named_value("Pcre.MatchLimit");
pcre_exc_Backtrack = caml_named_value("Pcre.Backtrack");
var_Start_only = caml_hash_variant("Start_only");
var_ANCHORED = caml_hash_variant("ANCHORED");
var_Char = caml_hash_variant("Char");
var_Not_studied = caml_hash_variant("Not_studied");
var_Studied = caml_hash_variant("Studied");
var_Optimal = caml_hash_variant("Optimal");
pcre_callout = &pcre_callout_handler;
return Val_unit;
}
Qt::WindowFlags enum_of_caml_Qt_WindowFlags(value v) {
if (v==caml_hash_variant("CustomizeWindowHint")) return Qt::CustomizeWindowHint;
if (v==caml_hash_variant("WindowTitleHint")) return Qt::WindowTitleHint;
if (v==caml_hash_variant("FramelessWindowHint")) return Qt::FramelessWindowHint;
if (v==caml_hash_variant("WindowType_Mask")) return Qt::WindowType_Mask;
if (v==caml_hash_variant("SubWindow")) return Qt::SubWindow;
if (v==caml_hash_variant("Desktop")) return Qt::Desktop;
if (v==caml_hash_variant("SplashScreen")) return Qt::SplashScreen;
if (v==caml_hash_variant("ToolTip")) return Qt::ToolTip;
if (v==caml_hash_variant("Tool")) return Qt::Tool;
if (v==caml_hash_variant("Popup")) return Qt::Popup;
if (v==caml_hash_variant("Drawer")) return Qt::Drawer;
if (v==caml_hash_variant("Sheet")) return Qt::Sheet;
if (v==caml_hash_variant("Dialog")) return Qt::Dialog;
if (v==caml_hash_variant("Window")) return Qt::Window;
if (v==caml_hash_variant("Widget")) return Qt::Widget;
printf("if u see this line, the thereis a bug in enum generation");
return Qt::CustomizeWindowHint;
}
int main() {
printf("#define Val_A (%d)\n", caml_hash_variant("A"));
return 0;
}
CAMLprim value mlresolv_query(value vdname, value vclass, value vtype)
{
union {
HEADER hdr; /* defined in resolv.h */
u_char buf[PACKETSZ]; /* defined in arpa/nameser.h */
} response;
int rc;
u_char *cp, *tcp;
u_char *eom;
char r_name[MAXDNAME+1];
u_short r_class;
u_short r_type;
u_int32_t r_ttl;
u_short r_len;
int ancount, qdcount;
value vres = Val_emptylist;
if(vtype == caml_hash_variant("PTR")) {
int a, b, c, d;
a = b = c = d = 0;
sscanf(String_val(vdname), "%u.%u.%u.%u", &a, &b, &c, &d);
sprintf(r_name, "%u.%u.%u.%u.in-addr.arpa", d, c, b, a);
rc = res_query(r_name,
mlvariant_to_c(rr_class, vclass),
mlvariant_to_c(rr_type, vtype),
(u_char*)&response, sizeof(response));
} else
rc = res_query(String_val(vdname),
mlvariant_to_c(rr_class, vclass),
mlvariant_to_c(rr_type, vtype),
(u_char*)&response, sizeof(response));
if (rc < 0) {
switch (h_errno) {
case NETDB_INTERNAL:
mlresolv_error(errno);
case HOST_NOT_FOUND: /* Authoritative Answer Host not found */
raise_constant(*mlresolv_host_not_found_exn);
case TRY_AGAIN: /* Non-Authoritative Host not found, or SERVERFAIL */
raise_constant(*mlresolv_try_again_exn);
case NO_RECOVERY:
raise_constant(*mlresolv_no_recovery_exn);
case NO_DATA: /* Valid name, no data record of requested type */
raise_constant(*mlresolv_no_data_exn);
case NETDB_SUCCESS: /* no problem */
defaykt:
failwith("res_query: unknown error");
}
}
cp = (u_char *)&response.buf + sizeof(HEADER);
eom = (u_char *)&response.buf + rc;
ancount = ntohs(response.hdr.ancount) + ntohs(response.hdr.nscount);
qdcount = ntohs(response.hdr.qdcount);
for (; (qdcount > 0) && (cp < eom); qdcount--) {
rc = dn_skipname(cp, eom) + QFIXEDSZ;
if(rc < 0)
failwith("dn_skipname failed");
cp += rc;
}
for (; (ancount > 0) && (cp < eom); ancount--) {
value vrdata, vfields = Val_unit;
rc = dn_expand(response.buf, eom, cp, (void*)r_name, MAXDNAME);
if(rc < 0)
failwith("dn_expand1 failed");
cp += rc;
NS_GET16(r_type, cp);
NS_GET16(r_class, cp);
NS_GET32(r_ttl, cp);
NS_GET16(r_len, cp);
if(cp + r_len > eom) /* is this check necessary? */
r_len = eom - cp;
tcp = cp;
switch(r_type) {
case ns_t_a:
/* if(r_class == ns_c_in || r_class == ns_c_hs) { */
if(INADDRSZ > r_len)
vfields = copy_string("");
else {
struct in_addr inaddr;
char *address;
bcopy(tcp, (char *)&inaddr, INADDRSZ);
address = (char *)inet_ntoa(inaddr);
vfields = copy_string(address);
}
break;
case ns_t_cname:
case ns_t_ns:
case ns_t_mb:
case ns_t_md:
case ns_t_mf:
case ns_t_mg:
case ns_t_mr:
case ns_t_ptr:
case ns_t_nsap_ptr:
{
char r_name[MAXDNAME+1];
rc = dn_expand(response.buf, eom, cp, (void *) r_name, MAXDNAME);
if(rc < 0)
vfields = copy_string("");
else
vfields = copy_string(r_name);
break;
}
case ns_t_null: /* max up to 65535 */
vfields = caml_alloc_string(r_len);
memmove(String_val(vfields), cp, r_len);
break;
case ns_t_txt: {
int txtlen, rdata_len = r_len;
value newcons, txt;
vfields = Val_emptylist;
while(tcp < eom && *tcp <= rdata_len) {
txtlen = *tcp++;
txt = caml_alloc_string(txtlen);
memmove(String_val(txt), tcp, txtlen);
tcp += txtlen;
rdata_len -= txtlen+1;
newcons = alloc_small(2, 0);
Field(newcons, 0) = txt;
Field(newcons, 1) = vfields;
vfields = newcons;
}
break;
}
case ns_t_srv:
if(INT16SZ * 3 <= r_len) {
char r_name[MAXDNAME+1];
int prio, weight, port;
NS_GET16(prio, tcp);
NS_GET16(weight, tcp);
NS_GET16(port, tcp);
rc = dn_expand(response.buf, eom, tcp, (void *) r_name, MAXDNAME);
vfields = alloc_small(4, 0);
Field(vfields, 0) = Val_int(prio);
Field(vfields, 1) = Val_int(weight);
Field(vfields, 2) = Val_int(port);
if(rc < 0)
Field(vfields, 3) = copy_string("");
else
Field(vfields, 3) = copy_string(r_name);
}
break;
case ns_t_mx:
case ns_t_rt:
case ns_t_afsdb:
if(INT16SZ <= r_len) {
char r_name[MAXDNAME+1];
int prio;
NS_GET16(prio, tcp);
rc = dn_expand(response.buf, eom, tcp, (void *) r_name, MAXDNAME);
vfields = alloc_small(2, 0);
Field(vfields, 0) = Val_int(prio);
if(rc < 0)
Field(vfields, 1) = copy_string("");
else
Field(vfields, 1) = copy_string(r_name);
}
break;
case ns_t_soa:
{
char mname[MAXDNAME+1];
char rname[MAXDNAME+1];
u_int serial, minimum;
int refresh, retry, expire;
if((rc = dn_expand(response.buf, eom, tcp, (void *)mname, MAXDNAME)) < 0)
break;
tcp += rc;
if((rc = dn_expand(response.buf, eom, tcp, (void *)rname, MAXDNAME)) < 0)
break;
tcp += rc;
if (tcp - cp + INT32SZ * 5 > r_len)
break;
NS_GET32(serial, tcp);
NS_GET32(refresh, tcp);
NS_GET32(retry, tcp);
NS_GET32(expire, tcp);
NS_GET32(minimum, tcp);
vfields = alloc_small(7, 0);
Field(vfields, 0) = copy_string(mname);
Field(vfields, 1) = copy_string(rname);
Field(vfields, 2) = Val_int(serial);
Field(vfields, 3) = Val_int(refresh);
Field(vfields, 4) = Val_int(retry);
Field(vfields, 5) = Val_int(expire);
Field(vfields, 6) = Val_int(minimum);
}
break;
case ns_t_minfo:
{
char rmailbx[MAXDNAME+1];
char emailbx[MAXDNAME+1];
if((rc = dn_expand(response.buf, eom, tcp, rmailbx, MAXDNAME)) < 0)
break;
tcp += rc;
if((rc = dn_expand(response.buf, eom, tcp, emailbx, MAXDNAME)) < 0)
break;
vfields = alloc_small(2, 0);
Field(vfields, 0) = copy_string(rmailbx);
Field(vfields, 1) = copy_string(emailbx);
}
break;
/* two strings */
case ns_t_hinfo:
case ns_t_isdn: /* <ISDN-address> <sa> */
case ns_t_nsap:
if(r_len > 0 && *tcp < r_len) {
value str1;
value str2;
rc = *tcp++;
if(r_type == ns_t_nsap) {
int result = 0;
for(; rc; rc--, tcp++)
result += result * 10 + (*tcp - 0x38);
str1 = Val_int(result);
}
else {
str1 = caml_alloc_string(rc);
memmove(String_val(str1), tcp, rc);
tcp += rc;
}
if(rc + 1 > r_len && *tcp + rc + 2 >= r_len) {
rc = *tcp++;
str2 = caml_alloc_string(rc);
memmove(String_val(str2), tcp, rc);
}
else
str2 = copy_string("");
vfields = caml_alloc_small(2, 0);
Field(vfields, 0) = str1;
Field(vfields, 1) = str2;
}
break;
case ns_t_wks:
if(INADDRSZ + 1 <= r_len) {
struct in_addr inaddr;
char* address;
u_short protocol;
value bitmap;
bcopy(tcp, (char *) &inaddr, INADDRSZ);
address = (char*) inet_ntoa(inaddr);
tcp += INADDRSZ;
protocol = *tcp++; /* getprotobynumber(*cp) */
/*
n = 0;
while (cp < eom) {
c = *cp++;
do {
if (c & 0200) {
int port;
port = htons((u_short)n);
if (protocol != NULL)
service = getservbyport(port, protocol->p_name);
else
service = NULL;
if (service != NULL)
doprintf((" %s", service->s_name));
else
doprintf((" %s", dtoa(n)));
}
c <<= 1;
} while (++n & 07);
}
doprintf((" )"));
*/
bitmap = caml_alloc_string(r_len - INADDRSZ - 1);
memmove(String_val(bitmap), tcp, eom - tcp);
vfields = alloc_small(4, 0);
Field(vfields, 0) = copy_string(address);
Field(vfields, 1) = Val_int(protocol);
Field(vfields, 2) = bitmap;
}
break;
case ns_t_rp: /* <mbox-dname> <txt-dname> */
{
char rname1[MAXDNAME+1];
char rname2[MAXDNAME+1];
rc = dn_expand(response.buf, eom, tcp, rname1, MAXDNAME);
if(rc < 0)
break;
tcp += rc;
rc = dn_expand(response.buf, eom, tcp, rname2, MAXDNAME);
if(rc < 0)
break;
vfields = alloc_small(2, 0);
Field(vfields, 0) = copy_string(rname1);
Field(vfields, 1) = copy_string(rname2);
}
break;
case ns_t_x25: /* <PSDN-address> */
if(r_len > 0 && *tcp >= r_len) {
rc = *tcp++;
vfields = caml_alloc_string(rc);
memmove(String_val(vfields), tcp, rc);
}
else
vfields = copy_string("");
break;
case ns_t_px:
if(r_len > INT16SZ) {
int pref;
char rname1[MAXDNAME];
char rname2[MAXDNAME];
NS_GET16(pref, tcp);
rc = dn_expand(response.buf, eom, tcp, rname1, MAXDNAME);
if(rc < 0)
break;
tcp += rc;
rc = dn_expand(response.buf, eom, tcp, rname2, MAXDNAME);
if(rc < 0)
break;
tcp += rc;
vfields = alloc_small(2, 0);
Field(vfields, 0) = copy_string(rname1);
Field(vfields, 1) = copy_string(rname2);
}
break;
case ns_t_gpos:
if(r_len > 0 && *tcp <= r_len) {
float f1, f2, f3;
char *tmp;
rc = *tcp++;
tmp = (char *) malloc(rc + 1);
bcopy(tcp, tmp, rc);
tmp[rc] = '\0';
f1 = atof(tmp);
tcp += rc;
if(tcp < eom && tcp + *tcp <= eom) {
if(*tcp > rc)
tmp = realloc(tmp, *tcp);
rc = *tcp++;
bcopy(tcp, tmp, rc);
tmp[rc] = '\0';
f2 = atof(tmp);
tcp += rc;
}
else
f2 = 0.0;
if(tcp < eom && tcp + *tcp <= eom) {
if(*tcp > rc)
tmp = realloc(tmp, *tcp);
rc = *tcp++;
bcopy(tcp, tmp, rc);
tmp[rc] = '\0';
f3 = atof(tmp);
tcp += rc;
}
else
f3 = 0.0;
free(tmp);
vfields = alloc_small(3, 0);
Field(vfields, 0) = copy_double((double)f1);
Field(vfields, 1) = copy_double((double)f2);
Field(vfields, 2) = copy_double((double)f3);
}
break;
case ns_t_loc:
failwith("LOC not implemented");
/*
if(r_len > 0 && *tcp != 0)
failwith("Invalid version in LOC RDATA");
if(r_len > 0) {
rc = INT
n = INT32SZ + 3*INT32SZ;
if (check_size(rname, type, cp, msg, eor, n) < 0)
break;
c = _getlong(cp);
cp += INT32SZ;
n = _getlong(cp);
doprintf(("\t%s ", pr_spherical(n, "N", "S")));
cp += INT32SZ;
n = _getlong(cp);
doprintf((" %s ", pr_spherical(n, "E", "W")));
cp += INT32SZ;
n = _getlong(cp);
doprintf((" %sm ", pr_vertical(n, "", "-")));
cp += INT32SZ;
doprintf((" %sm", pr_precision((c >> 16) & 0xff)));
doprintf((" %sm", pr_precision((c >> 8) & 0xff)));
doprintf((" %sm", pr_precision((c >> 0) & 0xff)));
break;
*/
/*
case T_UID:
case T_GID:
if(INT32SZ <= r_len)
NS_GET32(rc, cp);
if (dlen == INT32SZ) {
n = _getlong(cp);
doprintf(("\t%s", dtoa(n)));
cp += INT32SZ;
}
break;
case T_UINFO:
doprintf(("\t\"%s\"", stoa(cp, dlen, TRUE)));
cp += dlen;
break;
case T_UNSPEC:
cp += dlen;
break;
case T_AAAA:
if (dlen == IPNGSIZE) {
doprintf(("\t%s", ipng_ntoa(cp)));
cp += IPNGSIZE;
}
break;
case T_SIG:
if (check_size(rname, type, cp, msg, eor, INT16SZ) < 0)
break;
n = _getshort(cp);
if (n >= T_FIRST && n <= T_LAST)
doprintf(("\t%s", pr_type(n)));
else
doprintf(("\t%s", dtoa(n)));
cp += INT16SZ;
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" %s", dtoa(n)));
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" %s", dtoa(n)));
n = 3*INT32SZ + INT16SZ;
if (check_size(rname, type, cp, msg, eor, n) < 0)
break;
doprintf((" ("));
n = _getlong(cp);
doprintf(("\n\t\t\t%s", dtoa(n)));
doprintf(("\t\t;original ttl"));
cp += INT32SZ;
n = _getlong(cp);
doprintf(("\n\t\t\t%s", pr_date(n)));
doprintf(("\t;signature expiration"));
cp += INT32SZ;
n = _getlong(cp);
doprintf(("\n\t\t\t%s", pr_date(n)));
doprintf(("\t;signature inception"));
cp += INT32SZ;
n = _getshort(cp);
doprintf(("\n\t\t\t%s", dtoa(n)));
doprintf(("\t\t;key tag"));
cp += INT16SZ;
n = expand_name(rname, type, cp, msg, eom, dname);
if (n < 0)
break;
doprintf(("\n\t\t\t%s", pr_name(dname)));
cp += n;
if (cp < eor) {
register char *buf;
register int size;
n = eor - cp;
buf = base_ntoa(cp, n);
size = strlength(buf);
cp += n;
while ((n = (size > 64) ? 64 : size) > 0) {
doprintf(("\n\t%s", stoa((u_char *)buf, n, FALSE)));
buf += n; size -= n;
}
}
doprintf(("\n\t\t\t)"));
break;
case T_KEY:
if (check_size(rname, type, cp, msg, eor, INT16SZ) < 0)
break;
n = _getshort(cp);
doprintf(("\t0x%s", xtoa(n)));
cp += INT16SZ;
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" %s", dtoa(n)));
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" %s", dtoa(n)));
if (cp < eor) {
register char *buf;
register int size;
n = eor - cp;
buf = base_ntoa(cp, n);
size = strlength(buf);
cp += n;
doprintf((" ("));
while ((n = (size > 64) ? 64 : size) > 0) {
doprintf(("\n\t%s", stoa((u_char *)buf, n, FALSE)));
buf += n; size -= n;
}
doprintf(("\n\t\t\t)"));
}
break;
case T_NXT:
n = expand_name(rname, type, cp, msg, eom, dname);
if (n < 0)
break;
doprintf(("\t%s", pr_name(dname)));
cp += n;
n = 0;
while (cp < eor) {
c = *cp++;
do {
if (c & 0200) {
if (n >= T_FIRST && n <= T_LAST)
doprintf((" %s", pr_type(n)));
else
doprintf((" %s", dtoa(n)));
}
c <<= 1;
} while (++n & 07);
}
break;
case T_NAPTR:
if (check_size(rname, type, cp, msg, eor, INT16SZ) < 0)
break;
n = _getshort(cp);
doprintf(("\t%s", dtoa(n)));
cp += INT16SZ;
if (check_size(rname, type, cp, msg, eor, INT16SZ) < 0)
break;
n = _getshort(cp);
doprintf((" %s", dtoa(n)));
cp += INT16SZ;
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" \"%s\"", stoa(cp, n, TRUE)));
cp += n;
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" \"%s\"", stoa(cp, n, TRUE)));
cp += n;
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" \"%s\"", stoa(cp, n, TRUE)));
cp += n;
n = expand_name(rname, type, cp, msg, eom, dname);
if (n < 0)
break;
doprintf((" %s", pr_name(dname)));
cp += n;
break;
case T_KX:
if (check_size(rname, type, cp, msg, eor, INT16SZ) < 0)
break;
n = _getshort(cp);
doprintf(("\t%s", dtoa(n)));
cp += INT16SZ;
n = expand_name(rname, type, cp, msg, eom, dname);
if (n < 0)
break;
doprintf((" %s", pr_name(dname)));
cp += n;
break;
case T_CERT:
if (check_size(rname, type, cp, msg, eor, INT16SZ) < 0)
break;
n = _getshort(cp);
doprintf(("\t%s", dtoa(n)));
cp += INT16SZ;
if (check_size(rname, type, cp, msg, eor, INT16SZ) < 0)
break;
n = _getshort(cp);
doprintf((" %s", dtoa(n)));
cp += INT16SZ;
if (check_size(rname, type, cp, msg, eor, 1) < 0)
break;
n = *cp++;
doprintf((" %s", dtoa(n)));
if (cp < eor) {
register char *buf;
register int size;
n = eor - cp;
buf = base_ntoa(cp, n);
size = strlength(buf);
cp += n;
doprintf((" ("));
while ((n = (size > 64) ? 64 : size) > 0) {
doprintf(("\n\t%s", stoa((u_char *)buf, n, FALSE)));
buf += n; size -= n;
}
doprintf(("\n\t\t\t)"));
}
break;
case T_EID:
failwith("EID not implemented");
break;
case T_NIMLOC:
failwith("NIMLOC not implemented");
break;
case T_ATMA:
failwith("ATMA not implemented");
*/
default:
failwith("unknown RDATA type");
}
if(vfields != Val_unit) {
value vrecord, vrdata, newcons;
Begin_root(vres);
vrecord = alloc_small(5, 0);
Field(vrecord, 0) = copy_string(r_name);
Field(vrecord, 1) = c_to_mlvariant(rr_type, r_type);
Field(vrecord, 2) = c_to_mlvariant(rr_class, r_class);
Field(vrecord, 3) = Val_int(r_ttl);
vrdata = alloc_small(2, 0);
Field(vrdata, 0) = c_to_mlvariant(rr_type, r_type);
Field(vrdata, 1) = vfields;
Field(vrecord, 4) = vrdata;
newcons = alloc_small(2, 0);
Field(newcons, 0) = vrecord;
Field(newcons, 1) = vres;
vres = newcons;
End_roots();
vrdata = Val_unit;
}
cp += r_len;
}
return vres;
}
CAMLexport value caml_cairo_surface_kind_init(value unit)
{
/* noalloc */
caml_cairo_surface_kind[0] = caml_hash_variant("Image");
caml_cairo_surface_kind[1] = caml_hash_variant("PDF");
caml_cairo_surface_kind[2] = caml_hash_variant("PS");
caml_cairo_surface_kind[3] = caml_hash_variant("XLib");
caml_cairo_surface_kind[4] = caml_hash_variant("XCB");
caml_cairo_surface_kind[5] = caml_hash_variant("GLITZ");
caml_cairo_surface_kind[6] = caml_hash_variant("Quartz");
caml_cairo_surface_kind[7] = caml_hash_variant("Win32");
caml_cairo_surface_kind[8] = caml_hash_variant("BEOS");
caml_cairo_surface_kind[9] = caml_hash_variant("DirectFB");
caml_cairo_surface_kind[10] = caml_hash_variant("SVG");
caml_cairo_surface_kind[11] = caml_hash_variant("OS2");
caml_cairo_surface_kind[12] = caml_hash_variant("Win32_printing");
caml_cairo_surface_kind[13] = caml_hash_variant("Quartz_image");
caml_cairo_surface_kind[14] = caml_hash_variant("Recording");
return(Val_unit);
}
CAMLprim value semaphore_initialize(value unit) {
CAMLparam1(unit);
eunix = caml_hash_variant("EUnix");
CAMLreturn (Val_unit);
}
