* synchronised with trunk till r29513blocks

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blocks@29516 3ad0048d-3df7-0310-abae-a5850022a9f2

10 files changed, 106 insertions, 50 deletions

diff --git a/rtl/unix/baseunix.pp b/rtl/unix/baseunix.pp
index f53985e787..a9e44b2380 100644
--- a/rtl/unix/baseunix.pp
+++ b/rtl/unix/baseunix.pp
@@ -90,4 +90,12 @@ Uses Sysctl;
 {$i osmacro.inc}        { macro implenenations }
 {$i bunxovl.inc}        { redefs and overloads implementation }
 
+{$ifdef FPC_HAS_SETSYSNR_INC}
+{$I setsysnr.inc}
+{$endif FPC_HAS_SETSYSNR_INC}
+
+{$ifdef FPC_HAS_SETSYSNR_INC}
+begin
+  SetSyscallNumbers;
+{$endif FPC_HAS_SETSYSNR_INC}
 end.
diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp
index 9917fbc21f..925358edde 100644
--- a/rtl/unix/cthreads.pp
+++ b/rtl/unix/cthreads.pp
@@ -336,7 +336,7 @@ Type  PINTRTLEvent = ^TINTRTLEvent;
 {$endif DEBUG_MT}
       pthread_attr_init(@thread_attr);
       {$if not defined(HAIKU) and not defined(ANDROID)}
-      {$ifdef solaris}
+      {$if defined (solaris) or defined (netbsd) }
       pthread_attr_setinheritsched(@thread_attr, PTHREAD_INHERIT_SCHED);
       {$else not solaris}
       pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
@@ -874,8 +874,19 @@ var p:pintrtlevent;
 
 begin
   new(p);
-  pthread_cond_init(@p^.condvar, nil);
-  pthread_mutex_init(@p^.mutex, nil);
+  if not assigned(p) then
+    fpc_threaderror;
+  if pthread_cond_init(@p^.condvar, nil)<>0 then
+    begin
+      dispose(p);
+      fpc_threaderror;
+    end;
+  if pthread_mutex_init(@p^.mutex, nil)<>0 then
+    begin
+      pthread_cond_destroy(@p^.condvar);
+      dispose(p);
+      fpc_threaderror;
+    end;
   p^.isset:=false;
   result:=PRTLEVENT(p);
 end;
diff --git a/rtl/unix/cwstring.pp b/rtl/unix/cwstring.pp
index 08cc3bceb1..56cb14c41a 100644
--- a/rtl/unix/cwstring.pp
+++ b/rtl/unix/cwstring.pp
@@ -141,6 +141,12 @@ const
 {$elseif defined(aix)}
   CODESET = 49;
   LC_ALL = -1;
+{$elseif defined(dragonfly)}
+  CODESET = 0;
+  LC_ALL = 0;
+  __LC_CTYPE = 0;
+  _NL_CTYPE_CLASS = (__LC_CTYPE shl 16);
+  _NL_CTYPE_CODESET_NAME = (_NL_CTYPE_CLASS)+14;
 {$else not aix}
 {$error lookup the value of CODESET in /usr/include/langinfo.h, and the value of LC_ALL in /usr/include/locale.h for your OS }
 // and while doing it, check if iconv is in libc, and if the symbols are prefixed with iconv_ or libiconv_
@@ -803,6 +809,10 @@ function CompareTextWideString(const s1, s2 : WideString): PtrInt;
   end;
 
 
+{ return value: number of code points in the string. Whenever an invalid
+  code point is encountered, all characters part of this invalid code point
+  are considered to form one "character" and the next character is
+  considered to be the start of a new (possibly also invalid) code point }
 function CharLengthPChar(const Str: PChar): PtrInt;
   var
     nextlen: ptrint;
@@ -818,14 +828,14 @@ function CharLengthPChar(const Str: PChar): PtrInt;
 {$endif not beos}
     repeat
 {$ifdef beos}
-      nextlen:=ptrint(mblen(str,MB_CUR_MAX));
+      nextlen:=ptrint(mblen(s,MB_CUR_MAX));
 {$else beos}
