diff -ubrN ocaml-3.12.1/asmrun/Makefile.nt ocaml-3.12.1-new/asmrun/Makefile.nt --- ocaml-3.12.1/asmrun/Makefile.nt 2010-04-28 02:00:27.000000000 -1000 +++ ocaml-3.12.1-new/asmrun/Makefile.nt 2011-12-28 20:02:31.640625000 -1000 @@ -24,13 +24,13 @@ intern.$(O) hash.$(O) sys.$(O) parsing.$(O) gc_ctrl.$(O) terminfo.$(O) \ md5.$(O) obj.$(O) lexing.$(O) win32.$(O) printexc.$(O) callback.$(O) \ weak.$(O) compact.$(O) finalise.$(O) custom.$(O) globroots.$(O) \ - backtrace.$(O) natdynlink.$(O) debugger.$(O) + backtrace.$(O) natdynlink.$(O) debugger.$(O) u8tou16.$(O) LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \ compare.c ints.c floats.c str.c io.c extern.c intern.c hash.c sys.c \ parsing.c gc_ctrl.c terminfo.c md5.c obj.c lexing.c printexc.c callback.c \ weak.c compact.c meta.c finalise.c custom.c main.c globroots.c \ - dynlink.c signals.c debugger.c + dynlink.c signals.c debugger.c u8tou16.c ifeq ($(TOOLCHAIN),mingw) ASMOBJS=$(ARCH).o diff -ubrN ocaml-3.12.1/byterun/Makefile.common ocaml-3.12.1-new/byterun/Makefile.common --- ocaml-3.12.1/byterun/Makefile.common 2010-05-21 01:28:21.000000000 -1000 +++ ocaml-3.12.1-new/byterun/Makefile.common 2011-12-28 20:04:56.843750000 -1000 @@ -24,13 +24,13 @@ compare.o ints.o floats.o str.o array.o io.o extern.o intern.o \ hash.o sys.o meta.o parsing.o gc_ctrl.o terminfo.o md5.o obj.o \ lexing.o callback.o debugger.o weak.o compact.o finalise.o custom.o \ - dynlink.o + dynlink.o u8tou16.o PRIMS=\ alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c \ intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c \ signals.c str.c sys.c terminfo.c callback.c weak.c finalise.c stacks.c \ - dynlink.c backtrace.c + dynlink.c backtrace.c u8tou16.c PUBLIC_INCLUDES=\ alloc.h callback.h config.h custom.h fail.h intext.h \ diff -ubrN ocaml-3.12.1/byterun/sys.c ocaml-3.12.1-new/byterun/sys.c --- ocaml-3.12.1/byterun/sys.c 2011-05-12 05:12:14.000000000 -1000 +++ ocaml-3.12.1-new/byterun/sys.c 2011-12-28 19:58:29.281250000 -1000 @@ -46,6 +46,7 @@ #include "fail.h" #include "instruct.h" #include "mlvalues.h" +#include "memory.h" #include "osdeps.h" #include "signals.h" #include "stacks.h" @@ -54,6 +55,9 @@ #ifndef _WIN32 extern int errno; #endif +#ifdef UTF16 +#include "u8tou16.h" +#endif static char * error_message(void) { @@ -158,7 +162,20 @@ CAMLprim value caml_sys_file_exists(value name) { struct stat st; +#ifdef UTF16 + char * temp=String_val(name); + WCHAR * wtemp; + int retcode; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + retcode=_wstat(wtemp, &st); + free(wtemp); + return Val_bool((retcode==0)); +#else return Val_bool(stat(String_val(name), &st) == 0); +#endif } CAMLprim value caml_sys_is_directory(value name) @@ -175,26 +192,82 @@ CAMLprim value caml_sys_remove(value name) { int ret; +#ifdef UTF16 + char * temp=String_val(name); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + ret = _wunlink(wtemp); + free(wtemp); +#else ret = unlink(String_val(name)); +#endif if (ret != 0) caml_sys_error(name); return Val_unit; } CAMLprim value caml_sys_rename(value oldname, value newname) { +#ifdef UTF16 + char * temp1=String_val(oldname); + char * temp2=String_val(newname); + WCHAR * wtemp1, * wtemp2; + if(is_valid_utf8(temp1)) + wtemp1 = utf8_to_utf16(temp1); + else + wtemp1 = ansi_to_utf16(temp1); + if(is_valid_utf8(temp2)) + wtemp2 = utf8_to_utf16(temp2); + else + wtemp2 = ansi_to_utf16(temp2); + if (_wrename(wtemp1, wtemp2) != 0) +#else if (rename(String_val(oldname), String_val(newname)) != 0) +#endif caml_sys_error(NO_ARG); +#ifdef UTF16 + free(wtemp1); + free(wtemp2); +#endif return Val_unit; } CAMLprim value caml_sys_chdir(value dirname) { +#ifdef UTF16 + char * temp=String_val(dirname); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + if (_wchdir(wtemp) != 0) caml_sys_error(dirname); + free(wtemp); +#else if (chdir(String_val(dirname)) != 0) caml_sys_error(dirname); +#endif return Val_unit; } CAMLprim value caml_sys_getcwd(value unit) { +#ifdef UTF16 + CAMLparam0 (); + CAMLlocal1 (v); + WCHAR buff[4096*2]; + unsigned char * temp; +#ifdef HAS_GETCWD + if (_wgetcwd(buff, sizeof(buff)) == 0) caml_sys_error(NO_ARG); +#else + if (getwd(buff) == 0) caml_sys_error(NO_ARG); +#endif /* HAS_GETCWD */ + temp=utf16_to_utf8(buff); + v=caml_copy_string(temp); + free(temp); + CAMLreturn (v); +#else char buff[4096]; #ifdef HAS_GETCWD if (getcwd(buff, sizeof(buff)) == 0) caml_sys_error(NO_ARG); @@ -202,6 +275,7 @@ if (getwd(buff) == 0) caml_sys_error(NO_ARG); #endif /* HAS_GETCWD */ return caml_copy_string(buff); +#endif } CAMLprim value caml_sys_getenv(value var) diff -ubrN ocaml-3.12.1/byterun/u8tou16.c ocaml-3.12.1-new/byterun/u8tou16.c --- ocaml-3.12.1/byterun/u8tou16.c 1969-12-31 14:00:00.000000000 -1000 +++ ocaml-3.12.1-new/byterun/u8tou16.c 2011-12-28 19:58:29.281250000 -1000 @@ -0,0 +1,311 @@ +#include "u8tou16.h" + +/* Copyright 2005 b8_bavard, INRIA, CML */ +/* + This file is part of mldonkey. + + mldonkey is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + mldonkey is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with mldonkey; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*/ + +/* Stub code to interface with libiconv + * + * taken and modified from + * mldonkey/src/utils/lib/charsetstubs.c + * + */ + +#include +#include +#include + +#include + +#ifdef WIN32 +#define STRICT /* Strict typing, please */ +#include +#undef STRICT +#endif + +#define FALSE 0 +#define TRUE 1 + +#define UTF8_COMPUTE(Char, Mask, Len) \ + if (Char < 128) \ + { \ + Len = 1; \ + Mask = 0x7f; \ + } \ + else if ((Char & 0xe0) == 0xc0) \ + { \ + Len = 2; \ + Mask = 0x1f; \ + } \ + else if ((Char & 0xf0) == 0xe0) \ + { \ + Len = 3; \ + Mask = 0x0f; \ + } \ + else if ((Char & 0xf8) == 0xf0) \ + { \ + Len = 4; \ + Mask = 0x07; \ + } \ + else if ((Char & 0xfc) == 0xf8) \ + { \ + Len = 5; \ + Mask = 0x03; \ + } \ + else if ((Char & 0xfe) == 0xfc) \ + { \ + Len = 6; \ + Mask = 0x01; \ + } \ + else \ + Len = -1; + +#define UTF8_LENGTH(Char) \ + ((Char) < 0x80 ? 1 : \ + ((Char) < 0x800 ? 2 : \ + ((Char) < 0x10000 ? 3 : \ + ((Char) < 0x200000 ? 4 : \ + ((Char) < 0x4000000 ? 5 : 6))))) + + +#define UTF8_GET(Result, Chars, Count, Mask, Len) \ + (Result) = (Chars)[0] & (Mask); \ + for ((Count) = 1; (Count) < (Len); ++(Count)) \ + { \ + if (((Chars)[(Count)] & 0xc0) != 0x80) \ + { \ + (Result) = -1; \ + break; \ + } \ + (Result) <<= 6; \ + (Result) |= ((Chars)[(Count)] & 0x3f); \ + } + +#define UNICODE_VALID(Char) \ + ((Char) < 0x110000 && \ + (((Char) & 0xFFFFF800) != 0xD800) && \ + ((Char) < 0xFDD0 || (Char) > 0xFDEF) && \ + ((Char) & 0xFFFE) != 0xFFFE) + +int +ocaml_utf8_validate (const char *str, + size_t max_len, + const char **end) +{ + + const char *p; + + if (str == NULL) + return FALSE; + + if (end) + *end = str; + + p = str; + + while ((max_len < 0 || (p - str) < max_len) && *p) + { + int i, mask = 0, len; + unsigned int result; + unsigned char c = (unsigned char) *p; + + UTF8_COMPUTE (c, mask, len); + + if (len == -1) + break; + + /* check that the expected number of bytes exists in str */ + if (max_len >= 0 && + ((max_len - (p - str)) < len)) + break; + + UTF8_GET (result, p, i, mask, len); + + if (UTF8_LENGTH (result) != len) /* Check for overlong UTF-8 */ + break; + + if (result == (unsigned int)-1) + break; + + if (!UNICODE_VALID (result)) + break; + + p += len; + } + + if (end) + *end = p; + + /* See that we covered the entire length if a length was + * passed in, or that we ended on a nul if not + */ + if (max_len >= 0 && + p != (str + max_len)) + return FALSE; + else if (max_len < 0 && + *p != '\0') + return FALSE; + else + return TRUE; +} + +unsigned char* +ocaml_convert_with_iconv (const char *str, + size_t len, + iconv_t cd, + size_t *bytes_read, + size_t *bytes_written) +{ + unsigned char *dest; + unsigned char *outp; + const char *p; + size_t inbytes_remaining; + size_t outbytes_remaining; + size_t outbuf_size; + size_t err; + int have_error = FALSE; + + if (len < 0) + len = strlen (str); + + p = str; + inbytes_remaining = len; + outbuf_size = len*2 + 8; /* for unicode */ + + outbytes_remaining = outbuf_size - 1; /* -1 for nul */ + outp = dest = malloc (outbuf_size); + memset(outp,0,outbuf_size); + + iconv(cd,NULL,NULL,NULL,NULL); + again: + err = iconv (cd, (const char **)&p, &inbytes_remaining, (char **)&outp, &outbytes_remaining); + + if (err == (size_t) -1) + { + switch (errno) + { + case EINVAL: + /* Incomplete text, do not report an error */ + break; + case E2BIG: + { + size_t used = outp - dest; + + outbuf_size *= 2; + dest = realloc (dest, outbuf_size); + + outp = dest + used; + outbytes_remaining = outbuf_size - used - 1; /* -1 for nul */ + + goto again; + } + case EILSEQ: + have_error = TRUE; + break; + default: + have_error = TRUE; + break; + } + } + + *outp = '\0'; + + if (bytes_read) + *bytes_read = p - str; + else + { + if ((p - str) != len) + { + if (!have_error) + { + have_error = TRUE; + } + } + } + + if (bytes_written) + *bytes_written = outp - dest; /* Doesn't include '\0' */ + + if (have_error) + { + free (dest); + return NULL; + } + else + return dest; +} + +unsigned char* +ocaml_convert (const char *str, + size_t len, + const char *to_codeset, + const char *from_codeset, + size_t *bytes_read, + size_t *bytes_written) +{ + unsigned char *res; + iconv_t cd; + + cd = iconv_open (to_codeset, from_codeset); + + if (cd == (iconv_t) -1) + { + if (bytes_read) + *bytes_read = 0; + + if (bytes_written) + *bytes_written = 0; + + return NULL; + } + + res = ocaml_convert_with_iconv (str, len, cd, + bytes_read, bytes_written); + + iconv_close (cd); + return res; +} + +int is_valid_utf8(const char *s) +{ + return ocaml_utf8_validate(s,strlen(s),NULL); +} + +unsigned char * ansi_to_utf16(const char * str) +{ + size_t bw = 0; + return ocaml_convert(str,strlen(str), + "UNICODELITTLE","", + NULL,&bw); +} + +unsigned char * utf8_to_utf16(const char * str) +{ + size_t bw = 0; + return ocaml_convert(str,strlen(str), + "UNICODELITTLE","UTF-8", + NULL,&bw); +} + +unsigned char* utf16_to_utf8(const unsigned char * str) +{ + size_t bw = 0; + return ocaml_convert(str,wcslen(str)*sizeof(WCHAR), + "UTF-8","UNICODELITTLE", + NULL,&bw); +} diff -ubrN ocaml-3.12.1/byterun/u8tou16.h ocaml-3.12.1-new/byterun/u8tou16.h --- ocaml-3.12.1/byterun/u8tou16.h 1969-12-31 14:00:00.000000000 -1000 +++ ocaml-3.12.1-new/byterun/u8tou16.h 2011-12-28 19:58:29.296875000 -1000 @@ -0,0 +1,8 @@ +#ifndef WCHAR +typedef unsigned short WCHAR; +#endif + +int is_valid_utf8(const char *s); +unsigned char * ansi_to_utf16(const char * str); +unsigned char * utf8_to_utf16(const char * str); +unsigned char * utf16_to_utf8(const unsigned char * str); diff -ubrN ocaml-3.12.1/config/Makefile.mingw ocaml-3.12.1-new/config/Makefile.mingw --- ocaml-3.12.1/config/Makefile.mingw 2010-05-25 00:00:39.000000000 -1000 +++ ocaml-3.12.1-new/config/Makefile.mingw 2011-12-28 22:30:28.953125000 -1000 @@ -17,7 +17,7 @@ ######### General configuration -PREFIX=C:/ocamlmgw +PREFIX=/mingw ### Where to install the binaries BINDIR=$(PREFIX)/bin @@ -50,7 +50,7 @@ EXT_ASM=.$(S) MANEXT=1 SHARPBANGSCRIPTS=false -PTHREAD_LINK= +PTHREAD_LINK=-lpthread X11_INCLUDES= X11_LINK= DBM_INCLUDES= @@ -69,38 +69,38 @@ DEBUGGER=ocamldebugger CC_PROFILE= SYSTHREAD_SUPPORT=true -EXTRALIBS= +EXTRALIBS=-liconv NATDYNLINK=true CMXS=cmxs ########## Configuration for the bytecode compiler ### Which C compiler to use for the bytecode interpreter. -BYTECC=gcc -mno-cygwin +BYTECC=gcc ### Additional compile-time options for $(BYTECC). (For static linking.) -BYTECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused +BYTECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused -DUTF16 ### Additional link-time options for $(BYTECC). (For static linking.) -BYTECCLINKOPTS= +BYTECCLINKOPTS=-DUTF16 ### Additional compile-time options for $(BYTECC). (For building a DLL.) -DLLCCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused -DCAML_DLL +DLLCCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused -DCAML_DLL -DUTF16 ### Libraries needed -BYTECCLIBS=-lws2_32 -NATIVECCLIBS=-lws2_32 +BYTECCLIBS=-lws2_32 -liconv +NATIVECCLIBS=-lws2_32 -liconv ### How to invoke the C preprocessor CPP=$(BYTECC) -E ### Flexlink FLEXLINK=flexlink -chain mingw -FLEXDIR=$(shell $(FLEXLINK) -where) -IFLEXDIR=-I"$(FLEXDIR)" -MKDLL=$(FLEXLINK) -MKEXE=$(FLEXLINK) -exe -MKMAINDLL=$(FLEXLINK) -maindll +FLEXDIR=/mingw/bin +IFLEXDIR=-I/mingw/include -L/mingw/lib +MKDLL=$(FLEXLINK) -I/mingw/include -L/mingw/lib +MKEXE=$(FLEXLINK) -exe -I/mingw/include -L/mingw/lib +MKMAINDLL=$(FLEXLINK) -maindll -I/mingw/include -L/mingw/lib ### How to build a static library MKLIB=rm -f $(1); ar rcs $(1) $(2) @@ -129,7 +129,7 @@ NATIVECC=$(BYTECC) ### Additional compile-time options for $(NATIVECC). -NATIVECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused +NATIVECCCOMPOPTS=-O -mms-bitfields -Wall -Wno-unused -DUTF16 ### Additional link-time options for $(NATIVECC) NATIVECCLINKOPTS= @@ -139,7 +139,7 @@ ############# Configuration for the contributed libraries -OTHERLIBRARIES=win32unix str num win32graph dynlink bigarray systhreads labltk +OTHERLIBRARIES=win32unix str num win32graph dynlink bigarray systhreads ### Name of the target architecture for the "num" library BNG_ARCH=ia32 diff -ubrN ocaml-3.12.1/otherlibs/unix/chdir.c ocaml-3.12.1-new/otherlibs/unix/chdir.c --- ocaml-3.12.1/otherlibs/unix/chdir.c 2001-12-07 03:41:02.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/unix/chdir.c 2011-12-28 19:58:29.312500000 -1000 @@ -15,11 +15,25 @@ #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_chdir(value path) { int ret; +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + ret = _wchdir(wtemp); + free(wtemp); +#else ret = chdir(String_val(path)); +#endif if (ret == -1) uerror("chdir", path); return Val_unit; } diff -ubrN ocaml-3.12.1/otherlibs/unix/chmod.c ocaml-3.12.1-new/otherlibs/unix/chmod.c --- ocaml-3.12.1/otherlibs/unix/chmod.c 2001-12-07 03:41:02.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/unix/chmod.c 2011-12-28 19:58:29.328125000 -1000 @@ -17,11 +17,25 @@ #include #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_chmod(value path, value perm) { int ret; +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + ret = _wchmod(wtemp, Int_val(perm)); + free(wtemp); +#else ret = chmod(String_val(path), Int_val(perm)); +#endif if (ret == -1) uerror("chmod", path); return Val_unit; } diff -ubrN ocaml-3.12.1/otherlibs/unix/getcwd.c ocaml-3.12.1-new/otherlibs/unix/getcwd.c --- ocaml-3.12.1/otherlibs/unix/getcwd.c 2005-03-24 07:20:54.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/unix/getcwd.c 2011-12-28 19:58:29.328125000 -1000 @@ -16,6 +16,7 @@ #include #include #include +#include #include "unixsupport.h" #if !defined (_WIN32) && !macintosh @@ -31,12 +32,27 @@ #endif #ifdef HAS_GETCWD +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_getcwd(value unit) { +#ifdef UTF16 + CAMLparam0 (); + CAMLlocal1 (v); + WCHAR buff[PATH_MAX*2]; + unsigned char* temp; + if (_wgetcwd(buff, sizeof(buff)) == 0) uerror("getcwd", Nothing); + temp=utf16_to_utf8(buff); + v=copy_string(temp); + free(temp); + CAMLreturn (v); +#else char buff[PATH_MAX]; if (getcwd(buff, sizeof(buff)) == 0) uerror("getcwd", Nothing); return copy_string(buff); +#endif } #else diff -ubrN ocaml-3.12.1/otherlibs/unix/rmdir.c ocaml-3.12.1-new/otherlibs/unix/rmdir.c --- ocaml-3.12.1/otherlibs/unix/rmdir.c 2001-12-07 03:41:02.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/unix/rmdir.c 2011-12-28 19:58:29.328125000 -1000 @@ -15,9 +15,23 @@ #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_rmdir(value path) { +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + if (_wrmdir(wtemp) == -1) uerror("rmdir", path); + free(wtemp); +#else if (rmdir(String_val(path)) == -1) uerror("rmdir", path); +#endif return Val_unit; } diff -ubrN ocaml-3.12.1/otherlibs/unix/unlink.c ocaml-3.12.1-new/otherlibs/unix/unlink.c --- ocaml-3.12.1/otherlibs/unix/unlink.c 2001-12-07 03:41:02.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/unix/unlink.c 2011-12-28 19:58:29.343750000 -1000 @@ -15,9 +15,23 @@ #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_unlink(value path) { +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + if (_wunlink(wtemp) == -1) uerror("unlink", path); + free(wtemp); +#else if (unlink(String_val(path)) == -1) uerror("unlink", path); +#endif return Val_unit; } diff -ubrN ocaml-3.12.1/otherlibs/unix/utimes.c ocaml-3.12.1-new/otherlibs/unix/utimes.c --- ocaml-3.12.1/otherlibs/unix/utimes.c 2005-03-24 07:20:54.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/unix/utimes.c 2011-12-28 19:58:29.343750000 -1000 @@ -25,6 +25,9 @@ #else #include #endif +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_utimes(value path, value atime, value mtime) { @@ -35,7 +38,18 @@ t = × else t = (struct utimbuf *) NULL; +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + if (_wutime(wtemp, t) == -1) uerror("utimes", path); + free(wtemp); +#else if (utime(String_val(path), t) == -1) uerror("utimes", path); +#endif return Val_unit; } diff -ubrN ocaml-3.12.1/otherlibs/win32unix/Makefile.nt ocaml-3.12.1-new/otherlibs/win32unix/Makefile.nt --- ocaml-3.12.1/otherlibs/win32unix/Makefile.nt 2010-05-19 23:40:41.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/Makefile.nt 2011-12-28 20:10:10.062500000 -1000 @@ -22,7 +22,7 @@ select.c sendrecv.c \ shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \ system.c unixsupport.c windir.c winwait.c write.c \ - winlist.c winworker.c windbug.c + winlist.c winworker.c windbug.c u8tou16.c # Files from the ../unix directory UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \ @@ -34,7 +34,7 @@ UNIX_CAML_FILES = unix.mli unixLabels.mli unixLabels.ml ALL_FILES=$(WIN_FILES) $(UNIX_FILES) -WSOCKLIB=$(call SYSLIB,ws2_32) +WSOCKLIB=$(call SYSLIB,ws2_32) $(call SYSLIB,iconv) LIBNAME=unix COBJS=$(ALL_FILES:.c=.$(O)) diff -ubrN ocaml-3.12.1/otherlibs/win32unix/getpid.c ocaml-3.12.1-new/otherlibs/win32unix/getpid.c --- ocaml-3.12.1/otherlibs/win32unix/getpid.c 2001-12-07 03:41:02.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/getpid.c 2011-12-28 19:58:29.359375000 -1000 @@ -16,9 +16,7 @@ #include #include "unixsupport.h" -extern value val_process_id; - CAMLprim value unix_getpid(value unit) { - return val_process_id; + return Val_int(getpid()); } diff -ubrN ocaml-3.12.1/otherlibs/win32unix/link.c ocaml-3.12.1-new/otherlibs/win32unix/link.c --- ocaml-3.12.1/otherlibs/win32unix/link.c 2010-01-22 02:48:24.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/link.c 2011-12-28 19:58:29.359375000 -1000 @@ -17,26 +17,67 @@ #include #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#include +#include +#include +#endif +#ifdef UTF16 +typedef +BOOL (WINAPI *tCreateHardLink)( + LPCWSTR lpFileName, + LPCWSTR lpExistingFileName, + LPSECURITY_ATTRIBUTES lpSecurityAttributes +); +#else typedef BOOL (WINAPI *tCreateHardLink)( LPCTSTR lpFileName, LPCTSTR lpExistingFileName, LPSECURITY_ATTRIBUTES lpSecurityAttributes ); +#endif CAMLprim value unix_link(value path1, value path2) { HMODULE hModKernel32; tCreateHardLink pCreateHardLink; +#ifdef UTF16 + char * temp1=String_val(path1); + char * temp2=String_val(path2); + WCHAR * wtemp1, * wtemp2; + if(is_valid_utf8(temp1)) + wtemp1 = utf8_to_utf16(temp1); + else + wtemp1 = ansi_to_utf16(temp1); + if(is_valid_utf8(temp2)) + wtemp2 = utf8_to_utf16(temp2); + else + wtemp2 = ansi_to_utf16(temp2); +#endif hModKernel32 = GetModuleHandle("KERNEL32.DLL"); +#ifdef UTF16 + pCreateHardLink = + (tCreateHardLink) GetProcAddress(hModKernel32, "CreateHardLinkW"); +#else pCreateHardLink = (tCreateHardLink) GetProcAddress(hModKernel32, "CreateHardLinkA"); +#endif if (pCreateHardLink == NULL) invalid_argument("Unix.link not implemented"); +#ifdef UTF16 + if (! pCreateHardLink(wtemp2, wtemp1, NULL)) { +#else if (! pCreateHardLink(String_val(path2), String_val(path1), NULL)) { +#endif win32_maperr(GetLastError()); uerror("link", path2); } +#ifdef UTF16 + free(wtemp1); + free(wtemp2); +#endif return Val_unit; } diff -ubrN ocaml-3.12.1/otherlibs/win32unix/mkdir.c ocaml-3.12.1-new/otherlibs/win32unix/mkdir.c --- ocaml-3.12.1/otherlibs/win32unix/mkdir.c 2001-12-07 03:41:02.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/mkdir.c 2011-12-28 19:58:29.375000000 -1000 @@ -15,10 +15,24 @@ #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_mkdir(path, perm) value path, perm; { +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + if (_wmkdir(wtemp) == -1) uerror("mkdir", path); + free(wtemp); +#else if (_mkdir(String_val(path)) == -1) uerror("mkdir", path); +#endif return Val_unit; } diff -ubrN ocaml-3.12.1/otherlibs/win32unix/open.c ocaml-3.12.1-new/otherlibs/win32unix/open.c --- ocaml-3.12.1/otherlibs/win32unix/open.c 2008-01-11 06:13:18.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/open.c 2011-12-28 19:58:29.390625000 -1000 @@ -17,6 +17,9 @@ #include #include "unixsupport.h" #include +#ifdef UTF16 +#include "u8tou16.h" +#endif static int open_access_flags[12] = { GENERIC_READ, GENERIC_WRITE, GENERIC_READ|GENERIC_WRITE, @@ -32,6 +35,14 @@ int fileaccess, createflags, fileattrib, filecreate; SECURITY_ATTRIBUTES attr; HANDLE h; +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); +#endif fileaccess = convert_flag_list(flags, open_access_flags); @@ -56,9 +67,16 @@ attr.lpSecurityDescriptor = NULL; attr.bInheritHandle = TRUE; +#ifdef UTF16 + h = CreateFileW(wtemp, fileaccess, + FILE_SHARE_READ | FILE_SHARE_WRITE, &attr, + filecreate, fileattrib, NULL); + free(wtemp); +#else h = CreateFile(String_val(path), fileaccess, FILE_SHARE_READ | FILE_SHARE_WRITE, &attr, filecreate, fileattrib, NULL); +#endif if (h == INVALID_HANDLE_VALUE) { win32_maperr(GetLastError()); uerror("open", path); diff -ubrN ocaml-3.12.1/otherlibs/win32unix/rename.c ocaml-3.12.1-new/otherlibs/win32unix/rename.c --- ocaml-3.12.1/otherlibs/win32unix/rename.c 2010-01-22 02:48:24.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/rename.c 2011-12-28 19:58:29.406250000 -1000 @@ -16,12 +16,28 @@ #include #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value unix_rename(value path1, value path2) { static int supports_MoveFileEx = -1; /* don't know yet */ BOOL ok; +#ifdef UTF16 + char * temp1=String_val(path1); + char * temp2=String_val(path2); + WCHAR * wtemp1, * wtemp2; + if(is_valid_utf8(temp1)) + wtemp1 = utf8_to_utf16(temp1); + else + wtemp1 = ansi_to_utf16(temp1); + if(is_valid_utf8(temp2)) + wtemp2 = utf8_to_utf16(temp2); + else + wtemp2 = ansi_to_utf16(temp2); +#endif if (supports_MoveFileEx < 0) { OSVERSIONINFO VersionInfo; VersionInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); @@ -30,11 +46,25 @@ && (VersionInfo.dwPlatformId == VER_PLATFORM_WIN32_NT); } if (supports_MoveFileEx > 0) +#ifdef UTF16 + ok = MoveFileExW(wtemp1, wtemp2, + MOVEFILE_REPLACE_EXISTING | MOVEFILE_WRITE_THROUGH | + MOVEFILE_COPY_ALLOWED); +#else ok = MoveFileEx(String_val(path1), String_val(path2), MOVEFILE_REPLACE_EXISTING | MOVEFILE_WRITE_THROUGH | MOVEFILE_COPY_ALLOWED); +#endif else +#ifdef UTF16 + ok = MoveFileW(wtemp1, wtemp2); +#else ok = MoveFile(String_val(path1), String_val(path2)); +#endif +#ifdef UTF16 + free(wtemp1); + free(wtemp2); +#endif if (! ok) { win32_maperr(GetLastError()); uerror("rename", path1); diff -ubrN ocaml-3.12.1/otherlibs/win32unix/stat.c ocaml-3.12.1-new/otherlibs/win32unix/stat.c --- ocaml-3.12.1/otherlibs/win32unix/stat.c 2009-05-20 01:52:42.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/stat.c 2011-12-28 19:58:29.406250000 -1000 @@ -22,6 +22,9 @@ #define _INTEGRAL_MAX_BITS 64 #include #include +#ifdef UTF16 +#include "u8tou16.h" +#endif #ifndef S_IFLNK #define S_IFLNK 0 @@ -67,8 +70,18 @@ { int ret; struct _stati64 buf; - +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + ret = _wstati64(wtemp, &buf); + free(wtemp); +#else ret = _stati64(String_val(path), &buf); +#endif if (ret == -1) uerror("stat", path); if (buf.st_size > Max_long) { win32_maperr(ERROR_ARITHMETIC_OVERFLOW); @@ -81,7 +94,18 @@ { int ret; struct _stati64 buf; +#ifdef UTF16 + char * temp=String_val(path); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); + ret = _wstati64(wtemp, &buf); + free(wtemp); +#else ret = _stati64(String_val(path), &buf); +#endif if (ret == -1) uerror("stat", path); return stat_aux(1, &buf); } diff -ubrN ocaml-3.12.1/otherlibs/win32unix/system.c ocaml-3.12.1-new/otherlibs/win32unix/system.c --- ocaml-3.12.1/otherlibs/win32unix/system.c 2010-01-22 02:48:24.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/system.c 2011-12-28 19:58:29.406250000 -1000 @@ -20,12 +20,23 @@ #include "unixsupport.h" #include #include +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value win_system(cmd) value cmd; { int ret; value st; +#ifdef UTF16 + char * temp=String_val(cmd); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); +#endif char *buf; intnat len; @@ -34,7 +45,12 @@ memmove (buf, String_val (cmd), len + 1); enter_blocking_section(); _flushall(); +#ifdef UTF16 + ret = _wsystem(wtemp);; + free(wtemp); +#else ret = system(buf); +#endif leave_blocking_section(); caml_stat_free(buf); if (ret == -1) uerror("system", Nothing); diff -ubrN ocaml-3.12.1/otherlibs/win32unix/u8tou16.c ocaml-3.12.1-new/otherlibs/win32unix/u8tou16.c --- ocaml-3.12.1/otherlibs/win32unix/u8tou16.c 1969-12-31 14:00:00.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/u8tou16.c 2011-12-28 19:58:29.437500000 -1000 @@ -0,0 +1,311 @@ +#include "u8tou16.h" + +/* Copyright 2005 b8_bavard, INRIA, CML */ +/* + This file is part of mldonkey. + + mldonkey is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + mldonkey is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with mldonkey; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*/ + +/* Stub code to interface with libiconv + * + * taken and modified from + * mldonkey/src/utils/lib/charsetstubs.c + * + */ + +#include +#include +#include + +#include + +#ifdef WIN32 +#define STRICT /* Strict typing, please */ +#include +#undef STRICT +#endif + +#define FALSE 0 +#define TRUE 1 + +#define UTF8_COMPUTE(Char, Mask, Len) \ + if (Char < 128) \ + { \ + Len = 1; \ + Mask = 0x7f; \ + } \ + else if ((Char & 0xe0) == 0xc0) \ + { \ + Len = 2; \ + Mask = 0x1f; \ + } \ + else if ((Char & 0xf0) == 0xe0) \ + { \ + Len = 3; \ + Mask = 0x0f; \ + } \ + else if ((Char & 0xf8) == 0xf0) \ + { \ + Len = 4; \ + Mask = 0x07; \ + } \ + else if ((Char & 0xfc) == 0xf8) \ + { \ + Len = 5; \ + Mask = 0x03; \ + } \ + else if ((Char & 0xfe) == 0xfc) \ + { \ + Len = 6; \ + Mask = 0x01; \ + } \ + else \ + Len = -1; + +#define UTF8_LENGTH(Char) \ + ((Char) < 0x80 ? 1 : \ + ((Char) < 0x800 ? 2 : \ + ((Char) < 0x10000 ? 3 : \ + ((Char) < 0x200000 ? 4 : \ + ((Char) < 0x4000000 ? 5 : 6))))) + + +#define UTF8_GET(Result, Chars, Count, Mask, Len) \ + (Result) = (Chars)[0] & (Mask); \ + for ((Count) = 1; (Count) < (Len); ++(Count)) \ + { \ + if (((Chars)[(Count)] & 0xc0) != 0x80) \ + { \ + (Result) = -1; \ + break; \ + } \ + (Result) <<= 6; \ + (Result) |= ((Chars)[(Count)] & 0x3f); \ + } + +#define UNICODE_VALID(Char) \ + ((Char) < 0x110000 && \ + (((Char) & 0xFFFFF800) != 0xD800) && \ + ((Char) < 0xFDD0 || (Char) > 0xFDEF) && \ + ((Char) & 0xFFFE) != 0xFFFE) + +int +ocaml_utf8_validate (const char *str, + size_t max_len, + const char **end) +{ + + const char *p; + + if (str == NULL) + return FALSE; + + if (end) + *end = str; + + p = str; + + while ((max_len < 0 || (p - str) < max_len) && *p) + { + int i, mask = 0, len; + unsigned int result; + unsigned char c = (unsigned char) *p; + + UTF8_COMPUTE (c, mask, len); + + if (len == -1) + break; + + /* check that the expected number of bytes exists in str */ + if (max_len >= 0 && + ((max_len - (p - str)) < len)) + break; + + UTF8_GET (result, p, i, mask, len); + + if (UTF8_LENGTH (result) != len) /* Check for overlong UTF-8 */ + break; + + if (result == (unsigned int)-1) + break; + + if (!UNICODE_VALID (result)) + break; + + p += len; + } + + if (end) + *end = p; + + /* See that we covered the entire length if a length was + * passed in, or that we ended on a nul if not + */ + if (max_len >= 0 && + p != (str + max_len)) + return FALSE; + else if (max_len < 0 && + *p != '\0') + return FALSE; + else + return TRUE; +} + +unsigned char* +ocaml_convert_with_iconv (const char *str, + size_t len, + iconv_t cd, + size_t *bytes_read, + size_t *bytes_written) +{ + unsigned char *dest; + unsigned char *outp; + const char *p; + size_t inbytes_remaining; + size_t outbytes_remaining; + size_t outbuf_size; + size_t err; + int have_error = FALSE; + + if (len < 0) + len = strlen (str); + + p = str; + inbytes_remaining = len; + outbuf_size = len*2 + 8; /* for unicode */ + + outbytes_remaining = outbuf_size - 1; /* -1 for nul */ + outp = dest = malloc (outbuf_size); + memset(outp,0,outbuf_size); + + iconv(cd,NULL,NULL,NULL,NULL); + again: + err = iconv (cd, (const char **)&p, &inbytes_remaining, (char **)&outp, &outbytes_remaining); + + if (err == (size_t) -1) + { + switch (errno) + { + case EINVAL: + /* Incomplete text, do not report an error */ + break; + case E2BIG: + { + size_t used = outp - dest; + + outbuf_size *= 2; + dest = realloc (dest, outbuf_size); + + outp = dest + used; + outbytes_remaining = outbuf_size - used - 1; /* -1 for nul */ + + goto again; + } + case EILSEQ: + have_error = TRUE; + break; + default: + have_error = TRUE; + break; + } + } + + *outp = '\0'; + + if (bytes_read) + *bytes_read = p - str; + else + { + if ((p - str) != len) + { + if (!have_error) + { + have_error = TRUE; + } + } + } + + if (bytes_written) + *bytes_written = outp - dest; /* Doesn't include '\0' */ + + if (have_error) + { + free (dest); + return NULL; + } + else + return dest; +} + +unsigned char* +ocaml_convert (const char *str, + size_t len, + const char *to_codeset, + const char *from_codeset, + size_t *bytes_read, + size_t *bytes_written) +{ + unsigned char *res; + iconv_t cd; + + cd = iconv_open (to_codeset, from_codeset); + + if (cd == (iconv_t) -1) + { + if (bytes_read) + *bytes_read = 0; + + if (bytes_written) + *bytes_written = 0; + + return NULL; + } + + res = ocaml_convert_with_iconv (str, len, cd, + bytes_read, bytes_written); + + iconv_close (cd); + return res; +} + +int is_valid_utf8(const char *s) +{ + return ocaml_utf8_validate(s,strlen(s),NULL); +} + +unsigned char * ansi_to_utf16(const char * str) +{ + size_t bw = 0; + return ocaml_convert(str,strlen(str), + "UNICODELITTLE","", + NULL,&bw); +} + +unsigned char * utf8_to_utf16(const char * str) +{ + size_t bw = 0; + return ocaml_convert(str,strlen(str), + "UNICODELITTLE","UTF-8", + NULL,&bw); +} + +unsigned char* utf16_to_utf8(const unsigned char * str) +{ + size_t bw = 0; + return ocaml_convert(str,wcslen(str)*sizeof(WCHAR), + "UTF-8","UNICODELITTLE", + NULL,&bw); +} diff -ubrN ocaml-3.12.1/otherlibs/win32unix/u8tou16.h ocaml-3.12.1-new/otherlibs/win32unix/u8tou16.h --- ocaml-3.12.1/otherlibs/win32unix/u8tou16.h 1969-12-31 14:00:00.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/u8tou16.h 2011-12-28 19:58:29.437500000 -1000 @@ -0,0 +1,8 @@ +#ifndef WCHAR +typedef unsigned short WCHAR; +#endif + +int is_valid_utf8(const char *s); +unsigned char * ansi_to_utf16(const char * str); +unsigned char * utf8_to_utf16(const char * str); +unsigned char * utf16_to_utf8(const unsigned char * str); diff -ubrN ocaml-3.12.1/otherlibs/win32unix/windir.c ocaml-3.12.1-new/otherlibs/win32unix/windir.c --- ocaml-3.12.1/otherlibs/win32unix/windir.c 2010-01-22 02:48:24.000000000 -1000 +++ ocaml-3.12.1-new/otherlibs/win32unix/windir.c 2011-12-28 19:58:29.453125000 -1000 @@ -19,18 +19,35 @@ #include #include #include "unixsupport.h" +#ifdef UTF16 +#include "u8tou16.h" +#endif CAMLprim value win_findfirst(name) value name; { HANDLE h; value v; - WIN32_FIND_DATA fileinfo; value valname = Val_unit; value valh = Val_unit; +#ifdef UTF16 + WIN32_FIND_DATAW fileinfo; + char * tempo, *temp=String_val(name); + WCHAR * wtemp; + if(is_valid_utf8(temp)) + wtemp = utf8_to_utf16(temp); + else + wtemp = ansi_to_utf16(temp); +#else + WIN32_FIND_DATA fileinfo; +#endif Begin_roots2 (valname,valh); +#ifdef UTF16 + h = FindFirstFileW(wtemp,&fileinfo); +#else h = FindFirstFile(String_val(name),&fileinfo); +#endif if (h == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); if (err == ERROR_NO_MORE_FILES) @@ -40,22 +57,42 @@ uerror("opendir", Nothing); } } +#ifdef UTF16 + tempo = utf16_to_utf8(fileinfo.cFileName); + valname = copy_string(tempo); + free(tempo); +#else valname = copy_string(fileinfo.cFileName); +#endif valh = win_alloc_handle(h); v = alloc_small(2, 0); Field(v,0) = valname; Field(v,1) = valh; End_roots(); +#ifdef UTF16 + free(wtemp); +#endif return v; } CAMLprim value win_findnext(valh) value valh; { +#ifdef UTF16 + CAMLparam0 (); + CAMLlocal1 (v); + WIN32_FIND_DATAW fileinfo; + char * temp; +#else WIN32_FIND_DATA fileinfo; +#endif BOOL retcode; +#ifdef UTF16 + retcode = FindNextFileW(Handle_val(valh), &fileinfo); +#else retcode = FindNextFile(Handle_val(valh), &fileinfo); +#endif if (!retcode) { DWORD err = GetLastError(); if (err == ERROR_NO_MORE_FILES) @@ -65,7 +102,14 @@ uerror("readdir", Nothing); } } +#ifdef UTF16 + temp = utf16_to_utf8(fileinfo.cFileName); + v=copy_string(temp); + free(temp); + CAMLreturn (v); +#else return copy_string(fileinfo.cFileName); +#endif } CAMLprim value win_findclose(valh)