void Font::setGlyphPixel(char key, int x, int y, bool value)
{
int offset = glyphOffsets_[Byte(key)];
int width = glyphWidths_[Byte(key)];
int index = offset + y * width + x;
glyphData_[index] = value;
}
CAMLprim value lwt_unix_read(value fd, value buf, value vofs, value vlen)
{
intnat ofs, len, written;
DWORD numbytes, numwritten;
DWORD err = 0;
Begin_root (buf);
ofs = Long_val(vofs);
len = Long_val(vlen);
written = 0;
if (len > 0) {
numbytes = len;
if (Descr_kind_val(fd) == KIND_SOCKET) {
int ret;
SOCKET s = Socket_val(fd);
ret = recv(s, &Byte(buf, ofs), numbytes, 0);
if (ret == SOCKET_ERROR) err = WSAGetLastError();
numwritten = ret;
} else {
HANDLE h = Handle_val(fd);
if (! ReadFile(h, &Byte(buf, ofs), numbytes, &numwritten, NULL))
err = GetLastError();
}
if (err) {
win32_maperr(err);
uerror("write", Nothing);
}
written = numwritten;
}
End_roots();
return Val_long(written);
}
CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,
value vlength)
{
CAMLparam4 (vchannel, buff, vstart, vlength);
struct channel * channel = Channel(vchannel);
intnat start, len;
int n, avail, nread;
Lock(channel);
/* We cannot call caml_getblock here because buff may move during
caml_do_read */
start = Long_val(vstart);
len = Long_val(vlength);
n = len >= INT_MAX ? INT_MAX : (int) len;
avail = channel->max - channel->curr;
if (n <= avail) {
memmove(&Byte(buff, start), channel->curr, n);
channel->curr += n;
} else if (avail > 0) {
memmove(&Byte(buff, start), channel->curr, avail);
channel->curr += avail;
n = avail;
} else {
nread = caml_do_read(channel->fd, channel->buff,
channel->end - channel->buff);
channel->offset += nread;
channel->max = channel->buff + nread;
if (n > nread) n = nread;
memmove(&Byte(buff, start), channel->buff, n);
channel->curr = channel->buff + n;
}
Unlock(channel);
CAMLreturn (Val_long(n));
}
CAMLprim value caml_string_length_based_compare(value s1, value s2)
{
mlsize_t len1, len2;
mlsize_t temp;
int res;
if (s1 == s2) return Val_int(0);
len1 = Wosize_val(s1);
temp = Bsize_wsize(len1) - 1 ;
len1 = temp - Byte(s1,temp);
len2 = Wosize_val(s2);
temp = Bsize_wsize(len2) - 1 ;
len2 = temp - Byte(s2,temp);
if (len1 != len2)
{
if (len1 < len2 ) {
return Val_long_clang(-1);
} else {
return Val_long_clang(1);
}
}
else {
res = memcmp(String_val(s1), String_val(s2), len1);
if(res < 0) return Val_long_clang(-1);
if(res > 0) return Val_long_clang(1);
return Val_long_clang(0);
}
}
bool Font::getGlyphPixel(char key, int x, int y)
{
int offset = glyphOffsets_[Byte(key)];
int width = glyphWidths_[Byte(key)];
int index = offset + y * width + x;
return glyphData_[index];
}
CAMLprim value caml_ml_string_length(value s)
{
mlsize_t temp;
temp = Bosize_val(s) - 1;
Assert (Byte (s, temp - Byte (s, temp)) == 0);
return Val_long(temp - Byte (s, temp));
}
CAMLexport mlsize_t caml_string_length(value s)
{
mlsize_t temp;
temp = Bosize_val(s) - 1;
Assert (Byte (s, temp - Byte (s, temp)) == 0);
return temp - Byte (s, temp);
}
value camlzip_bzDecompress(value vzs, value srcbuf, value srcpos, value srclen,
value dstbuf, value dstpos, value dstlen)
{
#ifdef USE_BZIP2
bz_stream * zs = BZStream_val(vzs);
int retcode;
long used_in, used_out;
value res;
zs->next_in = &Byte(srcbuf, Long_val(srcpos));
zs->avail_in = Long_val(srclen);
zs->next_out = &Byte(dstbuf, Long_val(dstpos));
zs->avail_out = Long_val(dstlen);
retcode = BZ2_bzDecompress(zs);
if (retcode < 0)
camlzip_bzerror("Bzlib.decompress", retcode);
used_in = Long_val(srclen) - zs->avail_in;
used_out = Long_val(dstlen) - zs->avail_out;
zs->next_in = NULL; /* not required, but cleaner */
zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */
res = alloc_small(3, 0);
Field(res, 0) = Val_bool(retcode == BZ_STREAM_END);
Field(res, 1) = Val_int(used_in);
Field(res, 2) = Val_int(used_out);
return res;
#else
failwith("Bzip2 compression not supported");
#endif
}
CAMLprim value caml_des_transform(value ckey, value src, value src_ofs,
value dst, value dst_ofs)
{
d3des_transform((u32 *) String_val(ckey),
(u8 *) &Byte(src, Long_val(src_ofs)),
(u8 *) &Byte(dst, Long_val(dst_ofs)));
return Val_unit;
}
CAMLprim value caml_aes_decrypt(value ckey, value src, value src_ofs,
value dst, value dst_ofs)
{
rijndaelDecrypt((const u32 *) String_val(ckey),
Byte(ckey, Cooked_key_NR_offset),
(const u8 *) &Byte(src, Long_val(src_ofs)),
(u8 *) &Byte(dst, Long_val(dst_ofs)));
return Val_unit;
}
static value concat_strings(const char *s1, const char *s2)
{
int l1 = strlen(s1) ;
int l2 = strlen(s2) ;
value res = alloc_string(l1+l2+2);
memcpy(String_val(res), s1, l1) ;
Byte(res, l1) = ':' ;
Byte(res, l1+1) = ' ' ;
memcpy(String_val(res)+l1+2, s2, l2) ;
return res ;
}
value largeint_set_str(value dest, value str, value base)
{
long changesign = (Byte(str, 0) == '~');
long res;
if (changesign) { Byte(str, 0) = '-'; }
res = mpz_set_str(Large_val(dest), String_val(str), Long_val(base));
if (changesign) { Byte(str, 0) = '~'; }
if (0 == res)
{ return Val_unit; }
else
{ failwith("Ill-formed number string"); }
}
value largeint_get_str(value src, value base)
{
long len = 3 + mpz_sizeinbase(Large_val(src), Long_val(base));
char *buffer = (char*)(malloc(len));
value res;
mpz_get_str(buffer, Long_val(base), Large_val(src));
res = copy_string(buffer);
free(buffer);
/* Use the SML sign character: */
if (Byte(res, 0) == '-')
{ Byte(res, 0) = '~'; }
return res;
}
value string_mlval(value val)
{
value s;
byteoffset_t res;
extern_size = INITIAL_EXTERN_SIZE;
extern_block =
(byteoffset_t *) stat_alloc(extern_size * sizeof(unsigned long));
extern_pos = 0;
extern_table_size = INITIAL_EXTERN_TABLE_SIZE;
alloc_extern_table();
extern_table_used = 0;
res = emit_all(val);
stat_free((char *) extern_table);
/* We can allocate a string in the heap since the argument value is
not used from now on. */
if (extern_pos == 0)
{
s = alloc_string(8);
((size_t *)s)[0] = (size_t)extern_pos;
((size_t *)s)[1] = (size_t)res;
}
else
{
s = alloc_string(4 + extern_pos * sizeof(unsigned long));
((size_t *)s)[0] = (size_t)extern_pos;
memmove(&Byte(s, 4), (char *)extern_block, extern_pos * sizeof(unsigned long));
}
stat_free((char *) extern_block);
return s;
}
CAMLprim value unix_write(value fd, value buf, value vofs, value vlen)
{
long ofs, len, written;
int numbytes, ret;
char iobuf[UNIX_BUFFER_SIZE];
Begin_root (buf);
ofs = Long_val(vofs);
len = Long_val(vlen);
written = 0;
while (len > 0) {
numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
memmove (iobuf, &Byte(buf, ofs), numbytes);
enter_blocking_section();
ret = write(Int_val(fd), iobuf, numbytes);
leave_blocking_section();
if (ret == -1) {
if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break;
uerror("write", Nothing);
}
written += ret;
ofs += ret;
len -= ret;
}
End_roots();
return Val_long(written);
}
CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len,
value flags)
{
int ret, cv_flags;
long numbytes;
char iobuf[UNIX_BUFFER_SIZE];
value res;
value adr = Val_unit;
union sock_addr_union addr;
socklen_param_type addr_len;
cv_flags = convert_flag_list(flags, msg_flag_table);
Begin_roots2 (buff, adr);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
addr_len = sizeof(addr);
enter_blocking_section();
ret = recvfrom(Int_val(sock), iobuf, (int) numbytes, cv_flags,
&addr.s_gen, &addr_len);
leave_blocking_section();
if (ret == -1) uerror("recvfrom", Nothing);
memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
adr = alloc_sockaddr(&addr, addr_len, -1);
res = alloc_small(2, 0);
Field(res, 0) = Val_int(ret);
Field(res, 1) = adr;
End_roots();
return res;
}
CAMLprim value unix_read(value fd, value buf, value ofs, value vlen)
{
intnat len;
DWORD numbytes, numread;
char iobuf[UNIX_BUFFER_SIZE];
DWORD err = 0;
Begin_root (buf);
len = Long_val(vlen);
numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
if (Descr_kind_val(fd) == KIND_SOCKET) {
int ret;
SOCKET s = Socket_val(fd);
enter_blocking_section();
ret = recv(s, iobuf, numbytes, 0);
if (ret == SOCKET_ERROR) err = WSAGetLastError();
leave_blocking_section();
numread = ret;
} else {
HANDLE h = Handle_val(fd);
enter_blocking_section();
if (! ReadFile(h, iobuf, numbytes, &numread, NULL))
err = GetLastError();
leave_blocking_section();
}
if (err) {
win32_maperr(err);
uerror("read", Nothing);
}
memmove (&Byte(buf, Long_val(ofs)), iobuf, numread);
End_roots();
return Val_int(numread);
}
HRESULT COutArchive::WriteHeaderReal(const CItem &item)
{
char record[NFileHeader::kRecordSize];
char *cur = record;
int i;
for (i = 0; i < NFileHeader::kRecordSize; i++)
record[i] = 0;
// RETURN_IF_NOT_TRUE(CopyString(header.Name, item.Name, NFileHeader::kNameSize));
if (item.Name.Length() > NFileHeader::kNameSize)
return E_FAIL;
MyStrNCpy(cur, item.Name, NFileHeader::kNameSize);
cur += NFileHeader::kNameSize;
RETURN_IF_NOT_TRUE(MakeOctalString8(cur, item.Mode));
cur += 8;
RETURN_IF_NOT_TRUE(MakeOctalString8(cur, item.UID));
cur += 8;
RETURN_IF_NOT_TRUE(MakeOctalString8(cur, item.GID));
cur += 8;
RETURN_IF_NOT_TRUE(MakeOctalString12(cur, item.Size));
cur += 12;
RETURN_IF_NOT_TRUE(MakeOctalString12(cur, item.MTime));
cur += 12;
memmove(cur, NFileHeader::kCheckSumBlanks, 8);
cur += 8;
*cur++ = item.LinkFlag;
RETURN_IF_NOT_TRUE(CopyString(cur, item.LinkName, NFileHeader::kNameSize));
cur += NFileHeader::kNameSize;
memmove(cur, item.Magic, 8);
cur += 8;
RETURN_IF_NOT_TRUE(CopyString(cur, item.UserName, NFileHeader::kUserNameSize));
cur += NFileHeader::kUserNameSize;
RETURN_IF_NOT_TRUE(CopyString(cur, item.GroupName, NFileHeader::kGroupNameSize));
cur += NFileHeader::kUserNameSize;
if (item.DeviceMajorDefined)
RETURN_IF_NOT_TRUE(MakeOctalString8(cur, item.DeviceMajor));
cur += 8;
if (item.DeviceMinorDefined)
RETURN_IF_NOT_TRUE(MakeOctalString8(cur, item.DeviceMinor));
cur += 8;
UInt32 checkSumReal = 0;
for(i = 0; i < NFileHeader::kRecordSize; i++)
checkSumReal += Byte(record[i]);
RETURN_IF_NOT_TRUE(MakeOctalString8(record + 148, checkSumReal));
return WriteBytes(record, NFileHeader::kRecordSize);
}
CAMLprim value unix_recv(value sock, value buff, value ofs, value len,
value flags)
{
SOCKET s = Socket_val(sock);
int flg = convert_flag_list(flags, msg_flag_table);
int ret;
intnat numbytes;
char iobuf[UNIX_BUFFER_SIZE];
DWORD err = 0;
Begin_root (buff);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
enter_blocking_section();
ret = recv(s, iobuf, (int) numbytes, flg);
if (ret == -1) err = WSAGetLastError();
leave_blocking_section();
if (ret == -1) {
win32_maperr(err);
uerror("recv", Nothing);
}
memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
End_roots();
return Val_int(ret);
}
CAMLprim value
caml_backpack_mq_setattr(value val_mq, value val_flags)
{
CAMLparam2(val_mq, val_flags);
struct mq_attr attr = {
.mq_flags = caml_convert_flag_list(val_flags, mqueue_flags)
};
if (mq_setattr(Int_val(val_mq), &attr, NULL) == -1)
uerror("mq_setattr", Nothing);
CAMLreturn(Val_unit);
}
CAMLprim value
caml_backpack_mq_send(value val_mq, value val_buff, value val_ofs,
value val_len, value val_prio)
{
CAMLparam5(val_mq, val_buff, val_ofs, val_len, val_prio);
if (mq_send(Int_val(val_mq), &Byte(val_buff, Long_val(val_ofs)),
Long_val(val_len), Int_val(val_prio)) == -1)
uerror("mq_send", Nothing);
CAMLreturn(Val_unit);
}
bool CDecoder::DecodeLz(Int32 pos)
{
while (pos > 0)
{
UInt32 number = m_MainDecoder.DecodeSymbol(&m_InBitStream);
UInt32 length, distance;
if (number < 256)
{
m_OutWindowStream.PutByte(Byte(number));
pos--;
continue;
}
else if (number >= kMatchNumber)
{
number -= kMatchNumber;
length = kNormalMatchMinLen + UInt32(kLenStart[number]) +
m_InBitStream.ReadBits(kLenDirectBits[number]);
number = m_DistDecoder.DecodeSymbol(&m_InBitStream);
if (number >= kDistTableSize)
return false;
distance = kDistStart[number] + m_InBitStream.ReadBits(kDistDirectBits[number]);
if (distance >= kDistLimit3)
{
length += 2 - ((distance - kDistLimit4) >> 31);
// length++;
// if (distance >= kDistLimit4)
// length++;
}
}
static mlsize_t size_after_shrinkage(value64 * p, mlsize_t len)
/* len is the length in 64-bit words */
{
mlsize_t res;
value64 * q;
header_t hd;
mlsize_t n;
for (q = p + len, res = 0; p < q; /*nothing*/) {
hd = (header_t)(p->lsw);
if (p->msw != 0) return 0;
p++;
n = Wosize_hd(hd);
res++;
switch(Tag_hd(hd)) {
case String_tag:
{ mlsize_t ofs_last_byte, len, new_sz;
ofs_last_byte = n * sizeof(value64) - 1;
len = ofs_last_byte - Byte(p, ofs_last_byte);
new_sz = (len + sizeof(value)) / sizeof(value);
res += new_sz;
break;
}
case Double_tag:
res += sizeof(double) / sizeof(value);
break;
default:
res += n; /* all fields will be shrunk 64 -> 32 */
break;
}
p += n;
}
return res;
}
value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest)
{
SOCKET s = Socket_val(sock);
int flg = convert_flag_list(flags, msg_flag_table);
int ret;
intnat numbytes;
char iobuf[UNIX_BUFFER_SIZE];
union sock_addr_union addr;
socklen_param_type addr_len;
DWORD err = 0;
get_sockaddr(dest, &addr, &addr_len);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
enter_blocking_section();
ret = sendto(s, iobuf, (int) numbytes, flg, &addr.s_gen, addr_len);
if (ret == -1) err = WSAGetLastError();
leave_blocking_section();
if (ret == -1) {
win32_maperr(err);
uerror("sendto", Nothing);
}
return Val_int(ret);
}
CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value flags)
{
SOCKET s = Socket_val(sock);
int flg = convert_flag_list(flags, msg_flag_table);
int ret;
intnat numbytes;
char iobuf[UNIX_BUFFER_SIZE];
value res;
value adr = Val_unit;
union sock_addr_union addr;
socklen_param_type addr_len;
DWORD err = 0;
Begin_roots2 (buff, adr);
numbytes = Long_val(len);
if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
addr_len = sizeof(sock_addr);
enter_blocking_section();
ret = recvfrom(s, iobuf, (int) numbytes, flg, &addr.s_gen, &addr_len);
if (ret == -1) err = WSAGetLastError();
leave_blocking_section();
if (ret == -1) {
win32_maperr(err);
uerror("recvfrom", Nothing);
}
memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
adr = alloc_sockaddr(&addr, addr_len, -1);
res = alloc_small(2, 0);
Field(res, 0) = Val_int(ret);
Field(res, 1) = adr;
End_roots();
return res;
}
value
Pvm_upkstring(void)
{
CAMLparam0();
int bufid,bytes,msgtag,tid;
char *tab;
CAMLlocal1(s);
int res,i;
res=pvm_upkint(&bytes,1,1);
if (res<0)
TreatError(res);
tab=(char *)malloc(sizeof(char)*bytes);
res = pvm_upkbyte(tab,bytes,1);
if (res<0)
{
free(tab);
TreatError(res);
}
s = alloc_string(bytes);
for (i=0;i<bytes;i++) Byte(s,i)=tab[i];
free(tab);
CAMLreturn(s);
}
EXTERN value md5sum(value str) /* ML */
{
byte *buf;
byte digest[16], pr64[25];
int n, len, start;
MD5state *s;
s = nil;
len = string_length(str);
start = 0;
buf = calloc(256,64);
for(;;){
if (len - start < 128*64)
n = len - start;
else
n = 128*64;
bcopy(&Byte(str, start), buf, n);
start += n;
if(n <= 0 || n & 0x3f)
break;
s = md5(buf, n, 0, s);
}
md5(buf, n, digest, s);
enc64(pr64,digest,sizeof(digest));
pr64[22] = '\0'; /* chop trailing == */
free(buf);
return copy_string((char *)pr64);
}
value sml_ord(value s)
{
long i;
if( string_length(s) == 0 )
raiseprimitive0(SYS__EXN_ORD);
i = (unsigned char) *(&Byte(s,0));
return LONG_TO_VAL(i);
}
void Font::addGlyph(char key, int width, int height)
{
if (height_ && height != height_) {
std::stringstream message;
message << "Glyph height mismatch: " << key;
throw Error(message.str());
}
height_ = height;
glyphOffsets_[Byte(key)] = glyphData_.size();
glyphWidths_[Byte(key)] = width;
for (int y = 0; y < height; ++y) {
for (int x = 0; x < width; ++x) {
glyphData_.push_back(false);
}
}
}
bool TGAImageDecoder::SaveRLE32(DataStream* _ds,const Image* img) {
const Data* buffer = img->GetData();
if (!buffer) return false;
const Byte* data = buffer->GetData();
UInt32 pixels = img->GetWidth()*img->GetHeight();
BufferedWriter ds(_ds,1024);
UInt32 line_pixels = img->GetWidth();
while (pixels) {
UInt32 serie = 1;
for (size_t i=1; i<128; i++) {
if (i>=pixels) break;
if (i>=line_pixels) break;
if ((data[i*4]!=data[0])||
(data[i*4+1]!=data[1]) ||
(data[i*4+2]!=data[2]) ||
(data[i*4+3]!=data[3])) break;
serie++;
}
if (serie>=2) {
Byte c = (serie+127);
ds.Write(&c,1);
ds.Write(data,4);
pixels-=serie;
line_pixels-=serie;
data+=serie*4;
} else {
for (size_t i=1; i<128; i++) {
if (i>=pixels) {
break;
}
if (i>=line_pixels) break;
if ((data[i*4]==data[i*4-4])&&
(data[i*4+1]==data[i*4-3])&&
(data[i*4+2]==data[i*4-2])&&
(data[i*4+3]==data[i*4-1])) {
break;
}
serie++;
}
Byte c = ( Byte(serie-1) );
assert(c<128);
ds.Write(&c,1);
for (size_t i=0; i<serie; i++) {
ds.Write(&data[2],1);
ds.Write(&data[1],1);
ds.Write(&data[0],1);
ds.Write(&data[3],1);
data+=4;
}
pixels-=serie;
line_pixels-=serie;
}
if (line_pixels==0)
line_pixels = img->GetWidth();
}
return true;
}
CAMLprim value caml_des_cook_key(value key, value ofs, value direction)
{
CAMLparam2(key,direction);
value ckey = alloc_string(Cooked_key_size);
d3des_cook_key((u8 *) &Byte(key, Long_val(ofs)),
Int_val(direction),
(u32 *) String_val(ckey));
CAMLreturn(ckey);
}
