{$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.