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,99a64c15f8d0157e X-Google-Attributes: gid103376,public X-Google-Thread: 10891a,99a64c15f8d0157e X-Google-Attributes: gid10891a,public From: jerry@jvdsys.nextjk.stuyts.nl (Jerry van Dijk) Subject: Re: GNAT and interrupts with DJGPP and CWSPR0 Date: 1996/08/16 Message-ID: X-Deja-AN: 174841061 references: <32110129.3C6E@ee.ubc.ca> organization: * JerryWare HQ * followup-to: comp.lang.ada,comp.os.msdos.djgpp newsgroups: comp.lang.ada,comp.os.msdos.djgpp Date: 1996-08-16T00:00:00+00:00 List-Id: 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@jvdsys.nextjk.stuyts.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 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;