Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/OASSAM41.ZIP/SAMPLE8.PAS

Pascal/Delphi Source File | 1988-03-27 | 12.8 KB | 360 lines

PROGRAM Term_Emulator; {a skeleton of a terminal emulator}
{$R-,S+,I+,D+,T-,F-,V-,B-,N-,L+ }
{$M 16384,0,655360 }

uses scl;    {invoke SCL}

{--------------------------------------------------------------
The following routines handle the  poll select  protocoll
---------------------------------------------------------------}
CONST
  Tx_Buffers  = 1;   {nr of xmit buffers; minimum = 1}
  Rx_Buffers  = 1;   {nr of receive buffers; minimum = 1}
  Dc_Addr_1 : Byte = $33;  {first byte of terminal address}
  Dc_Addr_2 : Byte = $31;  {second byte of terminal address}

TYPE
  Buffer_Data = ARRAY[1..Dc_Buffer_Size] OF Byte;
  Buffer_Type = RECORD     {description of rx and tx buffers}
                  Len :INTEGER;  {length of data in buffer}
                  Data:Buffer_Data;
                END;
  Rx_Buffer_Type= ARRAY[0..Rx_Buffers] OF Buffer_Type;
  Tx_Buffer_Type= ARRAY[0..Tx_Buffers] OF Buffer_Type;

VAR
  Rx_Buffer_Overflow:BOOLEAN;   {rx data > buffersize}
  Rx_Buffer:Rx_Buffer_Type;
  Tx_Buffer:Tx_Buffer_Type;
  Result_Ok:BOOLEAN;
  Ch_Code:INTEGER;
  State:INTEGER;    {used in poll select state machine}
  Rx_Buff_Wptr,     {rx buffer to be filled next}
  Rx_Buff_Rptr,     {rx buffer to be read next}
  Tx_Buff_Wptr,     {tx buffer to be sent last}
  Tx_Buff_Rptr   : INTEGER;  {tx buffer to be sent first}
  This_Char_Done:BOOLEAN;    {used in poll select state machine}
  Dc_Msg_Header:String;
  Cont_String:String;
  Char_Ind:INTEGER;
  Ok : BOOLEAN;
  Head_Bcc:INTEGER;

