From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,46ae0b8b8bd48967
X-Google-Attributes: gid103376,public
From: mfb@mbunix.mitre.org (Michael F Brenner)
Subject: Re: Disk Tracer - help
Date: 1998/05/07
Message-ID: <6isefu$m6h@top.mitre.org>
X-Deja-AN: 351105824
References: <6ipc09$lnl$1@sun1000.pwr.wroc.pl> <6ipmc2$32m@hacgate2.hac.com>
Organization: The MITRE Corporation, Bedford Mass.
Newsgroups: comp.lang.ada
Date: 1998-05-07T00:00:00+00:00
List-Id: <comp.lang.ada>


An old PC-World magazine from about 7 years ago showed how to
trace file opens and I think they called it recorder.com, 
if that is what you want to do. 

To actually trace the interrupts you need to hook those 
interrupts. The following is free code downloaded from
the Net. This code is an outline can get you started in 
programming how to hook your interrupts in gnat-3.10DOS 
and in Alsys-83-DOS.

First, the visible part, then the gnat body, and then
the Alsys body. Obviously, this kind of thing is VERY
dependent on your operating system and your compiler.


package interrupt_control is
  pragma elaborate_body (interrupt_control);

  type interrupts is range 0..2**16-1;
  for interrupts'size use 16;

  procedure initialize;
  procedure attach (interrupt: interrupts;
                    address: system.address;
                    chain: boolean := False);

  procedure finalize;
  procedure detach (interrupt: interrupts);
  procedure disable_hardware_interrupts;
  procedure enable_hardware_interrupts;
end interrupt_control;

-- The gnat package body

