[Overview][Constants][Types][Procedures and functions][Variables][Index] Reference for unit 'go32' (#rtl)

get_rm_callback

Return real mode callback

Declaration

Source position: go32.pp line 130

function get_rm_callback(

  pm_func: pointer;

  const reg: trealregs;

  var rmcb: tseginfo

):Boolean;

Description

Returns a unique real mode segment:offset address, known as a "real mode callback," that will transfer control from real mode to a protected mode procedure.

Parameters:

pm_func
pointer to the protected mode callback function.
reg
supplied registers structure.
rmcb
buffer to real mode address of callback function.

Return values: True if successful, otherwise False.

Remark: Callback addresses obtained with this function can be passed by a protected mode program for example to an interrupt handler, device driver, or TSR, so that the real mode program can call procedures within the protected mode program or notify the protected mode program of an event. The contents of the supplied regs structure is not valid after function call, but only at the time of the actual callback.

Errors

Check the int31error variable.

See also

free_rm_callback

  

Release real mode callback.

Example

{$ASMMODE ATT}
{$MODE FPC}

uses
        crt,
        go32;

const
        mouseint = $33;

var
        mouse_regs    : trealregs; external name '___v2prt0_rmcb_regs';
        mouse_seginfo : tseginfo;

var
        mouse_numbuttons : longint;

        mouse_action : word;
        mouse_x, mouse_y : Word;
        mouse_b : Word;

        userproc_installed : Longbool;
        userproc_length : Longint;
        userproc_proc : pointer;

procedure callback_handler; assembler;
asm
   pushw %ds
   pushl %eax
   movw %es, %ax
   movw %ax, %ds

   cmpl $1, USERPROC_INSTALLED
   jne .LNoCallback
   pushal
   movw DOSmemSELECTOR, %ax
   movw %ax, %fs
   call *USERPROC_PROC
   popal
.LNoCallback:

   popl %eax
   popw %ds

   pushl %eax
   movl (%esi), %eax
   movl %eax, %es: 42(%edi)
   addw $4, %es:46(%edi)
   popl %eax
   iret
end;
procedure mouse_dummy; begin end;

procedure textuserproc;
begin
        mouse_b := mouse_regs.bx;
        mouse_x := (mouse_regs.cx shr 3) + 1;
        mouse_y := (mouse_regs.dx shr 3) + 1;
end;

procedure install_mouse(userproc : pointer; userproclen : longint);
var r : trealregs;
begin
        r.eax := $0; realintr(mouseint, r);
        if (r.eax <> $FFFF) then begin
                Writeln('No Microsoft compatible mouse found');
                Writeln('A Microsoft compatible mouse driver is necessary ',
                        'to run this example');
                halt;
        end;
        if (r.bx = $ffff) then mouse_numbuttons := 2
        else mouse_numbuttons := r.bx;
        Writeln(mouse_numbuttons, ' button Microsoft compatible mouse ',
                ' found.');
        if (userproc <> nil) then begin
                userproc_proc := userproc;
                userproc_installed := true;
                userproc_length := userproclen;
                lock_code(userproc_proc, userproc_length);
        end else begin
                userproc_proc := nil;
                userproc_length := 0;
                userproc_installed := false;
        end;
        lock_data(mouse_x, sizeof(mouse_x));
        lock_data(mouse_y, sizeof(mouse_y));
        lock_data(mouse_b, sizeof(mouse_b));
        lock_data(mouse_action, sizeof(mouse_action));

        lock_data(userproc_installed, sizeof(userproc_installed));
        lock_data(userproc_proc, sizeof(userproc_proc));

        lock_data(mouse_regs, sizeof(mouse_regs));
        lock_data(mouse_seginfo, sizeof(mouse_seginfo));
        lock_code(@callback_handler,
                longint(@mouse_dummy)-longint(@callback_handler));
        get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
        r.eax := $0c; r.ecx := $7f;
        r.edx := longint(mouse_seginfo.offset);
        r.es := mouse_seginfo.segment;
        realintr(mouseint, r);
        r.eax := $01;
        realintr(mouseint, r);
end;

procedure remove_mouse;
var
        r : trealregs;
begin
        r.eax := $02; realintr(mouseint, r);
        r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
        realintr(mouseint, r);
        free_rm_callback(mouse_seginfo);
        if (userproc_installed) then begin
                unlock_code(userproc_proc, userproc_length);
                userproc_proc := nil;
                userproc_length := 0;
                userproc_installed := false;
        end;
        unlock_data(mouse_x, sizeof(mouse_x));
        unlock_data(mouse_y, sizeof(mouse_y));
        unlock_data(mouse_b, sizeof(mouse_b));
        unlock_data(mouse_action, sizeof(mouse_action));

        unlock_data(userproc_proc, sizeof(userproc_proc));
        unlock_data(userproc_installed, sizeof(userproc_installed));

        unlock_data(mouse_regs, sizeof(mouse_regs));
        unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
        unlock_code(@callback_handler,
                longint(@mouse_dummy)-longint(@callback_handler));
        fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
end;


begin
        install_mouse(@textuserproc, 400);
        Writeln('Press any key to exit...');
        while (not keypressed) do begin
                gotoxy(1, wherey);
                write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2,
                        ' Buttons : ', mouse_b:2);
        end;
        remove_mouse;
end.
The latest version of this document can be found at lazarus-ccr.sourceforge.net.