PROCEDURE Ps_Handler;       {poll select state machine. run as }
  BEGIN;                    {background task}
    IF This_Char_Done THEN  {previous character finished}
      Receive_Char(Ch_Code,Ok); {get next char from dc rx buffer}
      IF Ok THEN                {there was a character}
      BEGIN;
        This_Char_Done:=TRUE;   {preset}
        CASE State OF
        0:IF Ch_Code = Eot THEN State:=1;  {eot received}
        1:IF Ch_Code = Dc_Addr_1 THEN    {first byte of address}
            State:=2                     {wait for second byte}
          ELSE
            State:=0;                   {reset state machine}
        2:IF Ch_Code = Dc_Addr_2 THEN   {second byte of address}
            State:=3                    {wait for cntrl char}
          ELSE State:=0;                {reset state machine}
        3:IF Ch_Code = Pol THEN State:=4 ELSE {poll string}
          IF Ch_Code = Sel THEN State:=7 ELSE {select string}
          IF Ch_Code = Fsl THEN State:=15 ELSE {fast sel}
            State:=0;       {otherwise reset state machine}
        4:IF Ch_Code = Enq THEN   {end of string}
            BEGIN;
              This_Char_Done:=FALSE;  {dont read next char}
              State:=5                {next is state = 5}
            END
          ELSE
            State:=0;                 {reset state machine}
        5:IF Tx_Buffer[Tx_Buff_Rptr].Len = 0 THEN
            BEGIN;                    {no data to send}
              Send_Char(Eot,Ok);      {send eot}
              State:=0;       {..and reset state machine}
            END
          ELSE               {there is data to be sent}
            BEGIN;           {send it with header and bcc}
              Send_Buffer(Tx_Buffer[Tx_Buff_Rptr].Data,
                          1,Tx_Buffer[Tx_Buff_Rptr].Len,Head_Bcc,
                          Dc_Msg_Header,Ok);
              IF Ok THEN     {successfully sent}
                State:=6     {wait for ack}
              ELSE
                State:=0;    {otherwise reset state machine}
            END;
        6:BEGIN;
            IF Ch_Code = Ack THEN  {ack received}
              BEGIN;
                Send_Char(Eot,Ok); {send eot}
                IF Ok THEN         {successfully sent}
                  BEGIN;    {clear buffer & increase pointer}
                    Tx_Buffer[Tx_Buff_Rptr].Len:=0;
                    Tx_Buff_Rptr:=SUCC(Tx_Buff_Rptr) MOD Tx_Buffers;
                  END;
                State:=0;      {reset state machine}
              END
            ELSE
            IF Ch_Code = Nak THEN {mainframe didnt receive ok}
              BEGIN;              {resend data}
                This_Char_Done:=FALSE;
                State:=5;
              END
            ELSE                  {mainframe did not respond}
              State:=0;           {reset state machine}
          END;
        7: IF Ch_Code = Enq THEN  {end of sel string}
            BEGIN;
              This_Char_Done:=FALSE; {dont receive next char}
              State:=8;              {answer}
            END
          ELSE
            State:=0;                {reset state machine}
       8: IF Rx_Buffer[Rx_Buff_Wptr].Len > 0 THEN
            BEGIN;         {we have no rx buffer available}
              Send_Char(Nak,Ok);     {send nak}
              State:=0;              {reset state machine}
            END
          ELSE        {we can receive data}
            BEGIN;
              Send_Char(Ack,Ok);  {send ack}
              IF Ok THEN State:=9 ELSE   {ack could be sent}
                State:=0;  {otherwise reset state machine}
            END;
       9: IF Ch_Code = Soh THEN
            State:=10      {SOH received}
          ELSE State:=0;
      10: IF Ch_Code = Dc_Addr_1 THEN  {first byte of address}
            State:=11
          ELSE State:=0;
      11: IF Ch_Code = Dc_Addr_2 THEN
            State:=12  {second byte of address received}
          ELSE State:=0;
      12: BEGIN;
            IF Ch_Code = Stx THEN    {stx received}
              BEGIN;
                Bcc:=Stx XOr Head_Bcc; {start bcc calculation}
                Char_Ind:=1;       {init rx buffer}
                State:=13;         {rx data}
              END
            ELSE
              State:=0;            {reset state machine}
          END;
      13: BEGIN;    {receive data & write into rx buffer}
            IF (Char_Ind < Dc_Buffer_Size) AND (Ch_Code <> Etx) THEN
              BEGIN; {buffer not full and not etx received}
                Rx_Buffer[Rx_Buff_Wptr].Data[Char_Ind]:=Ch_Code;
                Bcc:=Bcc XOr Ch_Code; {bcc calculation}
                Char_Ind:=SUCC(Char_Ind); {increase buffer index}
              END
            ELSE
            IF Ch_Code = Etx THEN  {etx received}
              BEGIN;
                Bcc:=Bcc XOr Etx;  {get final bcc}
                Rx_Buffer[Rx_Buff_Wptr].Len:=Char_Ind - 1;
                State:=14;
              END
            ELSE          {rx buffer overflow}
              BEGIN;
                State:=0; {reset state machine}
                Rx_Buffer_Overflow:=TRUE; {set flag}
              END;
          END;
      14: BEGIN;
            IF Ch_Code = Bcc THEN  {received = calculated bcc}
              BEGIN;
                Send_Char(Ack,Ok); {send an ACK}
                IF Ok THEN {successfully sent, next rx buffer}
                  Rx_Buff_Wptr:=SUCC(Rx_Buff_Wptr) MOD Rx_Buffers
                ELSE
                  Rx_Buffer[Rx_Buff_Wptr].Len:=0;{forget rx data}
              END
            ELSE                    {bcc error}
              BEGIN;
                Rx_Buffer[Rx_Buff_Wptr].Len:=0;{forget rx data}
                Send_Char(Nak,Ok); {send nak}
              END;
            State:=0;     {reset state machine}
          END;
      15: IF Ch_Code = Soh THEN State:=16 ELSE State:=0; {FSL}
      16: IF Ch_Code = Dc_Addr_1 THEN State:=17 ELSE State:=0;
      17: IF Ch_Code = Dc_Addr_2 THEN State:=18 ELSE State:=0;
      18: BEGIN;
            IF Ch_Code = Stx THEN  {stx received}
              BEGIN;
                IF Rx_Buffer[Rx_Buff_Wptr].Len > 0 THEN
                  State:=0    {no rx buffer available}
                ELSE
                  BEGIN;      {start bcc calculation}
                    Bcc:=Stx XOr Head_Bcc;
                    Char_Ind:=1; {init buff index}
                    State:=13;   {wait for rx data}
                  END;
              END
            ELSE
              State:=0;      {reset state machine}
          END;
       ELSE State:=0;  {reset state machine}
      END; {end case}
      IF Ch_Code = Eot THEN State:=1; {preset state machine}
    END;
  END;


