DOS interrupts with GNAT 3.04

DOS interrupts with GNAT 3.04

[Rich Maggio]

I am wondering if there are any provisions (aside from interfacing to another 
programming language) in this Ada compiler to access the software interrupts
in DOS.  The reason is this: by doing this, it would be very simple to put 
together a package to perform nice screen output - cursor positioning, 
character attributes, etc.  As a C programmer, I made it a habit not to rely
on libraries provided by the compiler for this since this leads to non protable
code.  I would like to do the same with my Ada code.  I know that you can interface
Ada with code written in other programming languages, but that would seem to 
me to be a last resort.  If I am primarily (hypothetical) an Ada programmer,
why should I have to resort to C?  

The reason that I ask this is that I was poking around some of the ADS files 
and found that there are provisions to create interrupts handlers.  Since
there is support for this, I thought that there must be support for 
the reverse - generating interrupts (software or otherwise).

One creative idea that I saw (in Michael Feldman's Ada 95 book) was to make
use of "escape sequences" that would be caught by ANSI.SYS and perform
screen positioning and such.  This is good for screen I/O stuff, but there are
many other services in DOS that can be accessed through the software interrupt
mechanism.

On the same note, is it possible to create the equivalent of a FAR pointer
to interface directly to regions in memory - for example video RAM?

Any input would be welcomed.  I realize that these questions are not specific
the the Ada language itself, but these are real world situations that many
Ada programmers (novice and experienced) must face.  I am just trying to get a 
feel for what the capabilities of GNAT are and what the "Ada way" is for certain
situations. 

Thanks in advance for your help.

Rich Maggio

Re: DOS interrupts with GNAT 3.04

[Gautier]

In article <E2qt4t.KAx@nonexistent.com>, 
Rich Maggio <maggior@world2u.com> writes:
> I am wondering if there are any provisions (aside from interfacing to another 
> programming language) in this Ada compiler to access the software interrupts
> in DOS.  The reason is this: by doing this, it would be very simple to put 
> together a package to perform nice screen output - cursor positioning, 
> character attributes, etc.
>...
> 
> Thanks in advance for your help.
> 
> Rich Maggio
>
The interface with DOS interruptions is done in a package (DJGPP_Library if I
remember well) of the vga-pack (EZ2LOAD). I've played with it some time ago
for mouse and screen interruptions. Browse the archives PAQS and TESTS at

    http://www.unine.ch/math/Personnel/Assistants/Gautier/Gaut_FTP.htm
                         
Gautier
 

Re: DOS interrupts with GNAT 3.04

[Robert Dewar]

"Rich Maggio <maggior@world2u.com> writes:
> I am wondering if there are any provisions (aside from interfacing to another
> programming language) in this Ada compiler to access the software interrupts
> in DOS.  The reason is this: by doing this, it would be very simple to put
> together a package to perform nice screen output - cursor positioning,
> character attributes, etc."


The best way to put together a package like that would be to generate
the necessary int sequences directly using package Machine_Code. Of course
this is only done once in the body of the package.

Re: DOS interrupts with GNAT 3.04

[Michael F Brenner]

Dos interrupts are done a little differently on several different compilers.
On Janus and Meridian they are provided. On Alsys only the interrupts which
did not pass an address were provided, otherwise you need access to assembly
code. On gnat the following code seems to work, and is subject to the Ada
modification to the Gnu GPPL which permits commercial companies to use it
but not change its free stataus:


with unsign;
package memory is
  use unsign;

  -- Memory:
  --
  -- Purpose:
  --    Provide physical memory access
  --
  -- Architecture:
  --   ADO (Abstract Data Object)
  --   SDS (Semantically Dependent Specification)
  --
  -- History
  --   1986-09-17 added pragma inline (put) which cut the drawing time for
  --   1986-09-17   the SV PCX 2%, from 36 down to 35 seconds.
  --   1986-02-25 created

  type addresses is new unsigned_32;
  type byte_arrays is array (addresses range <>) of unsigned_8;

  procedure put (address: addresses; data: in unsigned_8);
  procedure put (address: addresses; data: in unsigned_16);
  procedure put (address: addresses; data: in unsigned_32);
  procedure put (address: addresses; data: in byte_arrays);
  procedure put (address: addresses; data: in string);

  procedure get (address: addresses; data: out unsigned_8);
  procedure get (address: addresses; data: out unsigned_16);
  procedure get (address: addresses; data: out unsigned_32);
  procedure get (address: addresses; length: addresses; data: out byte_arrays);

  function  get (address: addresses) return unsigned_8;
  function  get (address: addresses) return unsigned_16;
  function  get (address: addresses) return unsigned_32;
  function  get (address: addresses; length: addresses)
    return byte_arrays;
  function  get (address: addresses; length: addresses)
    return string;
  pragma inline (put);
end memory;
with unsign;
package dos16bit is

  -- These objects and methods are common to all 16-bit and and 32-bit DOSs.
  -- They comprise all DOS calls that do not pass addresses or 32-bit lengths.
  -- DOS16bit is complemented by dos_utils which differs for each compiler.
  --
  -- Warning: DOS and Unix are not thread-safe for memory allocation, I/O, etc.
  -- Warning: DOS blocks on all I/O, Unix blocks on most I/O.
  -- Warning: DOS is not even re-entrant, as some Unixen are


  procedure init; -- not to be used by Alsys to avoid random reboots


  -- DOS SYSTEM CALLS

  DOS_interrupt: constant := 16#21#;

  type interrupts is range 0..255;
  for interrupts'size use 8;

  subtype register_data is unsign.unsigned_16;
  type registers_16 is record

    -- Half of the 16-bit and 32-bit DOS calls (those that do not pass
    -- addresses  or 32-bit lengths) can use the simplified registers
    -- (registers_16) to do their work. These DOS calls are identical
    -- across 16- and 32-bit systems.

    ax, bx, cx, dx, flags: register_data := 0;
  end record;

  procedure interrupt_16 (interrupt: interrupts; 
                          register: in out registers_16);

        -- flags is used in many DOS calls as an error indicator:
        -- flags bit 0: carry
        -- flags bit 2: parity
        -- flags bit 6: zero
        -- flags bit 7: sign

  type dos_error_numbers is range -2**15..2**15-1;

  function  command_line           return string; -- not to be used by Alsys
  function  error                  return dos_error_numbers;
  function  error_interpretation   return string;

end dos16bit;

with dos_utils;
with memory;
package body dos16bit is
  -- compiler_this_package_is_dependent_on: constant string := "any DOS";



  -- GLOBAL VARIABLES

  cmd_line:            string (1..255);
  cmd_line_length:     integer := 0;
  initialized:         boolean:=False;
  x:                   constant string (1..2):=ascii.nul & '$';
  interrupt_62_failed: exception;
  why_are_you_calling_dos16bit_Instead_Of_os_command_Line: exception;


  function odd (number: register_data) return boolean is
    use unsign;
  begin
    return (number and 1) = 1;
  end odd;

  -- INTERRUPTS

  procedure get_original_command_line is

    -- WARNING: not to be called by Alsys
    -- WARNING: not to be called twice

    use memory;
    use unsign;
    DOS_get_psp:      constant := 16#6200#;
    sixteen:          constant := 16#10#;
    offset_to_length: constant := 16#80#;
    reg:    dos16bit.registers_16;
    psp:    memory.addresses;
    length: unsigned_8;
    byte:   unsigned_8;
    char:   character;
    j:      natural := 1;
  begin
    if initialized then
      raise interrupt_62_failed;
    end if;
    reg.ax      := DOS_get_PSP;
    dos16bit.interrupt_16 (16#21#, reg);
    if (reg.flags and 1)=1 then
      raise interrupt_62_failed;
    end if;
    psp         := addresses (reg.bx) * sixteen;
    length      := memory.get (psp + offset_to_length);
    cmd_line_length := natural(length);
    for i in 1 .. cmd_line_length loop
      byte := memory.get (psp+offset_to_length+addresses(i));
      char := character'val (byte);
      cmd_line (i) := char;
    end loop;
    loop
      exit when j > cmd_line_length;
      exit when cmd_line(j) /= ' ';
      j:=j+1;
    end loop;
    if j>1 then
      for i in j..cmd_line_length loop
        cmd_line (i+1-j) := cmd_line (i);
      end loop;
      cmd_line_length := cmd_line_length+1-j;
    end if;
  end get_original_command_line;

  function command_line return string is
  begin
    if not initialized then
      raise why_are_you_calling_dos16bit_Instead_Of_os_command_Line;
    end if;
    return cmd_line (1..cmd_line_length);
  end command_line;

  function error return dos_error_numbers is
    reg: registers_16;
    dos_get_error: constant := 16#5900#;
  begin
    reg.ax := dos_get_error;
    reg.bx := 0;
    interrupt_16 (interrupt => DOS_interrupt, register => reg);
    return dos_error_numbers (reg.ax);
  end error;

  function error_interpretation return string is

    bh, bl, ch: register_data;
    reg: registers_16;

    type classes is (non_recognized_error,
                     non_available_resource,  busy_network,
                     wrong_password,          dos_failure,
                     hardware_failure,        bad_dos_system_file,
                     programmer_inserted_bug, missing_object,
                     wrong_control_block,     locked_item,
                     bad_spot_on_media,       duplicate_file,
                     surprize);

    type locuses is (plenum,
                     computer_somewhere,      block_device_driver,
                     network,                 character_device_driver,
                     memory,                  new_dos_feature);

    type errors  is (no_error,
                     bad_function,      file_not_found,     path_not_found,
                     file_too_many,     denied_access,      bad_handle,
                     memory_overwrite,  lack_of_memory,     bad_address,
                     bad_environment,   bad_format,         datum_bad,
                     bad_drive,         delete_current_dir, dissimilar_device,
                     file_no_more,      write_protect,      unit_unknown,
                     drive_not_ready,   command_unknown,    data_CRC_error,
                     bad_length,        seek_error,         medium_unknown,
                     sector_not_found,  printer_outa_paper, write_fault,
                     read_fault,        general_failure,    sharing_violation,
                     lock_violation,    sudden_disk_change,
                     hard_to_describe_file_error);

    type actions is (take_no_action,
                     retry_now,               retry_after_a_delay,
                     fix_the_incorrect_name,  terminate_after_cleanup,
                     abort_without_cleanup,   ignore_and_investigate_later,
                     make_it_available_now,   call_a_hacker);

    dos_get_error: constant := 16#5900#;
  begin
    reg.ax := dos_get_error;
    reg.bx := 0;
    interrupt_16 (interrupt => DOS_interrupt, register => reg);

    if natural (reg.ax)=0 then
      return ""; --No error to interpret
    end if;
    if natural (reg.ax) > errors'pos(errors'last) then
      reg.ax := errors'pos(errors'last);
    end if;

    bh := register_data (natural (reg.bx) / 256);
    if natural (bh) > natural (classes'pos(classes'last)) then
      bh := classes'pos(classes'last);
    end if;
    bl := register_data (natural (reg.bx) mod 256);
    if natural (bl) > actions'pos(actions'last) then
      bl := actions'pos(actions'last);
    end if;

    ch := register_data (natural (reg.cx) / 256);
    if natural (ch)>locuses'pos(locuses'last) then
      ch := locuses'pos(locuses'last);
    end if;

    return ascii.cr & ascii.lf                &
           "Error "                           &
           register_data'image(reg.ax)        &
           " occurred because a "             &
           classes'image(classes'val(bh))     &
           " in the "                         &
           locuses'image (locuses'val (ch))   &
           ascii.cr & ascii.lf                &
           " had a "                          &
           errors'image (errors'val (reg.ax)) &
           ". Your best hope is to "          &
           actions'image (actions'val (bl))   &
           ascii.cr & ascii.lf;
  end error_interpretation;

  procedure interrupt_16 (interrupt: interrupts;
                          register: in out registers_16) is
  begin
    dos_utils.interrupt_16 (interrupt, register);
  end interrupt_16;



  -- SYSTEM CALLS

  procedure init is
  begin
    if not initialized then
      get_original_command_line;
    end if;
    initialized:=True;
  end init;