with unsign;
with text_IO;
with System.Storage_Elements;
package body interrupt_control is
  use unsign;
  use System.Storage_Elements;

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

 protected_mode: constant boolean:=False;

  type DPMI_registers is
    record
      di, dih:   unsigned_16;
      si, sih:   unsigned_16;
      bp, bph:   unsigned_16;
      res,resh:  unsigned_16;
      bl, bh, bxl, bxh: unsigned_8;
      dl, dh, dxl, dxh: unsigned_8;
      cl, ch, cxl, cxh: unsigned_8;
      al, ah, axl, axh: unsigned_8;
      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_registers);
  type register_pointers is access DPMI_registers;

  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);
  null_DPMI_seginfo: constant DPMI_seginfo:= (0,0,0,0,0);
  type seginfo_pointers is access DPMI_Seginfo;

  procedure CLI;
  pragma Import(C, CLI, "disable");

  procedure STI;
  pragma Import(C, STI, "enable");

  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 Set_Protmode_Vector (IRQ     : in Unsigned_16;
                                 Segment : in seginfo_pointers);
  pragma Import (C, Set_Protmode_Vector,
    "_go32_dpmi_set_protected_mode_interrupt_vector");

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

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

  procedure Get_Real_Mode_Vector (IRQ    : in Unsigned_16;
                                 Segment : in seginfo_pointers);
  pragma Import (C, Get_Real_Mode_Vector,
    "_go32_dpmi_get_real_mode_interrupt_vector");

  procedure Set_Real_Mode_Vector (IRQ    : in Unsigned_16;
                                 Segment : in seginfo_pointers);
  pragma Import (C, Set_Real_Mode_Vector,
    "_go32_dpmi_set_real_mode_interrupt_vector");

  procedure Allocate_Callback (Segment: in seginfo_pointers;
                               Reg:     in register_pointers);

  pragma Import (C, Allocate_Callback,
     "_go32_dpmi_allocate_real_mode_callback_iret");

  procedure Free_Callback (Segment: in seginfo_pointers);
  pragma Import (C, Free_Callback,
    "_go32_dpmi_free_real_mode_callback");

  procedure Allocate_Wrapper (Segment: in seginfo_pointers);
  pragma Import (C, Allocate_Wrapper,
     "_go32_dpmi_allocate_iret_wrapper");

  procedure Free_Wrapper (Segment: in seginfo_pointers);
  pragma Import (C, Free_Wrapper,
    "_go32_dpmi_free_iret_wrapper");

  -- global variables


  type handles is range 0 .. 10;
  subtype valid_handles is handles range handles'first + 1 .. handles'last;
  type handler_pairs is record
    old:     seginfo_pointers;
    current: seginfo_pointers;
    chained: boolean:=False;
  end record;
  handle: array (valid_handles) of handler_pairs;

  interrupt_info: array (valid_handles) of interrupts;
  last: handles:=handles'first;
  register: register_pointers;

  procedure kill (interrupt: interrupts; message: string) is
    interrupt_error: exception;
  begin
    text_IO.put_line ("Error with Interrupt "&interrupts'image(interrupt)&
                       ":" & message);
    raise interrupt_error;
  end kill;

  function chained (interrupt: interrupts) return boolean is
  begin
    for i in valid_handles'first .. last loop
       if interrupt_info (i) = interrupt then
          return handle (i).chained;
       end if;
    end loop;
    kill (interrupt, "not in use");
    return False;
  end chained;

  function current (interrupt: interrupts) return seginfo_pointers is
  begin
    for i in valid_handles'first .. last loop
       if interrupt_info (i) = interrupt then
          return handle (i).current;
       end if;
    end loop;
    kill (interrupt, "not in use");
    return null;
  end current;

  function old (interrupt: interrupts) return seginfo_pointers is
  begin
    for i in valid_handles'first .. last loop
       if interrupt_info (i) = interrupt then
          return handle (i).old;
       end if;
    end loop;
    kill (interrupt, "not in use");
    return null;
  end old;

  procedure initialize is
  begin
    null;
  end initialize;

  procedure attach (interrupt: interrupts;
                    address: system.address;
                    chain: boolean:=False) is
  begin
    last:=last + 1;
    interrupt_info (last):=interrupt;

    register:=new DPMI_registers;
    handle(last).current:=new DPMI_Seginfo;
    handle(last).old:=new DPMI_Seginfo;

    handle (last).current.PM_Selector:= My_CS;
    handle (last).current.PM_Offset:= Unsigned_32 (To_Integer (address));
    handle (last).chained:=chain;

    if protected_mode then
       Get_Protmode_Vector (unsigned_16(interrupt),handle(last).old);

       if chain then
         Chain_Protmode_Vector (unsigned_16(interrupt),handle(last).current);
       else
         Allocate_Wrapper (handle(last).current);
         Set_Protmode_Vector (unsigned_16(interrupt),handle(last).current);
       end if;
    else
       Get_Real_mode_Vector (unsigned_16(interrupt),handle(last).old);

       Allocate_Callback (handle(last).current, register);
       Set_Real_mode_Vector (unsigned_16(interrupt),
          handle(last).current);
    end if;
  end attach;

  procedure finalize is
  begin
    null;
  end finalize;

  procedure detach (interrupt: interrupts) is
    old_handler: seginfo_pointers:= old (interrupt);
    new_handler: seginfo_pointers:= current (interrupt);

  begin
    if protected_mode then
       Set_Protmode_Vector (unsigned_16(interrupt), old_handler);
       if not chained (interrupt) then
         Free_Wrapper (new_handler);
       end if;
    else
      Set_Real_Mode_Vector (unsigned_16(interrupt), old_handler);
      Free_Callback (new_handler);
    end if;
  end detach;

  procedure Enable_Hardware_Interrupts is
  begin
    STI;
  end Enable_Hardware_Interrupts;

  procedure Disable_Hardware_Interrupts is
  begin
    CLI;
  end Disable_Hardware_Interrupts;

end interrupt_control;




-- The Alsys body

with interrupt_manager; -- Alsys interrupt_manager
with ARTK;              -- Alsys Ada Run-Time Kernel
package body interrupt_control is

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

  procedure initialize is
  begin
     interrupt_manager.init_interrupt_manager
        (number_of_buffers => 0,
         max_param_area_size => 0);
  end initialize;

  procedure attach (interrupt: interrupts;
                    address: system.address;
                    chain: boolean:=False) is

    Alsys_cannot_chain_interrupts: exception;

  begin
    if chain then
      raise Alsys_cannot_chain_interrupts;
    else
      interrupt_manager.install_handler
         (handler_address => address,
          int_number      => interrupt_manager.interrupt_number(interrupt));
    end if;
  end attach;

  procedure finalize is
  begin
    null;
  end finalize;

  procedure detach (interrupt: interrupts) is
  begin
    interrupt_manager.remove_handler (
      interrupt_manager.interrupt_number(interrupt));
  end detach;

  procedure Disable_Hardware_Interrupts is
  begin
    ARTK.CLI;
  end Disable_Hardware_Interrupts;

  procedure Enable_Hardware_Interrupts is
  begin
    ARTK.STI;
  end Enable_Hardware_Interrupts;

end interrupt_control;