{------------------------------------------------------------------------------
{
{              D D D   0 0
{              D     D     0
{              D    0 D     0
{              D    0 D     0
{              D    0 D     0
{              D     0     0
{              D D D   0 0         ------- D0 Online Software
{
{
{    ITC Connect Module --  CONNECT.EPAS
{
{    Purpose and Methods : Routines and data structures used to form, manage
{			   and delete connections.
{
{    Arguments : None
{    Exports   : ITC_Connect
{		 ITC_DisConnect
{		 ITC_Declare_Connect_Event
{		 ITC_Declare_Receive_Event
{
{    Created on October 9, 1989  by John Featherly
{    Modified 03-Mar-1992 S.Fuess to reset CCB[Channel].In_Use on
{				  connect failures
{    Modified 21-May-1993 S.Fuess fix use of status variable in Drop_Channel
{    Modified 24-MAY-1993 P.Laurens prevent infinite loop lock-up at max channel
{
{------------------------------------------------------------------------------
}

Module Connect;
Include $KERNELMSG, GLOBAL, SETUP_INIT;
Export	ITC_Connect, ITC_DisConnect,
	ITC_Declare_Connect_Event,
	ITC_Declare_Receive_Event,
	ITC_Connect_Server, Port_Listner_Started,
	ITC_Start_Port_Listner;

Type
  Wait_Arg_List	= RECORD
			Length	: INTEGER;
			RetStat	: ^INTEGER;
			Result	: ^INTEGER;
			Time	: ^LARGE_INTEGER;
			List	: ARRAY [CHANNEL_RANGE] of ^PORT;
		  END;

Var
  Connect_Event		: EVENT;
  Receive_Event		: EVENT;
  New_Port_List		: EVENT;
  Active_Channel_Count	: CHANNEL_RANGE := 0;
  Active_Chan_List	: ARRAY [1..Def_Number_of_Channels] of
					CHANNEL_RANGE := ZERO;
  Port_Listner_Started	: BOOLEAN := False;
  PL_Process		: PROCESS;
  Wait_Any_Arg_List	: Wait_Arg_List;
  Procedure ITC_Wait_Any_Callg (VAR Arg_List : Wait_Arg_List); EXTERNAL;

{------------------------
{   Get_Channel
{
{ Return the first free
{ channel control block
{ position.  If none are
{ free return false.
{------------------------
}
Function Get_Channel ( VAR Channel : CHANNEL_RANGE ) : BOOLEAN;

Begin
  Channel := 0;
  Repeat
    Channel := Channel + 1
  Until (not CCB[Channel].In_Use) or
	(Channel = Number_of_Channels);

  Get_Channel := not CCB[Channel].In_Use;
  CCB[Channel].In_Use := True
End  { Get Channel };


{------------------------------------------------------------------------------
{   ITC_Connect
{
{
{	Attempts to make a connection to the specified target.  If success-
{ ful, the channel number is passed back to the caller.  If the optional
{ argument "Node" is given and is not blank (i.e. ' '), the connection is
{ attempted via DECnet to the remote node.
{
{	Inputs:
{		Target	- Char string by arbitrary descriptor type
{			  The declared name of the target process
{		[Node]	- Char string by arbitrary descriptor type
{			  Optional remote node name (' ' = omission)
{
{	Output:
{  		Channel	- Longword Integer 1..Max_Channel by reference
{
{------------------------------------------------------------------------------
}
Function ITC_Connect
	  ( VAR Channel	: CHANNEL_RANGE;
	        Target  : STRING(<n2>);
	    VAR Node	: [LIST] dsc$descriptor ) : INTEGER;

Const
  Node_Name_Len = 7	{ aa.nnnn is 7 char }

Var
  Req_Node	: Varying_String(Node_Name_Len);
  VS_Target	: Varying_String(MaxLen_TargNam);

{--------------------------
{   Trim Up
{
{--------------------------
}
Procedure Trim_Up ( var result : varying_string(<n1>);
		        source : string(<n2>) );
const
  Up_Alpha   = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  Low_Alpha  = 'abcdefghijklmnopqrstuvwxyz';
var
  Whitespace : [READONLY] Set of Char := [' ',''(9)];
  Mark	: INTEGER;
Begin
  Mark := Find_NonMember(Source,Whitespace);
  If Mark<>0 Then Begin
    Result := Substr(Source,Mark);
    Mark := Find_Member(Result,Whitespace);
    If Mark<>0 Then Result := Substr(Result,1,Mark-1);
    Result := Translate_String( Result, Up_Alpha, oldchars := Low_Alpha)
  End
  Else
   Result := ''
End  { Trim and Upcase };

{-----------------------------
{   Clean_Target_Arg
{
{ Clean, trim etc. the target
{ arg and set VS_Target
{ accordingly.
{-----------------------------
}
Function Clean_Target_Arg : BOOLEAN;

Begin
  Trim_Up (VS_Target,Target);
  If VS_Target='' Then Clean_Target_Arg := False
		  Else Clean_Target_Arg := True
End  { Clean Target Arg };

{---------------------------
{   Parse_Node_Arg
{
{ Parse, trim etc. the node
{ arg if present and set
{ Req_Node accordingly.
{---------------------------
}
Function Parse_Node_Arg : BOOLEAN;

Begin
  Parse_Node_Arg := True;  { success unless proven wrong }
  If ARGUMENT_LIST_LENGTH(Node) > 0 Then
    Trim_Up (Req_Node, SUBSTR( ARGUMENT(Node,1).dsc$a_pointer^,
			1,
			ARGUMENT(Node,1).dsc$w_length) )
  Else
    Req_Node := ''
End  { Parse Node Arg };

{---------------------------
{   Connected_Already
{
{ Check to see if a channel
{ is already in place, if
{ so return that channel, if
{ none then set Channel=0
{ Sequential search must be
{ used since CCB's are not
{ ordered and not indexed.
{---------------------------
}
Function Connected_Already : BOOLEAN;
Var
  Idx   : INTEGER;
  Found : BOOLEAN;

Begin
  Found := False;
  Idx := 0;

  Repeat
    Idx := Idx + 1;
    With CCB[Idx] Do If ((To_Node=Req_Node) and
                         (To_Target=VS_Target)    )
			Then If Connected Then Begin
					    {check mbx ref count}
					    Found := True   End
					  Else {check in_use}
  Until (Found or (Idx=Number_Of_Channels));

  If not Found Then Channel := 0 Else Channel := Idx;
  Connected_Already := Found
End  { Connected Already ? };

{------------------------------
{  ITC_Connect -- Main section
{------------------------------
}
Var
  Status	: INTEGER;
  Acc_Data	: Opt_Data_Type;
  dest		: Varying_String(MaxLen_TargNam+2+Node_Name_Len);
					{ 2 is for :: }

Begin                                   
 { most code here in the main section does arg checking }
  If not Init Then ITC_Init;
  If not Port_Listner_Started Then ITC_Start_Port_Listner;
  If n2 > MaxLen_TargNam
	Then ITC_Connect := ITC__BAD_ARG	{ Target name too long }
  Else If not Clean_Target_Arg
	Then ITC_Connect := ITC__BAD_ARG	{ Bad Target Argument }
  Else If not Parse_Node_Arg
	Then ITC_Connect := ITC__BAD_ARG	{ Bad Node Argument }
  Else If Connected_Already        { sets Channel value as a side effect }
	Then ITC_Connect := ITC__CONALRINPL
  Else If not Get_Channel(Channel)
	Then ITC_Connect := ITC__EXCHANQUO  { no free channels }
  Else  { try a connect request }
  Begin
    If Req_Node <> '' Then
      dest := Req_Node + '::' + VS_Target
    Else
      dest := VS_Target;

    CREATE_PORT( CCB[Channel].IO_Port,
		LIMIT  := 128,	    {maximum of 128 messages queued on the port}
		STATUS := status);

    CONNECT_CIRCUIT( CCB[Channel].IO_Port,
			DESTINATION_NAME := dest,
			CONNECT_DATA	 := Con_Data.OD_Block,
			ACCEPT_DATA	 := Acc_Data.OD_Block,
			STATUS := status);
    If (status<>KER$_SUCCESS)	Then 
				  BEGIN
				  ITC_Connect := ITC__No_Target;
				  CCB[Channel].In_Use := FALSE;
				  Delete ( CCB[Channel].IO_Port, 
					   STATUS := status );
				  END
				Else With CCB[Channel],Acc_Data.Comp Do Begin
				  Start_Queue ( MLQH );
				  MQ_Empty	:= True;
				  Partner	:= ID;
				  To_Node	:= Node_Name;
				  DN_Numb	:= Node_Numb;
				  To_Target	:= VS_Target;
				  Get_Time ( Since );
				  Connected := True;
				  ITC_Connect := ITC__Success;
  { Add stuff for recv proc etc. }
				  Active_Channel_Count
					:= Active_Channel_Count + 1;
				  Active_Chan_List[Active_Channel_Count]
					:= Channel;
				  Signal (New_Port_List, STATUS := Status)
				End {with}
  End { final Else clause }

End  { ITC Connect function };


{------------------------------------------------------------------------------
{   ITC_DisConnect
{
{	Disconnects an active channel.
{
{	Inputs:
{  		Channel	- Longword Integer 1..Max_Channel by reference
{			  Number of the channel to disconnect
{
{	Output: none
{
{
{------------------------------------------------------------------------------
}
Function ITC_DisConnect ( VAR Channel   : CHANNEL_RANGE ) : INTEGER;
				{ VAR parameter to accomadate FORTRAN }
Var
  Status	: INTEGER;

Begin
  If not ( (Channel > None) and (Channel <= Number_of_Channels) )
			Then ITC_DisConnect := ITC__Bad_Arg
  Else If not (init and CCB[Channel].In_Use)
			Then ITC_DisConnect := ITC__No_Channel
  Else With CCB[Channel] Do Begin
    Disconnect_Circuit ( IO_Port, STATUS := Status );
    IF Status <> KER$_NO_SUCH_PORT THEN
	{ port listner will clean up CCB }
	Delete ( IO_Port, STATUS := status );
    ITC_DisConnect := ITC__Success
  End { with }
End  { ITC DisConnect function};


{------------------------------------------------------------------------------
{	ITC_Connect_Server
{
{------------------------------------------------------------------------------
}
Process_Block ITC_Connect_Server;
Var
  Next_Chan : CHANNEL_RANGE;
  Next	    : INTEGER;
  Acc_Data  : Opt_Data_Type;
  Status    : INTEGER;
Begin
Repeat
  If not Get_Channel(Next_Chan)  
  Then WAIT_ANY ( TIME := -10000000 ) {No more channel, but try again 1 s later}
  Else With CCB[Next_Chan],Acc_Data.Comp Do Begin
    Create_Port ( IO_Port, LIMIT := 128, Status := Status );
    Accept_Circuit (	Target_Port,
			CONNECT		:= IO_Port,
			ACCEPT_DATA	:= Con_Data.OD_Block,
			CONNECT_DATA	:= Acc_Data.OD_Block,
			STATUS		:= Status );
    Start_Queue ( MLQH );
    MQ_Empty	:= True;
    Partner	:= ID;
    To_Node	:= Node_Name;
    DN_Numb	:= Node_Numb;
    To_Target	:= Target_Name_String;
    Get_Time	( Since );
    Connected	:= True;

    { do activity buffer stuff etc.   }
    Next := (Head + 1) mod Ring_Buff_Size;
    If Next <> Tail Then Begin	{ for safety }
      Ring_Buff[Head].Chan   := Next_Chan;
      Ring_Buff[Head].Class  := ITC_K_Establish;
      Head := Next;
      Ring_Buff_Length := Ring_Buff_Length + 1  End;

    Active_Channel_Count := Active_Channel_Count + 1;
    Active_Chan_List[Active_Channel_Count] := Next_Chan;

    Signal (New_Port_List, STATUS := Status);
    Signal (Connect_Event, STATUS := Status)

  End { Else With ... Clause }
Until False  { forever }
End  { Process Block ITC Connect Server };


{------------------------------------------------------------------------------
{   ITC_Declare_Connect_Event
{
{	Creates the EVENT used to signal new connects.
{
{	Inputs:
{  		ConEvt	- Event, by reference
{
{	Output: none
{
{
{------------------------------------------------------------------------------
}
Function ITC_Declare_Connect_Event ( VAR ConEvt : Event ) : INTEGER;
Var
  Status	: INTEGER;
Begin
  Create_Event (Connect_Event, EVENT$CLEARED, STATUS := Status );
  ConEvt := Connect_Event;
  If Status = KER$_Success  Then ITC_Declare_Connect_Event := ITC__Success
			    Else ITC_Declare_Connect_Event := Status
End  { ITC Declare Connect Event function};


{------------------------------------------------------------------------------
{   ITC_Declare_Receive_Event
{
{	Creates the EVENT used to signal new messages.
{
{	Inputs:
{  		RecEvt	- Event, by reference
{
{	Output: none
{
{
{------------------------------------------------------------------------------
}
Function ITC_Declare_Receive_Event ( VAR RecEvt : Event ) : INTEGER;
Var
  Status	: INTEGER;
Begin
  Create_Event (Receive_Event, EVENT$CLEARED, STATUS := Status );
  RecEvt := Receive_Event;
  If Status = KER$_Success  Then ITC_Declare_Receive_Event := ITC__Success
			    Else ITC_Declare_Receive_Event := Status
End  { ITC Declare Receive Event function};

{-----------
{
{-----------
}
Procedure ITC_Start_Port_Listner;
Var
  Status : INTEGER;

Begin
  Create_Event (New_Port_List, EVENT$CLEARED, STATUS := Status );
  Create_Process ( PL_Process, ITC_Port_Listner,
			STATUS := Status );
  Set_Process_Priority ( PL_Process, 7, STATUS := Status );
	{ If we are priority 8, then 7 is one higher (priority)}
  Port_Listner_Started := True
End  { ITC Start Port Listner Procedure };


{------------------------------------------------------------------------------
{	ITC_Port_Listner
{
{------------------------------------------------------------------------------
}
Process_Block ITC_Port_Listner;
Var
  Status	: INTEGER;
  Satisfier	: INTEGER;
  Channel	: CHANNEL_RANGE;
  New_Data	: ^MESSBLK;
  Next		: INTEGER;

Procedure Make_WA_Arg_List;
Var I : 1..Def_Number_of_Channels;
Begin
  With Wait_Any_Arg_List Do Begin
    Length := 3 + 1 + Active_Channel_Count;
    For I:=1 To Active_Channel_Count Do List[I] :=
	ADDRESS(CCB[Active_Chan_List[I]].IO_Port)
  End {with}
End  { Procedure Make WA Arg List };

Procedure Queue_Message;
Var
  First_Entry	: BOOLEAN;
Begin
  Insert_Entry ( CCB[Channel].MLQH, New_Data^.Links, First_Entry, QUEUE$TAIL );
  If First_Entry Then CCB[Channel].MQ_Empty := False;
  Next := (Head + 1) mod Ring_Buff_Size;
  If Next <> Tail Then Begin	{ don't overwrite buffer tail }
    Ring_Buff[Head].Chan	:= Channel;
    Ring_Buff[Head].Class	:= ITC_K_Message;
    Head := Next;
    Ring_Buff_Length := Ring_Buff_Length + 1
  End {then};
  Signal (Receive_Event, STATUS := Status)
End  { Procedure Queue Message };

Procedure Drop_Channel;
Var X : INTEGER;
Begin
  With CCB[Channel] Do Begin
    Connected := False;
    If Status=KER$_DisConnect Then Delete (IO_Port);
    If MQ_Empty Then In_Use := False
  End {with};
  If Status=KER$_DisConnect Then Dispose (New_Data);
  For X:=Satisfier To Active_Channel_Count Do
				Active_Chan_List[X-1] := Active_Chan_List[X];
  Active_Chan_List[Active_Channel_Count] := 0;
  Active_Channel_Count := Active_Channel_Count - 1;

  Next := (Head + 1) mod Ring_Buff_Size;
  If Next <> Tail Then Begin	{ for safety }
    Ring_Buff[Head].Chan   := Channel;
    Ring_Buff[Head].Class  := ITC_K_Broken;
    Head := Next;
    Ring_Buff_Length := Ring_Buff_Length + 1  End;

  Make_WA_Arg_List
End  { Procedure Drop Channel };

Procedure Ignore_Problem;
Begin
  Dispose(New_Data)
End  { Procedure Ignore Problem };

Begin
  With Wait_Any_Arg_List Do Begin
    RetStat	:= Address(Status);
    Result	:= Address(Satisfier);
    Time	:= nil;
    List[0]::EVENT := New_Port_List
  End {with};
  Make_WA_Arg_List;
Repeat
  ITC_Wait_Any_Callg (Wait_Any_Arg_List);
  If Satisfier > 1	Then Channel := Active_Chan_List[Satisfier-1]
			Else Channel := 0;

  If Status=KER$_Bad_Value	{ Bad_Value is the result of Delete(port) }
    Then Drop_Channel		{ in ITC_DisConnect on THIS side	  }
    Else If Satisfier=1
		Then Begin
			Make_WA_Arg_List;
			Clear_Event (New_Port_List, STATUS := Status )  End
		Else Begin
			New (New_Data);
                        New_Data^.Trunc := FALSE;
			Receive (New_Data^.Mess, New_Data^.Info,
				 CCB[Channel].IO_Port,
				 SIZE := New_Data^.Length, STATUS := Status );
			Case Status Of
			  KER$_Success	  : Queue_Message;
			  KER$_DisConnect : Drop_Channel;
			  KER$_No_Message : Ignore_Problem;
			  Otherwise Ignore_Problem
			End {case}
		End {else}
Until False  { forever }
End  { Process Block ITC Port Listner };

End  { Module Connect }.