330 lines
9.6 KiB
ObjectPascal
330 lines
9.6 KiB
ObjectPascal
{$X+,B-,V-} {essential compiler directives}
|
|
|
|
Unit nwSema;
|
|
|
|
{ nwSema unit as of 950301 / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
|
|
|
|
INTERFACE
|
|
|
|
{ Primary functions: Interrupt: comments:
|
|
|
|
* CloseSemaphore (F220/04)
|
|
* ExamineSemaphore (F220/01)
|
|
* GetConnectionsSemaphores (F217/F1)
|
|
* GetSemaphoreInformation (F217/F2)
|
|
* OpenSemaphore (F220/00)
|
|
* SignalSemaphore (F220/03)
|
|
* WaitOnSemaphore (F220/02)
|
|
|
|
Notes: Functions marked with a '*' have been tested and found correct.
|
|
}
|
|
|
|
Uses nwIntr,nwMisc;
|
|
|
|
Type TsemaInfo=record
|
|
ConnNbr:word;
|
|
TaskNbr:word;
|
|
end;
|
|
TsemaInfoList=array[1..100] of TsemaInfo;
|
|
{ used by GetSemaphoreInformation }
|
|
|
|
TconnSema=record
|
|
OpenCount: Byte;
|
|
Value : Integer;
|
|
TaskNbr : Word;
|
|
unknown : byte; { always 00 ?! }
|
|
Name : string[127];
|
|
end;
|
|
{ used by GetConnectionsSemaphores }
|
|
|
|
Var Result:word;
|
|
|
|
{F220/00 [2.15? 3.x]}
|
|
Function OpenSemaphore(SemName : String; InitVal : Integer;
|
|
VAR SemHandle : LongInt;
|
|
VAR OpenCount : Word ):Boolean;
|
|
|
|
{F220/01 [2.15? 3.x]}
|
|
FUNCTION ExamineSemaphore( SemHandle :LongInt;
|
|
VAR Value :Integer;
|
|
VAR OpenCount :Word ) :Boolean;
|
|
{ This functions returns the current value and open count of a semaphore.}
|
|
|
|
{F220/02 [3.x]}
|
|
FUNCTION WaitOnSemaphore( SemHandle :LongInt;
|
|
Wait_Time :Word ) :Boolean;
|
|
{ Decrement the semaphore value and, if it is negative, }
|
|
{ wait until it becomes non-negative or until a timeout occurs. }
|
|
|
|
{F220/03 [3.x]}
|
|
FUNCTION SignalSemaphore(SemHandle:LongInt) : Boolean;
|
|
{ Increment the semaphore value and release if waiting. }
|
|
|
|
{F220/04 [3.x]}
|
|
FUNCTION CloseSemaphore(SemHandle:LongInt) : Boolean;
|
|
{ Decrement the open count of a semaphore.}
|
|
{ When the open count goes to zero, the semaphore is destroyed. }
|
|
|
|
|
|
{F217/F1 [2.15+? 3.x+]}
|
|
Function GetConnectionsSemaphores(ConnNbr:Word;
|
|
{i/o} Var seqNbr:Word;
|
|
{out} Var NbrOfSemaLeft:Byte;
|
|
{out} Var SemaInfo:TconnSema):Boolean;
|
|
{Caller needs console privileges }
|
|
|
|
{F217/F2 [2.15? 3.x+]}
|
|
Function GetSemaphoreInformation(SemaName:String;
|
|
{i/o} Var seqNbr:word;
|
|
{out} Var OpenCount:word;
|
|
Var SemValue:Integer;
|
|
Var NbrOfSemaLeft:byte;
|
|
Var info:TsemaInfoList):Boolean;
|
|
{ Caller needs console privileges }
|
|
|
|
|
|
IMPLEMENTATION {=============================================================}
|
|
|
|
|
|
{F220/00 [3.x]}
|
|
Function OpenSemaphore(SemName : String; InitVal : Integer;
|
|
VAR SemHandle : LongInt;
|
|
VAR OpenCount : Word ):Boolean;
|
|
Type Treq=Record
|
|
subf:byte;
|
|
_InitVal:byte;
|
|
_SemNameLen:byte;
|
|
_SemName:array[0..127] of byte;
|
|
end;
|
|
Trep=record
|
|
_SemHandle:LongInt;
|
|
_OpenCount:Byte;
|
|
end;
|
|
TPreq=^Treq;
|
|
TPrep=^Trep;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$00;
|
|
If InitVal<0
|
|
then _InitVal:=Lo(256+Initval)
|
|
else _InitVal:=Lo(InitVal);
|
|
UpString(SemName);SemName:=SemName+#0;
|
|
move(semName[1],_SemName[0],ord(SemName[0]));
|
|
_SemNameLen:=ord(semName[0])-1;
|
|
end;
|
|
F2SystemCall($20,SizeOf(treq),SizeOf(trep),result);
|
|
With TPrep(GlobalReplyBuf)^
|
|
do begin
|
|
SemHandle:=Lswap(_SemHandle);
|
|
OpenCount:=_OPenCount;
|
|
end;
|
|
OpenSemaphore:=(result=0);
|
|
end;
|
|
|
|
|
|
{F220/02 [3.x]}
|
|
Function WaitOnSemaphore( SemHandle : LongInt;
|
|
Wait_Time : Word ) : Boolean;
|
|
{ Decrement the semaphore value and wait if it is negative. If negative,}
|
|
{ the workstation will wait until it becomes non-negative or until a }
|
|
{ timeout occurs. }
|
|
Type Treq=Record
|
|
subf:byte;
|
|
_SemHandle:Longint;
|
|
_wait :word; { hi-lo }
|
|
end;
|
|
TPreq=^Treq;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$02;
|
|
_semHandle:=Lswap(SemHandle);
|
|
_wait:=swap(wait_Time);
|
|
end;
|
|
F2SystemCall($20,SizeOf(treq),0,result);
|
|
WaitOnSemaphore:=(result=0);
|
|
end;
|
|
|
|
|
|
{F220/03 [3.x+]}
|
|
Function SignalSemaphore(SemHandle:LongInt) : Boolean;
|
|
{ Increment the semaphore value and release if waiting. If any stations}
|
|
{ are waiting, the station that has been waiting the longest will be }
|
|
{ signalled to proceed }
|
|
Type Treq=Record
|
|
subf:byte;
|
|
_semhandle:Longint;
|
|
end;
|
|
TPreq=^Treq;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$03;
|
|
_semHandle:=Lswap(SemHandle);
|
|
end;
|
|
F2SystemCall($20,SizeOf(treq),0,result);
|
|
SignalSemaphore:=(result=0);
|
|
end;
|
|
|
|
|
|
{F220/04 [3.x+]}
|
|
Function CloseSemaphore(SemHandle:LongInt) : Boolean;
|
|
{ Decrement the open count of a semaphore. When the open count goes }
|
|
{ to zero, the semaphore is destroyed. }
|
|
Type Treq=Record
|
|
subf:byte;
|
|
_semhandle:Longint;
|
|
end;
|
|
TPreq=^Treq;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$04;
|
|
_semHandle:=Lswap(SemHandle);
|
|
end;
|
|
F2SystemCall($20,SizeOf(treq),0,result);
|
|
CloseSemaphore:=(result=0);
|
|
end;
|
|
|
|
|
|
{F220/01 [2.x/3.x]}
|
|
FUNCTION ExamineSemaphore(SemHandle:LongInt;
|
|
VAR Value : Integer;
|
|
VAR OpenCount : Word ) : Boolean;
|
|
{ The semaphore value that comes back is the count from the open call }
|
|
{ - the open count is incremented }
|
|
{ anytime a station opens the semaphore this can be used for controlling }
|
|
{ the number of users using your software }
|
|
Type Treq=record
|
|
subf:byte;
|
|
_semHandle:Longint;
|
|
end;
|
|
Trep=record
|
|
_Value:Byte;
|
|
_OpenCount:Byte;
|
|
end;
|
|
TPreq=^Treq;
|
|
TPrep=^Trep;
|
|
BEGIN
|
|
With TPreq(GlobalReqBuf)^
|
|
DO begin
|
|
subf:=$01;
|
|
_semHandle:=Lswap(SemHandle);
|
|
end;
|
|
F2SystemCall($20,SizeOf(Treq),SizeOf(Trep),result);
|
|
With TPrep(GlobalReplyBuf)^
|
|
do begin
|
|
if (_Value and $80)>0
|
|
then Value:=254-_Value
|
|
else Value:=_Value;
|
|
OpenCount:=_OpenCount;
|
|
end;
|
|
ExamineSemaphore := (result = 0);
|
|
END;
|
|
|
|
{F217/F1 [2.15+? 3.x+]}
|
|
Function GetConnectionsSemaphores(ConnNbr:Word;
|
|
{i/o} Var seqNbr:Word;
|
|
{out} Var NbrOfSemaLeft:Byte;
|
|
{out} Var SemaInfo:TconnSema):Boolean;
|
|
{ To be called iteratively. Inital seqNbr=1. Iterate until seqNbr
|
|
becomes 0 (or until NbrOfSemaLeft becomes 0).
|
|
|
|
This function can return information about several semaphores at the
|
|
same time. However, the size of the reply buffer is limited, causing
|
|
several as of now unsolvable problems. For now this function will
|
|
return information on a per semaphore basis. }
|
|
Type Treq=Record
|
|
len:word;
|
|
subf:byte;
|
|
_ConnNbr:word; {lo-hi}
|
|
_SeqNbr:word; {lo-hi}
|
|
end;
|
|
Trep=record
|
|
_NextSeqNbr:word;
|
|
_nbrOfSema:byte; { word (lo-hi) ? }
|
|
_unknown:byte; { -^ }
|
|
_SemaInfoBuf:array[1..508] of byte;
|
|
end;
|
|
TPreq=^Treq;
|
|
TPrep=^Trep;
|
|
Var i,t:Byte;
|
|
begin
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
len:=SizeOf(Treq)-2;
|
|
subf:=$F1;
|
|
_ConnNbr:=ConnNbr;
|
|
_SeqNbr:=SeqNbr;
|
|
end;
|
|
F2SystemCall($17,SizeOf(treq),SizeOf(trep),result);
|
|
if result=0
|
|
then With TPrep(GlobalReplyBuf)^
|
|
do begin
|
|
NbrOfSemaLeft:=(_NbrOfSema-1);
|
|
if NbrOfSemaLeft=0
|
|
then seqNbr:=0
|
|
else seqNbr:=seqNbr+1; { unfortunately, _NextSeqNbr returns no valid info. }
|
|
|
|
Move(_SemaInfoBuf[1],SemaInfo,7+_SemaInfoBuf[7]);
|
|
With SemaInfo
|
|
do begin
|
|
Value:=swap(Value);
|
|
TaskNbr:=swap(TaskNbr);
|
|
end;
|
|
end;
|
|
GetConnectionsSemaphores:=(result=0);
|
|
{ 00 Successful C6 No console rights FD Bad connection number }
|
|
end;
|
|
|
|
{F217/F2 [2.15? 3.x+]}
|
|
Function GetSemaphoreInformation(SemaName:String;
|
|
{i/o} Var seqNbr:word;
|
|
{out} Var OpenCount:word;
|
|
Var SemValue:Integer;
|
|
Var NbrOfSemaLeft:byte;
|
|
Var info:TsemaInfoList):Boolean;
|
|
Type Treq=Record
|
|
len:word;
|
|
subf:byte;
|
|
_seqNbr: word;
|
|
_semaName:string[127];
|
|
end;
|
|
Trep=record
|
|
_NextSeqNbr:Word;
|
|
_OpenCount:word;
|
|
_SemValue:word;
|
|
_NbrOfRecords:word;
|
|
_SemaInfoBuf:array[1..514] of byte;
|
|
end;
|
|
TPreq=^Treq;
|
|
TPrep=^Trep;
|
|
begin
|
|
UpString(SemaName);
|
|
if SemaName[0]>#127
|
|
then SemaName[0]:=#127;
|
|
With TPreq(GlobalReqBuf)^
|
|
do begin
|
|
subf:=$F2;
|
|
_seqNbr:=seqNbr;
|
|
_SemaName:=SemaName;
|
|
len:=4+ord(_SemaName[0]);
|
|
end;
|
|
F2SystemCall($17,SizeOf(treq),SizeOf(trep),result);
|
|
With TPrep(GlobalReplyBuf)^
|
|
do begin
|
|
OpenCount:=_OpenCount;
|
|
SemValue:=Integer(_SemValue);
|
|
NbrOfSemaLeft:=_NbrOfRecords;
|
|
move(_SemaInfoBuf,Info,SizeOf(TsemaInfoList));
|
|
if NbrOfSemaLeft>100
|
|
then seqNbr:=seqNbr+100
|
|
else seqNbr:=0;
|
|
end;
|
|
GetSemaphoreInformation:=(result=0);
|
|
{ 00 Successful C6 No console rights }
|
|
end;
|
|
|
|
|
|
END. |