unit Echo80Pmgr;

{**********************************************************}
{                                                          }
{ Development program for socket $80 protocol manager.     }
{ file : echo80pm.text                                     }
{ date : 19-August-1983  kb                                }
{                                                          }
{**********************************************************}
Interface

Uses
    {$U /CCOS/OS.GLOBALS} Globals,
    {$U       NETGLOBALS} NetGlobals;

Const
    {protocol ID}
    E80pid = $1C0;
    E80UserData = 256;

    {Dependent procedure's function codes}
    E80Drtry = 0;  {set send retry count}
    E80Dhost = 1;  {set send host number}
    E80Dcntr = 2;  {reset all counters}
    E80Dclra = 3;  {reset receive active}

    {Status procedure's function codes}
    E80Serrs = 0;  {return error counters}
    E80Smsgs = 1;  {return msg type counters}
    E80Sctrl = 2;  {return control parameters}

Type
    {Status procedure's error counters record}
    pE80SerCnt = ^E80SerCnt;
    E80SerCnt  =  record
                   SendErrs,
                   RecvErrs,
                   CntRetry,
                   BadFFFF,
                   BadMsgTypes: Longint;
                   end;

    {Status procedure's msg type counters record}
    pE80SmCnt = ^E80SmCnt;
    E80SmCnt  =  record
                   Send0000,
                   SendFFFF,
                   Recv0000,
                   RecvFFFF: Longint;
                   end;


    {Status procedure's control parameters record}
    pE80ScpCnt = ^E80ScpCnt;
    E80ScpCnt  =  record
                   ActiveRcv: Boolean;
                   SendHost : Byte;
                   RetryCont: Integer;
                   end;


{user interface code to pmgr}
procedure E80user(MType: Integer; pData: pBytes; DataLen,FncCode: Integer);

{init pmgr procedure - will be main code of pgm}
procedure E80init;
{$P}
Implementation

Const
    E80vers  = 0;  {version 0.1}
    E80level = 1;
    E80maxBuf = 264; {max buf size with protocol header}

    PMnoHOST = -1; {$FF - invalid omninet host number}

    MTeRqst =  0;  {msg type code for echo request}
    MTeRply = -1;  {msg type code for echo reply}

Type
    {protocol manager global variables}
    pE80gbl = ^E80gbl;
    E80gbl  =  record
                 RecvActive: Boolean;  {True means user tried receive}
                 SendHost  : Byte;     {host number to send to}
                 UserBfCtrl: pPMRcvBuf;{ptr to user buf ctl block}
                 UserMaxLen,           {max data length for receive}
                 SndRtryCnt: Integer;  {send retry count}
                 SendErrors,           {count of send errors}
                 RecvErrors,           {count of receive errors}
                 NmbrRtries,           {count of retries}
                 Sent0000,             {count of msgtype $0000 sent}
                 SentFFFF,             {count of msgtype $FFFF sent}
                 Rcvd0000,             {count of msgtype $0000 received}
                 RcvdFFFF,             {count of msgtype $FFFF received}
                 InvMsgType,           {cnt of msgs rcvd w/ unknown msg type}
                 BadCntFFFF: Longint;  {count of invalid $FFFF msgs rcvd}
                 SendResult: Integer;  {IOresult from send}
                 SendDone,             {send complete flag}
                 SendDque  : Boolean;  {send dequed}
                 ThisHost  : Byte;     {machine running this code host number}
                 end;

    pE80Buffer = ^E80Buffer;
    E80Buffer  =  record
                    case integer of
                      0: (a: array[1..E80maxBuf] of Byte);
                      1: (PID,
                          MsgType: Integer;
                          EchoSckt,
                          Source : Byte;
                          DataLen: Integer;
                          TheData: array[1..E80UserData] of Byte);
                    end;

{asm call via system vector to PD}
function xPDuser(ScktNmbr: TCsockets;   {socket number}
                 FncCode,               {function code}
                 PID,                   {protocol id  }
                 MaxBfSz : Integer;     {max buffer size}
                 Address : pE80Buffer;  {pointer to int rtn or buffer}
                 UserData: pE80gbl)     {user data = globals}
                                   : Integer;  {returns IOresult}
                 external;
{$P}
    function GetPMTentry(var lsyscom: pDEVDATA) : pPMTentry;
    {param will eventually be pointer to SysCom}
    Var
       pPMTbl: pPMtable;
       i: Integer;
       pp: pPMTentry;

    begin
    {get address of protocol mgr table from SysCom}
    lsyscom := pointer(pPMstuff); {return addr of syscom}
    pPMTbl := lsyscom^.pPMT;

    pp := Nil;  i := 1;
    while (i <= PMmaxents) AND (pp = Nil) do
       if (pPMTbl^[i].PMActive) AND (pPMTbl^[i].PMpid = E80pid) then
          pp := @pPMTbl^[i]
       else
          i := i + 1;

    GetPMTentry := pp;
    end; {GetPMTentry}

    procedure FillTCmd(var TC   : PDtrnpCMD;
                           pRslt: pPDresult;
                           pData: pE80Buffer;
                           DLen : Integer;
                           cmd,
                           host,
                           sckt : Byte);
    begin
    pRslt^.ResultCode := TRCwait;
    with TC do
      begin
      p.RP := pRslt;
      p.DP := @pData^;
      p.LN := DLen;
      p.HL := 0;     {$80 and $90 have no user control}
      p.Dest := host;
      a[crOPCD] := cmd;
      a[crSOCK] := sckt;
      end; {with}
    end;  {FillTCmd}

    procedure FillTPBlk(var TPB : PDtranpPB;
                        pTCmd   : pPDtrnpCMD;
                        pRtn    : pBytes;
                        pUD     : pE80gbl);
    begin
    with TPB do
      begin
      pComd :=  pTCmd;
      pProc :=  pRtn;
      pUser :=  ord4(pUD);
      end; {with}
    end;  {FillTPBlk}
{$P}
    procedure E80sndInt(Dque, Error: Integer;   {dequeue flag & err code}
                        RsltPtr: pPDresult;     {result array}
                        BufferPtr: pE80Buffer;  {data buffer}
                        pGbls: pE80gbl);        {user data= cntrl blk}

    {gets transporter driver send interrupt call}
    begin
    if (Dque <> 0) then   {deque operation}
       begin
       pGbls^.SendDque   := TRUE;  {show dequed}
       if (Error <> 0) then {if error then done}
          with pGbls^ do
            begin
            SendDone   := TRUE;
            SendResult := Error; {save error code}
            end; {with}
       {no error then operation continues}
       end {then}
    else
       with pGbls^ do {operation complete}
         begin
         SendDone   := TRUE;
         SendResult := 0;  {no driver error}
         end; {with}
    end; {E80sndInt}
{$P}
    function DoSend(pGbls: pE80gbl;              {global var ptr}
                    var SBuf: E80Buffer;         {send buffer}
                    Sendto,Socket: Byte):        {send host # & socket}
                                        Integer; {returns error code}
    Var
         TPB : PDtranpPB;    {transporter driver param block}
         TC  : PDtrnpCMD;    {transporter command block}
         Rslt: PDresult;     {transporter result record}
         ior: Integer;

    begin
    with pGbls^ do
      begin
      SendDque   := FALSE;
      SendDone   := FALSE;
      SendResult := 0;
      SBuf.Source := ThisHost;

      FillTCmd(TC,@Rslt,@SBuf,(SBuf.DataLen+8),TCsndOP,Socket,Sendto);
      FillTPBlk(TPB, @TC, @E80sndInt, pGbls);

      UnitStatus( 33, TPB, 0); {call transporter driver}
      ior := IOresult;

      if (ior = 30) then  {if queue warning wait until dqued}
         while (NOT SendDque) do ior := 0
      else
         SendDque := TRUE;

      if (ior = 0) then {if driver tried send then wait till done}
         begin
         while (NOT SendDone) do;
         DoSend := SendResult; {return result of operation}
         if (SendResult = 0) AND (Rslt.ResultCode < 0) then
            DoSend := Rslt.ResultCode; {if transporter failed report it}
         end
      else DoSend := ior; {else already done with error}
      end; {with}
    end; {DoSend}
{$P}
    procedure E80rcvInt(pE80glbls: pE80gbl; var BufCtl: BCentry);
    {gets protocol dispatcher receive interrupt call}
    Var
         pBuf: pE80Buffer;
         SBuf: E80Buffer;
         Sendto,Socket: Byte;
         i,Retry,Error: Integer;

         procedure MoveBuffer;
         {move data and protocol header from protocol}
         {dispatcher's buffer to local send buffer.  }
         {Release protocol dispatcher's buffer.      }
         Var
            i,ior: Integer;

         begin
         {move data from rcv buff to send buffer}
         for i := 1 to pBuf^.DataLen do
            SBuf.TheData[i] := pBuf^.TheData[i];

         Sendto := pBuf^.Source;       {get source host number}
         Socket := pBuf^.EchoSckt;     {get send to socket number]
         SBuf.DataLen := pBuf^.DataLen;{get data length}

         {Restor Buffer to protocol dispatcher}
         BufCtl.InUse := FALSE;          {mark buffer free}
         ior := xPDuser(Sckt80,          {uses socket $80}
                        PDFCrstr,        {restore buffer function}
                        E80pid,          {pid = $1C0}
                        0,               {parameter not used}
                        pBuf,            {buffer address}
                        Nil);            {parameter not used}
         end; {UseBuffer}

    begin  {E80rcvInt}
    with pE80glbls^ do
      begin
      pBuf := @BufCtl.BufferAdr^; {convert ptr to our buffer}
      if (pBuf^.MsgType = MTeRqst) then
         begin
         Rcvd0000 := Rcvd0000 + 1;
         MoveBuffer; {setup send buffer}
         SBuf.MsgType := MTeRply;   {echo back reply}
         SBuf.EchoSckt := 0;        {sending a reply}
         Retry := 0;
         repeat
           Retry := Retry + 1;
           Error := DoSend(pE80glbls,SBuf,Sendto,Socket);
           until( (Error = 0) OR (Retry > SndRtryCnt) );
         {if never get through then just give up}
         NmbrRtries := NmbrRtries + (Retry - 1);
         SentFFFF := SentFFFF + Retry;
         SendErrors := SendErrors + (Retry - 1);
         end {MTeRqst}

      else if (pBuf^.MsgType = MTeRply) then
         begin
         RcvdFFFF := RcvdFFFF + 1;
         MoveBuffer;
         if RecvActive then
            begin
            RecvActive := FALSE;
            with UserBfCtrl^ do
              begin
              ActualCnt := 0; i := 1;
              while ( (i <= UserMaxLen) AND (i <= SBuf.DataLen) ) do
                begin
                ActualCnt := ActualCnt + 1;
                pBuffer^[i] := SBuf.TheData[i];
                i := i + 1;
                end; {while}
              DataAvail := TRUE; {tell user data avail in buffer}
              end; {with}
            end {RecvActive}
         else BadCntFFFF := BadCntFFFF + 1; {no recv expected so Bad}
         end {MTeRply}

       else InvMsgType := InvMsgType + 1; {if wrong msg type then ignore}
      end; {with}
    end; {E80rcvInt}
{$P}
    procedure E80user{MType: Integer; pData: pBytes; DataLen,FncCode: Integer};
    {all parameters to procedure are used as globals to PM functions}
    Var
         pE80entry: pPMTentry;
         pE80glbls: pE80gbl;
         pb: ^Byte;
         lsyscom: pDEVDATA;  {temp for development- will be syscom ptr}

    function Attach: Integer;
    {global vars used :  E80user parameters, pE80entry}
    {                    and pE80glbls.               }

    begin
    {initialize global variables}
    fillchar(pE80glbls^,sizeof(E80gbl),chr(0)); {zero record}

    with pE80glbls^ do
       begin
       RecvActive := FALSE;
       SendHost   := PMnoHOST;
       SndRtryCnt := 1;
       {put host number of current machine in SysCom}
       {it is currently in Static Ram for Boot Proms}
       {CPtprnbr equ    RAMwksta+$00D   ;(70D-70D) OMNINET transporter number}
       pb := pointer($70D);
       ThisHost :=  pb^;
       end; {with}

    {Activate PIDtable entry in protocol dispatcher}
    Attach := xPDuser(Sckt80,          {uses socket $80}
                      PDFCactv,        {activate function}
                      E80pid,          {pid = $1C0}
                      E80maxBuf,       {max buffer len with header}
                      @E80rcvInt,      {interrupt routine}
                      pE80glbls);      {user data is ptr to globals}
    end; {Attach}

    function Detach: Integer;
    {global vars used :  E80user parameters, pE80entry}
    {                    and pE80glbls.               }
    begin
    {Deactivate PIDtable entry in protocol dispatcher}
    Detach := xPDuser(Sckt80,          {uses socket $80}
                      PDFCdact,        {deactivate function}
                      E80pid,          {pid = $1C0}
                      0,               {parameter not used}
                      Nil,             {parameter not used}
                      Nil);            {parameter not used}
    end; {Detach}
{$P}
    function Send: Integer;
    {global vars used :  E80user parameters, pE80entry}
    {                    and pE80glbls.               }
    begin
    end;

    function Receive: Integer;
    {global vars used :  E80user parameters, pE80entry}
    {                    and pE80glbls.               }
    begin
    end;
{$P}
    function Dependent: Integer;
    {global vars used :  E80user parameters, pE80entry}
    {                    and pE80glbls.               }
    Var
         fc: Integer;
         pi: ^Integer;

         procedure ResetCounters;
         {reset all global counters}
         begin
         with pE80glbls^ do
            begin
            SendErrors := 0;
            RecvErrors := 0;
            NmbrRtries := 0;
            Sent0000   := 0;
            SentFFFF   := 0;
            Rcvd0000   := 0;
            RcvdFFFF   := 0;
            InvMsgType := 0;
            BadCntFFFF := 0;
            end; {with}
         end; {ResetCounters}

    begin {Dependent}
    fc := MType;
    pi := @pData^;

    case fc of
      E80Drtry: pE80glbls^.SndRtryCnt := pi^;
      E80Dhost: begin
                if (pi^ >= 0) AND (pi^ <= 63) then
                   pE80glbls^.SendHost := pi^
                else
                   Dependent := 54; {IOEuiopm}
                end;
      E80Dcntr: ResetCounters;
      E80Dclra: pE80glbls^.RecvActive := FALSE;
      Otherwise: Dependent := 56; {IOEfnccd}
      end; {case}
    end; {Dependent}
{$P}
    function Status: Integer;
    {global vars used :  E80user parameters, pE80entry}
    {                    and pE80glbls.               }
    Var
         pErr : pE80SerCnt;
         pMsgs: pE80SmCnt;
         pCtrl: pE80ScpCnt;

    begin
    case MType of
      E80Serrs: begin
                pErr := @pData^;
                with pE80glbls^ do
                  begin
                  pErr^.SendErrs := SendErrors;
                  pErr^.RecvErrs := RecvErrors;
                  pErr^.BadMsgTypes := InvMsgType;
                  pErr^.CntRetry := NmbrRtries;
                  pErr^.BadFFFF  := BadCntFFFF;
                  end; {with}
                end;
      E80Smsgs: begin
                pMsgs := @pData^;
                with pE80glbls^ do
                  begin
                  pMsgs^.Send0000 := Sent0000;
                  pMsgs^.SendFFFF := SentFFFF;
                  pMsgs^.Recv0000 := Rcvd0000;
                  pMsgs^.RecvFFFF := RcvdFFFF;
                  end; {with}
                end;
      E80Sctrl: begin
                pCtrl := @pData^;
                with pE80glbls^ do
                  begin
                  pCtrl^.ActiveRcv := RecvActive;
                  pCtrl^.SendHost  := SendHost;
                  pCtrl^.RetryCont := SndRtryCnt;
                  end; {with}
                end;
      Otherwise: Status := 56; {IOEfnccd}
      end; {case}
    end; {Status}
{$P}
    begin {E80user}
    {get pointer to this pmgr's table entry}
    pE80entry := GetPMTentry(lsyscom);
    if (pE80entry = Nil) then
       begin
       lsyscom^.IOres := 50; {IOEtblid - no table entry}
       exit(E80user);
       end;

    {get pointer to global data}
    pE80glbls := @pE80entry^.PMpData^;
    if (pE80glbls = Nil) then
       begin
       lsyscom^.IOres := 3; {IOEioreq - no globals for pmgr}
       exit(E80user);
       end;

    case FncCode of
       PMFCatch: lsyscom^.IOres := Attach;
       PMFCdtch: lsyscom^.IOres := Detach;
       PMFCsend: lsyscom^.IOres := Send;
       PMFCrecv: lsyscom^.IOres := Receive;
       PMFCdpnd: lsyscom^.IOres := Dependent;
       PMFCstat: lsyscom^.IOres := Status;
       Otherwise:  begin
                   lsyscom^.IOres := 56; {IOEfnccd}
                   end;
       end; {case}
    end; {E80user}
{$P}
    procedure E80init;
    {this procedure will be the main line code of}
    {the protocol manager when pgm is built for  }
    {the real system.                            }
    Var
         pE80entry: pPMTentry;
         pE80glbls: pE80gbl;
         plo,phi: ^longint;
         l,lo: longint;
         lsyscom: pDEVDATA;  {temp for development- will be syscom ptr}

    begin
    {get pointer to this pmgr's table entry}
    pE80entry := GetPMTentry(lsyscom);
    if (pE80entry = Nil) then
       begin
       lsyscom^.IOres := 50; {IOEtblid - no table entry}
       exit(E80init);
       end;

    {allocate global space in driver area}
    plo := pointer($108); phi := pointer($10C);
    lo := plo^;
    l := sizeof(E80gbl);       {global area length}
    if odd(l) then l := l + 1; {make sure even number}

    {make sure enough room for data space}
    if ((lo + l) > phi^) then
       begin                 {not enough}
       pE80entry^.PMpData := Nil;
       lsyscom^.IOres := 69; {IOEbszerr - no room for data}
       exit(E80init);
       end;
    plo^ := lo + l; {save new top of driver address}

    {save addr of globals}
    pE80glbls := pointer(lo);

    with pE80entry^ do {initialize entry}
       begin
       PMpData := pointer(lo);  {global data pointer}
       PMVersion[0] := E80vers; {version word}
       PMVersion[1] := E80level;
       PMproc := @E80user;      {procedure pointer}
       end; {with}
    end; {E80init}

end.  {Echo80Pmgr}
