home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c221 / 5.ddi / MWHC.005 / C3 < prev    next >
Encoding:
Text File  |  1992-12-09  |  7.7 KB  |  198 lines
  1. { (C) Copyright  1986-1992 MetaWare Incorporated;  Santa Cruz, CA 95060. }
  2.  
  3. pragma C_include('implement.pf');
  4. pragma C_include('language.pf');
  5. package Interrupts;
  6.    with Language;
  7.    pragma Routine_aliasing_convention(Implement.RTE_aliasing);
  8. #if 0
  9.    In this package we implement both general interrupt handling
  10.    and a simple control/C trap routine.
  11.    If you're just interested in the latter, go to the end.
  12.    If you just want to call an arbitrary DOS interrupt and don't care
  13.    to write interrupt routines, see msdos.pf.
  14. #endif
  15.  
  16. -- To get inline CLI and STI, use the intrinsic Inline:
  17. #define CLI Loopholes.Inline(#fa)
  18. #define STI Loopholes.Inline(#fb)
  19.  
  20. #if 0
  21.    When an interrupt occurs, the registers in Machine_status
  22.    are saved at the entry and restored at the exit of an interrupt
  23.    routine.  If the interrupt routine modifies the registers, the
  24.    restored values will be the modified versions.  Therefore it is
  25.    possible to write an interrupt routine to completely replace, e.g.,
  26.    MS-DOS's INT 21, which takes arguments from registers and returns
  27.    results in registers.
  28.    In addition to the registers, the address following the location
  29.    of the interrupt and the flags register that were saved by the
  30.    processor are available for modification or printing.
  31. #endif
  32.  
  33.    type Machine_status = record
  34.       { In reverse of the order in which they're pushed:                }
  35.       ES,DS,DI,SI,Waste1,Waste2,BX,DX,CX,AX:    Cardinal;
  36.       { The wasted portions are due to the 286 PUSHA/POPA instructions    }
  37.       { used to effect the save.  We match the arrangement on the 8086    }
  38.       { for object code compatibility.                    }
  39.       Interrupt_address: record
  40.      Offset:Unsigned; Segment:Cardinal;
  41.      end;
  42.       Flags: Cardinal;
  43.       end;
  44.  
  45.    const Pascal_interrupt = Pascal + [Interrupt];
  46.  
  47.    { Each interrupt is designated by an index into the hardware     }
  48.    { interrupt vector located at address 0:                }
  49.    {    var Interrupt_vector: array[0.. ...] of 4-byte-address        }
  50.    { Type Interrupt_index subscripts this array.            }
  51.  
  52.    type Interrupt_index = Cardinal;
  53.    const Control_C_interrupt_index = #23;    -- MS-DOS.
  54.  
  55. #if 0
  56.    To declare that a routine is an interrupt routine, it must
  57.    have calling convention Pascal_interrupt and be of routine type
  58.    Interrupt_routine.
  59.    Because the representation of interrupt routines differ
  60.    depending upon the 8086 memory model used, and
  61.    each 8086 interrupt entry always is a segment-offset pair,
  62.    the Interrupt_vector_element type represents the latter.
  63.    Thus the latter cannot be an Interrupt_routine.
  64.    On more reasonable machines, these two types are identical.
  65. #endif
  66.  
  67.    pragma Calling_convention(Pascal_interrupt);
  68.    type Interrupt_routine = procedure(S:Machine_status);
  69.    type Interrupt_vector_element = record Offset,Segment:Cardinal; end;
  70.    pragma Calling_convention();
  71.  
  72.    { Enable/disable interrupts.                     }
  73.    procedure Interrupt_enable;    {STI}            External;
  74.    procedure Interrupt_disable; {CLI}            External;
  75.    { Generate an "int V" instruction and execute it.                    }
  76.    procedure Int(V:Interrupt_index);            External;
  77.  
  78.    { Value of Interrupt_vector[V].                    }
  79.    function Vector_element(V:Interrupt_index):Interrupt_vector_element;
  80.                             External;
  81.  
  82.    { Make P the interrupt handler for Interrupt_index V.        }
  83.  
  84.    procedure Install_interrupt_routine
  85.       (V:Interrupt_index; P:Interrupt_routine);     External;
  86.    procedure Install_interrupt_vector_element
  87.       (V:Interrupt_index; P:Interrupt_vector_element);    External;
  88. #if 0
  89.    NOTE:  It is not safe to install an Interrupt_routine P that is not
  90.    a level-1 routine!!!  The hardware will NOT supply the up-level
  91.    context that P needs to access the local variables of its parent
  92.    routine.  It is OK to install P only if no up-level references are
  93.    made -- and THIS INCLUDES any "goto" out of P.  See examples
  94.    below for a way to get around this.
  95.  
  96.    You can call either Pascal interrupt routines or 8086
  97.    Interrupt_vector_elements directly with the following
  98.    procedures that take arguments from and return results in
  99.    the passed Machine_status.
  100. #endif
  101.    procedure Call_interrupt_routine
  102.       (var S:Machine_status; P:Interrupt_routine); External;
  103.    procedure Call_interrupt_vector_element
  104.       (var S:Machine_status; P:Interrupt_vector_element); External;
  105.  
  106. #if 0 
  107.    For example, to define a routine to catch the MS-DOS control/C
  108.    interrupt:
  109.     with Interrupts;            -- Open this package.
  110.         pragma Calling_convention(Pascal_interrupt);
  111.     procedure Catch_Control_C(S:Machine_status);
  112.         pragma Calling_convention();    -- Restore default convention.
  113.        begin
  114.        writeln('Ouch!!  You typed Control/C!!');
  115.        writeln('Don''t do it again!');
  116.        end;
  117.     ...
  118.     Install_interrupt_routine(Control_C_interrupt_index,Catch_Control_C);
  119.     -- Now, when ^C is typed, Catch_control_C is invoked.
  120.  
  121.    The interrupt routine may not generally be a non-level-1 procedure,
  122.    since the up-level context is not loaded by the hardware when the
  123.    interrupt occurs.  To achieve the same effect, store the non-level-1
  124.    procedure in a global procedure variable, and call this variable
  125.    from a level-1 interrupt routine.  Since a procedure variable records
  126.    the up-level context, such context can be re-loaded when the
  127.    procedure variable is called.
  128.    For example, here is a way to
  129.    use ^C to get back into an editor command level:
  130.  
  131.  
  132.     with Interrupts;            -- Open this package.
  133.  
  134.     var Call_when_CC_occurs: procedure;
  135.         pragma Calling_convention(Pascal_interrupt);
  136.     procedure Catch_Control_C(S:Machine_status);
  137.         pragma Calling_convention();    -- Restore default convention.
  138.        begin
  139.        Call_when_CC_occurs();
  140.        end;
  141.     procedure Editor;
  142.        label 1;
  143.        procedure CC;
  144.           begin
  145.           writeln('<INTERRUPT> -- command terminated.');
  146.           goto 1;    -- Non-local goto requires up-level reference to label.
  147.           end;
  148.        begin
  149.        Call_when_CC_occurs := CC;
  150.        Install_interrupt_routine(Control_C_interrupt_index,Catch_Control_C);
  151.        1:  while True do begin
  152.           Read_editor_command;
  153.           Process_editor_command;
  154.           end;
  155.        end;
  156.  
  157.    Use Vector_element to retrieve the MS-DOS control/C routine BEFORE
  158.    you insert your own, so that you can restore it before exiting:
  159.  
  160.    var Old_routine: Interrupt_vector_element;
  161.    ...
  162.    begin
  163.    Old_routine := Vector_element(Control_C_interrupt_index);
  164.    Install_interrupt_routine(Control_C_interrupt_index,My_routine);
  165.    ...
  166.    Install_interrupt_vector_element(Control_C_interrupt_index,Old_routine);
  167.    end;
  168. #endif
  169.  
  170.    { Because MS assembler truncates at 31, we had to use shorter names: }
  171.    pragma Alias(Install_interrupt_vector_element,Implement.RTE || 'install_ive');
  172.    pragma Alias(Call_interrupt_vector_element,Implement.RTE || 'call_ive');
  173.  
  174.  
  175.  
  176.    -- Catching control/C:
  177.  
  178.    procedure On_user_interrupt(function F(): Boolean); external;
  179. #if 0
  180.    When a user interrupt occurs (^C), function F will be invoked.
  181.    If F returns "TRUE" then the program will be immediately aborted;
  182.    otherwise, execution will continue
  183.    at the point that the interrupt occurred.
  184.  
  185.    If F is NOT a level-one (outermost) routine, read this:
  186.    F may contain up-level addressing, i.e., access to ancestor's
  187.    local variables, and it may contain a non-local goto to an
  188.    ancestor.  HOWEVER, YOU MUST ENSURE that F's ancestry is intact
  189.    when the interrupt occurs.  For example, if the routine that contains
  190.    F returns, then up-level addressing or non-local gotos from F will
  191.    no longer work.
  192.    If F is a level-one routine, this is not an issue, since F will
  193.    then have no ancestry.
  194.  
  195.    ALSO: MS-DOS does not support recursive interrupts.
  196. #endif
  197.    end;
  198.