{===========================================================================================}
{	LlamaTalk}
{	}
{	Copyright © 1994 Apple Computer, Inc.}
{	All rights reserved.}
{	}
{	Modification Status}
{	YY/MM/DD	Name				Comments}
{	95/11/11	Jim Schram		Added CodeWarrior 7 IDE & PPC Universal Headers support, released as 2.0a1}
{	94/09/12	Jim Schram		Added CodeWarrior & LT_UsingGlobals support, released as 1.0a4}
{	94/07/07	Jim Schram		Added LTGetSocketState and cmQuiet for all sockets, released as 1.0a3}
{	94/05/09	Jim Schram		Bug fix in LTClockWriteMachine, released as 1.0a2}
{	94/05/04	Jim Schram		Released as 1.0a1}
{	94/03/17	Jim Schram		Initial Development}
{-------------------------------------------------------------------------------------------------------------}
{	The LlamaTalk packet format is as follows:	}
{		1 byte packet type									}
{		3 bytes packet length (MSB -> LSB order)	}
{		N bytes packet data									}
{	}
{	Currently only packet type cLTPacketType_Simple is implemented.					}
{	Future packet types will include features such as compression and encryption.	}
{	All other packet types are reserved.																	}
{-------------------------------------------------------------------------------------------------------------}

Unit LlamaTalk;

Interface

{-------------------------------------------------------------------------------------------------------------}
{	The following flag, LT_UsingGlobals, conditionally compiles LlamaTalk for application or code-resource use.}
{	Specifically, if LT_UsingGlobals = 1, it uses the asynchronous completion routines located in the main code segment.}
{	If LT_UsingGlobals = 0, it will load the comp procs from code resources of the current resource file in LTOpenLlamaTalk.}
{	}
{$IFC UNDEFINED LT_UsingGlobals}
{$SETC LT_UsingGlobals := 1}
{$ENDC}
{	}
{$IFC UNDEFINED LT_UsingUniversalHeaders}
{$SETC LT_UsingUniversalHeaders := 1}
{$ENDC}
{	}
{-------------------------------------------------------------------------------------------------------------}

