Procházet zdrojové kódy

* NetBSD fcl makefile fixes. Plain copy from FreeBSD

marco před 24 roky
rodič
revize
b564e018d1
5 změnil soubory, kde provedl 587 přidání a 1 odebrání
  1. 5 1
      fcl/Makefile
  2. 2 0
      fcl/Makefile.fpc
  3. 109 0
      fcl/netbsd/classes.pp
  4. 141 0
      fcl/netbsd/process.inc
  5. 330 0
      fcl/netbsd/thread.inc

+ 5 - 1
fcl/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2001/08/30]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2001/09/05]
 #
 default: all
 override PATH:=$(subst \,/,$(PATH))
@@ -146,6 +146,9 @@ endif
 ifeq ($(OS_TARGET),freebsd)
 override TARGET_UNITS+=process asyncio ssockets http
 endif
+ifeq ($(OS_TARGET),netbsd)
+override TARGET_UNITS+=process asyncio ssockets http
+endif
 override TARGET_RSTS+=classes ssockets cachecls
 override TARGET_EXAMPLEDIRS+=tests
 override INSTALL_FPCPACKAGE=y
@@ -605,6 +608,7 @@ endif
 ifeq ($(OS_TARGET),netbsd)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_INET=1
 endif
 ifeq ($(OS_TARGET),amiga)
 REQUIRE_PACKAGES_RTL=1

+ 2 - 0
fcl/Makefile.fpc

@@ -10,11 +10,13 @@ version=1.0.5
 packages=paszlib
 packages_linux=inet
 packages_freebsd=inet
+packages_netbsd=inet
 
 [target]
 dirs=xml db shedit
 units=classes inifiles registry ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls
 units_freebsd=process asyncio ssockets http
+units_netbsd=process asyncio ssockets http
 units_linux=process asyncio ssockets http
 units_win32=process fileinfo
 rsts=classes ssockets cachecls

+ 109 - 0
fcl/netbsd/classes.pp

@@ -0,0 +1,109 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for linux
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  sysutils,
+  typinfo;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+{$ifdef ver1_0}
+  linux
+{$else}
+  unix
+{$endif}
+  ;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+  CommonInit;
+
+finalization
+  CommonCleanup;
+
+  if ThreadsInited then
+     DoneThreads;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-09-05 14:30:04  marco
+   * NetBSD fcl makefile fixes. Plain copy from FreeBSD
+
+  Revision 1.4  2001/04/08 11:26:03  peter
+    * update so it can be compiled by both 1.0.x and 1.1
+
+  Revision 1.3  2001/01/21 20:45:09  marco
+   * Rename fest II  FCL version.
+
+  Revision 1.2  2000/10/26 22:30:21  peter
+    * freebsd update
+    * classes.rst
+
+  Revision 1.1.2.1  2000/10/17 13:47:43  marco
+   * Copy of fcl/linux dir with adapted makefiles to ease FreeBSD 1.0.2
+  packaging
+
+  Revision 1.1  2000/07/13 06:31:32  michael
+  + Initial import
+
+  Revision 1.19  2000/07/01 09:49:02  peter
+    * fixed go32v2,win32 build
+
+  Revision 1.18  2000/06/29 16:32:06  sg
+  * Changes in initialisation/finalisation for streaming support
+
+  Revision 1.17  2000/06/27 17:17:34  lazarus
+  Added code for registerclass, GetClass and RegisterClasses
+  Shane
+
+  Revision 1.16  2000/06/27 15:55:19  lazarus
+  Added TThreadlist code.   Shane
+
+  Revision 1.15  2000/01/07 01:24:34  peter
+    * updated copyright to 2000
+
+  Revision 1.14  2000/01/07 00:01:33  peter
+    * uses typinfo moved to interface
+
+  Revision 1.13  2000/01/06 01:20:33  peter
+    * moved out of packages/ back to topdir
+
+  Revision 1.2  2000/01/04 18:07:58  michael
+  + Added typinfo unit
+
+  Revision 1.1  2000/01/03 19:33:09  peter
+    * moved to packages dir
+
+  Revision 1.11  1999/05/30 10:46:41  peter
+    * start of tthread for linux,win32
+
+}