PROCEDURE Clear_Rx_Buffers;  {clear all rx buffers}
VAR
  X:INTEGER;
BEGIN;
  FOR X:=0 TO Rx_Buffers DO
    Rx_Buffer[X].Len:=0;    {set length to 0}
  Rx_Buff_Wptr:=0;          {both pointers to 0}
  Rx_Buff_Rptr:=0;
END;

PROCEDURE Clear_Tx_Buffers; {clear all xmit buffers}
VAR
  X:INTEGER;
BEGIN;
  FOR X:=0 TO Tx_Buffers DO
    Tx_Buffer[X].Len:=0;   {set length to 0}
  Tx_Buff_Wptr:=0;         {set both pointers to 0}
  Tx_Buff_Rptr:=0;
END;


PROCEDURE Init_Ps;         {init poll select system}
VAR
  Stat:INTEGER;
BEGIN;
  Rx_Buffer_Overflow:=FALSE;
  Cont_String:=CHR(Dc_Addr_1) + CHR(Dc_Addr_2)
              + CHR(Pol) + CHR(Enq);  {set up contention string}
  Dc_Msg_Header:=CHR(Soh)+CHR(Dc_Addr_1)+CHR(Dc_Addr_2); {header}
  Head_Bcc:=Dc_Addr_1 XOr Dc_Addr_2;  {calculate bcc for header}
  State:=0;             {reset state machine}
  Clear_Rx_Buffers;     {clear rx buffers}
  Clear_Tx_Buffers;     {clear tx buffers}
  This_Char_Done:=TRUE;
  Open_Dc(Stat);        {open datacom & install ISR}
  Send_String(Cont_String,Result_Ok); {send contention string}
END;

FUNCTION Data_Received:BOOLEAN;  {returns true if at least one }
BEGIN;         {of the rx buffers contains data}
  Data_Received:= Rx_Buffer[Rx_Buff_Rptr].Len > 0;
END;

FUNCTION Dc_Write_Ok:BOOLEAN;  {returns true if at least one}
BEGIN;            {of the tx buffers is available}
  Dc_Write_Ok:=Tx_Buffer[Tx_Buff_Wptr].Len = 0;
END;


PROCEDURE  Read_Dc(VAR Data;VAR Len:INTEGER;VAR Ok:BOOLEAN);
BEGIN;  {call this routine to obtain data received from Mainframe}
  IF Data_Received THEN {one of the rx buffers contains data}
    BEGIN;              {return it}
      Len:=Rx_Buffer[Rx_Buff_Rptr].Len;
      Move(Rx_Buffer[Rx_Buff_Rptr].Data,Data,Len);
      Rx_Buffer[Rx_Buff_Rptr].Len:=0; {clear this buffer}
      Rx_Buff_Rptr:=SUCC(Rx_Buff_Rptr) MOD Rx_Buffers; {incr pointer}
      Ok:=TRUE;
    END
  ELSE
    Ok:=FALSE;       {no rx data available}
