mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 01:08:07 +02:00
Amicommon: implemented BasicEvents in AThreads
git-svn-id: trunk@36905 -
This commit is contained in:
marcus
parent
ee4c92af6e
commit
a0aaa69c0f
@ -46,6 +46,7 @@ var
|
||||
SubThreadBaseName: String = 'FPC Subthread';
|
||||
|
||||
{.$define DEBUG_MT}
|
||||
{.$define DEBUG_AMIEVENT}
|
||||
type
|
||||
TThreadOperation = ( toNone, toStart, toResume, toExit );
|
||||
|
||||
@ -408,7 +409,7 @@ begin
|
||||
WaitPort(@thisThread^.pr_MsgPort);
|
||||
threadMsg:=PThreadMsg(GetMsg(@thisThread^.pr_MsgPort));
|
||||
|
||||
{ fetch existing threadinfo from the start message, and set
|
||||
{ fetch existing threadinfo from the start message, and set
|
||||
it to tc_userData, so we can proceed with threadvars }
|
||||
threadInfo:=threadMsg^.tm_ThreadInfo;
|
||||
thisThread^.pr_Task.tc_userData:=threadInfo;
|
||||
@ -831,27 +832,318 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
// Event Stuff
|
||||
|
||||
// Return values for WaitFor
|
||||
const
|
||||
wrSignaled = 0;
|
||||
wrTimeout = 1;
|
||||
wrAbandoned = 2;
|
||||
wrError = 3;
|
||||
|
||||
// the internal AmigaEvent
|
||||
type
|
||||
TAmiEvent = record
|
||||
IsSet: Boolean; // the actual Event setting
|
||||
Manual: Boolean; // do not automatically reset the event
|
||||
Name: string; // Name for the event structure (needed for cross process)
|
||||
Waiter: Integer; // number of WaitFor waiting for this event
|
||||
Destroyed: Boolean; // the event is going to be destroyed, all WaitFor please leave first
|
||||
Sem: TSignalSemaphore; // Semaphore to protect the whole stuff
|
||||
end;
|
||||
PAmiEvent = ^TAmiEvent;
|
||||
|
||||
// Create an Event
|
||||
function intBasicEventCreate(EventAttributes : Pointer;
|
||||
AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
|
||||
var
|
||||
AmiEvent: PAmiEvent;
|
||||
begin
|
||||
New(AmiEvent);
|
||||
AmiEvent^.isSet := InitialState;
|
||||
AmiEvent^.Name := Name;
|
||||
AmiEvent^.Waiter := 0;
|
||||
AmiEvent^.Manual := AManualReset;
|
||||
AmiEvent^.Destroyed := False;
|
||||
InitSemaphore(@AmiEvent^.Sem);
|
||||
Result := AmiEvent;
|
||||
end;
|
||||
|
||||
procedure intbasiceventdestroy(state:peventstate);
|
||||
var
|
||||
AmiEvent: PAmiEvent absolute State;
|
||||
Waiter: Integer;
|
||||
begin
|
||||
if Assigned(AmiEvent) then
|
||||
begin
|
||||
ObtainSemaphore(@AmiEvent^.Sem);
|
||||
AmiEvent^.Destroyed := True; // we destroy the event
|
||||
ReleaseSemaphore(@AmiEvent^.Sem);
|
||||
repeat
|
||||
DosDelay(1);
|
||||
until AmiEvent^.Waiter <= 0;
|
||||
ObtainSemaphore(@AmiEvent^.Sem); // is there anyone still waiting for it?
|
||||
ReleaseSemaphore(@AmiEvent^.Sem);
|
||||
Dispose(AmiEvent);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure intbasiceventResetEvent(state:peventstate);
|
||||
var
|
||||
AmiEvent: PAmiEvent absolute State;
|
||||
begin
|
||||
if Assigned(AmiEvent) then
|
||||
begin
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: Reset Event');
|
||||
{$ENDIF}
|
||||
ObtainSemaphore(@AmiEvent^.Sem);
|
||||
AmiEvent^.IsSet := False;
|
||||
ReleaseSemaphore(@AmiEvent^.Sem);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure intbasiceventSetEvent(state:peventstate);
|
||||
var
|
||||
AmiEvent: PAmiEvent absolute State;
|
||||
begin
|
||||
if Assigned(AmiEvent) then
|
||||
begin
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: Set Event');
|
||||
{$ENDIF}
|
||||
ObtainSemaphore(@AmiEvent^.Sem);
|
||||
AmiEvent^.IsSet := True;
|
||||
ReleaseSemaphore(@AmiEvent^.Sem);
|
||||
end;
|
||||
end;
|
||||
|
||||
function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
|
||||
// Timer stuff
|
||||
procedure NewList(List: PList); inline;
|
||||
begin
|
||||
with List^ do
|
||||
begin
|
||||
lh_Head := PNode(@lh_Tail);
|
||||
lh_Tail := nil;
|
||||
lh_TailPred := PNode(@lh_Head)
|
||||
end;
|
||||
end;
|
||||
|
||||
function CreatePort(Name: PChar; Pri: LongInt): PMsgPort;
|
||||
var
|
||||
SigBit: ShortInt;
|
||||
Port: PMsgPort;
|
||||
begin
|
||||
Sigbit := AllocSignal(-1);
|
||||
if sigbit = -1 then
|
||||
CreatePort := nil;
|
||||
Port := ExecAllocMem(SizeOf(TMsgPort), MEMF_CLEAR);
|
||||
if Port = nil then
|
||||
begin
|
||||
FreeSignal(SigBit);
|
||||
CreatePort := nil;
|
||||
end;
|
||||
with port^ do
|
||||
begin
|
||||
if Assigned(Name) then
|
||||
mp_Node.ln_Name := Name
|
||||
else
|
||||
mp_Node.ln_Name := nil;
|
||||
mp_Node.ln_Pri := pri;
|
||||
mp_Node.ln_Type := 4;
|
||||
mp_Flags := 0;
|
||||
mp_SigBit := SigBit;
|
||||
mp_SigTask := FindTask(nil);
|
||||
end;
|
||||
if Assigned(Name) then
|
||||
AddPort(Port)
|
||||
else
|
||||
NewList(Addr(Port^.mp_MsgList));
|
||||
CreatePort := Port;
|
||||
end;
|
||||
|
||||
procedure DeletePort(Port: PMsgPort);
|
||||
begin
|
||||
if port <> nil then
|
||||
begin
|
||||
if Port^.mp_Node.ln_Name <> nil then
|
||||
RemPort(Port);
|
||||
|
||||
Port^.mp_Node.ln_Type := $FF;
|
||||
Port^.mp_MsgList.lh_Head := PNode(-1);
|
||||
FreeSignal(Port^.mp_SigBit);
|
||||
ExecFreeMem(Port, SizeOf(TMsgPort));
|
||||
end;
|
||||
end;
|
||||
|
||||
function CreateExtIO(Port: PMsgPort; Size: LongInt): PIORequest;
|
||||
begin
|
||||
Result := nil;
|
||||
if Port <> nil then
|
||||
begin
|
||||
Result := ExecAllocMem(Size, MEMF_CLEAR);
|
||||
if Result <> nil then
|
||||
begin
|
||||
Result^.io_Message.mn_Node.ln_Type := 7;
|
||||
Result^.io_Message.mn_Length := Size;
|
||||
Result^.io_Message.mn_ReplyPort := Port;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DeleteExtIO (IoReq: PIORequest);
|
||||
begin
|
||||
if IoReq <> nil then
|
||||
begin
|
||||
IoReq^.io_Message.mn_Node.ln_Type := $FF;
|
||||
IoReq^.io_Message.mn_ReplyPort := PMsgPort(-1);
|
||||
IoReq^.io_Device := PDevice(-1);
|
||||
ExecFreeMem(IoReq, IoReq^.io_Message.mn_Length);
|
||||
end
|
||||
end;
|
||||
|
||||
function Create_Timer(TheUnit: LongInt): PTimeRequest;
|
||||
var
|
||||
TimerPort: PMsgPort;
|
||||
begin
|
||||
Result := nil;
|
||||
TimerPort := CreatePort(nil, 0);
|
||||
if TimerPort = nil then
|
||||
Exit;
|
||||
Result := PTimeRequest(CreateExtIO(TimerPort, SizeOf(TTimeRequest)));
|
||||
if Result = Nil then
|
||||
begin
|
||||
DeletePort(TimerPort);
|
||||
Exit;
|
||||
end;
|
||||
if OpenDevice(TIMERNAME, TheUnit, PIORequest(Result), 0) <> 0 then
|
||||
begin
|
||||
DeleteExtIO(PIORequest(Result));
|
||||
DeletePort(TimerPort);
|
||||
Result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure Delete_Timer(WhichTimer: PTimeRequest);
|
||||
var
|
||||
WhichPort: PMsgPort;
|
||||
begin
|
||||
WhichPort := WhichTimer^.tr_Node.io_Message.mn_ReplyPort;
|
||||
if assigned(WhichTimer) then
|
||||
begin
|
||||
CloseDevice(PIORequest(WhichTimer));
|
||||
DeleteExtIO(PIORequest(WhichTimer));
|
||||
end;
|
||||
if Assigned(WhichPort) then
|
||||
DeletePort(WhichPort);
|
||||
end;
|
||||
|
||||
function GetEventTime(TR: PTimeRequest): Int64;
|
||||
begin
|
||||
Result := -1;
|
||||
if tr = nil then
|
||||
Exit;
|
||||
tr^.tr_node.io_Command := TR_GETSYSTIME;
|
||||
DoIO(PIORequest(tr));
|
||||
// structure assignment
|
||||
Result := Int64(tr^.tr_time.TV_Secs) * 1000 + tr^.tr_time.TV_Micro div 1000;
|
||||
end;
|
||||
// End timer stuff
|
||||
|
||||
// the mighty Waitfor routine
|
||||
function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
|
||||
var
|
||||
AmiEvent: PAmiEvent absolute State;
|
||||
Tr: PTimeRequest = nil;
|
||||
StartTime, CurTime: Int64;
|
||||
begin
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: Enter WaitFor');
|
||||
{$ENDIF}
|
||||
Result := wrError;
|
||||
if Assigned(AmiEvent) then
|
||||
begin
|
||||
// we do an initial Check
|
||||
ObtainSemaphore(@AmiEvent^.Sem);
|
||||
if AmiEvent^.Destroyed then
|
||||
begin
|
||||
Result := wrAbandoned; // we got destroyed, so we just leave
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: WaitFor Early Destroy');
|
||||
{$ENDIF}
|
||||
Exit;
|
||||
end;
|
||||
if AmiEvent^.IsSet then
|
||||
begin
|
||||
Result := wrSignaled; // signal Already set
|
||||
if not AmiEvent^.Manual then
|
||||
AmiEvent^.IsSet := False;
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: WaitFor Early Signaled');
|
||||
{$ENDIF}
|
||||
Exit;
|
||||
end;
|
||||
// signal not set, so we add this call to the waiterlist
|
||||
Inc(AmiEvent^.Waiter);
|
||||
ReleaseSemaphore(@AmiEvent^.Sem);
|
||||
// that means we have to wait and care about the timeout -> need a timer
|
||||
Tr := create_timer(UNIT_MICROHZ);
|
||||
if not Assigned(Tr) then // cannot create timer :-O
|
||||
Exit;
|
||||
// time we started the actual waiting
|
||||
StartTime := GetEventTime(TR);
|
||||
try
|
||||
// the main loop, notice the breaks are inside the Obtain/Release
|
||||
// therefore the finally block must release it, (and no other exit allowed!)
|
||||
repeat
|
||||
CurTime := GetEventTime(TR); // to check the timeout, outside obtain/release to save some time
|
||||
ObtainSemaphore(@AmiEvent^.Sem);
|
||||
// check the status of event
|
||||
if AmiEvent^.Destroyed then
|
||||
begin
|
||||
Result := wrAbandoned; // we got destroyed
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: WaitFor Destroy');
|
||||
{$ENDIF}
|
||||
break;
|
||||
end;
|
||||
if AmiEvent^.IsSet then
|
||||
begin
|
||||
Result := wrSignaled; // signal got set
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: WaitFor Signaled');
|
||||
{$ENDIF}
|
||||
Break;
|
||||
end;
|
||||
if CurTime - StartTime > Timeout then
|
||||
begin
|
||||
Result := wrTimeOut; // we got a timeout
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: WaitFor TimeOut');
|
||||
{$ENDIF}
|
||||
Break;
|
||||
end;
|
||||
// if we reach here, nothing happend...
|
||||
// we release the semaphore and wait for other threads to do something
|
||||
ReleaseSemaphore(@AmiEvent^.Sem);
|
||||
DosDelay(1);
|
||||
until False;
|
||||
finally
|
||||
// reset the Event if needed
|
||||
if (Result = wrSignaled) and (not AmiEvent^.Manual) then
|
||||
AmiEvent^.IsSet := False;
|
||||
// we finished so get us away from waiter list
|
||||
Dec(AmiEvent^.Waiter);
|
||||
ReleaseSemaphore(@AmiEvent^.Sem); // unlock the event
|
||||
Delete_timer(tr); // timer not needed anymore
|
||||
end;
|
||||
end;
|
||||
{$IFDEF DEBUG_AMIEVENT}
|
||||
SysDebugLn('AmiEvent: Leave WaitFor');
|
||||
{$ENDIF}
|
||||
end;
|
||||
// end Event stuff
|
||||
|
||||
|
||||
function AInitThreads : Boolean;
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user