+ 141 - 0
fcl/netbsd/process.inc

@@ -0,0 +1,141 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt
+
+    Linux specific part of TProcess.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+uses
+{$ifdef ver1_0}
+  Linux
+{$else}
+  Unix
+{$endif}
+  ;
+
+Function TProcess.GetRunning : Boolean;
+
+begin
+  IF FRunning then
+    FRunning:=GetExitStatus=-1;
+  Result:=FRunning;
+end;
+
+Procedure TProcess.Execute;
+
+begin
+  FreeStreams;
+  CreatePipeStreams (FChildInputSTream,FParentOutPutStream);
+  CreatePipeStreams (FParentInputStream,FChildOutPutStream);
+  If poUsePipes in FCreateOptions then
+    begin
+    if poStdErrToOutPut in FCreateOptions then
+      CreatePipeStreams (FParentErrorStream,FChildErrorStream)
+    else
+      begin
+      FChildErrorStream:=FChildOutPutStream;
+      FParentErrorStream:=FParentInputStream;
+      end;
+    end
+  else
+    CreatePipeStreams (FParentErrorStream,FChildErrorStream);
+  If FCurrentDirectory<>'' then
+    Chdir(FCurrentDirectory);
+  FHandle:=fork();
+  if FHandle=0 then
+   begin
+   // Child
+   fdClose(0);
+   fdClose(1);
+   fdclose(2);
+   dup2(FChildInputStream.Handle,0);
+   dup2(FCHildOutputStream.Handle,1);
+   dup2(FChildErrorStream.Handle,2);
+   execl(FCommandline);
+   halt(127);
+   end
+  else
+    begin
+    // Parent
+    FPID:=FHandle;
+    FThreadHandle:=FHandle;
+    fdclose(FChildOutputStream.Handle);
+    fdclose(FChildInputStream.Handle);
+    fdclose(FChildErrorStream.Handle);
+    FRunning:=True;
+    if (poWaitOnExit in FCreateOptions) and
+        not (poRunSuspended in FCreateOptions) then
+    WaitOnExit;
+    end;
+end;
+
+Function TProcess.WaitOnExit : Dword;
+
+begin
+  waitpid(FPID, nil, 0);
+{
+  Result:=WaitForSingleObject (FprocessInformation.hProcess,Infinite);
+  If Result<>Wait_Failed then
+    GetExitStatus;
+}  FRunning:=False;
+  Result := 0;
+end;
+
+Function TProcess.Suspend : Longint;
+
+begin
+  Result:=Kill(Handle,SIGSTOP);
+end;
+
+Function TProcess.Resume : LongInt;
+
+begin
+  Result:=Kill(FHandle,SIGCONT);
+end;
+
+Function TProcess.Terminate(AExitCode : Integer) : Boolean;
+
+begin
+  Result:=False;
+  If ExitStatus=-1 then
+    Result:=Kill(FHandle,SIGTERM)=0;
+end;
+
+{
+  $Log$
+  Revision 1.1  2001-09-05 14:30:04  marco
+   * NetBSD fcl makefile fixes. Plain copy from FreeBSD
+
+  Revision 1.4  2001/04/08 11:26:03  peter
+    * update so it can be compiled by both 1.0.x and 1.1
+
+  Revision 1.3  2001/01/21 20:45:09  marco
+   * Rename fest II  FCL version.
+
+  Revision 1.2  2000/10/26 22:30:21  peter
+    * freebsd update
+    * classes.rst
+
+  Revision 1.1.2.1  2000/10/17 13:47:43  marco
+   * Copy of fcl/linux dir with adapted makefiles to ease FreeBSD 1.0.2
+  packaging
+
+  Revision 1.1  2000/07/13 06:33:44  michael
+  + Initial import
+
+  Revision 1.5  2000/02/15 22:03:38  sg
+  * Inserted wrong copyright notice ;)  Fixed.
+
+  Revision 1.4  2000/02/15 21:57:51  sg
+  * Added copyright notice and CVS log tags where necessary
+
+}

