* threads for FreeBSD. Not working tho

ide/fpdebug.pas

@@ -774,7 +774,7 @@ begin
       Assign(Debuggeefile,DebuggeeTTY);
       system.Reset(Debuggeefile);
       ResetOK:=IOResult=0;
-      If ResetOK and IsATTY(textrec(Debuggeefile).handle) then
+      If ResetOK and (IsATTY(textrec(Debuggeefile).handle)<>-1) then
         begin
           Command('tty '+DebuggeeTTY);
           TTYUsed:=true;
@@ -3603,7 +3603,10 @@ end.
 
 {
   $Log$
-  Revision 1.46  2003-03-30 12:12:12  armin
+  Revision 1.47  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.46  2003/03/30 12:12:12  armin
   * allow local and remote debugging if SUPPORT_REMOTE is given
 
   Revision 1.45  2003/03/27 14:10:55  pierre

ide/fpusrscr.pas

@@ -774,7 +774,7 @@ begin
   TTYFd:=-1;
   IsXterm:=getenv('TERM')='xterm';
   ThisTTY:=TTYName(stdinputhandle);
-  if Not IsXterm and IsATTY(stdinputhandle) then
+  if Not IsXterm and (IsATTY(stdinputhandle)<>-1) then
     begin
       Console:=TTyNetwork;  {Default: Network or other vtxxx tty}
       if (Copy(ThisTTY, 1, 8) = '/dev/tty') and (ThisTTY[9]<>'p') Then
@@ -910,7 +910,7 @@ begin
       ConsCursorY:=0;
       ConsVideoBuf:=nil;
     end;
-  ConsTioValid:=TCGetAttr(1,ConsTio);
+  ConsTioValid:=(TCGetAttr(1,ConsTio)<>-1);
 end;
 
 
@@ -1441,7 +1441,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.29  2003-11-14 21:52:58  marco
+  Revision 1.30  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.29  2003/11/14 21:52:58  marco
    * octal() is not necessary anymore. Use &xxx
 
   Revision 1.28  2003/09/27 14:03:45  peter

rtl/freebsd/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2003/11/02]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2003/11/11]
 #
 default: all
 MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
@@ -233,7 +233,7 @@ GRAPHDIR=$(INC)/graph
 ifndef USELIBGGI
 USELIBGGI=NO
 endif
-override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings baseunix syscall unixutil $(LINUXUNIT) unix initc  dos dl crt objects printer sysutils typinfo classes math varutils cpu mmx charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard console serial variants types systhrds sysctl
+override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings baseunix syscall unixutil $(LINUXUNIT) unix initc  dos dl crt objects printer sysutils typinfo systhrds classes math varutils cpu mmx charset ucomplex getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard console serial variants types sysctl
 override TARGET_LOADERS+=prt0 cprt0 gprt0
 override TARGET_RSTS+=math varutils typinfo classes variants
 override INSTALL_FPCPACKAGE=y y

rtl/freebsd/Makefile.fpc

@@ -13,10 +13,10 @@ loaders=prt0 cprt0 gprt0
 units=$(SYSTEMUNIT) objpas strings baseunix syscall unixutil \
       $(LINUXUNIT) unix initc  \
       dos dl crt objects printer \
-      sysutils typinfo classes math varutils \
+      sysutils typinfo systhrds classes math varutils \
       cpu mmx charset ucomplex getopts heaptrc lineinfo \
       errors sockets gpm ipc terminfo \
-      video mouse keyboard console serial variants types systhrds sysctl
+      video mouse keyboard console serial variants types sysctl
 rsts=math varutils typinfo classes variants
 
 [require]

rtl/freebsd/classes.pp

@@ -32,7 +32,7 @@ uses
 implementation
 
 uses
-  baseunix,unix
+  baseunix,unix,Systhrds
   ;
 
 { OS - independent class implementations are in /inc directory. }
@@ -51,7 +51,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.2  2003-10-09 10:55:20  marco
+  Revision 1.3  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.2  2003/10/09 10:55:20  marco
    * fix for moving classes to rtl while cycling with 1.0 start
 
   Revision 1.1  2003/10/06 21:01:06  peter

rtl/freebsd/console.pp

@@ -1828,7 +1828,7 @@ function physicalconsole(fd:longint) : boolean;
 var name:string;
 
 begin
- if isatty(fd) then
+ if (isatty(fd)<>-1) then
   begin
    name:=ttyname(fd);
    if Copy(name,1,8)<>'/dev/tty' then

rtl/freebsd/tthread.inc

@@ -14,6 +14,8 @@
 
  **********************************************************************}
 
+
+{$IFDEF VER1_0} // leaving the old implementation in for now...
 type
   PThreadRec=^TThreadRec;
   TThreadRec=record
@@ -56,15 +58,14 @@ begin
   fpwaitpid(-1, nil, WNOHANG);
 end;
 
-const zeroset :sigset = (0,0,0,0);
-
 procedure InitThreads;
 var
-  Act, OldAct: PSigActionRec;
+  Act, OldAct: Baseunix.PSigActionRec;
 begin
   ThreadRoot:=nil;
   ThreadsInited:=true;
 
+
 // This will install SIGCHLD signal handler
 // signal() installs "one-shot" handler,
 // so it is better to install and set up handler with sigaction()
@@ -72,13 +73,10 @@ begin
   GetMem(Act, SizeOf(SigActionRec));
   GetMem(OldAct, SizeOf(SigActionRec));
 