-      nextlen:=ptrint(mbrlen(str,MB_CUR_MAX,@mbstate));
+      nextlen:=ptrint(mbrlen(s,MB_CUR_MAX,@mbstate));
 {$endif beos}
       { skip invalid/incomplete sequences }
       if (nextlen<0) then
         nextlen:=1;
-      inc(result,nextlen);
+      inc(result,1);
       inc(s,nextlen);
     until (nextlen=0);
   end;
@@ -987,6 +997,18 @@ begin
   ansi2pchar(temp,str,result);
 end;
 
+
+function envvarset(const varname: pchar): boolean;
+var
+  varval: pchar;
+begin
+  varval:=fpgetenv(varname);
+  result:=
+    assigned(varval) and
+    (varval[0]<>#0);
+end;
+
+
 function GetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage;
 var
   langinfo: pchar;
@@ -998,15 +1020,25 @@ begin
       exit;
     end;
 {$endif}
-  langinfo:=nl_langinfo(CODESET);
-  { there's a bug in the Mac OS X 10.5 libc (based on FreeBSD's)
-    that causes it to return an empty string of UTF-8 locales
-    -> patch up (and in general, UTF-8 is a good default on
-    Unix platforms) }
-  if not assigned(langinfo) or
-     (langinfo^=#0) then
-    langinfo:='UTF-8';
-  Result := GetCodepageByName(ansistring(langinfo));
+  { if none of the relevant LC_* environment variables are set, fall back to
+    UTF-8 (this happens under some versions of OS X for GUI applications, which
+    otherwise get CP_ASCII) }
+  if envvarset('LC_ALL') or
+     envvarset('LC_CTYPE') or
+     envvarset('LANG') then
+    begin
+      langinfo:=nl_langinfo(CODESET);
+      { there's a bug in the Mac OS X 10.5 libc (based on FreeBSD's)
+        that causes it to return an empty string of UTF-8 locales
+        -> patch up (and in general, UTF-8 is a good default on
+        Unix platforms) }
+      if not assigned(langinfo) or
+         (langinfo^=#0) then
+        langinfo:='UTF-8';
+      Result:=GetCodepageByName(ansistring(langinfo));
+    end
+  else
+    Result:=unixcp.GetSystemCodepage;
 end;
 
 {$ifdef FPC_HAS_CPSTRING}
diff --git a/rtl/unix/dl.pp b/rtl/unix/dl.pp
index 191959c0c7..b2a1253a6d 100644
--- a/rtl/unix/dl.pp
+++ b/rtl/unix/dl.pp
@@ -27,7 +27,7 @@ const
   {$endif}
 {$endif}
 
-{$if defined(linux) or defined(freebsd) or defined(openbsd)}
+{$if defined(linux) or defined(freebsd) or defined(openbsd) or defined(dragonfly)}
   {$define ELF} // ELF symbol versioning.
 {$endif}
 
@@ -92,7 +92,7 @@ function dlerror() : Pchar; cdecl; external libdl;
 { overloaded for compatibility with hmodule }
 function dlsym(Lib : PtrInt; Name : Pchar) : Pointer; cdecl; external Libdl;
 function dlclose(Lib : PtrInt) : Longint; cdecl; external libdl;
-function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; {$ifndef aix}external;{$endif}
+function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; {$if not defined(aix) and not defined(android)} external; {$endif}
 
 implementation
 
@@ -133,9 +133,10 @@ uses
 {$i dlaix.inc}
 {$endif}
 
+{$ifdef android}
+{$i dlandroid.inc}
+{$endif}
 
 begin
-{$ifndef android}
   UnixGetModuleByAddrHook:=@UnixGetModuleByAddr;
-{$endif android}
 end.
diff --git a/rtl/unix/initc.pp b/rtl/unix/initc.pp
index 0adf8d6d85..627d96124b 100644
--- a/rtl/unix/initc.pp
+++ b/rtl/unix/initc.pp
@@ -59,7 +59,7 @@ function geterrnolocation: pcint; cdecl;external clib name '__errno_location';
 function geterrnolocation: pcint; cdecl;external clib name '__errno';
 {$endif}
 
-{$ifdef FreeBSD} // tested on x86
+{$if defined(FreeBSD) or defined(DragonFly)} // tested on x86
 function geterrnolocation: pcint; cdecl;external clib name '__error';
 {$endif}
 
diff --git a/rtl/unix/syscall.pp b/rtl/unix/syscall.pp
index fe001aac4b..58a12ab9a0 100644
--- a/rtl/unix/syscall.pp
+++ b/rtl/unix/syscall.pp
@@ -7,5 +7,13 @@ interface
 {$i syscallh.inc}
 
 implementation
+{$ifdef FPC_HAS_SETSYSNR_INC}
+{$define FPC_COMPILING_SYSCALL_UNIT}
+{$I setsysnr.inc}
+{$endif FPC_HAS_SETSYSNR_INC}
 
+{$ifdef FPC_HAS_SETSYSNR_INC}
+begin
+  SetSyscallNumbers;
+{$endif FPC_HAS_SETSYSNR_INC}
 end.
diff --git a/rtl/unix/sysfile.inc b/rtl/unix/sysfile.inc
index 43dc57813a..acc6d76315 100644
--- a/rtl/unix/sysfile.inc
+++ b/rtl/unix/sysfile.inc
@@ -20,6 +20,8 @@ Begin
   repeat
     res:=Fpclose(cint(Handle));
   until (res<>-1) or (geterrno<>ESysEINTR);
+  if res<>0 then
+    Errno2Inoutres;
 End;
 
 Procedure Do_Erase(p: pchar; pchangeable: boolean);
@@ -226,7 +228,10 @@ Begin
      until (FileRec(f).Handle<>-1) or (geterrno<>ESysEINTR);
    end;
   If Filerec(f).Handle<0 Then
-   Errno2Inoutres
+   begin
+     Errno2Inoutres;
+     FileRec(f).mode:=fmclosed;
+   end
   else
    InOutRes:=0;
 End;
diff --git a/rtl/unix/sysutils.pp b/rtl/unix/sysutils.pp
index 60e6664089..e7716c8b39 100644
--- a/rtl/unix/sysutils.pp
+++ b/rtl/unix/sysutils.pp
@@ -42,9 +42,11 @@ interface
 {$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
 
 uses
-{$IFDEF LINUX}linux,{$ENDIF} Unix,errors,sysconst,Unixtype;
+{$IFDEF LINUX}linux,{$ENDIF}
+{$IFDEF FreeBSD}freebsd,{$ENDIF}
+  Unix,errors,sysconst,Unixtype;
 
-{$IFDEF LINUX}
+{$IF defined(LINUX) or defined(FreeBSD)}
 {$DEFINE HAVECLOCKGETTIME}
 {$ENDIF}
 
diff --git a/rtl/unix/tthread.inc b/rtl/unix/tthread.inc
index afc2001249..e58977b48a 100644
--- a/rtl/unix/tthread.inc
+++ b/rtl/unix/tthread.inc
@@ -29,9 +29,9 @@
   control. Therefore, I didn't implement .Suspend() if its called from
   outside the threads execution flow (except on Linux _without_ NPTL).
 
-  The implementation for .suspend uses a semaphore, which is initialized
+  The implementation for .suspend uses an RTLEvent, which is initialized
   at thread creation. If the thread tries to suspend itself, we simply
-  let it wait on the semaphore until it is unblocked by someone else
+  let it wait on the Event until it is unblocked by someone else
   who calls .Resume.
 
 
@@ -82,8 +82,8 @@ begin
     WRITE_DEBUG('AfterConstruction should have been called for ',ptruint(lthread));
     if LThread.FInitialSuspended then
       begin
-        WRITE_DEBUG('thread ', ptruint(LThread), ' waiting for semaphore ', ptruint(LThread.FSem));
-        SemaphoreWait(LThread.FSem);
+        WRITE_DEBUG('thread ', ptruint(LThread), ' waiting for RTLEvent ', ptruint(LThread.FSuspendEvent));
+        RtlEventWaitFor(LThread.FSuspendEvent);
         if not(LThread.FTerminated) then
           begin
             if not LThread.FSuspended then
@@ -103,7 +103,7 @@ begin
        begin
          LThread.FSuspendedInternal := true;
          WRITE_DEBUG('waiting for SuspendedInternal - ', LThread.ClassName);
-         SemaphoreWait(LThread.FSem);
+         RtlEventWaitFor(LThread.FSuspendEvent);
          CurrentThreadVar := LThread;
          WRITE_DEBUG('going into LThread.Execute - ', LThread.ClassName);
          LThread.Execute;
@@ -148,17 +148,14 @@ end;
 procedure TThread.SysCreate(CreateSuspended: Boolean;
                             const StackSize: SizeUInt);
 begin
-  FSem := SemaphoreInit();
-  if FSem = pointer(-1) then
-    raise EThread.create('Semaphore init failed (possibly too many concurrent threads)');
-  WRITE_DEBUG('thread ', ptruint(self), ' created semaphore ', ptruint(FSem));
+  FSuspendEvent := RtlEventCreate;
+  WRITE_DEBUG('thread ', ptruint(self), ' created RTLEvent ', ptruint(FSuspendEvent));
   FSuspended := CreateSuspended;
-  FSuspendedExternal := false;
   FThreadReaped := false;
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
   FSuspendedInternal := not CreateSuspended;
-  WRITE_DEBUG('creating thread, self = ',longint(self));
+  WRITE_DEBUG('creating thread, self = ',ptruint(self));
   FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   if FHandle = TThreadID(0) then
     raise EThread.create('Failed to create new thread');
@@ -168,13 +165,13 @@ end;
 
 procedure TThread.SysDestroy;
 begin
-  if (FSem = nil) then
+  if not assigned(FSuspendEvent) then
     { exception in constructor }
     exit;
   if (FHandle = TThreadID(0)) then
   { another exception in constructor }
     begin
-      SemaphoreDestroy(FSem);
+      RtlEventDestroy(FSuspendEvent);
       exit;
     end;
   if (FThreadID = GetCurrentThreadID) then
@@ -200,7 +197,7 @@ begin
           WaitFor;
         end;
     end;
-  SemaphoreDestroy(FSem);
+  RtlEventDestroy(FSuspendEvent);
   FFatalException.Free;
   FFatalException := nil;
   { threadvars have been released by cthreads.ThreadMain -> DoneThread, or  }
@@ -223,13 +220,11 @@ begin
     begin
       if not FSuspended and
          (InterLockedExchange(longint(FSuspended),longint(longbool(true))) = longint(longbool(false))) then
-        SemaphoreWait(FSem)
+        RtlEventWaitFor(FSuspendEvent)
     end
   else
     begin
       Raise EThread.create('Suspending one thread from inside another one is unsupported (because it is unsafe and deadlock prone) by *nix and posix operating systems');
-//      FSuspendedExternal := true;
-//      SuspendThread(FHandle);
     end;
 end;
 
@@ -239,9 +234,9 @@ begin
   if FSuspendedInternal and (InterLockedExchange(longint(FSuspendedInternal),ord(false)) = longint(longbool(true))) then
     begin
       WRITE_DEBUG('resuming thread after TThread construction',ptruint(self));
-      SemaphorePost(FSem);
+      RtlEventSetEvent(FSuspendEvent);
     end
-  else if (not FSuspendedExternal) then
+  else
     begin
       if FSuspended and
          { don't compare with ord(true) or ord(longbool(true)), }
@@ -249,15 +244,9 @@ begin
          (InterLockedExchange(longint(FSuspended),longint(false)) <> longint(longbool(false))) then
         begin
           WRITE_DEBUG('resuming ',ptruint(self));
-          SemaphorePost(FSem);
+          RtlEventSetEvent(FSuspendEvent);
         end
     end
-  else
-    begin
-      raise EThread.create('External suspending is not supported under *nix/posix, so trying to resume from from an external suspension should never happen');
-//      FSuspendedExternal := false;
-//      ResumeThread(FHandle);
-    end;
 end;
 
 
diff --git a/rtl/unix/unixcp.pp b/rtl/unix/unixcp.pp
index 5601ee773e..532d9322d5 100644
--- a/rtl/unix/unixcp.pp
+++ b/rtl/unix/unixcp.pp
@@ -714,7 +714,7 @@ var
 begin
   // Get one of non-empty environment variables in the next order:
   // LC_ALL, LC_CTYPE, LANG. Default is UTF-8 or ASCII.
-{$ifdef linux}
+{$if defined(linux) or defined(darwin)}
   Result:=CP_UTF8;
 {$else}
   Result:=CP_ASCII;