NetNews Usenet Archive 1992 #16/NN_1992_16.iso/spool/comp/lang/ada/2161

Text File | 1992-07-21 | 12.2 KB | 400 lines

Newsgroups: comp.lang.ada
Path: sparky!uunet!wupost!darwin.sura.net!haven.umd.edu!decuac!ryhope.del.dec.com!jeff
From: [e-mail] (Jeff Finkelstein)
Subject: Re: Serial interrupt handler in Meridian Ada on PC?
Message-ID: <[e-mail]>
Sender:  [e-mail]
Nntp-Posting-Host: server.dco.dec.com
Organization: Digital Equipment Corporation
References: <[e-mail]>
Date: Tue, 21 Jul 1992 18:56:52 GMT
Lines: 387

In article <[e-mail]> [e-mail] (Steven Hovater) writes:
>I know this was a thread several months back, but did anyone ever 'fess
>up to having done this?
>
>If so, I'd like to see the source. Else, I'll have to do it myself
>(privately).
>
>Might also mention that this has no connection to my work. Honest!
>

I'll also start out by saying that the following code has nothing to do
with my work. The code that follows is an interrupt handler written in
Meridian Ada. It is not bug free by any stretch but it does seem to
work. Good luck and have at it. When I get it better tested I'll repost.
And yes, I know it looks like C code, I'm still trying to get into being
an Ada dude.

jeff
----
jeff finkelstein                | disclaimer:
digital equipment corporation   |   A horse is a horse, of course, of course.
[e-mail]         |
----
with system;

package async is

in_c_ct : integer := 0;    -- count of characters used in buffer

-- word size
BIT7 : constant integer := 2;
BIT8 : constant integer := 3;
-- stop bits
STOP1 : constant integer := 0;
STOP2  : constant integer := 4;
-- parity
NONE  : constant integer := 0;
ODD  : constant integer := 8;
EVEN  : constant integer := 24;
-- baud rate
B300  : constant integer := 384;
B1200  : constant integer := 96;
B2400  : constant integer := 48;
B4800  : constant integer := 24;
B9600  : constant integer := 12;
B19200 : constant integer := 6;

subtype byte is integer range 0..255;

procedure setport(prot : integer; baud : integer);   -- setup the serial port
-- prot is word | stop | parity    ex: setport(BIT8 or STOP1 or NONE,B1200)
function carrier return integer;
function getport return integer;    -- returns modem & line status
                   --   bits same as in ibm tech manual
procedure flush_port;             -- flushes input and output buffers
procedure uninit;                 -- remove interrupt
procedure comout(c : character);  -- que character in buffer
function inp_char return character;  -- get one char from buffer,
procedure init_com;               -- initialize the comm port,

end async;

with async; use async;
with port;
with bit_ops; use bit_ops;
with machine_code;
with system; use system;
with interrupt; use interrupt;
with text_io; use text_io;
with unchecked_conversion;

package body async is

CR : constant integer := 13;

-- define interrupt handler
task inthdlr is
   entry startint;
   for startint use at 16#0C#;
end inthdlr;

type uns8 is new integer range 0..255;

function to_integer is new unchecked_conversion(
   source => character,
   target => integer);

function to_character is new unchecked_conversion(
   source => integer,
   target => character);

function to_uns8 is new unchecked_conversion(
   source => integer,
   target => uns8);

--#define COM0 1          -- either com0 or com1

--#ifdef COM0
comport : constant integer := 0;      --  Com port #
base : constant integer := 16#03f8#; -- base for serial board
comint : constant integer :=  16#0c#;    --  Int Vector used by port
enblirq  : constant integer := 16#ef#;   -- enable communications
maskirq  : constant integer := 16#10#;   -- bit to disable comm interrupt
pused : constant integer := 0;
--#endif

--#ifdef COM1
--#define comport  1      --  Com Port
--#define base     0x02f8 -- base for serial board
--#define comint   0xb    --  Int Vector used by port
--#define enblirq  0xf7   -- enable communications
--#define maskirq  0x8    -- bit to disable comm interrupt
--int pused = 1;
--#endif

-- 8250 registers
mdmbd0  : constant integer :=   base;    -- lsb baud rate register
dataport  : constant integer := base;    -- transmit/receive data port
mdmbd1 : constant integer :=   base+1;  -- msb baud rate register
ier  : constant integer :=      base+1;  --  interrup enable register
irr  : constant integer :=      base+2;  -- reason for interrupt
lcr  : constant integer :=      base+3;  --  line control register
mcr  : constant integer :=      base+4;  -- modem control register
mdmsta : constant integer :=    base+5;  -- line status register
mdmmsr : constant integer :=    base+6;  -- modem status register