{$IFC UNDEFINED THINK_Pascal}
	Uses
		Traps, TextUtils, Connections, CommResources, Resources, Errors;
{$ELSEC}
	Uses
		Traps, Connections, CommResources, Resources, Errors;
{$ENDC}

	Const
{$IFC LT_UsingGlobals = 0}
	{	----------------------------------------	}
	{	CODE RESOURCES											}
	{	----------------------------------------	}
		cLTCompProcResType = 'lama';
		cLTCompProcResName_Listen = 'LlamaTalkCPListen';
		cLTCompProcResName_Open = 'LlamaTalkCPOpen';
		cLTCompProcResName_Close = 'LlamaTalkCPClose';
		cLTCompProcResName_Read = 'LlamaTalkCPRead';
		cLTCompProcResName_Write = 'LlamaTalkCPWrite';
{$ENDC}

	{	----------------------------------------	}
	{	ERROR CODES												}
	{	----------------------------------------	}
		cLTSocketTableFull = -17001;						{Socket table full -- no free indexes -- can't open any more connections}
		cLTBadToolName = -17002;							{Illegal or bad Comm Toolbox tool-name encountered}
		cLTBadConfig = -17003;								{Bad socket configuration parameters}

	{	----------------------------------------	}
	{	PACKET TYPES												}
	{	----------------------------------------	}
		cLTPacketType_Simple = 0;							{LlamaTalk packet type descriptor.  Currently only type 0 is implemented.}

	{	----------------------------------------	}
	{	cLTBitsPhase... are for INTERNAL USE ONLY	}
	{	----------------------------------------	}
		cLTBitsPhaseListen = $80;
		cLTBitsPhaseOpen = $40;
		cLTBitsPhaseClose = $20;
		cLTBitsPhaseRead = $10;
		cLTBitsPhaseWrite = $08;

		cLTBitsPhaseError = $07;
		cLTBitsPhase6 = $06;
		cLTBitsPhase5 = $05;
		cLTBitsPhase4 = $04;
		cLTBitsPhase3 = $03;
		cLTBitsPhase2 = $02;
		cLTBitsPhase1 = $01;

		cLTStateError = $8000;
		cLTStateDispose = $4000;
		cLTStateIdle = $2000;
		cLTStateListen = $1000;
		cLTStateOpen = $0800;
		cLTStateClose = $0400;
		cLTStateReadWrite = $0300;

		cLTListenPhase1 = cLTBitsPhaseListen + cLTBitsPhase1;
		cLTListenPhase2 = cLTBitsPhaseListen + cLTBitsPhase2;
		cLTListenPhase3 = cLTBitsPhaseListen + cLTBitsPhase3;
		cLTListenPhase4 = cLTBitsPhaseListen + cLTBitsPhase4;
		cLTListenPhaseError = cLTBitsPhaseListen + cLTBitsPhaseError;

		cLTOpenPhase1 = cLTBitsPhaseOpen + cLTBitsPhase1;
		cLTOpenPhase2 = cLTBitsPhaseOpen + cLTBitsPhase2;
		cLTOpenPhase3 = cLTBitsPhaseOpen + cLTBitsPhase3;
		cLTOpenPhaseError = cLTBitsPhaseOpen + cLTBitsPhaseError;

		cLTClosePhase1 = cLTBitsPhaseClose + cLTBitsPhase1;
		cLTClosePhase2 = cLTBitsPhaseClose + cLTBitsPhase2;
		cLTClosePhase3 = cLTBitsPhaseClose + cLTBitsPhase3;
		cLTClosePhase4 = cLTBitsPhaseClose + cLTBitsPhase4;
		cLTClosePhaseError = cLTBitsPhaseClose + cLTBitsPhaseError;

		cLTReadPhase1 = cLTBitsPhaseRead + cLTBitsPhase1;
		cLTReadPhase2 = cLTBitsPhaseRead + cLTBitsPhase2;
		cLTReadPhase3 = cLTBitsPhaseRead + cLTBitsPhase3;
		cLTReadPhase4 = cLTBitsPhaseRead + cLTBitsPhase4;
		cLTReadPhase5 = cLTBitsPhaseRead + cLTBitsPhase5;
		cLTReadPhaseError = cLTBitsPhaseRead + cLTBitsPhaseError;

		cLTWritePhase1 = cLTBitsPhaseWrite + cLTBitsPhase1;
		cLTWritePhase2 = cLTBitsPhaseWrite + cLTBitsPhase2;
		cLTWritePhase3 = cLTBitsPhaseWrite + cLTBitsPhase3;
		cLTWritePhase4 = cLTBitsPhaseWrite + cLTBitsPhase4;
		cLTWritePhase5 = cLTBitsPhaseWrite + cLTBitsPhase5;
		cLTWritePhaseError = cLTBitsPhaseWrite + cLTBitsPhaseError;

	{	----------------------------------------	}
	{	MISCELLANEOUS											}
	{	----------------------------------------	}
		cLTCheckAsyncErrors = TRUE;						{TRUE checks error return value of async calls to CM/Read/Write/Listen/Open/Close}
																			{This was needed to work around a bug in the Apple Modem Tool 1.5.1 which returns a}
																			{completely erroneous -1 error on each asynchronous call to CMRead.}

{===========================================================================================}

	Type
	{	----------------------------------------	}
	{	It may be necessary to comment out the		}
	{	following declarations depending on your		}
	{	build environment.	  The use of Short and		}
	{	Long as data types facilitates porting to C,	}
	{	and makes the use of 2-byte vs. 4-byte			}
	{	integers more clear.										}
	{	----------------------------------------	}
	{$IFC UNDEFINED Short}
	{$SETC Short = 2}
		Short = INTEGER;
	{$ENDC}
	{	----------------------------------------	}
	{$IFC UNDEFINED Long}
	{$SETC Long = 4}
		Long = LONGINT;
	{$ENDC}
	{	----------------------------------------	}
	{$IFC LT_UsingUniversalHeaders = 0}
		ConnectionCompletionUPP = Ptr;
		NewConnectionCompletionProc = Ptr;
	{$ENDC}
	{	----------------------------------------	}


		LTQueueHdl = ^LTQueuePtr;
		LTQueuePtr = ^LTQueueRec;
		LTQueueRec = Record
				fMaxElements: Long;								{Maximum elements that the queue can contain (size of fData array)}
				fNumElements: Long;								{Number of elements currently in the queue}
				fHead: Long;											{Array index of first element}
				fTail: Long;											{Array index of last element}
				fData: Array[0..0] Of Handle;
			End;


		LTSocketStatusRec = Record						{A status record returned by LTGetSocketStatus describing a connection's current state}
				fCMErr: CMErr;									{Error returned by CTB status routine CMStatus - noErr = good status record}
				fCMStatusFlags: CMStatFlags;				{Actual CTB status flags - never know when you might need them…}
				fCMBufferSizes: CMBufferSizes;			{Array of CTB buffer sizes - see definition of CMBufferSizes for more info…}

				fIsOpening: Boolean;								{TRUE if the connection is in the process of opening}
				fIsOpen: Boolean;									{TRUE if the connection is currently open}
				fIsClosing: Boolean;								{TRUE if the connection is in the process of closing}
				fIsClosed: Boolean;								{TRUE if the connection is currently closed}

				fIsDataInAvail: Boolean;						{TRUE if there is unread data available}
				fIsDataOutAvail: Boolean;						{TRUE if there is unwritten data available}

				fIsDataReadPending: Boolean;				{TRUE if there is an asynchronous read pending on the DATA channel}
				fIsDataWritePending: Boolean;				{TRUE if there is an asynchronous write pending on the DATA channel}

				fIsBreakPending: Boolean;						{TRUE if there is a break pending (on any channel)}
				fIsListenPending: Boolean;						{TRUE if there is a listen pending (on any channel)}
				fIsIncoming: Boolean;							{TRUE if there is an incoming request to connect (valid only when listening)}
			End;

	{	----------------------------------------	}
	{	NOTE:	Be sure to recompile the completion	}
	{				procedures if you modify					}
	{				LTSocketRec or LTGlobals!!!				}
	{	----------------------------------------	}
		LTSocketRec = Record
				fPhase: Short;										{Used by LTIdle state machines}

				fError: Long;
				fConnHdl: ConnHandle;							{Handle to the Comm Toolbox Connection Record for this connection, or NIL if not being used}
				fAddressConfigHdl: Handle;

				fListenPhase: Short;
				fOpenPhase: Short;
				fClosePhase: Short;

				fReadPhase: Short;
				fReadType: Short;
				fReadHeader: Long;
				fReadCount: Long;
				fReadBuffer: Handle;
				fReadQueue: LTQueueHdl;

				fWritePhase: Short;
				fWriteType: Short;
				fWriteHeader: Long;
				fWriteCount: Long;
				fWriteBuffer: Handle;
				fWriteQueue: LTQueueHdl;
			End;

		LTGlobalsHdl = ^LTGlobalsPtr;
		LTGlobalsPtr = ^LTGlobals;
		LTGlobals = Record											{NOTE:	LTGlobals is a variable sized structure.}
				fCompProcPtr_Listen: ConnectionCompletionUPP;
				fCompProcPtr_Open: ConnectionCompletionUPP;
				fCompProcPtr_Close: ConnectionCompletionUPP;
				fCompProcPtr_Read: ConnectionCompletionUPP;
				fCompProcPtr_Write: ConnectionCompletionUPP;

				fNumSockets: Short;
				fSockets: Array[0..0] Of LTSocketRec;	{NOTE:	fSockets[0] is RESERVED for future use!}
			End;

	{	----------------------------------------	}

	Function LTNewQueue (maxElements: Long): LTQueueHdl;
	Procedure LTDisposeQueue (Var q: LTQueueHdl);
	Procedure LTFlushQueue (q: LTQueueHdl);

	Procedure LTEnQueue (q: LTQueueHdl; Var data: Univ Handle);
	Function LTDeQueue (q: LTQueueHdl): Handle;

	Function LTGetQueueSize (q: LTQueueHdl): Long;
	Function LTGetMaxQueueSize (q: LTQueueHdl): Long;

	{	----------------------------------------	}

	Function LTOpenLlamaTalk (maxSockets: Short; Var globals: LTGlobalsHdl): OSErr;
	Procedure LTCloseLlamaTalk (globals: LTGlobalsHdl);

	Procedure LTIdle (globals: LTGlobalsHdl);

	Function LTNewSocket (globals: LTGlobalsHdl; toolName: Str255; socketConfigHdl, addressConfigHdl: Handle; maxReadQueue, maxWriteQueue: Short; Var socket: Short): OSErr;
	Procedure LTDisposeSocket (globals: LTGlobalsHdl; socket: Short);

	Function LTIsValidSocket (globals: LTGlobalsHdl; socket: Short): Boolean;
	Function LTGetSocketState (globals: LTGlobalsHdl; socket: Short): Long;
	Procedure LTGetSocketStatus (globals: LTGlobalsHdl; socket: Short; Var status: LTSocketStatusRec);

	Procedure LTListen (globals: LTGlobalsHdl; socket: Short);
	Procedure LTOpen (globals: LTGlobalsHdl; socket: Short);
	Procedure LTClose (globals: LTGlobalsHdl; socket: Short);
	Function LTRead (globals: LTGlobalsHdl; socket: Short): Handle;
	Procedure LTWrite (globals: LTGlobalsHdl; socket: Short; Var data: Handle);

	Function LTChoose (Var toolName: Str255; Var configHdl: Handle): Boolean;

	{	----------------------------------------	}

Implementation

{===========================================================================================}

	Function NumToolboxTraps: Short;
	Begin
		If NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) Then
			NumToolboxTraps := $200
		Else
			NumToolboxTraps := $400;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function GetTrapType (theTrap: Short): TrapType;
	Begin
		If BAND(theTrap, $0800) > 0 Then
			GetTrapType := ToolTrap
		Else
			GetTrapType := OSTrap;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function IsTrapAvailable (theTrap: Short): Boolean;
		Var
			tType: TrapType;
	Begin
		tType := GetTrapType(theTrap);
		If tType = ToolTrap Then Begin
				theTrap := BAND(theTrap, $07FF);
				If theTrap >= NumToolboxTraps Then
					theTrap := _Unimplemented;
			End;
		IsTrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented, ToolTrap);
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function IsCommToolboxAvailable: Boolean;
	Begin
		IsCommToolboxAvailable := IsTrapAvailable($008B)
	End;

