Xref:	news2.mv.net comp.lang.ada:24433 comp.os.msdos.djgpp:7434
Newsgroups:	comp.lang.ada,comp.os.msdos.djgpp
From:	jerry AT jvdsys DOT nextjk DOT stuyts DOT nl (Jerry van Dijk)
Subject:	Re: GNAT and interrupts with DJGPP and CWSPR0
Followup-To:	comp.lang.ada,comp.os.msdos.djgpp
Organization:	* JerryWare HQ *
Message-ID:	<Dw96tE.2L@jvdsys.nextjk.stuyts.nl>
References:	<32110129 DOT 3C6E AT ee DOT ubc DOT ca>
Date:	Fri, 16 Aug 1996 23:05:38 GMT
Lines:	187
To:	djgpp AT delorie DOT com
DJ-Gateway:	from newsgroup comp.os.msdos.djgpp

As my news seems to get out and my last post was not really of
examplary clarity, lets try an example:

-----------------------------------------------------------------------
--
--  File:        intedemo.adb
--  Description: Interrupt processing in GNAT/DOS v3.05
--  Rev:         0.1
--  Date:        Sat Aug 17 00:30:38 1996
--  Author:      Jerry van Dijk
--  Mail:        jerry AT jvdsys DOT nextjk DOT stuyts DOT nl
--
--  Copyright (c) Jerry van Dijk, 1996
--  Forelstraat 211
--  2037 KV  HAARLEM
--  THE NETHERLANDS
--  tel int + 31 23 540 1052
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

   -----------------------------------------------------------------
   -- Chains a GNAT procedure into the DOS timer interrupt        --
   -- and displays the current time in the upper right corner     --
   -- of the screen.                                              --
   -- Note that this demo assumes that virtual memory is disabled --
   -- and that there is enough space on the interrupt stack!      --
   -----------------------------------------------------------------

with Ada.Text_IO, Interfaces, System.Storage_Elements;
use  Ada.Text_IO, Interfaces, System.Storage_Elements;