-  signalhandler(Act^.sa_handler) := @SIGCHLDHandler;
+  Act^.sa_handler := @SIGCHLDHandler;
-
-  fillchar(Act^.sa_mask,sizeof(sigset_t),#0);
   Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
-			//Do not block all signals ??. Don't need if SA_NOMASK in flags
+  Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
-
+  FpSigAction(SIGCHLD, Act, OldAct);
-   fpsigaction(SIGCHLD, @Act, @OldAct);
 
   FreeMem(Act, SizeOf(SigActionRec));
   FreeMem(OldAct, SizeOf(SigActionRec));
@@ -150,6 +148,8 @@ var
   FreeThread: Boolean;
   Thread : TThread absolute args;
 begin
+  while Thread.FHandle = 0 do fpsleep(1);
+  if Thread.FSuspended then Thread.suspend();
   try
     Thread.Execute;
   except
@@ -161,7 +161,7 @@ begin
   Thread.DoTerminate;
   if FreeThread then
     Thread.Free;
-  fpExit(Result);
+  fpexit(Result);
 end;
 
 
@@ -175,12 +175,12 @@ begin
   Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
   { Setup 16k of stack }
   FStackSize:=16384;
-  Getmem(pointer(FStackPointer),FStackSize);
+  Getmem(FStackPointer,FStackSize);
   inc(FStackPointer,FStackSize);
   FCallExitProcess:=false;
   { Clone }
-  FHandle:= Clone(@ThreadProc,pointer(FStackPointer),Flags,self);
+  FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
-  if FSuspended then Suspend;
+//  if FSuspended then Suspend;
   FThreadID := FHandle;
   IsMultiThread := TRUE;
   FFatalException := nil;
@@ -195,9 +195,9 @@ begin
      WaitFor;
    end;
   if FHandle <> -1 then
-  fpkill(FHandle, SIGKILL);
+    fpkill(FHandle, SIGKILL);
   dec(FStackPointer,FStackSize);
-  Freemem(pointer(FStackPointer),FStackSize);
+  Freemem(FStackPointer);
   FFatalException.Free;
   FFatalException := nil;
   inherited Destroy;
@@ -228,8 +228,7 @@ var
   P: Integer;
   I: TThreadPriority;
 begin
-  P := 
+  P := fpGetPriority(Prio_Process,FHandle);
-         Unix.fpGetPriority	(Prio_Process,FHandle);
   Result := tpNormal;
   for I := Low(TThreadPriority) to High(TThreadPriority) do
     if Priorities[I] = P then
@@ -239,8 +238,7 @@ end;
 
 procedure TThread.SetPriority(Value: TThreadPriority);
 begin
-        Unix.fpSetPriority
+  fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
-         (Prio_Process,FHandle, Priorities[Value]);
 end;
 
 
@@ -266,14 +264,14 @@ end;
 
 procedure TThread.Suspend;
 begin
-  fpkill(FHandle, SIGSTOP);
   FSuspended := true;
+  fpKill(FHandle, SIGSTOP);
 end;
 
 
 procedure TThread.Resume;
 begin
-  fpkill(FHandle, SIGCONT);
+  fpKill(FHandle, SIGCONT);
   FSuspended := False;
 end;
 
@@ -288,45 +286,350 @@ var
   status : longint;
 begin
   if FThreadID = MainThreadID then
-   fpWaitPid(0,@status,0)
+    fpwaitpid(0,@status,0)
   else
-   fpWaitPid(FHandle,@status,0);
+    fpwaitpid(FHandle,@status,0);
   Result:=status;
 end;
+{$ELSE}
+
+{
+  What follows, is a short description on my implementation of TThread.
+  Most information can also be found by reading the source and accompanying
+  comments.
+  
+  A thread is created using BeginThread, which in turn calls
+  pthread_create. So the threads here are always posix threads.
+  Posix doesn't define anything for suspending threads as this is
+  inherintly unsafe. Just don't suspend threads at points they cannot
+  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
+  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
+  who calls .Resume.
+
+  If a thread is supposed to be suspended (from outside its own path of
+  execution) on a system where the symbol LINUX is defined, two things
+  are possible.
+  1) the system has the LinuxThreads pthread implementation
+  2) the system has NPTL as the pthread implementation.
+  
+  In the first case, each thread is a process on its own, which as far as
+  know actually violates posix with respect to signal handling.
+  But we can detect this case, because getpid(2) will
+  return a different PID for each thread. In that case, sending SIGSTOP
+  to the PID associated with a thread will actually stop that thread
+  only.
+  In the second case, this is not possible. But getpid(2) returns the same
+  PID across all threads, which is detected, and TThread.Suspend() does
+  nothing in that case. This should probably be changed, but I know of
+  no way to suspend a thread when using NPTL.
+  
+  If the symbol LINUX is not defined, then the unimplemented
+  function SuspendThread is called.
+  
+  Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+  I don't like this. It eats up 2 filedescriptors for each thread,
+  and those are a limited resource. If you have a server programm
+  handling client connections (one per thread) it will not be able
+  to handle many if we use 2 fds already for internal structures.
+  However, right now I don't see a better option unless some sem_*
+  functions are added to systhrds.
+  I encapsulated all used functions here to make it easier to
+  change them completely.
+}
+
+function SemaphoreInit: Pointer;
+begin
+  SemaphoreInit := GetMem(SizeOf(TFilDes));
+  fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+  b: byte;
+begin
+  fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+begin
+  fpwrite(PFilDes(FSem)^[1], #0, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+  fpclose(PFilDes(FSem)^[0]);
+  fpclose(PFilDes(FSem)^[1]);
+  FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+  ThreadsInited: boolean = false;
+{$IFDEF LINUX}
+  GMainPID: LongInt = 0;
+{$ENDIF}
+const
+  // stupid, considering its not even implemented...
+  Priorities: array [TThreadPriority] of Integer =
+   (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+  if not ThreadsInited then begin
+    ThreadsInited := true;
+    {$IFDEF LINUX}
+    GMainPid := fpgetpid();
+    {$ENDIF}
+  end;
+end;
+
+procedure DoneThreads;
+begin
+  ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+  a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): LongInt; cdecl;
+var
+  LThread: TThread;
+  c: char;
+begin
+  WRITE_DEBUG('ThreadFunc is here...');
+  LThread := TThread(parameter);
+  {$IFDEF LINUX}
+  // save the PID of the "thread"
+  // this is different from the PID of the main thread if
+  // the LinuxThreads implementation is used
+  LThread.FPid := fpgetpid();
+  {$ENDIF}
+  WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+  try
+    if LThread.FInitialSuspended then begin
+      SemaphoreWait(LThread.FSem);
+      if not LThread.FInitialSuspended then begin
+        WRITE_DEBUG('going into LThread.Execute');
+        LThread.Execute;
+      end;
+    end else begin
+      WRITE_DEBUG('going into LThread.Execute');
+      LThread.Execute;
+    end;
+  except
+    on e: exception do begin
+      WRITE_DEBUG('got exception: ',e.message);
+      LThread.FFatalException :=  TObject(AcquireExceptionObject);
+      // not sure if we should really do this...
+      // but .Destroy was called, so why not try FreeOnTerminate?
+      if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+    end;
+  end;
+  WRITE_DEBUG('thread done running');
+  Result := LThread.FReturnValue;
+  WRITE_DEBUG('Result is ',Result);
+  LThread.FFinished := True;
+  LThread.DoTerminate;
+  if LThread.FreeOnTerminate then begin
+    WRITE_DEBUG('Thread should be freed');
+    LThread.Free;
+    WRITE_DEBUG('Thread freed');
+  end;
+  WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean);
+begin
+  // lets just hope that the user doesn't create a thread
+  // via BeginThread and creates the first TThread Object in there!
+  InitThreads;
+  inherited Create;
+  FSem := SemaphoreInit;
+  FSuspended := true;
+  FSuspendedExternal := false;
+  FInitialSuspended := CreateSuspended;
+  FFatalException := nil;
+  WRITE_DEBUG('creating thread, self = ',longint(self));
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if FThreadID = GetCurrentThreadID then begin
+    raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+  end;
+  // if someone calls .Free on a thread with
+  // FreeOnTerminate, then don't crash!
+  FFreeOnTerminate := false;
+  if not FFinished and not FSuspended then begin
+    Terminate;
+    WaitFor;
+  end;
+  if (FInitialSuspended) then begin
+    // thread was created suspended but never woken up.
+    SemaphorePost(FSem);
+    WaitFor;
+  end;
+  FFatalException.Free;
+  FFatalException := nil;
+  SemaphoreDestroy(FSem);
+  inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+  if Value <> FSuspended then
+    if Value then
+      Suspend
+    else
+      Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+  if not FSuspended then begin
+    if FThreadID = GetCurrentThreadID then begin
+      FSuspended := true;
+      SemaphoreWait(FSem);
+    end else begin
+      FSuspendedExternal := true;
+{$IFDEF LINUX}
+      // naughty hack if the user doesn't have Linux with NPTL...
+      // in that case, the PID of threads will not be identical
+      // to the other threads, which means that our thread is a normal
+      // process that we can suspend via SIGSTOP...
+      // this violates POSIX, but is the way it works on the
+      // LinuxThreads pthread implementation. Not with NPTL, but in that case
+      // getpid(2) also behaves properly and returns the same PID for
+      // all threads. Thats actually (FINALLY!) native thread support :-)
+      if FPid <> GMainPID then begin
+        FSuspended := true;
+        fpkill(FPid, SIGSTOP);
+      end;
+{$ELSE}
+      SuspendThread(FHandle);
+{$ENDIF}
+    end;
+  end;
+end;
+
+
+procedure TThread.Resume;
+begin
+  if (not FSuspendedExternal) then begin
+    if FSuspended then begin
+      SemaphorePost(FSem);
+      FInitialSuspended := false;
+      FSuspended := False;
+    end;
+  end else begin
+{$IFDEF LINUX}
+    // see .Suspend
+    if FPid <> GMainPID then begin
+      fpkill(FPid, SIGCONT);
+      FSuspended := False;
+    end;
+{$ELSE}
+    ResumeThread(FHandle);
+{$ENDIF}
+    FSuspendedExternal := false;
+  end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+  WRITE_DEBUG('waiting for thread ',FHandle);
+  WaitFor := WaitForThreadTerminate(FHandle, 0);
+  WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+  // no need to check if FOnTerminate <> nil, because
+  // thats already done in DoTerminate
+  FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+  P: Integer;
+  I: TThreadPriority;
+begin
+  P := ThreadGetPriority(FHandle);
+  Result := tpNormal;
+  for I := Low(TThreadPriority) to High(TThreadPriority) do
+    if Priorities[I] = P then
+      Result := I;
+end;
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+begin
+{$TODO someone with more clue of the GUI stuff will have to do this}
+end;
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+  ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+{$ENDIF}
 
 {
   $Log$
-  Revision 1.4  2003-11-03 09:42:27  marco
+  Revision 1.5  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.4  2003/11/17 08:27:49  marco
+   * pthreads based ttread from Johannes Berg
+
+  Revision 1.3  2003/11/10 16:54:28  marco
+   * new oldlinux unit. 1_0 defines killed in some former FCL parts.
+
+  Revision 1.2  2003/11/03 09:42:28  marco
    * Peter's Cardinal<->Longint fixes patch
 
-  Revision 1.3  2003/10/27 17:12:45  marco
-   * fixes for signal handling.
-
-  Revision 1.2  2003/10/09 10:55:20  marco
-   * fix for moving classes to rtl while cycling with 1.0 start
-
   Revision 1.1  2003/10/06 21:01:06  peter
     * moved classes unit to rtl
 
-  Revision 1.12  2003/10/06 17:06:55  florian
+  Revision 1.9  2003/10/06 17:06:55  florian
     * applied Johannes Berg's patch for exception handling in threads
 
-  Revision 1.11  2003/09/20 14:51:42  marco
+  Revision 1.8  2003/09/20 15:10:30  marco
-   * small v1_0 fix
+   * small fixes. fcl now compiles
 
-  Revision 1.10  2003/09/20 12:38:29  marco
+  Revision 1.7  2002/12/18 20:44:36  peter
-   * FCL now compiles for FreeBSD with new 1.1. Now Linux.
+    * use fillchar to clear sigset
 
-  Revision 1.9  2003/01/17 19:01:07  marco
+  Revision 1.6  2002/09/07 15:15:27  peter
-   * small fix
-
-  Revision 1.8  2002/11/17 21:09:44  marco
-   * 16byte sigset
-
-  Revision 1.7  2002/10/24 12:47:54  marco
-   * Fix emptying sa_mask
-
-  Revision 1.6  2002/09/07 15:15:24  peter
     * old logs removed and tabs fixed
 
 }