{===========================================================================================}

	Function NewHiLockedHdl (Var h: Univ Handle; hSize: Long): Boolean;
	Begin
		h := NewHandle(hSize);
		If h = Nil Then
			NewHiLockedHdl := FALSE
		Else Begin
				HLockHi(h);
				NewHiLockedHdl := TRUE;
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function SetHdlSize (h: Univ Handle; s: Long): Boolean;
	Begin
		If h = Nil Then
			SetHdlSize := FALSE
		Else Begin
				SetHandleSize(h, s);
				SetHdlSize := (MemError = noErr);
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure DisposeHdl (Var h: Univ Handle);
	Begin
		If h <> Nil Then Begin
				DisposeHandle(h);
				h := Nil;
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LockHdl (h: Univ Handle);
	Begin
		If h <> Nil Then
			HLock(h);
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure MoveHiLockHdl (h: Univ Handle);
	Begin
		If h <> Nil Then Begin
				HUnLock(h);
				HLockHi(h);
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure UnLockHdl (h: Univ Handle);
	Begin
		If h <> Nil Then
			HUnLock(h);
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function GetHdlSize (h: Univ Handle): Long;
	Begin
		If h = Nil Then
			GetHdlSize := 0
		Else
			GetHdlSize := GetHandleSize(h);
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function GetCodePtrFromNamedCodeRsrc (rType: ResType; rName: Str255): Ptr;
		Var
			h: Handle;
	Begin
		h := GetNamedResource(rType, rName);
		If h <> Nil Then Begin
				LoadResource(h);
				MoveHiLockHdl(h);
				GetCodePtrFromNamedCodeRsrc := h^;
			End
		Else
			GetCodePtrFromNamedCodeRsrc := Nil;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure BlockZero (p: Univ Ptr; count: Long);
		Var
			address: Long;
	Begin
		If p <> Nil Then
			If count > 0 Then
				For address := Ord4(p) To Ord4(p) + count - 1 Do
					Ptr(address)^ := 0;
	End;

