{ vesaipm.pas, Vesa Internal Protected Mode Services,
  Copr. 1995 Matthias K"oppe

  $Id$
 
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Library General Public
  License as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This library is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Library General Public License for more details.

  You should have received a copy of the GNU Library General Public
  License along with this library; if not, write to the Free
  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}

type
  PRealModeRegs = ^TRealModeRegs;
  TRealModeRegs = record
    case Integer of
      0: (
	EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
	Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
      1: (
	DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
	case Integer of
	  0: (
	    BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
	  1: (
	    BL, BH, BLH, BHH, DL, DH, DLH, DHH,
	    CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
  end;

var
  CallbackRegs: TRealModeRegs;
  RealMapFunc: pointer;

procedure AllocInfoArea; assembler;
asm
	mov	WORD PTR InfoDos[0], 0
	mov	WORD PTR InfoDos[2], 0
	mov	WORD PTR InfoPtr[0], 0
	mov	WORD PTR InfoPtr[2], 0
	mov	ax, 100h		{ allocate dos memory block }
	mov	bx, ASize
	mov	InfoSize, bx
	add	bx, 15
	shr	bx, 4
	int	31h
	jc	@@0
	mov	WORD PTR InfoDos[2], ax
	mov	WORD PTR InfoPtr[2], dx
@@0:
end;

procedure FreeInfoArea; assembler;
asm
	xor	ax, ax
	mov	es, ax			{ zero segment register;
					  DPMI does this since 1.0 }
	mov	ax, 101h		{ free dos memory block }
	mov	dx, WORD PTR InfoPtr[2]
	or	dx, dx
	jz	@@0
	int	31h
@@0:
end;

procedure ClearCB; assembler;
asm
	push    ax
	push	cx
	push	di
	MOV	CX, TYPE TRealModeRegs / 2
	XOR	AX, AX
	PUSH	DS
	POP	ES
	MOV	DI, OFFSET CallbackRegs
	CLD
	REP	STOSW
	pop	di
	pop	cx
	pop	ax
end;

procedure CallInt; assembler;
asm
	call	ClearCB
	mov	CallbackRegs.&ax, ax
	mov	CallbackRegs.&bx, bx
	mov	CallbackRegs.&cx, cx
	mov	CallbackRegs.&dx, dx
	mov	CallbackRegs.&si, si
	mov	CallbackRegs.&di, di
	mov	ax, WORD PTR InfoDos[2]
	mov	CallbackRegs.&es, ax
	mov	ax, ds
	mov	es, ax
	mov	di, OFFSET CallbackRegs
	MOV	AX, 0300H		{ Simulate real mode interrupt }
	MOV	BX, 0010H
	MOV	CX, 0
	INT	31H
	mov	ax, CallbackRegs.&ax
	mov	bx, CallbackRegs.&bx
	mov	dx, CallbackRegs.&dx
end;

procedure CallMapFunc; far; assembler;
asm
	push	es
	pusha
	call	ClearCB
	mov	CallbackRegs.&bx, bx
	mov	CallbackRegs.&dx, dx
	mov	ax, WORD PTR RealMapFunc[0]
	mov	dx, WORD PTR RealMapFunc[2]
	mov	CallbackRegs.&ip, ax
	mov	CallbackRegs.&cs, dx
	mov	ax, ds
	mov	es, ax
	mov	di, OFFSET CallbackRegs
	MOV	AX, 0301H		{ call real mode proc with far frame }
	MOV	BX, 0010H
	MOV	CX, 0
	INT	31H
	popa
	pop	es
	mov	ax, CallbackRegs.&ax
	mov	dx, CallbackRegs.&dx
end;

function GetProtModeCode(Func: Word): pointer;
var
  Source, CodeBuf: pointer;
  CodeSel: Word;
begin
  asm
	mov	ax, 4F0Ah
	mov	bx, Func
	call	CallInt
	cmp	ax, 004Fh
	jz	@@0
	mov	CallbackRegs.&cx, 0
  @@0:
  end;
  If CallbackRegs.cx <> 0
  then begin
    CodeBuf := GlobalAllocPtr(gmem_Fixed, CallbackRegs.cx);
    asm
	mov	ax, 0002h
	mov	bx, CallbackRegs.&es
	int	31h			{ Segment to descriptor }
	mov	Source.Word[2], ax
	mov	ax, CallbackRegs.&di
	mov	Source.Word[0], ax
    end;
    Move(Source^, CodeBuf^, CallbackRegs.cx);
    CodeSel := AllocSelector(Seg(CodeBuf^));
    CodeSel := PrestoChangoSelector(Seg(CodeBuf^), CodeSel);
    GetProtModeCode := Ptr(CodeSel, Ofs(CodeBuf^));
  end
  else
    GetProtModeCode := nil
end;

procedure FreeProtModeCode(Code: pointer);
begin
  GlobalFreePtr(Code)
end;

function MapFunc;
Begin
  MapFunc := @CallMapFunc;
  RealMapFunc := Func
end;