rtl/freebsd/unixsysc.inc

@@ -75,20 +75,19 @@ begin
  do_syscall(syscall_nr_gettimeofday,longint(@tv),longint(@tz));
 end;
 }
-Function  fdFlush (fd : Longint) : Boolean;
+Function  fdFlush (fd : cint) : cint;
 
 begin
-  fdflush:=do_syscall(syscall_nr_fsync,fd)=0;
+  fdflush:=do_syscall(syscall_nr_fsync,fd);
 end;
 
-Function  Flock (fd,mode : longint) : boolean;
+Function  Flock (fd,mode : longint) : cint;
 
 begin
- Flock:=do_syscall(syscall_nr_flock,fd,mode)=0;
+ Flock:=do_syscall(syscall_nr_flock,fd,mode);
 end;
 
-
+Function StatFS(Path:Pathstr;Var Info:Tstatfs):cint;
-Function StatFS(Path:Pathstr;Var Info:Tstatfs):Boolean;
 
 {
   Get all information on a fileSystem, and return it in Info.
@@ -98,10 +97,10 @@ Function StatFS(Path:Pathstr;Var Info:Tstatfs):Boolean;
 
 begin
   path:=path+#0;
-  StatFS:=Do_Syscall(syscall_nr_statfs,longint(@path[1]),longint(@info))=0;
+  StatFS:=Do_Syscall(syscall_nr_statfs,longint(@path[1]),longint(@info));
 end;
 
-Function StatFS(Fd:Longint;Var Info:tstatfs):Boolean;
+Function fStatFS(Fd:Longint;Var Info:tstatfs):cint;
 {
   Get all information on a fileSystem, and return it in Info.
   Fd is the file descriptor of a file/directory on the fileSystem
@@ -109,7 +108,7 @@ Function StatFS(Fd:Longint;Var Info:tstatfs):Boolean;
 }
 
 begin
- StatFS:=do_syscall(syscall_nr_fstatfs,fd,longint(@info))=0;
+ fStatFS:=do_syscall(syscall_nr_fstatfs,fd,longint(@info));
 end;
 
 // needs oldfpccall;
@@ -142,7 +141,7 @@ begin
 end;
 
 // can't have oldfpccall here, linux doesn't need it.
-Function AssignPipe(var pipe_in,pipe_out:longint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
 {
   Sets up a pair of file variables, which act as a pipe. The first one can
   be read from, the second one can be written to.
@@ -244,7 +243,10 @@ end;
 
 {
   $Log$
-  Revision 1.13  2003-11-14 16:21:59  marco
+  Revision 1.14  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.13  2003/11/14 16:21:59  marco
    * linuxerror elimination
 
   Revision 1.12  2003/11/09 12:00:16  marco

rtl/linux/unixsysc.inc

@@ -14,17 +14,17 @@
 **********************************************************************}
 
 
-Function  fdFlush (fd : Longint) : Boolean;
+Function  fdFlush (fd : cint) : cint;
 begin
-  fdFlush := (do_SysCall(syscall_nr_fsync, fd)=0);
+  fdFlush := do_SysCall(syscall_nr_fsync, fd);
 end;
 
-Function  Flock (fd,mode : longint) : boolean;
+Function  Flock (fd,mode : cint) : cint;
 begin
-  flock:=do_Syscall(Syscall_nr_flock,fd,mode)=0;
+  flock:=do_Syscall(Syscall_nr_flock,fd,mode);
 end;
 
-Function StatFS(Path:Pathstr;Var Info:tstatfs):Boolean;
+Function StatFS(Path:Pathstr;Var Info:tstatfs):cint;
 {
   Get all information on a fileSystem, and return it in Info.
   Path is the name of a file/directory on the fileSystem you wish to
@@ -32,20 +32,20 @@ Function StatFS(Path:Pathstr;Var Info:tstatfs):Boolean;
 }
 begin
   path:=path+#0;
-  StatFS:=(do_SysCall(SysCall_nr_statfs,longint(@path[1]),longint(@Info))=0);
+  StatFS:=(do_SysCall(SysCall_nr_statfs,longint(@path[1]),longint(@Info));
 end;
 
-Function StatFS(Fd:Longint;Var Info:tstatfs):Boolean;
+Function fStatFS(Fd:cint;Var Info:tstatfs):cint;
 {
   Get all information on a fileSystem, and return it in Info.
   Fd is the file descriptor of a file/directory on the fileSystem
   you wish to investigate.
 }
 begin
-  StatFS:=(do_SysCall(SysCall_nr_fstatfs,fd,longint(@info))=0);
+  fStatFS:=(do_SysCall(SysCall_nr_fstatfs,fd,longint(@info)));
 end;
 
-Function AssignPipe(var pipe_in,pipe_out:longint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
 
 {
   Sets up a pair of file variables, which act as a pipe. The first one can
@@ -60,10 +60,10 @@ begin
   pipe_out:=pip[2];
 end;
 
-Function PClose(Var F:text) :longint;
+Function PClose(Var F:text) :cint;
 var
-  pl  : ^longint;
+  pl  : ^cint;
-  res : longint;
+  res : cint;
 begin
   do_SysCall (syscall_nr_close,Textrec(F).Handle);
 { closed our side, Now wait for the other - this appears to be needed ?? }
@@ -72,10 +72,10 @@ begin
   pclose:=res shr 8;
 end;
 
-Function PClose(Var F:file) : longint;
+Function PClose(Var F:file) : cint;
 var
-  pl : ^longint;
+  pl : ^cint;
-  res : longint;
+  res : cint;
 begin
   do_SysCall (Syscall_nr_close,filerec(F).Handle);
 { closed our side, Now wait for the other - this appears to be needed ?? }
@@ -90,7 +90,7 @@ end;
 
 {$ifdef cpui386}
 
-Function  IOperm (From,Num : Cardinal; Value : Longint) : boolean;
+Function IOperm (From,Num : cuint; Value : cint) : boolean;
 {
   Set permissions on NUM ports starting with port FROM to VALUE
   this works ONLY as root.
@@ -100,7 +100,7 @@ begin
   IOPerm:=do_Syscall(Syscall_nr_ioperm,from,num,value)=0;
 end;
 
-Function IoPL(Level : longint) : Boolean;
+Function IoPL(Level : cint) : Boolean;
 
 begin
   IOPL:=do_Syscall(Syscall_nr_iopl,level)=0;
@@ -110,7 +110,10 @@ end;
 
 {
   $Log$
-  Revision 1.18  2003-11-13 17:40:12  marco
+  Revision 1.19  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.18  2003/11/13 17:40:12  marco
    * small fixes
 
   Revision 1.17  2003/11/13 13:36:23  marco

rtl/unix/crt.pp

@@ -1329,7 +1329,7 @@ var
   c : char;
   i : longint;
 Begin
-  if isATTY(F.Handle) then
+  if isATTY(F.Handle)<>-1 then
     begin
       F.BufPos := 0;
       i := 0;
@@ -1636,10 +1636,10 @@ Initialization
   Reset(Input);
   TextRec(Input).Handle:=StdInputHandle;
 { Are we redirected to a file ? }
-  OutputRedir:= not IsAtty(TextRec(Output).Handle);
+  OutputRedir:= IsAtty(TextRec(Output).Handle)=-1;
 { does the input come from another console or from a file? }
   InputRedir :=
-   not IsAtty(TextRec(Input).Handle) or
+   (IsAtty(TextRec(Input).Handle)=-1) or
    (not OutputRedir and
     (TTYName(TextRec(Input).Handle) <> TTYName(TextRec(Output).Handle)));
 { Get Size of terminal and set WindMax to the window }
@@ -1681,7 +1681,10 @@ Finalization
 End.
 {
   $Log$
-  Revision 1.13  2003-09-16 20:52:24  marco
+  Revision 1.14  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.13  2003/09/16 20:52:24  marco
    * small cleanups. Mostly killing of already commented code in unix etc
 
   Revision 1.12  2003/09/16 16:13:56  marco

rtl/unix/dos.pp

@@ -402,8 +402,8 @@ Function DiskFree(Drive: Byte): int64;
 var
   fs : tstatfs;
 Begin
-  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and StatFS(StrPas(fixdrivestr[drive]),fs)) or
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (StatFS(StrPas(fixdrivestr[drive]),fs)<>-1)) or
-     ((not (drivestr[Drive]=nil)) and StatFS(StrPas(drivestr[drive]),fs)) then
+     ((not (drivestr[Drive]=nil)) and (StatFS(StrPas(drivestr[drive]),fs)<>-1)) then
    Diskfree:=int64(fs.bavail)*int64(fs.bsize)
   else
    Diskfree:=-1;
@@ -415,8 +415,8 @@ Function DiskSize(Drive: Byte): int64;
 var
   fs : tstatfs;
 Begin
-  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and StatFS(StrPas(fixdrivestr[drive]),fs)) or
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (StatFS(StrPas(fixdrivestr[drive]),fs)<>-1)) or
-     ((not (drivestr[Drive]=nil)) and StatFS(StrPas(drivestr[drive]),fs)) then
+     ((not (drivestr[Drive]=nil)) and (StatFS(StrPas(drivestr[drive]),fs)<>-1)) then
    DiskSize:=int64(fs.blocks)*int64(fs.bsize)
   else
    DiskSize:=-1;
@@ -903,7 +903,10 @@ End.
 
 {
   $Log$
-  Revision 1.19  2003-10-17 22:13:30  olle
+  Revision 1.20  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.19  2003/10/17 22:13:30  olle
     * changed i386 to cpui386
 
   Revision 1.18  2003/09/27 12:51:33  peter

rtl/unix/keyboard.pp

@@ -307,7 +307,7 @@ var
 begin
   IsConsole:=false;
   { check for tty }
-  if IsATTY(stdinputhandle) then
+  if (IsATTY(stdinputhandle)<>-1) then
    begin
      { running on a tty, find out whether locally or remotely }
      ThisTTY:=TTYName(stdinputhandle);
@@ -1532,7 +1532,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2003-09-16 16:13:56  marco
+  Revision 1.16  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.15  2003/09/16 16:13:56  marco
    * fdset functions renamed to fp<posix name>
 
   Revision 1.14  2003/09/14 20:15:01  marco

rtl/unix/systhrds.pp

@@ -91,7 +91,9 @@ function  pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutex_attr_t):cint;
 function  pthread_mutex_destroy (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_lock    (p:ppthread_mutex_attr_t):cint; cdecl;external;
 function  pthread_mutex_unlock  (p:ppthread_mutex_attr_t):cint; cdecl;external;
-
+function  pthread_cancel(_para1:pthread_t):cint;cdecl;external;
+function  pthread_detach(_para1:pthread_t):cint;cdecl;external;
+function  pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external;
 {$endif}
 
 {*****************************************************************************
@@ -230,7 +232,7 @@ CONST
 {$endif DEBUG_MT}
         ThreadMain:=pointer(ti.f(ti.p));
         DoneThread;
-        pthread_detach(pthread_self);
+	pthread_detach(pointer(pthread_self));
       end;
 
 
@@ -286,7 +288,7 @@ CONST
     procedure EndThread(ExitCode : DWord);
       begin
         DoneThread;
-        pthread_detach(pthread_self);
+        pthread_detach(pointer(pthread_self));
         pthread_exit(pointer(ExitCode));
       end;
 
@@ -418,7 +420,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.16  2003-11-17 08:27:50  marco
+  Revision 1.17  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.16  2003/11/17 08:27:50  marco
    * pthreads based ttread from Johannes Berg
 
   Revision 1.15  2003/10/01 21:00:09  peter

rtl/unix/sysutils.pp

@@ -357,8 +357,8 @@ Function DiskFree(Drive: Byte): int64;
 var
   fs : tstatfs;
 Begin
-  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and statfs(StrPas(fixdrivestr[drive]),fs)) or
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
-     ((not (drivestr[Drive]=nil)) and statfs(StrPas(drivestr[drive]),fs)) then
+     ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
    Diskfree:=int64(fs.bavail)*int64(fs.bsize)
   else
    Diskfree:=-1;
@@ -370,8 +370,8 @@ Function DiskSize(Drive: Byte): int64;
 var
   fs : tstatfs;
 Begin
-  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and statfs(StrPas(fixdrivestr[drive]),fs)) or
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(StrPas(fixdrivestr[drive]),fs)<>-1)) or
-     ((not (drivestr[Drive]=nil)) and statfs(StrPas(drivestr[drive]),fs)) then
+     ((not (drivestr[Drive]=nil)) and (statfs(StrPas(drivestr[drive]),fs)<>-1)) then
    DiskSize:=int64(fs.blocks)*int64(fs.bsize)
   else
    DiskSize:=-1;
@@ -490,7 +490,10 @@ end.
 {
 
   $Log$
-  Revision 1.24  2003-10-25 23:43:59  hajny
+  Revision 1.25  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.24  2003/10/25 23:43:59  hajny
     * THandle in sysutils common using System.THandle
 
   Revision 1.23  2003/10/07 08:28:49  marco

rtl/unix/unix.pp

@@ -62,7 +62,7 @@ Const
   LOCK_NB = 4;
 
 Type
-  Tpipe = array[1..2] of longint;
+  Tpipe = array[1..2] of cint;
 
   pglob = ^tglob;
   tglob = record
@@ -115,12 +115,12 @@ var
   tzname     : array[boolean] of pchar;
 
 { timezone support }
-procedure GetLocalTimezone(timer:longint;var leap_correct,leap_hit:longint);
+procedure GetLocalTimezone(timer:cint;var leap_correct,leap_hit:cint);
-procedure GetLocalTimezone(timer:longint);
+procedure GetLocalTimezone(timer:cint);
 procedure ReadTimezoneFile(fn:string);
 function  GetTimezoneFile:string;
 
-Function  GetEpochTime: longint;
+Function  GetEpochTime: cint;
 procedure GetTime(var hour,min,sec,msec,usec:word);
 procedure GetTime(var hour,min,sec,sec100:word);
 procedure GetTime(var hour,min,sec:word);
@@ -150,12 +150,12 @@ Function Execle(Todo: AnsiString;Ep:ppchar):cint;
 Function Execlp(Todo: string;Ep:ppchar):cint;
 Function Execlp(Todo: Ansistring;Ep:ppchar):cint;
 
-Function  Shell(const Command:String):Longint;
+Function  Shell(const Command:String):cint;
-Function  Shell(const Command:AnsiString):Longint;
+Function  Shell(const Command:AnsiString):cint;
 
 {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
-function  Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
+function  Clone(func:TCloneFunc;sp:pointer;flags:cint;args:pointer):cint;
-Function  WaitProcess(Pid:longint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+Function  WaitProcess(Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
 
 Function WIFSTOPPED(Status: Integer): Boolean;
 Function W_EXITCODE(ReturnCode, Signal: Integer): Integer;
@@ -165,30 +165,30 @@ Function W_STOPCODE(Signal: Integer): Integer;
      File Handling
 ***************************}
 
-Function  fdFlush (fd : Longint) : Boolean;
+Function  fdFlush (fd : cint) : cint;
 
-Function  Flock (fd,mode : longint) : boolean;
+Function  Flock (fd,mode : cint)   : cint ;
-Function  Flock (var T : text;mode : longint) : boolean;
+Function  Flock (var T : text;mode : cint) : cint;
-Function  Flock (var F : File;mode : longint) : boolean;
+Function  Flock (var F : File;mode : cint) : cint;
 
-Function  StatFS(Path:Pathstr;Var Info:tstatfs):Boolean;
+Function  StatFS(Path:Pathstr;Var Info:tstatfs):cint;
-Function  StatFS(Fd: Longint;Var Info:tstatfs):Boolean;
+Function  fStatFS(Fd: cint;Var Info:tstatfs):cint;
 
-Function  SelectText(var T:Text;TimeOut :PTimeVal):Longint;
+Function  SelectText(var T:Text;TimeOut :PTimeVal):cint;
-Function  SelectText(var T:Text;TimeOut :Longint):Longint;
+Function  SelectText(var T:Text;TimeOut :cint):cint;
 
 {**************************
    Directory Handling
 ***************************}
 
-procedure SeekDir(p:pdir;off:longint);
+procedure SeekDir(p:pdir;loc:clong);
-function  TellDir(p:pdir):longint;
+function  TellDir(p:pdir):clong;
 
 {**************************
     Pipe/Fifo/Stream
 ***************************}
 
-Function  AssignPipe(var pipe_in,pipe_out:longint):cint;
+Function  AssignPipe(var pipe_in,pipe_out:cint):cint;
 Function  AssignPipe(var pipe_in,pipe_out:text):cint;
 Function  AssignPipe(var pipe_in,pipe_out:file):cint;
 Function  PClose(Var F:text) : cint;
@@ -208,21 +208,21 @@ Function  GetHostName:String;
   IOCtl/Termios Functions
 ***************************}
 
-Function  TCGetAttr(fd:longint;var tios:TermIOS):boolean;
+Function  TCGetAttr (fd:cint;var tios:TermIOS):cint;
-Function  TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
+Function  TCSetAttr (fd:cint;OptAct:cint;const tios:TermIOS):cint;
-Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+Procedure CFSetISpeed (var tios:TermIOS;speed:Cardinal);
-Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+Procedure CFSetOSpeed (var tios:TermIOS;speed:Cardinal);
-Procedure CFMakeRaw(var tios:TermIOS);
+Procedure CFMakeRaw   (var tios:TermIOS);
-Function  TCSendBreak(fd,duration:longint):boolean;
+Function  TCSendBreak (fd,duration:cint):cint;
-Function  TCSetPGrp(fd,id:longint):boolean;
+Function  TCSetPGrp   (fd,id:cint)  :cint;
-Function  TCGetPGrp(fd:longint;var id:longint):boolean;
+Function  TCGetPGrp   (fd:cint;var id:cint):cint;
-Function  TCFlush(fd,qsel:longint):boolean;
+Function  TCFlush     (fd,qsel:cint):cint;
-Function  TCDrain(fd:longint):boolean;
+Function  TCDrain     (fd:cint)     :cint;
-Function  TCFlow(fd,act:longint):boolean;
+Function  TCFlow      (fd,act:cint) :cint;
-Function  IsATTY(Handle:Longint):Boolean;
+Function  IsATTY      (Handle:cint) :cint;
-Function  IsATTY(var f:text):Boolean;
+Function  IsATTY      (var f:text)  :cint;
-function  TTYname(Handle:Longint):string;
+function  TTYname     (Handle:cint):string;
-function  TTYname(var F:Text):string;
+function  TTYname     (var F:Text) :string;
 
 {**************************
      Memory functions
@@ -250,7 +250,6 @@ const
     Utility functions
 ***************************}
 
-Function  Octal(l:longint):longint;
 Function  FExpand(Const Path: PathStr):PathStr;
 Function  FSearch(const path:pathstr;dirlist:string):pathstr;
 Function  Glob(Const path:pathstr):pglob;
@@ -294,8 +293,8 @@ Function getenv(name:string):Pchar; external name 'FPC_SYSC_FPGETENV';
 ******************************************************************************}
 
 { Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
-Function  WaitProcess(Pid:longint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+Function  WaitProcess(Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
-var     ret,r,s     : LongInt;
+var     ret,r,s     : cint;
 begin
   s:=$7F00;
 
@@ -322,7 +321,7 @@ begin
    end;
 end;
 
-function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
+function InternalCreateShellArgV(cmd:pChar; len:cint):ppchar;
 {
   Create an argv which executes a command in a shell using /bin/sh -c
 }
@@ -546,7 +545,7 @@ Function Shell(const Command:String):cint;
 }
 var
   p      : ppchar;
-  pid    : longint;
+  pid    : cint;
 begin
   p:=CreateShellArgv(command);
   pid:=fpfork;
@@ -569,7 +568,7 @@ Function Shell(const Command:AnsiString):cint;
 }
 var
   p     : ppchar;
-  pid   : longint;
+  pid   : cint;
 begin { Changes as above }
   p:=CreateShellArgv(command);
   pid:=fpfork;
@@ -606,7 +605,7 @@ end;
                        Date and Time related calls
 ******************************************************************************}
 
-Function GetEpochTime: longint;
+Function GetEpochTime: cint;
 {
   Get the number of seconds since 00:00, January 1 1970, GMT
   the time NOT corrected any way
@@ -670,15 +669,15 @@ End;
 
 {$ifndef BSD}
 {$ifdef linux}
-Function stime (t : longint) : Boolean;
+Function stime (t : cint) : Boolean;
 begin
-  stime:=do_SysCall(Syscall_nr_stime,longint(@t))=0;
+  stime:=do_SysCall(Syscall_nr_stime,cint(@t))=0;
 end;
 {$endif}
 {$endif}
 
 {$ifdef BSD}
-Function stime (t : longint) : Boolean;
+Function stime (t : cint) : Boolean;
 begin
 end;
 {$endif}
@@ -722,18 +721,18 @@ begin
   Execl:=ExecLE(ToDo,EnvP);
 end;
 
-Function Flock (var T : text;mode : longint) : boolean;
+Function Flock (var T : text;mode : cint) : cint;
 begin
   Flock:=Flock(TextRec(T).Handle,mode);
 end;
 
 
-Function  Flock (var F : File;mode : longint) : boolean;
+Function  Flock (var F : File;mode : cint) :cint;
 begin
   Flock:=Flock(FileRec(F).Handle,mode);
 end;
 
-Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
+Function SelectText(var T:Text;TimeOut :PTimeval):cint;
 Var
   F:TfdSet;
 begin
@@ -750,7 +749,7 @@ begin
    SelectText:=fpselect(textrec(T).handle+1,nil,@f,nil,TimeOut);
 end;
 
-Function SelectText(var T:Text;TimeOut :Longint):Longint;
+Function SelectText(var T:Text;TimeOut :cint):cint;
 var
   p  : PTimeVal;
   tv : TimeVal;
@@ -770,7 +769,7 @@ end;
                                Directory
 ******************************************************************************}
 
-procedure SeekDir(p:pdir;off:longint);
+procedure SeekDir(p:pdir;loc:clong);
 begin
   if p=nil then
    begin
@@ -778,13 +777,13 @@ begin
      exit;
    end;
  {$ifndef bsd}
-  p^.dd_nextoff:=fplseek(p^.dd_fd,off,seek_set);
+  p^.dd_nextoff:=fplseek(p^.dd_fd,loc,seek_set);
  {$endif}
   p^.dd_size:=0;
   p^.dd_loc:=0;
 end;
 
-function TellDir(p:pdir):longint;
+function TellDir(p:pdir):clong;
 begin
   if p=nil then
    begin
@@ -857,7 +856,7 @@ Function AssignPipe(var pipe_in,pipe_out:text):cint;
   be read from, the second one can be written to.
 }
 var
-  f_in,f_out : longint;
+  f_in,f_out : cint;
 begin
   if AssignPipe(f_in,f_out)=-1 then
      exit(-1);
@@ -889,7 +888,7 @@ Function AssignPipe(var pipe_in,pipe_out:file):cint;
   If the operation was unsuccesful, 
 }
 var
-  f_in,f_out : longint;
+  f_in,f_out : cint;
 begin
   if AssignPipe(f_in,f_out)=-1 then
      exit(-1);
@@ -1006,8 +1005,8 @@ Function POpen(var F:file;const Prog:String;rw:char):cint;
 var
   pipi,
   pipo : file;
-  pid  : longint;
+  pid  : cint;
-  pl   : ^longint;
+  pl   : ^cint;
   p,pp : ppchar;
   temp : string[255];
   ret  : cint;
@@ -1095,8 +1094,8 @@ Function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : cint;
 var
   pipi,
   pipo : text;
-  pid  : longint;
+  pid  : cint;
-  pl   : ^Longint;
+  pl   : ^cint;
 begin
   AssignStream:=-1;
   if AssignPipe(streamin,pipo)=-1 Then
@@ -1144,7 +1143,7 @@ begin
    end;
 end;
 
-function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String): LongInt;
+function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: String):cint;
 {
   Starts the program in 'prog' and makes its input, output and error output the
   other end of three pipes, which are the stdin, stdout and stderr of a program
@@ -1159,8 +1158,8 @@ function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: Stri
 }
 var
   PipeIn, PipeOut, PipeErr: text;