+ 330 - 0
fcl/netbsd/thread.inc

@@ -0,0 +1,330 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Peter Vreman
+
+    Linux TThread implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program 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.
+
+ **********************************************************************}
+
+type
+  PThreadRec=^TThreadRec;
+  TThreadRec=record
+    thread : TThread;
+    next   : PThreadRec;
+  end;
+
+var
+  ThreadRoot : PThreadRec;
+  ThreadsInited : boolean;
+//  MainThreadID: longint;
+
+Const
+  ThreadCount: longint = 0;
+
+function ThreadSelf:TThread;
+var
+  hp : PThreadRec;
+  sp : longint;
+begin
+  sp:=SPtr;
+  hp:=ThreadRoot;
+  while assigned(hp) do
+   begin
+     if (sp<=hp^.Thread.FStackPointer) and
+        (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
+      begin
+        Result:=hp^.Thread;
+        exit;
+      end;
+     hp:=hp^.next;
+   end;
+  Result:=nil;
+end;
+
+
+//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
+procedure SIGCHLDHandler(Sig: longint); cdecl;
+begin
+  waitpid(-1, nil, WNOHANG);
+end;
+
+procedure InitThreads;
+var
+  Act, OldAct: 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()
+
+  GetMem(Act, SizeOf(SigActionRec));
+  GetMem(OldAct, SizeOf(SigActionRec));
+
+  Act^.handler.sh := @SIGCHLDHandler;
+  Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
+  Act^.sa_mask := 0; //Do not block all signals ??. Don't need if SA_NOMASK in flags
+
+  SigAction(SIGCHLD, Act, OldAct);
+
+  FreeMem(Act, SizeOf(SigActionRec));
+  FreeMem(OldAct, SizeOf(SigActionRec));
+end;
+
+
+procedure DoneThreads;
+var
+  hp : PThreadRec;
+begin
+  while assigned(ThreadRoot) do
+   begin
+     ThreadRoot^.Thread.Destroy;
+     hp:=ThreadRoot;
+     ThreadRoot:=ThreadRoot^.Next;
+     dispose(hp);
+   end;
+  ThreadsInited:=false;
+end;
+
+
+procedure AddThread(t:TThread);
+var
+  hp : PThreadRec;
+begin
+  { Need to initialize threads ? }
+  if not ThreadsInited then
+   InitThreads;
+
+  { Put thread in the linked list }
+  new(hp);
+  hp^.Thread:=t;
+  hp^.next:=ThreadRoot;
+  ThreadRoot:=hp;
+
+  inc(ThreadCount, 1);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+  lasthp,hp : PThreadRec;
+begin
+  hp:=ThreadRoot;
+  lasthp:=nil;
+  while assigned(hp) do
+   begin
+     if hp^.Thread=t then
+      begin
+        if assigned(lasthp) then
+         lasthp^.next:=hp^.next
+        else
+         ThreadRoot:=hp^.next;
+        dispose(hp);
+        exit;
+      end;
+     lasthp:=hp;
+     hp:=hp^.next;
+   end;
+
+  Dec(ThreadCount, 1);
+  if ThreadCount = 0 then DoneThreads;
+end;
+
+
+{ TThread }
+function ThreadProc(args:pointer): Integer;cdecl;
+var
+  FreeThread: Boolean;
+  Thread : TThread absolute args;
+begin
+  Thread.Execute;
+  FreeThread := Thread.FFreeOnTerminate;
+  Result := Thread.FReturnValue;
+  Thread.FFinished := True;
+  Thread.DoTerminate;
+  if FreeThread then
+    Thread.Free;
+  ExitProcess(Result);
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+  Flags: Integer;
+begin
+  inherited Create;
+  AddThread(self);
+  FSuspended := CreateSuspended;
+  Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
+  { Setup 16k of stack }
+  FStackSize:=16384;
+  Getmem(pointer(FStackPointer),FStackSize);
+  inc(FStackPointer,FStackSize);
+  FCallExitProcess:=false;
+  { Clone }
+  FHandle:= Clone(@ThreadProc,pointer(FStackPointer),Flags,self);
+  if FSuspended then Suspend;
+  FThreadID := FHandle;
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if not FFinished and not Suspended then
+   begin
+     Terminate;
+     WaitFor;
+   end;
+  if FHandle <> -1 then
+    Kill(FHandle, SIGKILL);
+  dec(FStackPointer,FStackSize);
+  Freemem(pointer(FStackPointer),FStackSize);
+  inherited Destroy;
+  RemoveThread(self);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+  FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+
+const
+{ I Don't know idle or timecritical, value is also 20, so the largest other
+  possibility is 19 (PFV) }
+  Priorities: array [TThreadPriority] of Integer =
+   (-20,-19,-10,9,10,19,20);
+
+function TThread.GetPriority: TThreadPriority;
+var
+  P: Integer;
+  I: TThreadPriority;
+begin
+  P := {$ifdef ver1_0}Linux{$else}Unix{$endif}.GetPriority(Prio_Process,FHandle);
+  Result := tpNormal;
+  for I := Low(TThreadPriority) to High(TThreadPriority) do
+    if Priorities[I] = P then
+      Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+  {$ifdef ver1_0}Linux{$else}Unix{$endif}.SetPriority(Prio_Process,FHandle, Priorities[Value]);
+end;
+
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+begin
+  FSynchronizeException := nil;
+  FMethod := Method;
+{  SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
+  if Assigned(FSynchronizeException) then
+    raise FSynchronizeException;
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+  if Value <> FSuspended then
+    if Value then
+      Suspend
+    else
+      Resume;
+end;
+
+
+procedure TThread.Suspend;
+begin
+  Kill(FHandle, SIGSTOP);
+  FSuspended := true;
+end;
+
+
+procedure TThread.Resume;
+begin
+  Kill(FHandle, SIGCONT);
+  FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+  status : longint;
+begin
+  if FThreadID = MainThreadID then
+   WaitPid(0,@status,0)
+  else
+   WaitPid(FHandle,@status,0);
+  Result:=status;
+end;
+
+{
+  $Log$
+  Revision 1.1  2001-09-05 14:30:04  marco
+   * NetBSD fcl makefile fixes. Plain copy from FreeBSD
+
+  Revision 1.4  2001/04/08 11:26:03  peter
+    * update so it can be compiled by both 1.0.x and 1.1
+
+  Revision 1.3  2001/01/21 20:45:09  marco
+   * Rename fest II  FCL version.
+
+  Revision 1.2  2000/10/26 22:30:21  peter
+    * freebsd update
+    * classes.rst
+
+  Revision 1.1.2.1  2000/10/17 13:47:43  marco
+   * Copy of fcl/linux dir with adapted makefiles to ease FreeBSD 1.0.2
+  packaging
+
+  Revision 1.1  2000/07/13 06:33:44  michael
+  + Initial import
+
+  Revision 1.9  2000/05/17 18:31:18  peter
+    * fixed for new sigactionrec
+
+  Revision 1.8  2000/01/07 01:24:34  peter
+    * updated copyright to 2000
+
+  Revision 1.7  2000/01/06 01:20:33  peter
+    * moved out of packages/ back to topdir
+
+  Revision 1.1  2000/01/03 19:33:09  peter
+    * moved to packages dir
+
+  Revision 1.5  1999/10/27 10:40:30  peter
+    * fixed threadproc decl
+
+  Revision 1.4  1999/08/28 09:32:26  peter
+    * readded header/log
+
+  Revision 1.2  1999/05/31 12:47:59  peter
+    * classes unit to unitobjects
+
+  Revision 1.1  1999/05/30 10:46:42  peter
+    * start of tthread for linux,win32
+
+}