(* Example for an Interrupt in Protected Mode *)
(* For BORLAND PASCAL 7.0 using 16-bit DPMI   *)
(* Written by Winfried Borchardt              *)

program irq_call;

uses
crt, dos;

type
tregs =
record
edi, esi, ebp, res,
ebx, edx, ecx, eax : longint;
flags, es, ds, fs, gs,
ip, cs, sp, ss : word
end;

real_mode_ptr =
record
offset, segment : word
end;

var
reg_image : tregs;

int_1b_save,
int_1b_inst : real_mode_ptr;

ch : char;

{$F+}

procedure ctrl_break (ax, bx, cx, dx, si, di, ds, es, bp : word); 
interrupt;
type
int_stack = (ip, cs, flags);
stack_frame =
array [int_stack] of word;
var
stack : ^ stack_frame;
begin
stack := ptr (ds, si); 

(* here is the playground of the interrupt handler *)
(* don't use ax ...                                *)
(* you find the real mode registers in reg_image   *)

writeln ('BREAK');

reg_image.ip    := stack^ [ip];
reg_image.cs    := stack^ [cs];
reg_image.flags := stack^ [flags];
reg_image.sp    := reg_image.sp + 6;
end;

procedure get_real_int_vec (int_no : byte; var p : real_mode_ptr);
var regs : registers;
begin
with regs do
begin
ah := $02;
al := $00;
bl := int_no;
intr ($31, regs);
p.segment := cx;
p.offset := dx;
end;
end;

procedure set_call_back (const pm_routine     : pointer;
const data           : tregs;
var   real_mode_call : real_mode_ptr);
var regs : registers;
begin
with regs do
begin
ah := $03;
al := $03;
ds := seg (pm_routine^);
si := ofs (pm_routine^);
es := seg (data);
di := ofs (data);
intr ($31, regs);
real_mode_call.segment := cx;
real_mode_call.offset  := dx;
end;
end;

procedure release_call_back (p : real_mode_ptr);
var regs : registers;
begin
with regs do
begin
ah := $03;
al := $04;
cx := p.segment;
dx := p.offset;
intr ($31, regs);
end;
end;

procedure set_real_int_vec (int_no : byte; p : real_mode_ptr);
var regs : registers;
begin
with regs do
begin
ah := $02;
al := $01;
bl := int_no;
cx := p.segment;
dx := p.offset;
intr ($31, regs);
end;
end;

begin
set_call_back (addr (ctrl_break), reg_image, int_1b_inst); 
(* use for nested interrupts different t_regs *)   

get_real_int_vec ($1b, int_1b_save);
set_real_int_vec ($1b, int_1b_inst);

repeat
ch := readkey
until ch = #$1b;

set_real_int_vec ($1b, int_1b_save);
release_call_back (int_1b_inst);
end.