-  pid: LongInt;
+  pid: cint;
-  pl: ^LongInt;
+  pl: ^cint;
 begin
   AssignStream := -1;
 
@@ -1284,19 +1283,19 @@ end;
                          IOCtl and Termios calls
 ******************************************************************************}
 
-Function TCGetAttr(fd:longint;var tios:TermIOS):boolean;
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
 begin
  {$ifndef BSD}
-  TCGetAttr:=fpIOCtl(fd,TCGETS,@tios)=0;
+  TCGetAttr:=fpIOCtl(fd,TCGETS,@tios);
  {$else}
-  TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios)=0;
+  TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
  {$endif}
 end;
 
 
-Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean;
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
 var
-  nr:longint;
+  nr:cint;
 begin
  {$ifndef BSD}
   case OptAct of
@@ -1312,11 +1311,11 @@ begin
   else
    begin
      fpsetErrNo(ESysEINVAL);
-     TCSetAttr:=false;
+     TCSetAttr:=-1;
      exit;
    end;
   end;
-  TCSetAttr:=fpIOCtl(fd,nr,@Tios)=0;
+  TCSetAttr:=fpIOCtl(fd,nr,@Tios);
 end;
 
 
@@ -1369,60 +1368,60 @@ begin
  {$endif}
 end;
 