procedure Interrupt_Demo is

   --------------------------------
   -- Interface to DJGPP library --
   --------------------------------

   type DPMI_Seginfo is
      record
         Size        : Unsigned_32;
         PM_Offset   : Unsigned_32;
         PM_Selector : Unsigned_16;
         RM_Offset   : Unsigned_16;
         RM_Segment  : Unsigned_16;
   end record;
   pragma Convention (C, DPMI_Seginfo);

   type Go32_Info_Block is
      record
         Size_Of_This_Structure_In_Bytes        : Unsigned_32;
         Linear_Address_Of_Primary_Screen       : Unsigned_32;
         Linear_Address_Of_Secondary_Screen     : Unsigned_32;
         Linear_Address_Of_Transfer_Buffer      : Unsigned_32;
         Size_Of_Transfer_Buffer                : Unsigned_32;
         Pid                                    : Unsigned_32;
         Master_Interrupt_Controller_Base       : Unsigned_8;
         Slave_Interrupt_Controller_Base        : Unsigned_8;
         Selector_For_Linear_Memory             : Unsigned_16;
         Linear_Address_Of_Stub_Info_Structure  : Unsigned_32;
         Linear_Address_Of_Original_Psp         : Unsigned_32;
         Run_Mode                               : Unsigned_16;
         Run_Mode_Info                          : Unsigned_16;
      end record;
   pragma Convention(C, Go32_Info_Block);

   Current_Info : Go32_Info_Block;
   pragma Import(C, Current_Info, "_go32_info_block");

   procedure Set_Selector(Selector : in Unsigned_16);
   pragma Import(C, Set_Selector, "_farsetsel");

   procedure Outportb (Port  : in Unsigned_16; Value : in Unsigned_8);
   pragma Import (C, Outportb, "outportb");

   function Inportb (Port : in Unsigned_16) return Unsigned_8;
   pragma Import (C, Inportb, "inportb");

   procedure Farnspokew(Offset : in Unsigned_32; Value : in Unsigned_16);
   pragma Import(C, Farnspokew, "_farnspokew");

   function My_CS return Unsigned_16;
   pragma Import (C, My_CS, "_go32_my_cs");

   procedure Get_Protmode_Vector (IRQ     : in Unsigned_16;
                                  Segment : out DPMI_Seginfo);
   pragma Import (C, Get_Protmode_Vector,
     "_go32_dpmi_get_protected_mode_interrupt_vector");

   procedure Chain_Protmode_Vector (IRQ     : in Unsigned_16;
                                    Segment : out DPMI_Seginfo);
   pragma Import (C, Chain_Protmode_Vector,
     "_go32_dpmi_chain_protected_mode_interrupt_vector");

   procedure Set_Protmode_Vector (IRQ     : in Unsigned_16;
                                  Segment : out DPMI_Seginfo);
   pragma Import (C, Set_Protmode_Vector,
     "_go32_dpmi_set_protected_mode_interrupt_vector");

   ---------------
   -- Constants --
   ---------------
   Timer_IRQ : constant := 8;

   ----------------------
   -- Global Variables --
   ----------------------
   Old_Handler : DPMI_Seginfo;

   -----------------------
   -- Interrupt Handler --
   -----------------------

   Procedure Handler is

      function Hi_Char (Char : in Unsigned_8) return Unsigned_16 is
      begin
         return 16#2F30# or Unsigned_16 (Shift_Right (Char, 4));
      end Hi_Char;
      pragma Inline (Hi_Char);

      function Lo_Char (Char : in Unsigned_8) return Unsigned_16 is
      begin
         return 16#2F30# or Unsigned_16 (Char and 16#F#);
      end Lo_Char;
      pragma Inline (Lo_Char);

      Hours, Minutes, Seconds : Unsigned_8;

   begin
      Outportb(16#70#, 0);
      Seconds := Inportb(16#71#);
      Outportb(16#70#, 2);
      Minutes := Inportb(16#71#);
      Outportb(16#70#, 4);
      Hours := Inportb(16#71#);
      Set_Selector (Current_Info.Selector_For_Linear_Memory);
      Farnspokew(16#B8090#, Hi_Char(hours));
      Farnspokew(16#B8092#, Lo_Char(hours));
      Farnspokew(16#B8094#, 16#2F3A#);
      Farnspokew(16#B8096#, Hi_Char(minutes));
      Farnspokew(16#B8098#, Lo_Char(minutes));
      Farnspokew(16#B809A#, 16#2F3A#);
      Farnspokew(16#B809C#, Hi_Char(seconds));
      Farnspokew(16#B809E#, Lo_Char(seconds));
   end Handler;

   --------------------------------------
   -- Install/Remove Interrupt Handler --
   --------------------------------------

   procedure Install_Interrupt_Handler is
      New_Handler : DPMI_Seginfo;
   begin
      Get_Protmode_Vector (Timer_IRQ, Old_Handler);
      New_Handler.PM_Selector := My_Cs;
      New_Handler.PM_Offset := Unsigned_32 (To_Integer (Handler'Address));
      Chain_Protmode_Vector (Timer_IRQ, New_Handler);
   end Install_Interrupt_Handler;

   procedure Remove_Interrupt_Handler is
   begin
      Set_Protmode_Vector (Timer_IRQ, Old_Handler);
   end Remove_Interrupt_Handler;

   ------------------------------
   -- Wait for <Enter> pressed --
   ------------------------------

   procedure Wait_For_Return is
      C : Character;
   begin
      Put ("Press return to exit: ");
      Get_Immediate (C);
   end Wait_For_Return;

begin
   Install_Interrupt_Handler;
   Wait_For_Return;
   Remove_Interrupt_Handler;
end Interrupt_Demo;

- Raw text -