mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 04:39:28 +02:00
* NetBSD fcl makefile fixes. Plain copy from FreeBSD
This commit is contained in:
marco
parent
c304a73c77
commit
b564e018d1
@ -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
|
||||
|
||||
@ -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
fcl/netbsd/classes.pp
Normal file
109
fcl/netbsd/classes.pp
Normal file
@ -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
fcl/netbsd/process.inc
Normal file
141
fcl/netbsd/process.inc
Normal file
@ -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
fcl/netbsd/thread.inc
Normal file
330
fcl/netbsd/thread.inc
Normal file
@ -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
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user