end dos16bit;
with dos16bit;
with system;
package DOS_utils is

  --  DOS_utils: Gnat Version
  --
  --  Purpose:
  --     Provide interface to 80x86 software interrupts
  --
  --  Architecture:
  --    ADO (Abstract Data Object)
  --    SIS (Semantically Dependent Specification)

  subtype interrupts is dos16bit.interrupts;

  procedure interrupt_16 (interrupt: interrupts;
                          register:  in out dos16bit.registers_16);

  type register_data is mod 2**32;
  type short_register_data is mod 2**16;
  type flag_data is mod 2**8;
  type registers is record
    di, si, bp, cflag, bx, dx, cx, ax: register_data := 0;
    flags: flag_data := 0;
  end record; -- This register order is for gnat3.05 (djgpp 2.0)

  procedure interrupt (interrupt: interrupts; register: in out registers);
end DOS_utils;
with System.Storage_Elements;
package body DOS_utils is

  -- compiler_this_package_is_dependent_on: constant string := "gnat3";

  procedure os_interrupt (interrupt: interrupts;
                          register:  system.address;
                          results:   system.address);
  pragma Import (C, os_interrupt, "int86");

  procedure interrupt_16 (interrupt: interrupts;
                          register:  in out dos16bit.registers_16) is
    reg: registers;
  begin
    reg.ax := register_data (register.ax);
    reg.bx := register_data (register.bx);
    reg.cx := register_data (register.cx);
    reg.dx := register_data (register.dx);
    os_interrupt (interrupt, reg'address, reg'address);
    register.ax    := dos16bit.register_data (reg.ax);
    register.bx    := dos16bit.register_data (reg.bx);
    register.cx    := dos16bit.register_data (reg.cx);
    register.dx    := dos16bit.register_data (reg.dx);
    register.flags := dos16bit.register_data (reg.flags);
  end interrupt_16;

  procedure interrupt (interrupt: interrupts; register: in out registers) is
  begin
    os_interrupt (interrupt, register'address, register'address);
  end interrupt;