-Function TCSendBreak(fd,duration:longint):boolean;
+Function TCSendBreak(fd,duration:cint):cint;
 begin
   {$ifndef BSD}
-  TCSendBreak:=fpIOCtl(fd,TCSBRK,pointer(duration))=0;
+  TCSendBreak:=fpIOCtl(fd,TCSBRK,pointer(duration));
   {$else}
-  TCSendBreak:=fpIOCtl(fd,TIOCSBRK,0)=0;
+  TCSendBreak:=fpIOCtl(fd,TIOCSBRK,0);
   {$endif}
 end;
 
 
-Function TCSetPGrp(fd,id:longint):boolean;
+Function TCSetPGrp(fd,id:cint):cint;
 begin
-  TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id))=0;
+  TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
 end;
 
 
-Function TCGetPGrp(fd:longint;var id:longint):boolean;
+Function TCGetPGrp(fd:cint;var id:cint):cint;
 begin
-  TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id)=0;
+  TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
 end;
 
-Function TCDrain(fd:longint):boolean;
+Function TCDrain(fd:cint):cint;
 begin
  {$ifndef BSD}
-  TCDrain:=fpIOCtl(fd,TCSBRK,pointer(1))=0;
+  TCDrain:=fpIOCtl(fd,TCSBRK,pointer(1));
  {$else}
