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