{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                  串行通讯支持单元                       ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FCommu;
Interface
Uses
  Dos,Crt;

Const
  {Port Code}
  sioCOM1         = $0000;
  sioCOM2         = $0001;
  sioCOM3         = $0002;
  sioCOM4         = $0003;

  {Register Delta Addr}
  sioDATA         = 0;   { data register                    }
  sioBAUDL        = 0;   { baud rate divisor (LSB)          }
  sioIER          = 1;   { Interrupt Enable Register        }
  sioBAUDH        = 1;   { baud rate divisor (MSB)          }
  sioIIR          = 2;   { Interrupt Identification Register}
  sioLCR          = 3;   { Line Control Register            }
  sioMCR          = 4;   { Modem Control Register           }
  sioLSR          = 5;   { Line Status Register             }
  sioMSR          = 6;   { Modem Status Register            }

  {Modem Status Code}
  sioDCD          = $80;
  sioRI           = $40;
  sioDSR          = $20;
  sioCTS          = $10;
  sioDeltaDCD     = $08;
  sioDeltaRI      = $04;
  sioDeltaDSR     = $02;
  sioDeltaCTS     = $01;

  {Parity Code}
  sioNoParity     = 0;
  sioOddParity    = 1;
  sioEvenParity   = 3;
  sioMarkParity   = 5;
  sioSpaceParity  = 7;

  {Stop Bits Code}
  sioOneStopBit   = 0;
  sioTwoStopBits  = 1;

  {Code Bits Code}
  sioCodeLength5  = 0;
  sioCodeLength6  = 1;
  sioCodeLength7  = 2;
  sioCodeLength8  = 3;

  {Line Status Code}
  sioTransEmpty   = $20;
  sioBreakDetect  = $10;
  sioFramingError = $08;
  sioParityError  = $04;
  sioOverrunError = $02;
  sioDataReady    = $01;


Const
  dfBufLen:Word       = 10000;
  dfSendBufLen:Word   = 1000;
  dfBaud:Longint      = 1200;
  dfDataBits:Integer  = 7;
  dfStopBits:Integer  = 1;
  dfParity:Char       = 'N';
  dfComPort:Integer   = 1;
  dfExecOldInt:Boolean= True;
  ComIndex:Integer    = 1;
  SioBasePort:array[1..4] of Integer = ($3F8,$2F8,$2E8,$2E8);

Var
  AsyncVector:Pointer;
  CharsInBuf,CircIn,CircOut:Word;
  SendCharsInBuf,SendIn,SendOut:Word;

Procedure ClearReceiveBuffer;
Procedure ClearSendBuffer;
Procedure InitSerialPort(BPS:Longint;StopBits,DataBits:Integer;Parity:Char);
Procedure DoneSerialPort;
Procedure EnableSerialInt;
Procedure DisableSerialInt;
Function  InitBuffer:Boolean;
Procedure DoneBuffer;
Function  GetCharInBuf:Byte;
Function  CarrierDetected:Boolean;
Function  SendCharToBuf(Ch:Byte):Boolean;
Procedure SendChar(B:Byte);
Procedure SendString(S:string);
Procedure SendByte;
Function  GetChar:Byte;
Function  GetModemStatus:Byte;
Function  GetComAddr(Com:Integer):Word;

Implementation
Type
  BufferType=array[1..1] of Byte;

Const
  IerSR    = $03;
  IntCtrl  = $21;

Const
  ComIntNum:array[1..4] of Integer=($0C,$0B,$0C,$0B);
  ComInitFlag:Boolean=False;
  ComPortIntFlag:Boolean=False;

Var
  R:Registers;
  ReceiveBuffer,SendBuffer:^BufferType;
  OldIntCtrl:Byte;
  OldDLL,OldDLM:Byte;
  OldIER:Byte;
  OldMCR:Byte;
  OldLCR:Byte;

Procedure  CallOldInt(Sub:Pointer);
begin
  inline($9C/
         $FF/$5E/$06);
end;

Procedure ClearReceiveBuffer;
begin
  CircIn:=1;
  CircOut:=1;
  CharsInBuf:=0;
end;

Procedure ClearSendBuffer;
begin
  SendIn:=1;
  SendOut:=1;
  SendCharsInBuf:=0;
end;

Function SendCharToBuf(Ch:Byte):Boolean;
begin
  SendCharToBuf:=False;
  if SendCharsInBuf<dfSendBufLen then
  begin
    SendCharToBuf:=True;
    SendBuffer^[SendOut]:=Ch;
    Inc(SendCharsInBuf);
    if SendOut=dfSendBufLen then
      SendOut:=1
    else
      Inc(SendOut);
  end;
end;

Function Wait: Boolean;
var
  Ch:Char;
begin
  Wait:=False;
  if KeyPressed then
  begin
    Ch:=ReadKey;
    if Ch=#27 then Wait:=True
    else if Ch=#0 then Ch:=ReadKey;
  end;
end;

Procedure AsyncInt;Interrupt;
var
  TempIIR:Byte;
begin
  TempIIR:=Port[SioBasePort[ComIndex]+sioIIR];
  if (TempIIR and $07)=$04 then
  begin
   if (CharsInBuf<dfBufLen) then
   begin
     ReceiveBuffer^[CircIn]:=Port[SioBasePort[ComIndex]];
     if (CircIn<dfBufLen) then
       inc(CircIn)
     else
       CircIn:=1;
     inc(CharsInBuf);
   end
  end else
  if (TempIIR and $07)=$02 then
  begin
   if (SendCharsInBuf>0) then
   begin
     Port[SioBasePort[ComIndex]]:=SendBuffer^[SendIn];
     if (SendIn<dfSendBufLen) then
       inc(SendIn)
     else
       SendIn:=1;
     dec(SendCharsInBuf);
   end;
  end;
  if dfExecOldInt then
    CallOldInt(AsyncVector);
  Port[$20]:=$20;
end;

Procedure InitSerialPort(BPS:Longint;StopBits,DataBits:Integer;Parity:char);
var
  Temp:Byte;
  BPSDiv:Word;
begin
  if ComInitFlag then Exit;
  ComIndex:=dfComPort;
  OldLCR:=Port[SioBasePort[ComIndex]+sioLCR];
  Port[SioBasePort[ComIndex]+sioLCR]:=Port[SioBasePort[ComIndex]+sioLCR] or $80;
  OldDLM:=Port[SioBasePort[ComIndex]+sioBAUDH];
  OldDLL:=Port[SioBasePort[ComIndex]+sioBAUDL];
  BPSDiv:=Word(115200 div BPS);
  Port[SioBasePort[ComIndex]+sioBAUDH]:=Hi(BPSDiv);
  Port[SioBasePort[ComIndex]+sioBAUDL]:=Lo(BPSDiv);
  Temp:=((StopBits-1) shl 2) + (DataBits-5);
  case Parity of
  'E':Inc(Temp,24);
  'O':Inc(Temp,8);
  end;
  Port[SioBasePort[ComIndex]+sioLCR]:=Temp;
  ComInitFlag:=True;
end;

Procedure DoneSerialPort;
begin
  if not ComInitFlag then Exit;
  Port[SioBasePort[ComIndex]+sioLCR]:=Port[SioBasePort[ComIndex]+sioLCR] or $80;
  Port[SioBasePort[ComIndex]+sioBAUDH]:=OldDLM;
  Port[SioBasePort[ComIndex]+sioBAUDL]:=OldDLL;
  Port[SioBasePort[ComIndex]+sioLCR]:=OldLCR;
  ComInitFlag:=False;
end;

Function InitBuffer:Boolean;
begin
  GetMem(ReceiveBuffer,dfBufLen);
  GetMem(SendBuffer,dfSendBufLen);
  InitBuffer:=(ReceiveBuffer<>nil) and (SendBuffer<>nil);
end;

Procedure DoneBuffer;
begin
  if ReceiveBuffer<>nil then
    FreeMem(ReceiveBuffer,dfBufLen);
  if SendBuffer<>nil then
    FreeMem(SendBuffer,dfSendBufLen);
  ReceiveBuffer:=nil;
  SendBuffer:=nil;
end;

Procedure EnableSerialInt;
var
  B:Byte;
begin
  if ComPortIntFlag then Exit;
  InitBuffer;
  GetIntVec(ComIntNum[ComIndex],AsyncVector);
  SetIntVec(ComIntNum[ComIndex],@AsyncInt);
  OldIntCtrl:=Port[IntCtrl];
  OldIER:=Port[SioBasePort[ComIndex]+sioIER];
  OldMCR:=Port[SioBasePort[ComIndex]+sioMCR];
  B:=OldIntCtrl;
  if Odd(ComIndex) then
    B:=B and $0EF
  else
    B:=B and $0F7;
  Port[IntCtrl]:=B;
  Port[SioBasePort[ComIndex]+sioLCR]:=Port[SioBasePort[ComIndex]+sioLCR] and $7F;
  Port[SioBasePort[ComIndex]+sioIER]:=IerSR;
  Port[SioBasePort[ComIndex]+sioMCR]:=$0B;
  B:=Port[SioBasePort[ComIndex]+sioIIR];
  ComPortIntFlag:=True;
end;

Procedure DisableSerialInt;
var
  B:Byte;
begin
  if not ComPortIntFlag then Exit;
  Port[IntCtrl]:=OldIntCtrl;
  Port[SioBasePort[ComIndex]+sioLCR]:=Port[SioBasePort[ComIndex]+sioLCR] and $7F;
  Port[SioBasePort[ComIndex]+sioIER]:=OldIER;
  Port[SioBasePort[ComIndex]+sioMCR]:=OldMCR;
  SetIntVec(ComIntNum[ComIndex],AsyncVector);
  B:=Port[SioBasePort[ComIndex]+sioIIR];
  DoneBuffer;
  ComPortIntFlag:=False;
end;

Function GetCharInBuf:Byte;
begin
  if CharsInBuf>0 then
  begin
    GetCharInBuf:=ReceiveBuffer^[CircOut];
    if CircOut<dfBufLen then
      inc(CircOut)
    else
      CircOut:=1;
    dec(CharsInBuf);
  end;
end;

Function CarrierDetected:Boolean;
var
  Ch:Char;
  Timer:Integer;
begin
  CarrierDetected:=False;
  Timer:=40;
  while (Port[SioBasePort[ComIndex]+sioMSR] and $80)<>$80 do
  begin
    if Wait then Exit;
    if (CharsInBuf>0) then
    begin
      Ch:=Char(GetCharInBuf);
      Write(Ch);
    end;
    if Timer=0 then
      Exit
    else
    begin
      Dec(Timer);
      Delay(1000);
    end;
  end;
  CarrierDetected:=True;
end;

Procedure SendChar(B:Byte);
begin
  while ((Port[SioBasePort[ComIndex]+sioLSR] and $60)<>$60) do
  begin
    if Wait then Exit;
  end;
  Port[SioBasePort[ComIndex]]:=B;
end;

Procedure SendString(s:string);
var
  i:integer;
begin
  for i:=1 to length(s) do
    SendChar(ord(s[i]));
end;

Procedure SendByte;
begin
  if (SendCharsInBuf>0) then
  begin
    while ((Port[SioBasePort[ComIndex]+sioLSR] and $60)<>$60) do
    begin
      if wait then exit;
    end;
    Port[SioBasePort[ComIndex]]:=SendBuffer^[SendIn];
    if (SendIn<dfSendBufLen) then
      inc(SendIn)
    else
      SendIn:=1;
    dec(SendCharsInBuf);
  end;
end;

Function GetChar:Byte;
begin
  if ((Port[SioBasePort[ComIndex]+sioLSR] and $01)=$01) then
    GetChar:=Port[SioBasePort[ComIndex]]
  else
    GetChar:=0;
end;

Function GetModemStatus:Byte;
begin
  GetModemStatus:=Port[SioBasePort[ComIndex]+sioMSR];
end;

Function GetComAddr(Com:Integer):Word;
begin
  GetComAddr:=MemW[$0000:($0400+(Com-1) shl 1)];
end;

end.