Liren Large Software Subsidy 7/07.iso/c/c221/5.ddi/MWHC.005/D3

Text File | 1992-12-09 | 5.2 KB | 140 lines

{*********************************************************************
(C) Copyright 1983-92; MetaWare Incorporated;  Santa Cruz, CA 95060.
*********************************************************************}
pragma on(Optimize_for_space);
Export(Here);
pragma C_include('Implement.pf');
pragma C_include('Interrupts.pf');
pragma C_include('Portio.pf');
package Here;
   pragma Routine_aliasing_convention(Implement.RTE_aliasing);
   procedure Init_interrupts;    External;
   procedure Restore_interrupts;External;
   end;

with Loopholes:[Adr,Retype,Longptr,Sizeof,Address,Pointer_arithmetic];

package Elsewhere;
   pragma Routine_aliasing_convention(Implement.RTE_aliasing);
   with Interrupts:[Interrupt_vector_element];
   procedure Pop_and_jmp(A:Address; I:Interrupt_vector_element);       External;
   procedure Display(const S:string); external;
   procedure Abort(const Msg:String); external;
   -- Displays message "stack overflow":
   procedure Stkerr;            external;
   end;

with Elsewhere,Interrupts,Portio;
pragma Off(With_warnings);
--with System;
pragma Pop(With_warnings);

program Implement_ints;
pragma Alias(Implement_ints,Implement.RTE || 'ints');

pragma off(emit_names);

{ Interrupt processing.                 }

procedure Make_trace_work(var S:Machine_status);
   { Place the return address near the saved BP so trace works.     }
   begin
   S.DS := S.Interrupt_address.Segment;
   S.ES := S.Interrupt_address.Offset;
   end;

const
   Range    = 5;    -- Range or nil check error.
   Quotient_oflo= 0;    -- Quotient oflo or divide by 0.
   Control_C    = #23;    -- Control/C.

-- In later versions the divide & range errors will be user-trappable with
-- exception handlers.

{ Save area for old interrupt routine addresses:    }
var
   Range_H_old, Quotient_oflo_H_old, Control_C_H_old: Interrupt_vector_element;

procedure Die;
   -- Can't afford to clean up with Halt since it may call
   -- call_onexit_fcns in C, causing potential recursive interrupts.
   begin
   Abort('');
   end;

pragma Calling_convention(Pascal_interrupt);
procedure Interrupt5(S:Machine_status);
   var Dummy: Machine_status;
   begin
   -- Check if this is a range interrupt, generated by an INT 5 instruction,
   -- or some other source of an interrupt 5, such as SHIFT-PRTSC on an IBM PC.
   -- If the latter, just call the latter routine.
   -- How to detect the latter?  Right now there is no easy way.
   -- Unfortunately, the MS-DOS designers used INT 5, where the 286
   -- reserves this interrupt for range errors.  Print screen was really
   -- put in the wrong place!    We therefore assume that if the INT 5
   -- was issued above address #f000:0, it was from the BIOS and we assume
   -- it wasn't a range error.  What are we going to do when we go to zenix?
   -- Perhaps hope that the designers didn't mis-use int 5!
   if S.Interrupt_address.Segment >= #f000 then
      -- Someone else generated this interrupt!  Call the routine so doing.
      Call_interrupt_vector_element(Dummy,Range_H_old)
   else begin
      Make_trace_work(S);
      Display('***RANGE OR NIL CHECK ERROR***');
      Fstackdump(Stderr);
      Die;
      end;
   end;
procedure Interrupt0(S:Machine_status);
   begin
   Make_trace_work(S);
   { Examine instruction preceding the interrupt location to see if    }
   { it was an INT 0 or an actual divide error.  We use INT 0 to flag    }
   { stack overflow.                            }
   Dec(S.Interrupt_address.Offset,2);
   if Retype(S.Interrupt_address,Longptr(Cardinal))^ = #00CD then Stkerr()
   else Display('***QUOTIENT OVERFLOW ON DIVIDE***');
   Fstackdump(Stderr);    -- Trace must come from here so as not
            -- to confuse reader with too many procs.
   Die;
   end;
procedure Control_C_H(S:Machine_status);
   begin
   Restore_interrupts;
   -- Now call the original control/C handler to wind up:
-- Call_interrupt_vector_element(S,Control_C_H_old);
   -- Unfortunately the above doesn't work under MS-DOS.  For some strange
   -- reason the only way this will work is if we unwind the stack
   -- back to just before we saved status, and directly jump to
   -- Control_C_H_old.
   -- Pop back to the pushed address and jump to the old routine.
   -- 6 = size of flags + rtn adr, same in all memory models.
   Pop_and_jmp(Adr(S)+Sizeof(S)-6,Control_C_H_old);
   -- Therefore we just call DOS_exit here.
-- Dos_exit(1);
   -- This doesn't work well because we then lose the "interruptedness"
   -- of the ^C -- in particular, a batch file will not abort.
   end;
pragma Calling_convention;

procedure Init_interrupts;
   begin
   Range_H_old := Vector_element(Range);
   Quotient_oflo_H_old := Vector_element(Quotient_oflo);
   Control_C_H_old := Vector_element(Control_C);
   Install_interrupt_routine(Range,Interrupt5);
   Install_interrupt_routine(Quotient_oflo,Interrupt0);
   Install_interrupt_routine(Control_C,Control_C_H);
   end;

procedure Restore_interrupts;
   begin
   Install_interrupt_vector_element(Range,Range_H_old);
   Install_interrupt_vector_element(Quotient_oflo,Quotient_oflo_H_old);
   Install_interrupt_vector_element(Control_C,Control_C_H_old);
   end;

{ (C) Copyright 1983-1985;  unpublished property and trade secret of }
{ MetaWare Incorporated; Santa Cruz, CA 95060; detailed notice above.}