Newsgroup: it.comp.lang.pascal
Titolo: Porta seriale

Buondģ news!
Avrei bisogno del vostro illustre aiuto.
Come funziona la gestione della porta seriale?
Ho imparato ad usare la parallela, facile facile dal mio
bel libro di elettronica delle superiori. perņ delle seriali
non dice niente. Sapete niente? Magari anche qualche sito...
Thanks. Illustri saluti, Augusto

Questo lo usavo alle superiori.
Ciauz
program TERMINAL;
{
************************************************************************** }
{
         }
{ Turbo Pascal 7.0 Demo
         }
{ Version
     }
{ Written 1995 by Stephan A.
       }
{ Copyright (c) 1995 by Stephan A.
       }
{ Internet:
                      }
{ For any questions, please mail to 
sup...@maciej.muc.de
  }
{ WWW:
                            }
{
************************************************************************** }
{ This program is for demonstration purpose only. Any commercial use
th-   }
{ out the written permission of the author is illegal. Please report
gs,   }
{ corrections or any other ideas to 
ste...@maciej.muc.de
. You are
lowed   }
{ to distribute this program as often as you want as long as you do
    }
{ change it or edit it anyway. The author is not responsible for any
amage  }
{ or destruction caused - directly or indirectly - by this
         }
{
************************************************************************** }
const
  TxDataReg = 0;                { transmitter data register            }
  RxDataReg = 0;                { reciever data register               }
  DivLow = 0;                   { divisor latch, low byte              }
  DivHigh = 1;                  { divisor latch, high byte             }
  IntrEnable = 1;               { interrupt enable register            }
  IntrId = 2;                   { interrupt identification register    }
  FifoCtrl = 2;                 { first-in/first-out buffer controller }
  LineCtrl = 3;                 { line controll register               }
  ModemCtrl = 4;                { modem controll register              }
  LineStatus = 5;               { line status register                 }
  ModemStatus = 6;              { modem status register                }
  ScratchReg = 7;               { scratch pad (free useable)           }
const
  QueueLen = 1024;              { Length of a queue in bytes }
type
  { The TQueue type }
  TQueue = record
    Content: array[0..QueueLen - 1] of byte;
    Start: word;
    Stop: word;
    end;
type
  { The TQuadString type }
  TQuadString = string[4];      { For the Hex-function }
var
  { The two queues, one for incoming characters, the other for }
  { outgoing characters.                                       }
  InQueue: TQueue;              { The two queues: one for input buffering, }
  OutQueue: TQueue;             { the other for output buffering           }
const
  SpeedCount = 19;              { Number of valid speeds stored below }
