-- PhoneNetworkDriver.mesa (last edited by: BLyon on: March 13, 1981 1:03 PM

DIRECTORY
BufferDefs USING [
Buffer, BufferAccessHandle, FreeBufferPool, MakeBufferPool, OisBuffer, PupBuffer,
BufferType],
CommFlags USING [doStats],
CommUtilDefs USING [GetEthernetHostNumber],
Dialup USING [Dial, RetryCount],
DriverDefs USING [
NetworkObject, Network, PutOnGlobalDoneQueue, DriverXmitStatus,
AddDeviceToChain, GetInputBuffer, PutOnGlobalInputQueue, ReturnFreeBuffer,
RemoveDeviceFromChain],
DriverTypes USING [Byte, phoneEncapsulationOffset, phoneEncapsulationBytes],
HalfDuplex USING [Initialize, Destroy, WaitToSend, SendCompleted, CheckForTurnAround],
OISCP USING [unknownNetID],
OISCPConstants USING [phoneNetID],
OISTransporter USING [],
PhoneNetwork USING [FindPhonePath, UnknownPath],
Process USING [SetPriority, SetTimeout, MsecToTicks],
PupTypes USING [PupHostID, PupErrorCode],
RS232C USING [
ChannelHandle, CompletionHandle, PhysicalRecord, PhysicalRecordHandle,
TransferStatus, DeviceStatus, LineSpeed, Get, Put, TransferWait, TransmitNow,
GetStatus, StatusWait, SetParameter, Suspend, Restart, ChannelSuspended],
RS232CManager USING [NetAccess, CommParamObject, CommParamHandle, CommDuplex],
NSAddress USING [
GetProcessorID, HostNumber, NetworkNumber, ProcessorID, nullProcessorID,
broadcastHostNumber];

PhoneNetworkDriver: MONITOR
IMPORTS
BufferDefs, CommUtilDefs, Dialup, DriverDefs, HalfDuplex, PhoneNetwork,
Process, RS232C, NSAddress
EXPORTS BufferDefs, OISTransporter
SHARES BufferDefs =
BEGIN

-- EXPORTed TYPEs
Network: PUBLIC TYPE = DriverDefs.Network;

-- various definitions
NetworkState: TYPE = {available, unavailable};
LineState: TYPE = {closed, active};
ConnectionStatus: TYPE = {successful, modemDown, channelPreempted};
CreatePhonePathOutcome: TYPE = {
success, busyOrNoAnswer, noDialer, noTranslation, dialerError};
CheckPathOutcome: TYPE = {
success, noTranslation, busyOrNoAnswer, noDialer, dialerError, circuitInUse};
StatsRecord: TYPE = RECORD [
pktsSent, pktsReceived, pktsRejected, notTheCurrentPath, noPathSendNoNet,
busyOrNoAnswer, noTranslationForAddress, sendErrorBadStatus,
noPathSendLineDown, rcvErrorDataLost, rcvErrorChecksum, rcvErrorNoGet,
rcvErrorUnknown, rcvErrorFrameTimeout, rcvDeviceError, bytesSent,
bytesReceived, dialError, dsrDropped: CARDINAL];
-- state things
lineState: LineState; -- becomes active when DSR comes up
networkState: NetworkState;
-- becomes available after we tell router about ourselves; unavailable when channel deleted (includes preempted)
sendRecProcessesActive: BOOLEAN;
-- Pup support
pupAddrKnown: BOOLEAN;
-- FALSE means they cannot be JOINed during cleanup
dialing: BOOLEAN; -- Receiver process waits for this
awaitingLineUpAfterDial: BOOLEAN; -- Receiver process waits for this
dialComplete: CONDITION;
-- current channel usage
channelHandle: RS232C.ChannelHandle;
currentPathSystemElement: NSAddress.HostNumber;
mySystemElement: NSAddress.ProcessorID;
duplexity: RS232CManager.CommDuplex;
modemSpeed: RS232C.LineSpeed;
lineMode: RS232CManager.NetAccess;
autoDial: BOOLEAN;
dialRetries: Dialup.RetryCount;
-- output queue
headOutputBuffer, tailOutputBuffer: BufferDefs.Buffer;
packetToSend: CONDITION;
-- phone network object for Router
phoneNetObject: DriverDefs.NetworkObject ←
[next: NIL, decapsulateBuffer: TypeOfBuffer, encapsulatePup: PupFrameIt,
encapsulateOis: OISFrameIt, sendBuffer: EnqueueSend,
forwardBuffer: ForwardFrame, -- rejects
activateDriver: ActivateTransporter, deactivateDriver: KillTransporter,
deleteDriver: KillTransporter, interrupt: InterruptNop,
-- this gets locked! (a crok)
changeNumberOfInputBuffers: NIL, index:,
device: phonenet, alive: TRUE, speed: 1, buffers: 0, spare:, netNumber:,
hostNumber:, pupStats: StatsNop, stats: NIL];
phoneNetwork: Network ← @phoneNetObject;
-- process handles
senderProcess: PROCESS;
receiverProcess: PROCESS;
statusWaitProcess: PROCESS;
-- personal buffer
phoneBufferAccessHandle: BufferDefs.BufferAccessHandle;
-- stats
statsRec: StatsRecord;
-- constants
noError: DriverTypes.Byte = 0B;
noPathError: DriverTypes.Byte = 100B;
noTranslationError: DriverTypes.Byte = 101B;
circuitInUseError: DriverTypes.Byte = 102B;
noDialerError: DriverTypes.Byte = 103B;
dialerHardwareError: DriverTypes.Byte = 104B;
noAnswerOrBusyError: DriverTypes.Byte = 104B;
dialNetNumber: NSAddress.NetworkNumber = OISCPConstants.phoneNetID;
outstandingGets: CARDINAL = 2;
-- determines the amount of Channel receives for multiple buffering
-- signals and errors
-- ************ Initialization/Termination (from RS232CManager) ************
Initialize: PUBLIC PROCEDURE [
chHandle: RS232C.ChannelHandle, commParams: RS232CManager.CommParamObject] =
-- start the Transporter with the given params
BEGIN
-- locals
-- initialize globals
lineState ← closed; -- becomes active when DSR comes up
networkState ← unavailable;
-- becomes available after we tell router about ourselves
sendRecProcessesActive ← FALSE;
awaitingLineUpAfterDial ← FALSE;
pupAddrKnown ← FALSE;
channelHandle ← chHandle;
duplexity ← commParams.duplex;
modemSpeed ← commParams.lineSpeed;
headOutputBuffer ← tailOutputBuffer ← NIL;
-- stats
IF CommFlags.doStats THEN
statsRec ← [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0];
-- get our own host number, initialize remote ID
mySystemElement ← NSAddress.GetProcessorID[];
phoneNetwork.hostNumber ← 0;
currentPathSystemElement ← NSAddress.nullProcessorID;
-- decode Communication parameters
WITH commParams SELECT FROM
directConn =>
 BEGIN
 phoneNetwork.netNumber ← OISCP.unknownNetID;
 lineMode ← directConn;
 END;
dialConn =>
 BEGIN
 phoneNetwork.netNumber ← dialNetNumber;
 autoDial ← (dialMode = auto);
 dialRetries ← retryCount;
 lineMode ← dialConn;
 END;
ENDCASE;
-- set RS-232-C parameters that matter (note: bitSynchronous has mostly defaults)
RS232C.SetParameter[channelHandle, [dataTerminalReady[TRUE]]];
-- tell modem we are ready to boogie
networkState ← available; -- allow sends from Router
-- start status change watch process (which will start the receiver process and any half-duplex)
statusWaitProcess ← FORK StatusChangeWait[];
-- tell Router about ourselves
DriverDefs.AddDeviceToChain[phoneNetwork, 0];
END;

Destroy: PUBLIC PROCEDURE [chHandle: RS232C.ChannelHandle] =
-- stop everything so we don't make any more channel calls
BEGIN
-- locals
pupAddrKnown ← FALSE;
RS232C.Suspend[channelHandle, all];
JOIN statusWaitProcess; -- sender and receiver JOINED by status wait guy
END;
-- **************** Encapsulation ****************

FrameAny: PROCEDURE [buffer: BufferDefs.Buffer] =
-- fill buffer with level 0 header stuff
BEGIN
-- locals
-- encapsulation offset with no HDLC framing should be 3, with HDLC framing should be 1
buffer.encapsulation ←
[phonenet[
 framing0: noError, framing1: 0, framing2: 0, framing3: 0, framing4: 0,
 framing5: 0, recognition: 0, -- for auto-recog
 pnType: oisPhonePacket, pnSrcID: mySystemElement]];
END;

OISFrameIt: PROCEDURE [
buffer: BufferDefs.OisBuffer, systemElem: NSAddress.HostNumber] =
-- fill buffer with OIS level 0 header stuff
BEGIN
-- locals
errorByte: DriverTypes.Byte;
-- check if we are talking to the system element (may cause dialing)
errorByte ←
SELECT CheckPath[systemElem] FROM
 success => noError,
 busyOrNoAnswer => noAnswerOrBusyError,
 noTranslation => noTranslationError,
 dialerError => dialerHardwareError,
 noDialer => noDialerError,
 circuitInUse => circuitInUseError,
 ENDCASE => noPathError;
IF errorByte # noError THEN
BEGIN -- set error in encapsulation field
buffer.encapsulation.framing0 ← errorByte;
IF CommFlags.doStats THEN
 SELECT errorByte FROM
  = noAnswerOrBusyError => StatIncr[@statsRec.busyOrNoAnswer];
  = noTranslationError => StatIncr[@statsRec.noTranslationForAddress];
  = circuitInUseError => StatIncr[@statsRec.notTheCurrentPath];
  ENDCASE;
RETURN;
END;
FrameAny[buffer];
buffer.encapsulation.pnType ← oisPhonePacket;
buffer.length ←
(buffer.ois.pktLength + 1 + DriverTypes.phoneEncapsulationBytes)/2;
-- note that length is in words. Since software checksum is on words, it expects the driver to pad.

END;

PupFrameIt: PROCEDURE [
buffer: BufferDefs.PupBuffer, systemElem: PupTypes.PupHostID] =
-- fill buffer with Pup level 0 header stuff
BEGIN
-- locals
IF ~pupAddrKnown THEN
BEGIN
phoneNetwork.hostNumber ← CommUtilDefs.GetEthernetHostNumber[];
pupAddrKnown ← TRUE;
END;
FrameAny[buffer];
buffer.encapsulation.pnType ← pupPhonePacket;
buffer.length ←
(buffer.pupLength + 1 + DriverTypes.phoneEncapsulationBytes)/2;
-- note that length is in rounded-up words, because higher-level checksum on words
END;

TypeOfBuffer: PROCEDURE [buffer: BufferDefs.Buffer]
RETURNS [type: BufferDefs.BufferType] =
-- determine buffer type
BEGIN
SELECT buffer.encapsulation.pnType FROM
oisPhonePacket => type ← ois;
pupPhonePacket => type ← pup;
ENDCASE =>
 BEGIN
 type ← rejected;
 IF CommFlags.doStats THEN StatIncr[@statsRec.pktsRejected];
 END;
END;
-- **************** Packet Transport / Sending ****************

EnqueueSend: ENTRY PROCEDURE [buffer: BufferDefs.Buffer] =
-- queue the buffer for output
BEGIN ENABLE UNWIND => NULL;
-- locals
errorByte: DriverTypes.Byte ← buffer.encapsulation.framing0;
xmitStatus: DriverDefs.DriverXmitStatus;
-- check for error states (some set in encapsulation routine)
IF (lineState = closed) OR (networkState = unavailable) OR
(errorByte # noError) THEN
BEGIN
IF networkState = unavailable THEN xmitStatus ← noRouteToNetwork
ELSE
 IF ~awaitingLineUpAfterDial THEN
  BEGIN
  xmitStatus ←
  SELECT errorByte FROM
  = noPathError => noRouteToNetwork,
  = noAnswerOrBusyError => noAnswerOrBusy,
  = noTranslationError => noTranslationForDestination,
  = dialerHardwareError => dialerHardwareProblem,
  = noDialerError => noDialingHardware,
  = circuitInUseError => circuitInUse,
  ENDCASE =>
  IF lineState = closed THEN circuitNotReady ELSE noRouteToNetwork;
  END
 ELSE xmitStatus ← goodCompletion; -- drop on the floor waiting for DSR
buffer.status ← LOOPHOLE[xmitStatus];
DriverDefs.PutOnGlobalDoneQueue[buffer];
IF CommFlags.doStats THEN
 BEGIN
 IF lineState = closed THEN StatIncr[@statsRec.noPathSendLineDown];
 IF networkState = unavailable THEN StatIncr[@statsRec.noPathSendNoNet];
 END;
RETURN;
END;
IF headOutputBuffer = NIL THEN headOutputBuffer ← tailOutputBuffer ← buffer
ELSE BEGIN tailOutputBuffer.next ← buffer; tailOutputBuffer ← buffer; END;
NOTIFY packetToSend;
END;

Sender: PROCEDURE =
-- process that waits for things to send
BEGIN
-- locals
b: BufferDefs.Buffer;
AwaitPacketToSend: ENTRY PROCEDURE =
-- wait for a non-empty queue
BEGIN ENABLE UNWIND => NULL;
UNTIL (headOutputBuffer # NIL) OR ~sendRecProcessesActive DO
 WAIT packetToSend; ENDLOOP;
END;
UNTIL ~sendRecProcessesActive DO
AwaitPacketToSend[]; SendFrame[DequeueSend[]]; ENDLOOP;
-- clear any remaining things to send and go away
UNTIL (b ← DequeueSend[]) = NIL DO
DriverDefs.PutOnGlobalDoneQueue[b]; ENDLOOP;
END;

NotifySenderToGoAway: ENTRY PROCEDURE =
-- make Sender wake up
BEGIN NOTIFY packetToSend; END;

DequeueSend: ENTRY PROCEDURE RETURNS [buffer: BufferDefs.Buffer] =
-- dequeue the buffer for output
BEGIN
-- locals
IF headOutputBuffer = NIL THEN buffer ← NIL
ELSE BEGIN buffer ← headOutputBuffer; headOutputBuffer ← buffer.next; END;
END;

SendFrame: PROCEDURE [buffer: BufferDefs.Buffer] =
-- build and Put a frame to the channel
BEGIN
-- locals
complHandle: RS232C.CompletionHandle;
rec: RS232C.PhysicalRecord ←
[header: [NIL, 0, 0], body:, trailer: [NIL, 0, 0]];
IF buffer = NIL THEN RETURN;
-- FIll Channel Physical record
rec.body.blockPointer ←
@buffer.encapsulation + DriverTypes.phoneEncapsulationOffset;
-- word boundary
rec.body.startIndex ← 0;
rec.body.stopIndexPlusOne ← buffer.length*2; -- even bytes
-- if half duplex, set RTS and await CTS
IF duplexity = half THEN HalfDuplex.WaitToSend[];
-- do the Put
complHandle ← RS232C.Put[
channelHandle, @rec !
RS232C.ChannelSuspended =>
 BEGIN -- someone wants us to go away
 PreemptedSending[buffer];
 IF duplexity = half THEN HalfDuplex.SendCompleted[FALSE];
 GOTO returnPlace;
 END];
-- wait for completion
SendWait[buffer, complHandle];
IF duplexity = half THEN HalfDuplex.SendCompleted[(headOutputBuffer # NIL)];
-- give a chance for line turn-around and say if we have more to send

EXITS returnPlace => NULL;
END;

SendWait: PROCEDURE [
buffer: BufferDefs.Buffer, complete: RS232C.CompletionHandle] =
-- waits for Put to complete
BEGIN
-- locals
bytes: CARDINAL;
xferstatus: RS232C.TransferStatus;
-- wait for completion
[bytes, xferstatus] ← RS232C.TransmitNow[channelHandle, complete];
-- fill status, bytes in buffer
buffer.status ← TranslateChannelStatus[xferstatus];
buffer.length ← bytes;
-- stats
IF CommFlags.doStats THEN
IF xferstatus = success THEN
 BEGIN
 StatIncr[@statsRec.pktsSent];
 StatBump[@statsRec.bytesSent, bytes];
 END
ELSE StatIncr[@statsRec.sendErrorBadStatus];
-- call completion procedure
DriverDefs.PutOnGlobalDoneQueue[buffer];
END;

TranslateChannelStatus: PRIVATE PROCEDURE [chStatus: RS232C.TransferStatus]
RETURNS [oisStatus: CARDINAL] =
-- translate channel status to driver xmit status
BEGIN -- need more definitive codes ???????
-- locals
frameStatus: DriverDefs.DriverXmitStatus;
SELECT chStatus FROM
success => frameStatus ← goodCompletion;
aborted => frameStatus ← aborted;
ENDCASE => frameStatus ← hardwareProblem;
oisStatus ← LOOPHOLE[frameStatus, CARDINAL];
END;

PreemptedSending: PRIVATE PROCEDURE [buffer: BufferDefs.Buffer] =
-- called if channel ripped away due to preemption (by Channel Mgr)
BEGIN
networkUnavailableStatus: DriverDefs.DriverXmitStatus ← aborted;
buffer.status ← LOOPHOLE[networkUnavailableStatus, CARDINAL];
--we may not be a network driver if preemption reported in Receiver or StatusWait, but we can still return the buffer (Yogen says)
DriverDefs.PutOnGlobalDoneQueue[buffer];
END;

ForwardFrame: PROCEDURE [buffer: BufferDefs.Buffer]
RETURNS [PupTypes.PupErrorCode] =
-- reject forward attempt
BEGIN RETURN[gatewayResourceLimitsPupErrorCode]; END;
-- **************** Packet Transport / Receiving ****************

Receiver: PROCEDURE =
-- process that receives frames and notifies OIS
BEGIN

DoGet: PRIVATE PROCEDURE [
recHandle: RS232C.PhysicalRecordHandle, buffer: BufferDefs.Buffer]
RETURNS [preempted: BOOLEAN, complHandle: RS232C.CompletionHandle] =
-- perform the channel Get and watch for preemption
-- assumes record header and trailer nil
INLINE BEGIN
-- locals
preempted ← FALSE;
-- fill physical record (it is being reused)
-- clear encapsulation words ?????
recHandle.body ←
[blockPointer: @buffer.encapsulation + DriverTypes.phoneEncapsulationOffset,
startIndex: 0,
stopIndexPlusOne:
(buffer.length - DriverTypes.phoneEncapsulationOffset)*2];
-- perform receive
-- need more error handling here ????
complHandle ← RS232C.Get[
channelHandle, recHandle !
RS232C.ChannelSuspended =>
BEGIN
DriverDefs.ReturnFreeBuffer[buffer]; -- return unused buffer
preempted ← TRUE;
CONTINUE;
END];
END; -- DoGet

-- locals
recArray: ARRAY [0..outstandingGets) OF RS232C.PhysicalRecord ←
ALL[[[NIL, 0, 0], [NIL, 0, 0], [NIL, 0, 0]]];
bufferArray: ARRAY [0..outstandingGets) OF BufferDefs.Buffer ← ALL[NIL];
complArray: ARRAY [0..outstandingGets) OF RS232C.CompletionHandle;
preemptedArray: ARRAY [0..outstandingGets) OF BOOLEAN ← ALL[FALSE];
someoneGotPreempted: BOOLEAN ← FALSE;
desperatelyNeedABuffer: BOOLEAN ← FALSE;
nilBufCount, i: CARDINAL;
Process.SetPriority[3];
-- wait for dialing if necessary
WaitDialComplete[];
-- perform some Gets for multiple buffering
UNTIL (lineState = closed) OR (networkState = unavailable) OR
someoneGotPreempted DO
-- get frames, pass to OIS
nilBufCount ← 0;
FOR i IN [0..outstandingGets) DO
-- wait for a completion and give to Router or discard
IF bufferArray[i]#NIL THEN AwaitAndDisposeOfFrame[complArray[i], bufferArray[i]]
ELSE desperatelyNeedABuffer ← (nilBufCount ← nilBufCount + 1)>=outstandingGets;
-- get next buffer
IF (bufferArray[i] ← DriverDefs.GetInputBuffer[desperatelyNeedABuffer])#NIL THEN
BEGIN
desperatelyNeedABuffer ← FALSE; -- if we have one then OK
-- gets buffer.length (words) includes encaps.
-- perform next receive
[preemptedArray[i], complArray[i]] ← DoGet[@recArray[i], bufferArray[i]];
IF (someoneGotPreempted ← preemptedArray[i]) THEN EXIT;
END;
ENDLOOP;
ENDLOOP; -- of UNTIL
-- wait for Get completion of those not preempted
FOR i IN [0..outstandingGets) DO
IF (~preemptedArray[i]) AND (bufferArray[i]#NIL) THEN
AwaitAndDisposeOfFrame[complArray[i], bufferArray[i]];
ENDLOOP;
END;

AwaitAndDisposeOfFrame: PROCEDURE [
complHandle: RS232C.CompletionHandle, buffer: BufferDefs.Buffer] =
-- wait for get to complete and either hand to router or throw away
BEGIN
-- locals
transferStatus: RS232C.TransferStatus;
globalStatus: RS232C.DeviceStatus;
bytes: CARDINAL;
statsPtr: POINTER TO CARDINAL;
checksum: CARDINAL = 2;
-- wait for completion (no errors can occur here)
[bytes, transferStatus] ← RS232C.TransferWait[channelHandle, complHandle];
IF transferStatus = success THEN
BEGIN -- pass only good frames to Router
-- set byte count for consistency check in decapsulation
buffer.length ← bytes - checksum;
-- add network object to buffer
buffer.network ← phoneNetwork;
buffer.device ← phonenet;
-- check contents of header and trailer
currentPathSystemElement ← buffer.encapsulation.pnSrcID;
IF (duplexity = half) AND HalfDuplex.CheckForTurnAround[buffer] THEN
 BEGIN -- throw buffer away
 DriverDefs.ReturnFreeBuffer[buffer];
 RETURN;
 END;
-- notify OIS
DriverDefs.PutOnGlobalInputQueue[buffer];
-- stats
IF CommFlags.doStats THEN
 BEGIN
 StatIncr[@statsRec.pktsReceived];
 StatBump[@statsRec.bytesReceived, bytes - checksum];
 END;
END
ELSE
BEGIN -- bad frame => free the buffer
DriverDefs.ReturnFreeBuffer[buffer];
IF CommFlags.doStats AND (transferStatus # aborted) THEN
 BEGIN
 statsPtr ←
  SELECT transferStatus FROM
  dataLost => @statsRec.rcvErrorDataLost,
  checksumError => @statsRec.rcvErrorChecksum,
  frameTimeout => @statsRec.rcvErrorFrameTimeout,
  deviceError => @statsRec.rcvDeviceError,
  ENDCASE => @statsRec.rcvErrorUnknown;
 StatIncr[statsPtr];
 END;
IF transferStatus = deviceError THEN
 BEGIN
 globalStatus ← RS232C.GetStatus[channelHandle];
 IF globalStatus.dataLost THEN -- clear the data lost latch bit
  BEGIN
  RS232C.SetParameter[
  channelHandle, [latchBitClear[globalStatus]] !
  RS232C.ChannelSuspended => CONTINUE];
  IF CommFlags.doStats THEN StatIncr[@statsRec.rcvErrorNoGet];
  END;
 END;
END;
END;
-- **************** Driver Management (by Router) ****************

ActivateTransporter: PROCEDURE =
-- call from Router when we add ourselves as network driver
BEGIN
-- locals
END;

KillTransporter: PROCEDURE =
-- called by Router when we removed ourselves as a network driver
BEGIN
-- locals
END;

StatsNop: PROCEDURE [buffer: BufferDefs.PupBuffer, network: Network]
RETURNS [BOOLEAN] =
-- NOP
BEGIN
-- locals
RETURN[FALSE];
END;

InterruptNop: PROCEDURE =
-- NOP
BEGIN
-- locals

END;
-- **************** Connection Management ****************

CheckPath: PRIVATE PROCEDURE [systemElem: NSAddress.HostNumber]
RETURNS [outcome: CheckPathOutcome] =
-- create new path if necessary & auto-dial mode
BEGIN
-- locals
IF lineMode = directConn OR ~autoDial THEN RETURN[success];
IF lineState = closed THEN
BEGIN -- must create auto-dialed path
SELECT CreatePhonePath[systemElem] FROM
 success =>
  BEGIN currentPathSystemElement ← systemElem; RETURN[success]; END;
 noTranslation => RETURN[noTranslation];
 busyOrNoAnswer => RETURN[busyOrNoAnswer];
 dialerError => RETURN[dialerError];
 noDialer => RETURN[noDialer];
 ENDCASE => RETURN[dialerError];
END
ELSE
BEGIN -- check if same as previous or probing (uses broadcast processor ID)
IF systemElem = currentPathSystemElement OR systemElem =
 NSAddress.broadcastHostNumber --probing-- THEN RETURN[success]
ELSE RETURN[circuitInUse];
END;
END;

CreatePhonePath: PROCEDURE [systemElem: NSAddress.HostNumber]
RETURNS [outcome: CreatePhonePathOutcome] =
-- dial thru the auto-dial hardware
BEGIN
-- locals
commParamHandle: RS232CManager.CommParamHandle;
phoneNumber: STRING;
dialerZero: CARDINAL = 0;
-- get phone number, etc.
[commParamHandle, phoneNumber] ← PhoneNetwork.FindPhonePath[
systemElem ! PhoneNetwork.UnknownPath => GOTO noTranslation];
-- set params that may be different (ignore for now, use global ones)
-- dial it
dialing ← TRUE;
outcome ←
SELECT Dialup.Dial[dialerZero, phoneNumber, dialRetries] FROM
 success => success,
 failure => busyOrNoAnswer,
 dialerNotPresent => noDialer,
 ENDCASE => dialerError;
IF ~(outcome = success) THEN
IF CommFlags.doStats THEN StatIncr[@statsRec.dialError];
NotifyDialComplete[(outcome = success)];
RETURN[outcome];
EXITS noTranslation => RETURN[noTranslation];
END;

NotifyDialComplete: ENTRY PROCEDURE [successfulDial: BOOLEAN] =
-- tell Receiver that it can receive now (in case it was created because DSR came up)
BEGIN
dialing ← FALSE;
awaitingLineUpAfterDial ← successfulDial;
NOTIFY dialComplete;
END;

WaitDialComplete: ENTRY PROCEDURE =
-- wait for dialing and resetting of line params (if not RS366)
BEGIN ENABLE UNWIND => NULL;
UNTIL ~dialing DO WAIT dialComplete; ENDLOOP;
END;

StatusChangeWait: PRIVATE PROCEDURE =
-- a process to wait for an abnormal status change
-- this process must terminate if channel goes away
BEGIN
--locals
newStatus: RS232C.DeviceStatus;
BEGIN
DO
-- until channel is preempted
-- wait for complete connection (may be complete already)
newStatus ← RS232C.GetStatus[
 channelHandle ! RS232C.ChannelSuspended => GOTO preempted];
UNTIL newStatus.dataSetReady DO
 newStatus ← RS232C.StatusWait[
  channelHandle, newStatus ! RS232C.ChannelSuspended => GOTO preempted];
 ENDLOOP;
lineState ← active;
CreateSendReceiveProcesses[];
-- await line drop or preemption
UNTIL ProcessStatusChange[newStatus] = modemDown DO
 newStatus ← RS232C.StatusWait[
  channelHandle, newStatus ! RS232C.ChannelSuspended => GOTO preempted];
 ENDLOOP;
IF CommFlags.doStats THEN StatIncr[@statsRec.dsrDropped];
-- abort the channel to reach consistent state (make Receiver go away)
lineState ← closed;
RS232C.Suspend[channelHandle, input];
RS232C.Suspend[channelHandle, output];
RemoveSendReceiveProcesses[];
RS232C.Restart[channelHandle, input];
RS232C.Restart[channelHandle, output];
currentPathSystemElement ← NSAddress.nullProcessorID;
-- current guy is nobody

ENDLOOP;
EXITS preempted => BEGIN PreemptCleanup[]; RemoveSendReceiveProcesses[]; END;
END;
END;

ProcessStatusChange: PRIVATE ENTRY PROCEDURE [status: RS232C.DeviceStatus]
RETURNS [ConnectionStatus] =
-- check line status; determine if transient
BEGIN ENABLE UNWIND => NULL;
--locals
timeOut: CONDITION;
dsrRecovTimeInSecs: CARDINAL = 2; -- secs to wait for DataSetReady recovery
loopWait: CARDINAL ← 500; -- msecs between checking for DataSetReady
loopCount: CARDINAL ← dsrRecovTimeInSecs*1000/loopWait;
ourWaits: CARDINAL ← 0;
newStatus: RS232C.DeviceStatus;
-- check for lost line
IF ~status.dataSetReady THEN
BEGIN -- wait a reasonable time for it to come back without hogging
UNTIL ourWaits > loopCount DO
 Process.SetTimeout[@timeOut, Process.MsecToTicks[loopWait]];
 WAIT timeOut;
 newStatus ← RS232C.GetStatus[
  channelHandle ! RS232C.ChannelSuspended => GOTO fatalPlace];
 IF newStatus.dataSetReady THEN RETURN[successful];
 ourWaits ← ourWaits + 1;
 REPEAT fatalPlace => RETURN[channelPreempted];
 ENDLOOP;
RETURN[modemDown];
END
ELSE RETURN[successful];
END;

CreateSendReceiveProcesses: PROCEDURE =
-- start the receiver
BEGIN
phoneBufferAccessHandle ← BufferDefs.MakeBufferPool[outstandingGets+1];
awaitingLineUpAfterDial ← FALSE;
sendRecProcessesActive ← TRUE;
receiverProcess ← FORK Receiver;
senderProcess ← FORK Sender;
IF duplexity = half THEN
HalfDuplex.Initialize[channelHandle, modemSpeed, mySystemElement];
END;

RemoveSendReceiveProcesses: PROCEDURE =
-- bring back the receiver
BEGIN
IF sendRecProcessesActive THEN
BEGIN
sendRecProcessesActive ← FALSE;
NotifySenderToGoAway[];
IF duplexity = half THEN HalfDuplex.Destroy[];
JOIN receiverProcess;
JOIN senderProcess;
BufferDefs.FreeBufferPool[phoneBufferAccessHandle];
END;
END;

PreemptCleanup: ENTRY PROCEDURE =
-- called if channel ripped away due to preemption (by Channel Mgr)
BEGIN ENABLE UNWIND => NULL;
IF networkState = available THEN
BEGIN -- inform our cohorts
networkState ← unavailable; -- inform other processes
DriverDefs.RemoveDeviceFromChain[phoneNetwork];
END;
END;
-- **************** Statistics ****************

StatIncr: PROCEDURE [counter: POINTER TO CARDINAL] =
-- add one to counter
BEGIN
-- locals
counter^ ← (counter^ + 1) MOD (LAST[CARDINAL] - 1);
END;

StatBump: PROCEDURE [counter: POINTER TO CARDINAL, bumpAmount: CARDINAL] =
-- add bumpAmount to counter; if bumpAmount < 10000, there will never be overflow
BEGIN
-- locals
counter^ ← (counter^ + bumpAmount) MOD (LAST[CARDINAL] - 10000);
END;
-- **************** Main Program ****************

END.
Issues to address in future:
1. Don't hog the output buffers so other media drivers (especially Ethernets) get their share. Either drop packets on the floor or send back a flow control status to the router.
2. Keep the queue length for half duplex and for #1. Can use the MoreToSend packet-type to tell the other end to hurry with the line turn-around.

LOG
Time: August 2, 1978 10:04 AM By: Garlick Action: Created file
Time: January 22, 1980 1:29 PM By: Garlick Action: fixed CreatePhonePath to call RS232C.SetLineType after dialing.
Time: January 25, 1980 5:13 PM By: Garlick Action: fixed initialization of currentPathSystemElement in InitOisTransporter and StatusChangeWait.
Time: January 29, 1980 9:48 AM By: Garlick Action: made Receiver wait for dialing and all associated line resetting before performing Gets, since SetLineType does an implicit abort of the channel.
Time: January 29, 1980 11:49 AM By: Garlick Action: added padding of OISCP packet so that we always send integral words. This is a compatibility service (hack) provided by all drivers.
Time: January 30, 1980 6:27 PM By: Garlick Action: made changes for compatibility with new NSAddress, new RS232C and RS366, and new PhoneNetwork.
Time: March 17, 1980 9:28 AM By: Garlick Action: in CheckPath, allows a broadcastProcessorID at any time. Allows flexibility in our probe protocol.
Time: June 11, 1980 2:49 PM By: McJones Action: broadcastProcessorID=>broadcastHostNumber.
Time: July 2, 1980 12:01 PM By: Garlick Action: changed name of module to PhoneNetworkDriver.
Time: July 7, 1980 1:24 AM By: Garlick Action: made termination compatible with new RS232C changes.
Time: July 18, 1980 2:17 PM By: Garlick Action: added half-duplex support and a queued sending interface.
Time: August 5, 1980 6:39 PM By: Garlick Action: 1.) changed EnqueueSend to not report noRouteToNetwork when awaiting line up after a dial. 2.) made compatible with new PhoneNetwork (that uses HostNumbers). 3.) added a Destroy and renamed InitOisTransporter to be Initialize. Now we JOIN the StatusWait process.
Time: August 6, 1980 8:57 AM By: Garlick Action: No longer get a net number for a leased line; rather use OISCPTypes.unknownNetID. Use OISCPConstants.phoneNetID for the phone network number instead of 40B.
Time: August 11, 1980 3:18 PM By: Garlick Action: Changed order of JOINs and deleting HalfDuplex guy.
Time: September 15, 1980 9:26 AM By: Garlick Action: Implemented return of many new error codes to be returned when sending.
Time: September 18, 1980 5:17 PM By: BLyon Action: added buffers & spare to phoneNetObject.
Time: September 19, 1980 5:22 PM By: Garlick Action: fixed bugs in error codes. CircuitNotReady overriding other errors.
Time: October 12, 1980 9:18 PM By: Garlick Action: added implementtation of DriverDefs XmitStatus[noAnswerOrBusy].
Time: January 23, 1981 4:30 PM By: Garlick Action: added several UNWINDs to release monitors if errors arise.
Time: January 23, 1981 4:30 PM By: BLyon Action: re-wrote Receive and DoGet to take care of getting a NIL buffer.