Re: OS specific support in ADA

[jerry@jvdsys.nextjk.stuyts.nl (Jerry van Dijk)]

Scott H. James (sjames@wam.umd.edu) wrote:

: Through the C interface to DJGPP functions you will find
: GNAT readily suitable for the first two tasks, however, direct memory
: access will not be as straight forward

If you use CWSDPMI (or another DPMI 1.0 compliant) dpmi provider with GNAT/DOS
you can access memory directly by using the djgpp dpmi functions to map your 
Ada data structures upon physical memory.

If you cannot be sure about the dpmi provider used, the djgpp library offers
several alternatives to accessing memory directly, the example below uses the
sys/farptr package:


   --  Example program that shows how to do direct memory access in GNAT/DOS.
   --  Assuming a color screen it fills the screen with the specified video
   --  attribute and character. Look up the djgpp functions with 'info'
   --  to see how this works.

   with Unchecked_Conversion;
   with Ada.Characters.Latin_1;

   with Interfaces; use Interfaces;

   procedure Demo is

      -----------------------
      -- DJGPP INTERFACING --
      -----------------------

      --  Define DOS extender information block
      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);

      --  Make current extender info block available
      Current_Info : Go32_Info_Block;
      pragma Import (C, Current_Info, "_go32_info_block");

      --  Set the selector for the poke function
      procedure Set_Selector
        (Selector : in Unsigned_16);
      pragma Import (C, Set_Selector, "_farsetsel");

      --  Poke a byte into memory
      procedure Poke_Byte
        (Offset : in Unsigned_32;
         Value  : in Unsigned_8);
      pragma Import (C, Poke_Byte, "_farnspokeb");


      -------------------------
      -- DOS VIDEO ATTRIBUTE --
      -------------------------

      type Video_Blink is new Boolean;

      type Background_Color is (Black,
                                Blue,
                                Green,
                                Cyan,
                                Red,
                                Magenta,
                                Brown,
                                Light_Gray);

      type Foreground_Color is (Black,
                                Blue,
                                Green,
                                Cyan,
                                Red,
                                Magenta,
                                Brown,
                                Light_Gray,
                                Dark_Gray,
                                Light_Blue,
                                Light_Green,
                                Light_Cyan,
                                Light_Red,
                                Light_Magenta,
                                Yellow,
                                White);

      type Video_Attribute is
         record
            Blink      : Video_Blink;
            Background : Background_Color;
            Foreground : Foreground_Color;
         end record;

      for Video_Attribute use
         record
            Blink      at 0 range 7 .. 7;
            Background at 0 range 4 .. 6;
            Foreground at 0 range 0 .. 3;
         end record;

      for Video_Attribute'Size use 8;

      function To_Unsigned_8 is
        new Unchecked_Conversion (Video_Attribute, Unsigned_8);

      --  Default values
      Default_Fill_Char : constant Character :=
        Ada.Characters.Latin_1.Space;
      Default_Fill_Attr : constant Video_Attribute :=
        (Blink      => False,
         Background => Black,
         Foreground => Light_Gray);


      ------------------
      -- Clear Screen --
      ------------------

      procedure Clear_Screen
        (Attr  : in Video_Attribute := Default_Fill_Attr;
         Char  : in Character       := Default_Fill_Char) is
         Color_Screen : Unsigned_32 := 16#B8000#;
      begin
         Set_Selector (Current_Info.Selector_For_Linear_Memory);
         for I in 0 .. 2 * 80 * 25 loop
            Poke_Byte (Color_Screen, Unsigned_8 (Character'Pos (Char)));
            Poke_Byte (Color_Screen + 1, To_Unsigned_8 (Attr));
            Color_Screen := Color_Screen + 2;
         end loop;
      end Clear_Screen;


   ------------------
   -- MAIN PROGRAM --
   ------------------
   begin
      Clear_Screen;
   end Demo;

-- 
-----------------------------------------------------------------------
--  Jerry van Dijk       --   e-mail: jerry@jvdsys.nextjk.stuyts.nl  --
--  Banking Consultant   --              Member Team-Ada             -- 
--  Ordina Finance BV    --    Located at Haarlem, The Netherlands   --