END;

PROCEDURE  Write_Dc(VAR Buff; Len:INTEGER;VAR Ok:BOOLEAN);
BEGIN;  {call this routine to send data to mainframe}
  IF Dc_Write_Ok THEN  {tx buffer available}
    BEGIN;
      Move(Buff,Tx_Buffer[Tx_Buff_Wptr].Data,SIZEOF(Buff));
      Tx_Buffer[Tx_Buff_Wptr].Len:=Len;
      Tx_Buff_Wptr:=SUCC(Tx_Buff_Wptr) MOD Tx_Buffers;
      Ok:=TRUE;
    END
  ELSE
    Ok:=FALSE;        {no tx buffer available}
END;

{-----------------------------------------------------------}
{end of poll select routines.}
{-----------------------------------------------------------}
{$F+} {Set Far calls;required for SCL background tasks}

PROCEDURE Lp_Background_Task;
VAR
  Mybuffer:ARRAY[0..Dc_Buffer_Size] OF Byte;
  Rx_Len  :INTEGER;
  Ok      :BOOLEAN;
  I       :INTEGER;
  Mystring:String80;
BEGIN;
  Read_Dc(Mybuffer,Rx_Len,Ok);
  IF Ok THEN                     {something has been received}
    BEGIN;
      IF Rx_Len > 78 THEN Rx_Len:=78; {max length = 78 chars}
      FOR I:=0 TO Rx_Len-1 DO         {to display in field}
        Mystring[I+1]:=CHR(Mybuffer[I]);  {convert to string}
      Mystring[0]:=CHR(Rx_Len);
      W_Cont(2,Mystring);         {display in field 2}
    END;
END;

PROCEDURE Hp_Background_Task;
BEGIN;
  REPEAT Ps_Handler UNTIL NOT Ok;   {Call poll select handler}
END;

{$F-} {Reset Far Calls}



PROCEDURE Write_To_Mainframe(VAR Mystring:String;VAR Ok:BOOLEAN);
VAR
  Mybuffer: ARRAY[0..Dc_Buffer_Size] OF Byte;
  Mylen    : INTEGER;
  I        : INTEGER;
BEGIN;
  Mylen:=LENGTH(Mystring);            {convert string to array}
  FOR I:=0 TO Mylen DO
    Mybuffer[I]:=ORD(Mystring[I+1]);
  Write_Dc(Mybuffer,Mylen,Ok);        {place it into tx buffer}
END;

PROCEDURE Do_Dialog;
VAR
  Wrkstr:String80;
BEGIN;
  Select_Format('dialog');
  Display_Format(0,0);
  REPEAT
    Handle_Format;
    IF End_Of_Field THEN
      BEGIN;
        C_Cont(2);                    {clear field 2}
        Wrkstr:=G_Cont(1);
        IF LENGTH(Wrkstr) > 0 THEN
          BEGIN;
            Write_To_Mainframe(Wrkstr,Ok);
            IF NOT Ok THEN
              Glb_Error:=40
            ELSE
              BEGIN;
                Char_Code:=Code_Noop; {don't terminate format}
                Goto_Field(1);
              END;
          END;
      END;
  UNTIL Format_Done;                 {in this case f10 pressed}
END;

BEGIN; {of main}
  Select_Format_File('sample8');
  LP_background_pointer:=@LP_background_task; {invoke our background tasks}
  HP_background_pointer:=@HP_background_task;
  Init_Ps; {initialize the poll select system; calls also 'Open_DC'}
  Do_Dialog;
  Close_Dc;  {stop datacom subsystem and deinstall ISR}
  Close_Formats;
END.  {of main}