-  TCDrain:=fpIOCtl(fd,TIOCDRAIN,0)=0; {Should set timeout to 1 first?}
+  TCDrain:=fpIOCtl(fd,TIOCDRAIN,0); {Should set timeout to 1 first?}
  {$endif}
 end;
 
 
-Function TCFlow(fd,act:longint):boolean;
+Function TCFlow(fd,act:cint):cint;
 begin
   {$ifndef BSD}
-   TCFlow:=fpIOCtl(fd,TCXONC,pointer(act))=0;
+   TCFlow:=fpIOCtl(fd,TCXONC,pointer(act));
   {$else}
     case act OF
-     TCOOFF :  TCFlow:=fpIoctl(fd,TIOCSTOP,0)=0;
+     TCOOFF :  TCFlow:=fpIoctl(fd,TIOCSTOP,0);
-     TCOOn  :  TCFlow:=fpIOctl(Fd,TIOCStart,0)=0;
+     TCOOn  :  TCFlow:=fpIOctl(Fd,TIOCStart,0);
      TCIOFF :  {N/I}
     end;
   {$endif}
 end;
 
-Function TCFlush(fd,qsel:longint):boolean;
+Function TCFlush(fd,qsel:cint):cint;
 begin
  {$ifndef BSD}
-  TCFlush:=fpIOCtl(fd,TCFLSH,pointer(qsel))=0;
+  TCFlush:=fpIOCtl(fd,TCFLSH,pointer(qsel));
  {$else}