-- 8250 values
mdmcd  : constant integer :=   16#80#;     -- mask for carrier dectect
mdmtbe : constant integer :=   16#20#;     -- 8250 tbe flag
dlab  : constant integer :=    16#80#;     -- enable divisor latch

-- 8250 interrupt enable values
enbldrdy  : constant integer := 1;       --  enable 'data-ready' interrupt bit
enbltrdy  : constant integer := 2;       --  enable 'xmit-empty' interrupt bit
enbllrdy  : constant integer := 4;       --  enable 'line-change' interrupt bit
enblmrdy  : constant integer := 8;       --  enable 'modem-change' interrupt bit

-- 8250 interrupt causes
intms  : constant integer :=    0;       -- int caused by modem status
inttx  : constant integer :=    2;       -- int caused by td
intrd  : constant integer :=    4;       -- int caused by dr
intls  : constant integer :=    6;       -- int caused by line status

-- 8259 ports and values
intctlr : constant integer :=  16#21#;     -- ocw 1 for 8259 controller
rs8259 : constant integer :=   16#20#;     -- ocw 3 for 8259
rstint : constant integer :=   16#20#;     -- specific eoi for comm interrupt

--        miscellaneous equates
xoff : constant integer :=     16#13#;
xon  : constant integer :=     16#11#;
bufsiz : constant integer :=   512;     -- max number of chars

in_c_buf : array (1..bufsiz) of character;   -- allow 512 buffered characters
ou_c_buf : array (1..bufsiz) of character;
linstat : integer;
xon_sent : boolean := false;

ou_c_top : constant integer := bufsiz;
in_c_top : constant integer := bufsiz;

in_c_in : integer := 0;   -- in_c_buf pointer to last char. placed in buffer
in_c_cur : integer := 0;  -- in_c_buf pointer to next char. to be retrieved
ou_c_in : integer := 0;   -- ou_c_buf pointer to last char. placed in buffer
ou_c_cur : integer := 0;  -- ou_c_buf pointer to next char. to be transmitted
ou_c_ct : integer := 0;    -- count of characters used in buffer
modstat : integer := 0;    -- modem status

oldseg : integer;
oldoff : integer;
regs : registers;
rd,tx : character;  -- last received and transmitted character

function carrier return integer is
begin
   return port.in_byte(mdmmsr) and 16#80#;
end carrier;

procedure disable is
use machine_code;
begin
   inst1'(b1 => 16#FA#);
end disable;

procedure enable is
use machine_code;
begin
   inst1'(b1 => 16#FB#);
end enable;