end DOS_utils;

Re: DOS interrupts with GNAT 3.04

[Jerry van Dijk]

Robert Dewar <dewar@merv.cs.nyu.edu> wrote in article
<dewar.851440688@merv>...

> > I am wondering if there are any provisions (aside from interfacing to
another
> > programming language) in this Ada compiler to access the software
interrupts
> > in DOS.

> The best way to put together a package like that would be to generate
> the necessary int sequences directly using package Machine_Code. Of
course
> this is only done once in the body of the package.

Hmmmm, I didn't know 3.04 for DOS supported Machine_Code...

But even the I wouldn't recommend doing it this way. On a 16-bit real-mode 
compiler, this would be easy.. On a 32-bit protected mode compile (&
runtime)
your code would also have to handle the mode switches (RM<->PM), transfer,
callbacks, etc.

Better use the existing DJGPP code.

As far as fast character I/O under DOS is concerned, If someone has some
server
space left, I have some usefull packages...

Merry Christmas!
Jerry.

Re: DOS interrupts with GNAT 3.04

[Jerry van Dijk]

>   procedure interrupt_16 (interrupt: interrupts;
>                           register:  in out dos16bit.registers_16) is
>     reg: registers;

As DJ  and other warned several times:

1) This 16-bit Borland interface supports only a limited number of DOS
calls, which
    ones is not documented.