{===========================================================================================}

	Function LTNewQueue (maxElements: Long): LTQueueHdl;
		Var
			q: LTQueueHdl;
	Begin
		q := LTQueueHdl(NewHandleClear(SIZEOF(LTQueueRec) + (SIZEOF(Handle) * maxElements)));
		If q <> Nil Then
			q^^.fMaxElements := maxElements;
		LTNewQueue := q;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTDisposeQueue (Var q: LTQueueHdl);
	Begin
		If q <> Nil Then Begin
				LTFlushQueue(q);
				DisposeHdl(q);
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTFlushQueue (q: LTQueueHdl);
		Var
			i: Short;
	Begin
		If q <> Nil Then Begin
				LockHdl(q);
				With q^^ Do
					If fNumElements > 0 Then Begin
							For i := fHead To fTail - 1 Do
								DisposeHdl(fData[i]);
							fNumElements := 0;
							fHead := 0;
							fTail := 0;
						End;
				UnLockHdl(q);
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTEnQueue (q: LTQueueHdl; Var data: Univ Handle);
	Begin
		If q <> Nil Then
			With q^^ Do
				If fNumElements < fMaxElements Then Begin
						fData[fTail] := data;
						data := Nil;
						fTail := (fTail + 1) Mod fMaxElements;
						fNumElements := fNumElements + 1;
					End;
		DisposeHdl(data);
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTDeQueue (q: LTQueueHdl): Handle;
	Begin
		LTDeQueue := Nil;
		If q <> Nil Then
			With q^^ Do
				If fNumElements > 0 Then Begin
						LTDeQueue := fData[fHead];
						fHead := (fHead + 1) Mod fMaxElements;
						fNumElements := fNumElements - 1;
					End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTGetQueueSize (q: LTQueueHdl): Long;
	Begin
		If q = Nil Then
			LTGetQueueSize := 0
		Else
			LTGetQueueSize := q^^.fNumElements;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTGetMaxQueueSize (q: LTQueueHdl): Long;
	Begin
		If q = Nil Then
			LTGetMaxQueueSize := 0
		Else
			LTGetMaxQueueSize := q^^.fMaxElements;
	End;

{-------------------------------------------------------------------------------------------------------------}

{$IFC LT_UsingGlobals = 1}
{$S Main}
	Procedure LTCompProc_Listen (connHdl: ConnHandle);
		Var
			globals: LTGlobalsHdl;
			socket: Short;
	Begin
		globals := LTGlobalsHdl(connHdl^^.refCon);
		socket := connHdl^^.userData;
		With globals^^.fSockets[socket] Do
			Case fConnHdl^^.errCode Of
				cmNoErr: 
					fListenPhase := cLTListenPhase4;
				Otherwise
					fListenPhase := cLTListenPhaseError;
			End;
	End;

	Procedure LTCompProc_Open (connHdl: ConnHandle);
		Var
			globals: LTGlobalsHdl;
			socket: Short;
	Begin
		globals := LTGlobalsHdl(connHdl^^.refCon);
		socket := connHdl^^.userData;
		With globals^^.fSockets[socket] Do
			Case fConnHdl^^.errCode Of
				cmNoErr: 
					fOpenPhase := cLTOpenPhase3;
				Otherwise
					fOpenPhase := cLTOpenPhaseError;
			End;
	End;

	Procedure LTCompProc_Close (connHdl: ConnHandle);
		Var
			globals: LTGlobalsHdl;
			socket: Short;
	Begin
		globals := LTGlobalsHdl(connHdl^^.refCon);
		socket := connHdl^^.userData;
		With globals^^.fSockets[socket] Do Begin
				fError := fConnHdl^^.errCode;
				Case fError Of
					cmNoErr: 
						fClosePhase := cLTClosePhase3;
					cmTimeout: 
						fClosePhase := cLTClosePhase4;
					Otherwise
						fClosePhase := cLTClosePhaseError;
				End;
			End;
	End;

	Procedure LTCompProc_Read (connHdl: ConnHandle);
		Var
			globals: LTGlobalsHdl;
			socket: Short;
	Begin
		globals := LTGlobalsHdl(connHdl^^.refCon);
		socket := connHdl^^.userData;
		With globals^^.fSockets[socket] Do Begin
				fReadCount := fConnHdl^^.asyncCount[cmDataIn];
				Case fConnHdl^^.errCode Of
					cmNoErr: 
						Case fReadPhase Of
							cLTReadPhase2: 
								fReadPhase := cLTReadPhase3;
							cLTReadPhase4: 
								fReadPhase := cLTReadPhase5;
						End;
					Otherwise
						fReadPhase := cLTReadPhaseError;
				End;
			End;
	End;

	Procedure LTCompProc_Write (connHdl: ConnHandle);
		Var
			globals: LTGlobalsHdl;
			socket: Short;
	Begin
		globals := LTGlobalsHdl(connHdl^^.refCon);
		socket := connHdl^^.userData;
		With globals^^.fSockets[socket] Do Begin
				fWriteCount := fConnHdl^^.asyncCount[cmDataOut];
				Case fConnHdl^^.errCode Of
					cmNoErr: 
						Case fWritePhase Of
							cLTWritePhase2: 
								fWritePhase := cLTWritePhase3;
							cLTWritePhase4: 
								fWritePhase := cLTWritePhase5;
						End;
					cmNotOpen: 
						fWritePhase := cLTWritePhaseError;
					Otherwise
						fWritePhase := cLTWritePhaseError;
				End;
			End;
	End;

{$S}
{$ENDC}