procedure setport(prot : integer; baud : integer) is
begin
    disable;                  -- disable interrupts
    port.out_byte(lcr,dlab);           -- enable buad sender
    port.out_byte(mdmbd0,baud and 16#FF#); -- send lsb
    port.out_byte(mdmbd1,baud / 256);  -- send msb
    port.out_byte(lcr,prot);           -- set protocol
    enable;
end setport;

--  int getport();
--15 14 13 12 11 10  9  8  7  6  5  4  3  2  1  0
--   T  T  B  F  P   O  D  D  R  D  C  D  T  D  D
--   S  H  I  E  E   R  R  C  I  S  T  D  E  D  C
--   R  R                  D     R  S  C  R  S  T
--   E  E                              D  I  R  S
--Data Ready = DR, Overrun Error = OR, Parity Error = PE, Framing Error = FE,
--Break Interrupt = BI, Transmitter Holding Register = THRE,
--Transmitter Empty = TSRE, Delta Clear to Send = DCTS, Clear to Send = CTS,
--Delta Data Set Ready = DDSR, Data Set Ready = DSR, Ring Indicator = RI,
--Trailing Edge Ring Indicator = TERI, Delta Carrier Detect = DCD,
--Carrier Detect = CD
function getport return integer is
begin
    return(256 * linstat + modstat);
end getport;

-- flush_port --   flush the buffers
procedure flush_port is
begin
    disable;
    in_c_in := 0;
    in_c_cur := 0; --&in_c_buf[0];
    in_c_ct := 0;
    ou_c_in := 0;
    ou_c_cur := 0; --&ou_c_buf[0];
    ou_c_ct := 0;
    xon_sent := false;
    enable;
end flush_port;

procedure getvect is
begin
   regs.ax := 16#350C#; -- get vector for com 1 interrupt routine
   vector(
      on => 16#21#,
      register_block => regs);
   oldseg := regs.es;
   oldoff := regs.bx;
end getvect;

procedure setvect is
begin
   regs.ax := 16#250C#; -- set vector for new com1 interrupt routine
   regs.ds := oldseg;
   regs.dx := oldoff;
   vector(
      on => 16#21#,
      register_block => regs);
end setvect;

procedure uninit is     -- remove initialization,
begin
    disable;
    setvect; -- restore old vector
    port.out_byte(intctlr,port.in_byte(intctlr) or maskirq); --  disable irq on 8259
    port.out_byte(ier,0); -- clear all interrupt enables
    port.out_byte(lcr,0); -- clear the protocol
    port.out_byte(mcr,0); -- disable out2 on 8250
    enable;
end uninit;

procedure comout(c : character) is -- que character in buffer
begin
    if (port.in_byte(mdmsta) and mdmtbe) > 0 and ou_c_ct /= 0 then
    port.out_byte(dataport,to_integer(c)); -- if status is clear then just send
    tx := c;
    else                     -- load it in the buffer
    disable;
    if ou_c_ct < bufsiz then  -- if buffer is full ignore character
        ou_c_buf(ou_c_in) := c;
        ou_c_ct := ou_c_ct + 1;
        if ou_c_in = ou_c_top then
           ou_c_in := 1;
        else
           ou_c_in := ou_c_in + 1;
        end if;
    end if;
    enable;
    end if;
end comout;

-- char inp_char()        return a character from the in_c_buf
--                        buffer. assumes you have called
-- in_c_ct to see if theres any characters to get.

function inp_char return character is         -- get one char from buffer,
cin : character;
begin
    disable;
    cin := in_c_buf(in_c_cur);
    if in_c_ct > 0 then
    in_c_ct := in_c_ct - 1;
    if in_c_cur = in_c_top then
        in_c_cur := 0;
    else
        in_c_cur := in_c_cur + 1;
    end if;
    end if;
    enable;
    if xon_sent and in_c_ct < 128 then
    comout(ASCII.DC1);
    xon_sent := FALSE;
    end if;
    return cin;
end inp_char;

-- receive interrupt handler (changed to place characters in in_c_buf)
task body inthdlr is
begin
 loop
  select
    accept startint do
    disable;
    case port.in_byte(irr) is
      when intrd => -- receive data
        if in_c_ct < bufsiz then -- if buffer is full ignore character
        in_c_buf(in_c_in) := to_character(port.in_byte(dataport));
        rd := in_c_buf(in_c_in);
        in_c_ct := in_c_ct + 1;
        if in_c_in = in_c_top then
           in_c_in := 0;
        else
           in_c_in := in_c_in + 1;
        end if;
        end if;
      when intms =>
        modstat := port.in_byte(mdmmsr);  -- modem status
      when intls =>
        linstat := port.in_byte(mdmsta);  -- line status
      when inttx => -- transmitter empty
        if ou_c_ct > 0 then -- if there is a character
        port.out_byte(dataport,to_integer(ou_c_buf(ou_c_cur)));
        tx := ou_c_buf(ou_c_cur);
        ou_c_ct := ou_c_ct - 1;         -- decrement in_c_buf count
        if ou_c_cur = ou_c_top then
          ou_c_cur := 0;
        else
          ou_c_cur := ou_c_cur + 1;
        end if;
        end if;
      when others =>
        null;
    end case;
    port.out_byte(rs8259,rstint);
    if in_c_ct > (bufsiz*3/4) then
        comout(ASCII.DC3);
        xon_sent := TRUE;
    end if;
    enable;
       end startint;
     end select;
   end loop;
end inthdlr;

--  --------- init -----------------------------------
--  program initialization:
--    --  set up vector for rs232 interrupt
--    --  enbl irq
--    --  enbl rs232 interrupt on dr,tx,ms,ls

--  ---------------------------------------------------

procedure init_com is        -- initialize the comm port,
begin
    getvect;
    disable;
    flush_port;
    port.out_byte(intctlr,port.in_byte(intctlr) and enblirq);
    port.out_byte(lcr,port.in_byte(lcr) and 16#7f#); -- reset dlab for ier access
    port.out_byte(ier,enbldrdy+enbllrdy+enblmrdy+enbltrdy);
    port.out_byte(mcr,16#0f#); --modem control register enable out2 out1 dtr rts
    linstat := port.in_byte(mdmsta);
    modstat := port.in_byte(mdmmsr);
    enable;
end init_com;

procedure comok is
begin
    port.out_byte(mcr,16#0F#); -- enable modem
end comok;

end async;
--
jeff finkelstein                | disclaimer:
digital equipment corporation   |   A horse is a horse, of course, of course.
[e-mail]         |