Power-Programmierung/CD1.mdf/pascal/library/dos/oasis/prog/pollsel.inc

Text File | 1987-03-28 | 10.4 KB | 274 lines

{--------------------------------------------------------------
These routines can be used to emulate a terminal in a
Poll Select (multipoint) environment.
---------------------------------------------------------------}
const
  tx_buffers  = 4;   {nr of xmit buffers; minimum = 1}
  rx_buffers  = 4;   {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:string255;
  cont_string:string255;
  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;