{-------------------------------------------------------------------------------------------------------------}

	Function LTOpenLlamaTalk (maxSockets: Short; Var globals: LTGlobalsHdl): OSErr;

		Procedure Fail (error: OSErr);
		Begin
			DisposeHdl(globals);
			LTOpenLlamaTalk := error;
			Exit(LTOpenLlamaTalk);
		End;

		Procedure Fail_If_OSErr (error: OSErr);
		Begin
			If error <> noErr Then
				Fail(error);
		End;

		Procedure Fail_If_ResErr (p: Ptr);
		Begin
			If p = Nil Then
				If ResError = noErr Then
					Fail(resNotFound)
				Else
					Fail(ResError);
		End;

		Procedure Fail_If_MemErr (h: Univ Handle);
		Begin
			If h = Nil Then
				If MemError = noErr Then
					Fail(memFullErr)
				Else
					Fail(MemError);
		End;

	Begin
		LTOpenLlamaTalk := noErr;
		globals := Nil;

		If Not IsCommToolboxAvailable Then
			Fail(cmNotSupported);

		Fail_If_OSErr(InitCTBUtilities);
		Fail_If_OSErr(InitCM);

		globals := LTGlobalsHdl(NewHandleClear(SIZEOF(LTGlobals) + (SIZEOF(LTSocketRec) * maxSockets)));
		Fail_If_MemErr(globals);

		MoveHiLockHdl(globals);
		With globals^^ Do Begin