const
  AllowedSpeeds: array[0..SpeedCount] of longint =
    (    50,      75,    110,    150,    300,    600,     900,    1200,
       1800,    2400,   3600,   4800,   7200,   9600,   14400,   19200,
      28800,   38400,  57600, 115200);
    { Just add any other speeds supported by your UART/Modem - don't }
    { forget to increase the SpeedCount                              }
var
  { Some global variables... }
  PortNr: byte;                 { Number of the used port (1, 2
      }
  PortBase: word;               { I/O base address of the used
     }
  Speed: longint;               { Speed in
     }
  UARTType: byte;               { UART type (one of the UART_xxxx
constants }
  UsedIRQ: byte;                { The number of the used
    }
procedure SendEOI; assembler;
{ Send a EOI to the Interrupt Controller }
asm
        mov     al, 20h
        out     20h, al
end;
function KeyPressed: word; assembler;
asm
        mov     ah, 01h
        int     16h
        jnz     @@1
        xor     ax, ax
@@1:    nop
end;
function GetKeystroke: word; assembler;
asm
        mov     ah, 00h
        int     16h
end;
function GetPortBase(N: byte): word; assembler;
{ Read the I/O base address of the desired port from the BIOS data segment }
asm
        { Load the segment address of the BIOS data segment into ES }
        mov     ax, 0040h
        mov     es, ax
        { Calculate the offset of the I/O port base address }
        xor     ax, ax
        mov     al, N
        dec     al
        shl     ax, 1
        mov     si, ax
        { Read the desired value and return }
        mov     ax, es:[si]
end;
procedure SetIntVec(N: byte; P: pointer); assembler;
{ Set an interrupt vector to the given address }
asm
        push    ds
        { Just use the MS-DOS function 25h to set the vector }
        mov     ah, 25h
        mov     al, N
        { ds:dx contains the vector to set }
        lds     dx, P
        int     21h
        pop     ds
end;
function GetIntVec(N: byte): pointer; assembler;
{ Get the interrupt vector }
asm
        push    es
        { Use the MS-DOS function 35h to read the vector }
        mov     ah, 35h
        mov     al, N
        int     21h
        { Move the vector from es:bx to dx:ax }
        mov     ax, bx
        mov     dx, es
        pop     es
end;
procedure ResetQueue(var Q: TQueue);
{ Resets a Queue }
begin
  Q.Start := 0;
  Q.Stop := 0;
end;
procedure PutQueueByte(var Q: TQueue; B: byte);
{ Put a byte into the Queue }
begin
  { Put the byte into the Queue before incrementing the Queue end }
  Q.Content[Q.Stop] := B;
  { Now increment the Queue end position. When Q.Stop reaches QueueLen, }
  { be sure you don't increment Q.Stop but wrap it around to 0 again !  }
  inc(Q.Stop);
  if (Q.Stop = QueueLen) then
    Q.Stop := 0;
end;
function GetQueueByte(var Q: TQueue; var B: byte): boolean;
{ Get a byte out of the Queue }
begin
  if (Q.Stop = Q.Start) then
    { If the Queue is empty, just return false. Don't set B anyway. }
    GetQueueByte := false
  else
    begin
      { Queue is not empty: return true. }
      GetQueueByte := true;
      { Get the first byte out of the Queue and return it in B. }
      B := Q.Content[Q.Start];
      { Now increment the Queue position. Be sure to wrap it to zero }
      { if the Q.Start field reaches the QueueLen constant.         }
      inc(Q.Start);
      if (Q.Start = QueueLen) then
        Q.Start := 0;
    end;
end;
procedure SerialInterrupt; interrupt;
{ This procedure handles any incoming events from the UART. }
var
  Id: byte;
  Trash: byte;
begin
  repeat
    { Now read the Interrupt Identification register }
    Id := Port[PortBase + IntrId];
    { Check if there's any pending interrupt. }
    if ((Id and 1) = 0) then
      begin
        { Now select the event. }
        case ((Id and 6) shr 1) of
          $03:
            { The Line Status register changed. }
            begin
              { Just read the LSR to clear the event. }
              Trash := Port[PortBase + LineStatus];
            end;
          $02:
            { Data arrived at the UART. }
            begin
              { Read out the data from the RxD register and store }
              { it in the incoming Queue.                         }
              Trash := Port[PortBase + RxDataReg];
              PutQueueByte(InQueue, Trash);
            end;
          $01:
            { The TxD register is empty. }
            begin
              { If there's any byte in the outgoing Queue, send it to the }
              { UART, else disable this interrupt.                        }
              if (GetQueueByte(OutQueue, Trash)) then
                Port[PortBase + TxDataReg] := Trash
              else
                Port[PortBase + IntrEnable] := $0D;
            end;
          $00:
            { The Modem Status register changed. }
            begin
              { Just read the MSR to clear the event. }
              Trash := Port[PortBase + ModemStatus];
            end;
          end;
        end;
    { Handle all interrupts ! Just check if there's }
    { one more interrupt pending.                   }
  until ((Id and 1) = 1);
  { Now tell the PIC our interrupt handler has finished it's work. }
  SendEOI;
end;
procedure SendChar(C: byte);
{ Send a char to the modem }
begin
  { Put the character into the outgoing queue. }
  PutQueueByte(OutQueue, byte(C));
  { Enable the "Transmitter register empty" interrupt }
  Port[PortBase + IntrEnable] := $0F;
end;
const
  UART_Bad = 0;                 { Bad UART: not working or unidentifieable }
  UART_8250 = 1;                { Standart 8250 UART                       }
  UART_16450 = 2;               { 16450 UART (faster than 8250)            }
  UART_16550 = 3;               { 16550 UART (with buggy 16-byte FIFO)     }
  UART_16550A = 4;              { 16550A UART (with working FIFO)          }
function GetUARTType(Base: word): byte; assembler;
{ Check which UART type is assigned to the appropriate port }
asm
        { First difference: The 16450 has a scratch register which is }
        { readable and writeable. Check if it's there. If not, we've  }
        { got a 8250 UART.                                            }
        mov     dx, Base
        add     dx, ScratchReg
        mov     al, 0AAh
        out     dx, al
        in      al, dx
        cmp     al, 0AAh
        je      @@1
        mov     ax, UART_8250
        jmp     @@5
@@1:    { Now check out if the UART has got a FIFO. If it has none, it's  }
        { a 16450, if it has one but it's not working it's a 16550.       }
        { The UART will be identified as a 16550A if the FIFO is working. }
        mov     dx, Base
        add     dx, FifoCtrl
        mov     al, 01h
        out     dx, al
        nop
        mov     dx, Base
        add     dx, IntrId
        in      al, dx
        and     al, 0C0h
        cmp     al, 0C0h
        jne     @@2
        mov     al, UART_16550A
        jmp     @@5
@@2:    cmp     al, 80h
        jne     @@3
        mov     al, UART_16550
        jmp     @@5
@@3:    cmp     al, 0
        jne     @@4
        mov     al, UART_16450
        jmp     @@5
@@4:    mov     al, UART_Bad
@@5:    nop
end;
procedure UpCaseStr(var S: string); assembler;
{ Convert all chars in a string to uppercase letters }
asm
        les     di, S
        xor     cx, cx
        mov     cl, es:[di]
        inc     di
@@1:    mov     al, es:[di]
        cmp     al, 'a'
        jb      @@2
        cmp     al, 'z'
        ja      @@2
        { Chars between 'a' and 'z' will be uppercased here. }
        sub     al, 20h
@@2:    mov     es:[di], al
        inc     di
        loop    @@1
end;
function IsAllowedSpeed(Speed: longint): boolean;
{ Check if a speed is valid or not }
var
  I: byte;
begin
  { Return false by default. }
  IsAllowedSpeed := false;
  { Check if you can find the desired speed in the speeds table. }
  { If you found it, return "true".                              }
  for I := 0 to SpeedCount do
    if (AllowedSpeeds[I] = Speed) then
      begin
        IsAllowedSpeed := true;
        exit;
      end;
  { The default value ("false") will be returned if the speed wasn't }
  { found in the table.                                              }
end;
procedure GetCommandLine(var PortId: byte; var Speed: longint);
{ Check the command line and extract all parameters }
var
  S: string;
  I: byte;
  J: integer;
begin
  { If less than 1 parameter is specified, print a little help and }
  { terminate the programm.                                        }
  if (ParamCount < 1) then
    begin
      writeln('Usage: TERMINAL <com-port>[=<speed>]');
      writeln('<com-port> is one out of COM1, COM2, COM3 or COM4.');
      writeln('<speed> is the desired communication speed. The default value
is 9600.');
      writeln;
      { Halt the programm immediately. }
      halt;
    end;
  S := '';
  { Just create one long string from all parameters }
  for I := 1 to ParamCount do
    S := S + ParamStr(I);
  { Convert all lower-cased characters in that string to uppercased-chars }
  UpCaseStr(S);
  { The first three bytes of the string must be 'COM'. If not, }
  { there's an error in the command line.                      }
  if (copy(S, 1, 3) <> 'COM') or (S[5] <> '=') then
    begin
      writeln('Error in command line. Call TERMINAL without options to see
the help text.');
      halt;
    end;
  { Extract the number of the COM port that shall be used. }
  I := byte(S[4]) - ord('0');
  { Check for it's boundaries ! }
  if (i < 1) or (i > 4) then
    begin
      writeln('Wrong COM port specified.');
      halt;
    end
  else
    PortId := I;
  { Now extract the desired speed and check if it's a valid input. }
  val(copy(S, 6, length(S) - 5), Speed, J);
  if (J <> 0) then
    begin
      writeln('Error in speed specifier.');
      halt;
    end;
  { At last, check if the desired speed is supported. }
  if (not IsAllowedSpeed(Speed)) then
    begin
      writeln('The speed you selected is not supported by this TERMINAL.');
      halt;
    end;
end;
procedure EnableIRQ(IRQ: byte); assembler;
{ Enable a given IRQ from 0 to 7 }
asm
        mov     cl, IRQ
        mov     bl, 1
        shl     bl, cl
        mov     ah, 255
        sub     ah, bl
        in      al, 21h
        and     al, ah
        out     21h, al
end;
procedure DisableIRQ(IRQ: byte); assembler;
{ Disable a given IRQ from 0 to 7 }
asm
        mov     cl, IRQ
        mov     bl, 1
        shl     bl, cl
        in      al, 21h
        or      al, bl
        out     21h, al
end;
procedure PrintChar(Character: char); assembler;
{ Print a character on the screen - fast }
asm
        mov     ah, 0Eh
        mov     al, Character
        xor     bh, bh
        mov     bl, 07h
        int     10h
end;
var
  OldInterruptVec: pointer;
procedure SetupPort(PortBase: word; Speed: longint; IRQ: byte);
{ Setup the UART and prepare for communication. }
var
  D: word;
  B: byte;
begin
  { For startup, disable the IRQ for the UART. }
  DisableIRQ(IRQ);
  { Get the address of the old interrupt handler and set the vector }
  { to our won interrupt handling procedure ("SerialInterrupt")     }
  OldInterruptVec := GetIntVec($08 + IRQ);
  SetIntVec($08 + IRQ, @SerialInterrupt);
  { Enable the "Recieved Data avaliable" interrupt so we can }
  { read all data out of the UART's RxD register.            }
  Port[PortBase + IntrEnable] := $01;
  { Now clear all pending interrupts - if any }
  repeat
    { Read all important registers to clear any interrupt types, }
    { B is just used for temporary result storage                }
    B := Port[PortBase + RxDataReg];
    B := Port[PortBase + LineStatus];
    B := Port[PortBase + ModemStatus];
    { Just repeat until no more interrupts are pending. }
  until ((Port[PortBase + IntrId] and 1) = 1);
  { Enable the IRQ line for the UART after all pending interrupts }
  { have been cleared.                                            }
  EnableIRQ(IRQ);
  { Calculate the divisor latch contents for the desired baud rate }
  D := (115200 div Speed);
  { Set the DLAB bit to 1, then write the divisor latch low and high bytes }
  Port[PortBase + LineCtrl] := $80;
  Port[PortBase + DivLow] := Lo(D);
  Port[PortBase + DivHigh] := Hi(D);
  { Now set the divisor latch bit to 0 and write all other values }
  Port[PortBase + LineCtrl] := $03;
  Port[PortBase + ModemCtrl] := $0B;
  Port[PortBase + IntrEnable] := $0F;
  { Check if a 16550A UART is present... }
  if (UARTType = UART_16550A) then
    begin
      { Clear the FIFO queues }
      Port[PortBase + FifoCtrl] := $07;
      { Enable the FIFO queues }
      Port[PortBase + FifoCtrl] := $C1;
      { Print a message so the user recognizes the FIFO queues are on }
      writeln('Enabling 16550A FIFO queues...');
    end;
end;
const
  scEsc = $011B;
  scF1 = $3B00; scF2 = $3C00; scF3 = $3D00; scF4 = $3E00; scF5 = $3F00;
  scF6 = $4000; scF7 = $4100; scF8 = $4200; scF9 = $4300; scF10 = $4400;
  scAltF1 = $6800; scAltF2 = $6900; scAltF3 = $6A00; scAltF4 = $6B00;
  scAltF5 = $6C00; scAltF6 = $6D00; scAltF7 = $6E00; scAltF8 = $6F00;
  scAltF9 = $7000; scAltF10 = $7100; scCtrlF1 = $5C00; scCtrlF2 = $5D00;
  scCtrlF3 = $5E00; scCtrlF4 = $5F00; scCtrlF5 = $6000; scCtrlF6 = $6100;
  scCtrlF7 = $6200; scCtrlF8 = $6300; scCtrlF9 = $6400; scCtrlF10 = $6500;
procedure RunTerminal(PortBase: word);
{ Run the Terminal }
var
  B: char;
  W: word;
begin
  { Just print a free line }
  Writeln;
  repeat
    { Was a key pressed ? If yes, the character is written }
    { into the outgoing queue.                             }
    if (KeyPressed <> 0) then
      begin
        { Read the key. If it was <ESC>, the terminal session will }
        { be aborted, else the character will be sent out.         }
        W := GetKeystroke;
        if ((W and $FF) <> 27) then
          SendChar(W and 255);
      end
    { Is there any character in the incoming queue ? }
    else if (GetQueueByte(InQueue, byte(B))) then
      { If yes, just get the character and write it onto screen. }
      PrintChar(B);
    { Repeat this loop until the <ESC> key was pressed. }
  until (W = $011B);
end;
procedure ResetPort(PortBase: word; IRQ: byte);
{ Reset UART and reset interrupt vectors }
begin
  { Reset the DLAB bit. Clear all other registers. }
  Port[PortBase + LineCtrl] := Port[PortBase + LineCtrl] and $7F;
  Port[PortBase + ModemCtrl] := 0;
  Port[PortBase + IntrEnable] := 0;
  { Disable the IRQ for the UART, then restore the old interrupt vector. }
  DisableIRQ(IRQ);
  SetIntVec($08 + IRQ, OldInterruptVec);
  { Inform the user that the terminal session was aborted. }
  Writeln;
  Writeln('Port closed.');
end;
function Hex(W: word): TQuadString;
{ Convert a number into hexadecimal outfit }
const
  HexChars: array[0..15] of char = '0123456789ABCDEF';
begin
  Hex := HexChars[W shr 12] +
         HexChars[(W shr 8) and 15] +
         HexChars[(W shr 4) and 15] +
         HexChars[W and 15];
end;
procedure WritePortInfo;
{ Output some info about the selected port }
begin
  write('Using COM', PortNr, ' (base address ', Hex(PortBase), ', IRQ ',
UsedIRQ);
  write(', UART is a ');
  { Print the detected UART type }
  case UARTType of
    UART_8250:
      write('8250');
    UART_16450:
      write('16450');
    UART_16550:
      write('16550');
    UART_16550A:
      write('16550A');
    end;
  writeln(')...');
end;
{****************}
{* Main Routine *}
{****************}
begin
  { Just output some information. }
  writeln;
  writeln('TERMINAL     Version 1.00     Written 1995 by Stephan A.
Maciej');
  writeln('Internet: 
ste...@maciej.muc.de
http://www.muc.de/~stephanm'
);
  writeln;
  { Check for some correct parameters on the command line. }
  GetCommandLine(PortNr, Speed);
  PortBase := GetPortBase(PortNr);
  if (PortBase = 0) then
    begin
      writeln('COM', PortNr, ': no such port !');
      halt;
    end;
  UsedIRQ := 4 - ((PortNr - 1) and 1);
  UARTType := GetUARTType(PortBase);
  { Reset both the incoming as well as the outgoing Queue. }
  ResetQueue(InQueue);
  ResetQueue(OutQueue);
  { Write some information about the selected port. }
  WritePortInfo;
  { Setup the port, run the terminal and reset the port when ready. }
  SetupPort(PortBase, Speed, UsedIRQ);
  RunTerminal(PortBase);
  ResetPort(PortBase, UsedIRQ);
end.