-  TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel))=0;
+  TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
  {$endif}
 end;
 
-Function IsATTY (Handle:Longint):Boolean;
+Function IsATTY (Handle:cint):cint;
 {
   Check if the filehandle described by 'handle' is a TTY (Terminal)
 }
@@ -1433,7 +1432,7 @@ begin
 end;
 
 
-Function IsATTY(var f: text):Boolean;
+Function IsATTY(var f: text):cint;
 {
   Idem as previous, only now for text variables.
 }
@@ -1442,7 +1441,7 @@ begin
 end;
 
 
-function TTYName(Handle:Longint):string;
+function TTYName(Handle:cint):string;
 {
   Return the name of the current tty described by handle f.
   returns empty string in case of an error.
@@ -1499,8 +1498,7 @@ var
 
 begin
   TTYName:='';
-  fpfstat(handle,st);
+  if (fpfstat(handle,st)=-1) and (isatty (handle)<>-1) then
-  if (fpgeterrno<>0) and isatty (handle) then
    exit;
   mydev:=st.st_dev;
   myino:=st.st_ino;
@@ -1521,13 +1519,14 @@ end;
                              Utility calls
 ******************************************************************************}
 
-Function Octal(l:longint):longint;
+{
+Function Octal(l:cint):cint;
 {
   Convert an octal specified number to decimal;
 }
 var
   octnr,
-  oct : longint;
+  oct : cint;
 begin
   octnr:=0;
   oct:=0;
@@ -1539,7 +1538,7 @@ begin
    end;
   Octal:=oct;
 end;
-
+}
 
 {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
 {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
@@ -1557,7 +1556,7 @@ Function FSearch(const path:pathstr;dirlist:string):pathstr;
 }
 Var
   NewDir : PathStr;
-  p1     : Longint;
+  p1     : cint;
   Info   : Stat;
 Begin
 {Replace ':' with ';'}
@@ -1677,7 +1676,7 @@ begin
   glob:=root;
 end;
 
-Function GetFS (var T:Text):longint;
+Function GetFS (var T:Text):cint;
 {
   Get File Descriptor of a text file.
 }
@@ -1689,7 +1688,7 @@ begin
 end;
 
 
-Function GetFS(Var F:File):longint;
+Function GetFS(Var F:File):cint;
 {
   Get File Descriptor of an unTyped file.
 }
@@ -1705,7 +1704,6 @@ end;
       Stat.Mode Macro's
 --------------------------------}
 