2) BIOS and other interrupt calls are not possible
3) These functions are *unsupported* and will disappear in the next DJGPP
    distribution.

Here's an example that shows some reliable techniques to access DOS from
the
GNAT/DJGPP enviroment:

-- Demonstrates how to call a dos interrupt with GNAT 3.05

with Interfaces;   use Interfaces;
with Interfaces.C; use Interfaces.C;

procedure Demo is

   -- Raised if the conventional memory transfer buffer is too small
   Transfer_Buffer_Too_Small : exception;

   -- Defines the DPMI available processor registers.
   -- Note: one of several possible definitions
   type Dpmi_Regs is
      record
         Di     : Unsigned_16;
         Di_Hi  : Unsigned_16;
         Si     : Unsigned_16;
         Si_Hi  : Unsigned_16;
         Bp     : Unsigned_16;
         Bp_Hi  : Unsigned_16;
         Res    : Unsigned_16;
         Res_Hi : Unsigned_16;
         Bx     : Unsigned_16;
         Bx_Hi  : Unsigned_16;
         Dx     : Unsigned_16;
         Dx_Hi  : Unsigned_16;
         Cx     : Unsigned_16;
         Cx_Hi  : Unsigned_16;
         Ax     : Unsigned_16;
         Ax_Hi  : Unsigned_16;
         Flags  : Unsigned_16;
         Es     : Unsigned_16;
         Ds     : Unsigned_16;
         Fs     : Unsigned_16;
         Gs     : Unsigned_16;
         Ip     : Unsigned_16;
         Cs     : Unsigned_16;
         Sp     : Unsigned_16;
         Ss     : Unsigned_16;
      end record;
   pragma Convention (C, Dpmi_Regs);

   -- Make DPMI issue a real mode interrupt
   procedure Dpmi_Int (Vector : in Unsigned_16; Regs : in out Dpmi_Regs);
   pragma Import (C, Dpmi_Int, "__dpmi_int");

   -- Defines the dos extender info 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 the current extender info available within Ada
   Current_Info : Go32_Info_Block;
   pragma Import (C, Current_Info, "_go32_info_block");

   -- Procedure to copy data to conventional memory
   procedure Dosmemput (Buffer  : in char_array;
                        Length  : in Unsigned_32;
                        Fysical : in Unsigned_32);
   pragma Import (C, Dosmemput, "dosmemput");

   procedure DOS_Print(Str : in String) is

      -- The DOS formatted string (note the zero)
      DOS_String : char_array(0..Str'Length);

      -- The processor registers
      Regs : Dpmi_Regs;

   begin

      -- Translate the string to a DOS string by appending
      -- the '$' that DOS uses to mark the end of the string
      for I in Str'Range loop
         DOS_String (size_t (I-1)) := To_C ( Str (I));
      end loop;
      DOS_String (size_t (Str'Length)) := To_C ('$');

      -- Check that the djgpp conventional memory transfer buffer is
      -- large enough to hold our string. If not, raise an exception.
      -- Normally we would either enlarge the transfer buffer or allocate
      -- our own. Here we leave this as an exercise for the reader :-)
      if Current_Info.Linear_Address_Of_Transfer_Buffer < Str'Length + 1
then
         raise Transfer_Buffer_Too_Small;
      end if;

      -- Next, copy our string to the transfer buffer
      Dosmemput (DOS_String, Str'Length + 1,
        Current_Info.Linear_Address_Of_Transfer_Buffer);

      -- Now, tell dos to print the contents of the transfer buffer
      Regs.Ax := 16#0900#;

      -- Make Ds point to the segment part of the physical address
      Regs.Ds := Unsigned_16( Shift_Right(
        Current_Info.Linear_Address_Of_Transfer_Buffer, 4)) and 16#FFFF#;

      -- Make Dx point to the offset part of the physical address
      Regs.Dx := Unsigned_16(
        Current_Info.Linear_Address_Of_Transfer_Buffer) and 16#0F#;

      -- Issue the interrupt
      Dpmi_Int (16#21#, Regs);

   end DOS_Print;

begin
   DOS_Print("Hello, world!");
end Demo;

Jerry.

Re: DOS interrupts with GNAT 3.04

[Robert Dewar]

Jerry said

"Hmmmm, I didn't know 3.04 for DOS supported Machine_Code...

But even the I wouldn't recommend doing it this way. On a 16-bit real-mode
compiler, this would be easy.. On a 32-bit protected mode compile (&
runtime)
your code would also have to handle the mode switches (RM<->PM), transfer,
callbacks, etc.

Better use the existing DJGPP code."


Machine_Code is not supported till version 3.07 (the current public release
of the DOS version is 3.05, we hope to see a 3.07 in the near future, we
are working on it right now).

Re: DOS interrupts with GNAT 3.04

[Robert Dewar]

iJerry said

"But even the I wouldn't recommend doing it this way. On a 16-bit real-mode
compiler, this would be easy.. On a 32-bit protected mode compile (&
runtime)
your code would also have to handle the mode switches (RM<->PM), transfer,
callbacks, etc.

Better use the existing DJGPP code."


I agree, much better to use the existing routines. What would be nice
is a complete Ada 95 interface to the useful DJGPP routines.