{$IFC LT_UsingGlobals = 1}
				fCompProcPtr_Listen := NewConnectionCompletionProc(@LTCompProc_Listen);
				fCompProcPtr_Open := NewConnectionCompletionProc(@LTCompProc_Open);
				fCompProcPtr_Close := NewConnectionCompletionProc(@LTCompProc_Close);
				fCompProcPtr_Read := NewConnectionCompletionProc(@LTCompProc_Read);
				fCompProcPtr_Write := NewConnectionCompletionProc(@LTCompProc_Write);
{$ELSEC}
				fCompProcPtr_Listen := GetCodePtrFromNamedCodeRsrc(cLTCompProcResType, cLTCompProcResName_Listen);
				Fail_If_ResErr(fCompProcPtr_Listen);

				fCompProcPtr_Open := GetCodePtrFromNamedCodeRsrc(cLTCompProcResType, cLTCompProcResName_Open);
				Fail_If_ResErr(fCompProcPtr_Open);

				fCompProcPtr_Close := GetCodePtrFromNamedCodeRsrc(cLTCompProcResType, cLTCompProcResName_Close);
				Fail_If_ResErr(fCompProcPtr_Close);

				fCompProcPtr_Read := GetCodePtrFromNamedCodeRsrc(cLTCompProcResType, cLTCompProcResName_Read);
				Fail_If_ResErr(fCompProcPtr_Read);

				fCompProcPtr_Write := GetCodePtrFromNamedCodeRsrc(cLTCompProcResType, cLTCompProcResName_Write);
				Fail_If_ResErr(fCompProcPtr_Write);
{$ENDC}

				fNumSockets := maxSockets;
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTCloseLlamaTalk (globals: LTGlobalsHdl);
		Var
			error: Long;
			i: Short;
			k: CMBufFields;
	Begin
		If globals = Nil Then
			Exit(LTCloseLlamaTalk);

		With globals^^ Do Begin
				For i := 1 To fNumSockets Do
					With fSockets[i] Do
						If fPhase <> 0 Then Begin
								error := CMAbort(fConnHdl);
								For k := cmDataIn To cmRsrvOut Do
									error := CMIOKill(fConnHdl, Ord(k));
								CMDispose(fConnHdl);
							End;
			End;

		DisposeHdl(globals);
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTGetSocketStatus (globals: LTGlobalsHdl; socket: Short; Var status: LTSocketStatusRec);
	Begin
		With status Do Begin
				fCMErr := CMStatus(globals^^.fSockets[socket].fConnHdl, fCMBufferSizes, fCMStatusFlags);

				fIsOpening := BAND(fCMStatusFlags, cmStatusOpening) <> 0;											{Opening}
				fIsOpen := BAND(fCMStatusFlags, cmStatusOpen) <> 0;													{Open}
				fIsClosing := BAND(fCMStatusFlags, cmStatusClosing) <> 0;											{Closing}
				fIsClosed := Not fIsOpening & Not fIsOpen & Not fIsClosing;											{Closed}

				fIsDataInAvail := LTGetQueueSize(globals^^.fSockets[socket].fReadQueue) > 0;				{Data in read queue}
				fIsDataOutAvail := LTGetQueueSize(globals^^.fSockets[socket].fWriteQueue) > 0;			{Data in write queue}

				fIsDataReadPending := BAND(fCMStatusFlags, cmStatusDRPend) <> 0;							{Data Read Pending}
				fIsDataWritePending := BAND(fCMStatusFlags, cmStatusDWPend) <> 0;							{Data Write Pending}

				fIsBreakPending := BAND(fCMStatusFlags, cmStatusBreakPend) <> 0;							{Break Pending}
				fIsListenPending := BAND(fCMStatusFlags, cmStatusListenPend) <> 0;							{Listen Pending}
				fIsIncoming := BAND(fCMStatusFlags, cmStatusIncomingCallPresent) <> 0;					{Incoming Call Pending}
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTGetSocketState (globals: LTGlobalsHdl; socket: Short): Long;
	Begin
		If LTIsValidSocket(globals, socket) Then
			LTGetSocketState := globals^^.fSockets[socket].fPhase
		Else
			LTGetSocketState := 0;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTIsValidSocket (globals: LTGlobalsHdl; socket: Short): Boolean;
	Begin
		LTIsValidSocket := FALSE;
		If globals <> Nil Then
			If socket > 0 Then
				If socket <= globals^^.fNumSockets Then
					If globals^^.fSockets[socket].fPhase <> 0 Then
						LTIsValidSocket := TRUE;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTChoose (Var toolName: Str255; Var configHdl: Handle): Boolean;
	{	----------------------------------------	}
	{	NOTE:	Set toolName to the name of the tool	}
	{				to use as the default selection.			}
	{	----------------------------------------	}
		Var
			error: OSErr;
			i: Short;
			p: Ptr;
			connHdl: ConnHandle;
			bufferSizes: CMBufferSizes;
			name: Str255;
	Begin
		LTChoose := FALSE;
		configHdl := Nil;
		BlockZero(@bufferSizes, SIZEOF(bufferSizes));

		i := 0;
		Repeat
			i := i + 1;
			error := CRMGetIndToolName(ClassCM, i, name);
		Until (error <> noErr) | EqualString(name, toolName, FALSE, FALSE);

		If error <> noErr Then
			error := CRMGetIndToolName(ClassCM, 1, name);

		If error = noErr Then Begin
				connHdl := CMNew(CMGetProcID(name), cmData, bufferSizes, 0, 0);
				If connHdl <> Nil Then Begin

						p := CMGetConfig(connHdl);
						DisposePtr(p);

						i := CMChoose(connHdl, Point($00400040), Nil);
						If (i = chooseOKMinor) | (i = chooseOKMajor) Then Begin

								CMGetToolName(connHdl^^.procID, toolName);

								p := CMGetConfig(connHdl);
								error := PtrToHand(p, configHdl, GetPtrSize(p));
								DisposePtr(p);

								LTChoose := TRUE;
							End;

						If connHdl <> Nil Then
							CMDispose(connHdl);
					End;
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTNewSocket (globals: LTGlobalsHdl; toolName: Str255; socketConfigHdl, addressConfigHdl: Handle; maxReadQueue, maxWriteQueue: Short; Var socket: Short): OSErr;
		Var
			error: OSErr;
			i: Short;
			toolID: Short;
			bufferSizes: CMBufferSizes;

		Procedure Fail (error: OSErr);
		Begin
			UnLockHdl(socketConfigHdl);
			If globals <> Nil Then
				If socket <> -1 Then
					With globals^^.fSockets[socket] Do
						If fConnHdl <> Nil Then Begin
								CMDispose(fConnHdl);
								fConnHdl := Nil;
							End;
			LTNewSocket := error;
			Exit(LTNewSocket);
		End;

	Begin
		error := cLTSocketTableFull;
		socket := -1;
		If globals = Nil Then
			Exit(LTNewSocket);

		With globals^^ Do
			For i := 1 To fNumSockets Do
				If fSockets[i].fPhase = 0 Then Begin
						socket := i;
						error := noErr;
						Leave;
					End;

		If error = noErr Then
			With globals^^.fSockets[socket] Do Begin

					toolID := CMGetProcID(toolName);
					If toolID <= 0 Then
						Fail(cLTBadToolName);

					BlockZero(@bufferSizes, SIZEOF(bufferSizes));
					fConnHdl := CMNew(toolID, cmData + cmDataClean + cmQuiet, bufferSizes, Long(globals), socket);
					If fConnHdl = Nil Then
						Fail(memFullErr);

					LockHdl(fConnHdl);

					If GetHdlSize(socketConfigHdl) > 0 Then Begin
							LockHdl(socketConfigHdl);
							error := CMSetConfig(fConnHdl, socketConfigHdl^);
							If error <> noErr Then
								Fail(cLTBadConfig);
							UnLockHdl(socketConfigHdl);
						End;

					fAddressConfigHdl := addressConfigHdl;

					fReadQueue := LTNewQueue(maxReadQueue);
					fReadHeader := 0;
					fReadBuffer := Nil;

					fWriteQueue := LTNewQueue(maxWriteQueue);
					fWriteHeader := 0;
					fWriteBuffer := Nil;

					If (fReadQueue = Nil) | (fWriteQueue = Nil) Then
						Fail(memFullErr);

					fError := 0;
					fPhase := cLTStateIdle;
				End;

		LTNewSocket := error;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTDisposeSocket (globals: LTGlobalsHdl; socket: Short);
	Begin
		If LTIsValidSocket(globals, socket) Then
			globals^^.fSockets[socket].fPhase := cLTStateDispose;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTListen (globals: LTGlobalsHdl; socket: Short);
	Begin
		If LTIsValidSocket(globals, socket) Then
			With globals^^.fSockets[socket] Do Begin
					fListenPhase := cLTListenPhase1;
					fPhase := cLTStateListen;
				End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTOpen (globals: LTGlobalsHdl; socket: Short);
	Begin
		If LTIsValidSocket(globals, socket) Then
			With globals^^.fSockets[socket] Do Begin
					fOpenPhase := cLTOpenPhase1;
					fPhase := cLTStateOpen;
				End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClose (globals: LTGlobalsHdl; socket: Short);
	Begin
		If LTIsValidSocket(globals, socket) Then
			With globals^^.fSockets[socket] Do Begin
					fClosePhase := cLTClosePhase1;
					fPhase := cLTStateClose;
				End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Function LTRead (globals: LTGlobalsHdl; socket: Short): Handle;
	Begin
		If LTIsValidSocket(globals, socket) Then
			LTRead := LTDeQueue(globals^^.fSockets[socket].fReadQueue)
		Else
			LTRead := Nil;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTWrite (globals: LTGlobalsHdl; socket: Short; Var data: Handle);
	Begin
		If LTIsValidSocket(globals, socket) Then
			LTEnQueue(globals^^.fSockets[socket].fWriteQueue, data);
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTErrorSocket (globals: LTGlobalsHdl; socket: Short; error: CMErr);
		Var
			sizes: CMBufferSizes;
			flags: CMStatFlags;
	Begin
		If LTIsValidSocket(globals, socket) Then
			With globals^^.fSockets[socket] Do Begin
					If error <> noErr Then
						fError := error
					Else Begin
							fError := CMStatus(fConnHdl, sizes, flags);
							If fError = noErr Then
								If BAND(flags, cmStatusOpening + cmStatusOpen + cmStatusClosing) = 0 Then
									fError := cmNotOpen
								Else
									fError := cmGenericError;
						End;
					fPhase := cLTStateError;
				End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClockCloseMachine (globals: LTGlobalsHdl; socket: Short);
		Var
			error: CMErr;
	Begin
		With globals^^.fSockets[socket] Do
			Case fClosePhase Of
				cLTClosePhase1:  Begin
						fClosePhase := cLTClosePhase2;
						error := CMClose(fConnHdl, TRUE, globals^^.fCompProcPtr_Close, 300, FALSE);
						If cLTCheckAsyncErrors Then
							If error <> noErr Then
								LTErrorSocket(globals, socket, error);
					End;

				cLTClosePhase2: 
					;								{	Awaiting close completion proc to be called…	}

				cLTClosePhase3:  			{	Connection has been closed, return to pending-listen mode…	}
					fPhase := cLTStateIdle;

				cLTClosePhase4:  			{	Close request timed-out waiting for pending data to be transferred.  Re-queue the close request.	}
					fClosePhase := cLTClosePhase1;

				cLTClosePhaseError:  	{	Close request just plain failed.  Kill the connection and report the error.	}
					LTErrorSocket(globals, socket, 0)
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClockWriteMachine (globals: LTGlobalsHdl; socket: Short);
		Var
			error: CMErr;
			flags: CMFlags;
	Begin
		With globals^^.fSockets[socket] Do
			Case fWritePhase Of
				cLTWritePhase1:  Begin
						fWriteBuffer := LTDeQueue(fWriteQueue);
						If fWriteBuffer <> Nil Then Begin
								fWritePhase := cLTWritePhase2;
								fWriteType := cLTPacketType_Simple;
								fWriteHeader := BOR(BSL(fWriteType, 24), BAND(GetHdlSize(fWriteBuffer), $00FFFFFF));
								fWriteCount := 4;
								flags := 0;
								error := CMWrite(fConnHdl, @fWriteHeader, fWriteCount, cmData, TRUE, globals^^.fCompProcPtr_Write, -1, flags);
								If cLTCheckAsyncErrors Then
									If error <> noErr Then
										LTErrorSocket(globals, socket, error);
							End;
					End;

				cLTWritePhase2: 
					;		{	Awaiting first completion proc to be called…	}

				cLTWritePhase3:  Begin
						MoveHiLockHdl(fWriteBuffer);
						fWritePhase := cLTWritePhase4;
						fWriteCount := GetHdlSize(fWriteBuffer);
						flags := 0;
						error := CMWrite(fConnHdl, fWriteBuffer^, fWriteCount, cmData, TRUE, globals^^.fCompProcPtr_Write, -1, flags);
						If cLTCheckAsyncErrors Then
							If error <> noErr Then
								LTErrorSocket(globals, socket, error);
					End;

				cLTWritePhase4: 
					;		{	Awaiting second completion proc to be called…	}

				cLTWritePhase5:  Begin
						DisposeHdl(fWriteBuffer);
						fWritePhase := cLTWritePhase1;
					End;

				cLTWritePhaseError: 
					LTErrorSocket(globals, socket, 0)
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClockReadWriteMachine (globals: LTGlobalsHdl; socket: Short);
		Var
			error: CMErr;
			flags: CMFlags;
	Begin
		With globals^^.fSockets[socket] Do
			Case fReadPhase Of
				cLTReadPhase1:  Begin
						fReadPhase := cLTReadPhase2;
						fReadType := cLTPacketType_Simple;
						fReadHeader := 0;
						fReadCount := 4;
						fReadBuffer := Nil;
						flags := 0;
						error := CMRead(fConnHdl, @fReadHeader, fReadCount, cmData, TRUE, globals^^.fCompProcPtr_Read, -1, flags);
						If cLTCheckAsyncErrors Then
							If error <> noErr Then
								LTErrorSocket(globals, socket, error);
					End;

				cLTReadPhase2:  				{	Awaiting first read completion proc to be called, execute a write machine step…	}
					LTClockWriteMachine(globals, socket);

				cLTReadPhase3:  Begin	{	First completion proc has been called, adjust read buffer size, & read remaining data…	}
						fReadPhase := cLTReadPhase4;
						If fReadCount <> 4 Then
							LTErrorSocket(globals, socket, 0)
						Else Begin
								fReadType := BSR(fReadHeader, 24);
								fReadCount := BAND(fReadHeader, $00FFFFFF);
								If fReadCount = 0 Then
									fReadPhase := cLTReadPhase1
								Else If Not NewHiLockedHdl(fReadBuffer, fReadCount) Then
									LTErrorSocket(globals, socket, 0)
								Else Begin
										flags := 0;
										error := CMRead(fConnHdl, fReadBuffer^, fReadCount, cmData, TRUE, globals^^.fCompProcPtr_Read, -1, flags);
										If cLTCheckAsyncErrors Then
											If error <> noErr Then
												LTErrorSocket(globals, socket, error);
									End;
							End;
					End;

				cLTReadPhase4:  				{	Awaiting second read completion proc to be called…	}
					LTClockWriteMachine(globals, socket);

				cLTReadPhase5:  Begin	{	Full read completed.  Move read buffer into read queue.	}
						fReadPhase := cLTReadPhase1;
						If fReadCount <> BAND(fReadHeader, $00FFFFFF) Then
							LTErrorSocket(globals, socket, 0)
						Else
							Case fReadType Of
								cLTPacketType_Simple: 		{	No compression or encryption.	}
									LTEnQueue(fReadQueue, fReadBuffer);
								Otherwise Begin				{	Unsupported packet type.	}
										DisposeHdl(fReadBuffer);
										LTErrorSocket(globals, socket, cmNotSupported)
									End;
							End;
					End;

				cLTReadPhaseError:  		{	First or second read request just plain failed.  Kill the connection and report the error.	}
					LTErrorSocket(globals, socket, 0);
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClockDisposeMachine (globals: LTGlobalsHdl; socket: Short);
		Var
			error: CMErr;
			k: CMBufFields;
	Begin
		With globals^^.fSockets[socket] Do
			If fConnHdl <> Nil Then Begin						{	Note:  fConnHdl may be NIL when called!   }
					error := CMAbort(fConnHdl);
					For k := cmDataIn To cmRsrvOut Do
						error := CMIOKill(fConnHdl, Ord(k));

					CMDispose(fConnHdl);
					fConnHdl := Nil;
					DisposeHdl(fReadBuffer);
					LTDisposeQueue(fReadQueue);
					fWriteHeader := 0;
					DisposeHdl(fWriteBuffer);
					LTDisposeQueue(fWriteQueue);

					fError := 0;
					fPhase := 0;
					fListenPhase := 0;
					fOpenPhase := 0;
					fClosePhase := 0;
					fReadPhase := 0;
					fWritePhase := 0;
				End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClockListenMachine (globals: LTGlobalsHdl; socket: Short);
		Var
			error: CMErr;
			i: Short;
			s: Str255;
			sizes: CMBufferSizes;
			flags: CMStatFlags;
	Begin
		With globals^^.fSockets[socket] Do
			Case fListenPhase Of
				cLTListenPhase1:  Begin		{	Socket created and waiting for other listen requests to complete (only 1 can be active at a time).	}
						fListenPhase := cLTListenPhase2;
						For i := 1 To globals^^.fNumSockets Do		{	Is ANY OTHER socket NOT in a listen phase?	}
							If i <> socket Then
								If LTIsValidSocket(globals, i) Then
									Case globals^^.fSockets[i].fListenPhase Of
										0, cLTListenPhase1: 
											;
										Otherwise Begin
												fListenPhase := cLTListenPhase1;
												Leave;
											End;
									End;
					End;

				cLTListenPhase2:  Begin		{	Socket was told to listen for a connection…	}
						If GetHdlSize(fAddressConfigHdl) > 0 Then Begin
								LockHdl(fAddressConfigHdl);
								error := CMSetConfig(fConnHdl, fAddressConfigHdl^);	{	Ignore any error this might return -- only necessary for ADSP anyway…	}
								UnLockHdl(fAddressConfigHdl);
							End;

						fListenPhase := cLTListenPhase3;
						error := CMListen(fConnHdl, TRUE, globals^^.fCompProcPtr_Listen, -1);
						If cLTCheckAsyncErrors Then
							If error <> noErr Then
								LTErrorSocket(globals, socket, error);
					End;

				cLTListenPhase3: 
					;		{	Waiting to receive a connection request…	}

				cLTListenPhase4:  Begin		{	Verify there is an incoming connection request…	}
						error := CMStatus(fConnHdl, sizes, flags);
						If error <> noErr Then
							LTErrorSocket(globals, socket, error)

						Else If BAND(flags, cmStatusIncomingCallPresent) <> 0 Then Begin
								error := CMAccept(fConnHdl, TRUE);
								If error <> noErr Then
									LTErrorSocket(globals, socket, error)
								Else Begin
										fListenPhase := 0;
										fReadPhase := cLTReadPhase1;
										fWritePhase := cLTWritePhase1;
										fPhase := cLTStateReadWrite;
									End;
							End

						Else If BAND(flags, cmStatusListenPend) = 0 Then
							fListenPhase := cLTListenPhase2;
					End;

				cLTListenPhaseError: 
					LTErrorSocket(globals, socket, 0);
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClockOpenMachine (globals: LTGlobalsHdl; socket: Short);
		Var
			error: CMErr;
	Begin
		With globals^^.fSockets[socket] Do
			Case fOpenPhase Of
				cLTOpenPhase1:  Begin
						fOpenPhase := cLTOpenPhase2;
						error := CMOpen(fConnHdl, TRUE, globals^^.fCompProcPtr_Open, -1);
						If cLTCheckAsyncErrors Then
							If error <> noErr Then
								LTErrorSocket(globals, socket, error);
					End;

				cLTOpenPhase2: 
					;									{	Awaiting open completion proc to be called…	}

				cLTOpenPhase3:  Begin	{	Connection has been opened, move to I/O mode…	}
						fOpenPhase := 0;
						fReadPhase := cLTReadPhase1;
						fWritePhase := cLTWritePhase1;
						fPhase := cLTStateReadWrite;
					End;

				cLTOpenPhaseError:  		{	Open request just plain failed.  Kill the connection and report the error.	}
					LTErrorSocket(globals, socket, 0)
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTClockStateMachines (globals: LTGlobalsHdl; socket: Short);
	Begin
		With globals^^.fSockets[socket] Do Begin
				CMIdle(fConnHdl);
				Case fPhase Of

					cLTStateReadWrite: 
						LTClockReadWriteMachine(globals, socket);

					cLTStateListen: 
						LTClockListenMachine(globals, socket);

					cLTStateOpen: 
						LTClockOpenMachine(globals, socket);

					cLTStateClose: 
						LTClockCloseMachine(globals, socket);

					cLTStateDispose: 
						LTClockDisposeMachine(globals, socket);

					cLTStateIdle: 
						;

					cLTStateError: 
						;		{	Socket must be disposed of if this state is reached.	}
				End;
			End;
	End;

{-------------------------------------------------------------------------------------------------------------}

	Procedure LTIdle (globals: LTGlobalsHdl);
		Var
			i: Short;
	Begin
		If globals <> Nil Then
			For i := 1 To globals^^.fNumSockets Do
				If LTIsValidSocket(globals, i) Then
					LTClockStateMachines(globals, i);
	End;

{===========================================================================================}

End.