-
 Initialization
   InitLocalTime;
 
@@ -1715,7 +1713,10 @@ End.
 
 {
   $Log$
-  Revision 1.47  2003-11-14 17:30:14  marco
+  Revision 1.48  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.47  2003/11/14 17:30:14  marco
    * weeehoo linuxerror is no more :-)
 
   Revision 1.46  2003/11/14 16:44:48  marco

rtl/unix/video.pp

@@ -625,7 +625,7 @@ begin
 {$endif CPUI386}
   { check for tty }
   ThisTTY:=TTYName(stdinputhandle);
-  if IsATTY(stdinputhandle) then
+  if (IsATTY(stdinputhandle)<>-1) then
    begin
      { save current terminal characteristics and remove rawness }
      prepareInitVideo;
@@ -641,7 +641,7 @@ begin
         Case ThisTTY[9] of
          '0'..'9' : begin { running Linux on native console or native-emulation }
                      FName:='/dev/vcsa' + ThisTTY[9];
-                     TTYFd:=fpOpen(FName, Octal(666), Open_RdWr); { open console }
+                     TTYFd:=fpOpen(FName, &666, Open_RdWr); { open console }
                      IF TTYFd <>-1 Then
                        Console:=ttyLinux;
                     end;
@@ -898,7 +898,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.18  2003-10-26 15:32:25  marco
+  Revision 1.19  2003-11-17 10:05:51  marco
+   * threads for FreeBSD. Not working tho
+
+  Revision 1.18  2003/10/26 15:32:25  marco
    * partial fix for bug 2212.
 
   Revision 1.17  2003/10/25 22:48:52  marco