home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
utility
/
tpfortra
/
opro.inc
< prev
next >
Wrap
Text File
|
1992-03-08
|
8KB
|
237 lines
{ This unit contains extracts from the excellent Object Professional
library by Turbopower Software, included here with their kind
permission. If you own Object Professional, you won't need this file;
just define the OPRO_VER conditional define in the Fortlink source
code.
If you don't own Object Professional, leave OPRO_VER undefined and this
include file will be automatically included. However, if you don't
own Object Professional you're really missing out; I'd suggest buying
it. You can contact TurboPower at 800-333-4160 or 719-260-6641
(voice), 719-260-7151 (fax), or by email to Compuserve ID 76004,2611
(that's 76004.2611@compuserve.com on Internet).
Duncan Murdoch
}
{$F+} { These are all far calls! }
{*********************************************************}
{* OPINLINE.PAS 1.10 *}
{* Copyright (c) TurboPower Software 1987, 1989. *}
{* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
{* and used under license to TurboPower Software *}
{* All rights reserved. *}
{*********************************************************}
type
OS =
record
O, S : Word;
end;
procedure FarCall(ProcAddr : Pointer);
{-ProcAddr is the address of a routine to be called far. Can be used to
implement jump tables if procedures take no parameters.}
inline(
$89/$E3/ {mov bx,sp}
$36/$FF/$1F/ {call far dword ptr ss:[bx]}
$81/$C4/$04/$00); {add sp,4}
function Normalized(P : Pointer) : Pointer;
{-Return P as a normalized pointer}
inline(
$58/ {pop ax ;pop offset into AX}
$5A/ {pop dx ;pop segment into DX}
$89/$C3/ {mov bx,ax ;BX = Ofs(P^)}
$B1/$04/ {mov cl,4 ;CL = 4}
$D3/$EB/ {shr bx,cl ;BX = Ofs(P^) div 16}
$01/$DA/ {add dx,bx ;add BX to segment}
$25/$0F/$00); {and ax,$F ;mask out unwanted bits in offset}
function PtrToLong(P : Pointer) : LongInt;
{-Convert pointer, in range $0:$0 to $FFFF:$000F, to LongInt}
begin
PtrToLong := (LongInt(OS(P).S) shl 4)+OS(P).O;
end;
function PtrDiff(P1, P2 : Pointer) : LongInt;
{-Return the number of bytes between P1^ and P2^}
begin
PtrDiff := Abs(PtrToLong(P1)-PtrToLong(P2));
end;
{*********************************************************}
{* OPINT.PAS 1.10 *}
{* Copyright (c) TurboPower Software 1987, 1989. *}
{* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
{* and used under license to TurboPower Software *}
{* All rights reserved. *}
{*********************************************************}
const
MaxISRs = 20;
type
Dummy5 = array[1..5] of Word;
IntRegisters =
record
case Byte of
1 : (BP, ES, DS, DI, SI, DX, CX, BX, AX, IP, CS, Flags : Word);
2 : (Dummy : Dummy5; DL, DH, CL, CH, BL, BH, AL, AH : Byte);
end;
IsrRecord =
record
IntNum : Byte; {Interrupt vector number}
OrigAddr : Pointer; {Original vector}
NewAddr : Pointer; {New vector}
Captured : Boolean; {Used for error checking}
end;
var
{global array of ISR records}
IsrArray : array[1..MaxISRs] of IsrRecord;
var
SaveExitProc : Pointer;
procedure InterruptsOn;
{-Turn interrupts on}
inline($FB); {sti}
function InitVector(IntNumber, Handle : Byte; UserRoutine : Pointer) : Boolean;
{-Sets up an interrupt service routine}
begin
{assume failure}
InitVector := False;
case Handle of
1..MaxISRs :
with IsrArray[Handle] do
if not Captured then begin
{Setup variables}
IntNum := IntNumber;
GetIntVec(IntNumber, OrigAddr);
{Set the vector}
SetIntVec(IntNumber, UserRoutine);
NewAddr := UserRoutine;
Captured := True;
InitVector := True;
end;
end;
end;
procedure RestoreVector(Handle : Byte);
{-Restores an interrupt vector to its original value}
begin
case Handle of
1..MaxISRs :
with IsrArray[Handle] do
if Captured then begin
SetIntVec(IntNum, OrigAddr);
Captured := False;
OrigAddr := nil;
end;
end;
end;
procedure SwapStackAndCallNear(Routine : Word; SP : Pointer;
var Regs : IntRegisters);
{-Switches to stack designated by SP and calls Routine with Regs as a
parameter. The Routine must be a NEAR call from the current ISR.}
inline(
$9C/ {pushf ;Load flags into AX}
$58/ {pop ax}
$5A/ {pop dx ;AX = Ofs(Regs)}
$07/ {pop es ;ES = Seg(Regs)}
$59/ {pop cx ;CX = new SP}
$5F/ {pop di ;DI = new SS}
$5B/ {pop bx ;BX = offset of Routine to call}
$8C/$D6/ {mov si,ss ;Save SS in SI}
$FA/ {cli ;Force interrupts off}
$8E/$D7/ {mov ss,di ;Switch stack segments}
$87/$E1/ {xchg cx,sp ;Get new SP and save old in CX}
$50/ {push ax ;Restore flags}
$9D/ {popf}
$9C/ {pushf ;Save flags again}
$56/ {push si ;Save old SS on stack}
$51/ {push cx ;Save old SP}
$06/ {push es ;Push Seg(Regs)}
$52/ {push dx ;Push Ofs(Regs)}
$FF/$D3/ {call near bx ;Call Routine}
$FA/ {cli ;Interrupts off}
$58/ {pop ax ;Get back old SP}
$5A/ {pop dx ;Get back old SS}
$59/ {pop cx ;Get back old flags}
$8E/$D2/ {mov ss,dx ;Restore SS}
$89/$C4/ {mov sp,ax ;Restore SP}
$51/ {push cx ;Restore flags}
$9D); {popf}
procedure RestoreAllVectors;
{-Restores all captured interrupt vectors}
var
I : Word;
begin
{restore in reverse order}
for I := MaxISRs downto 1 do
RestoreVector(I);
end;
procedure OpIntExit;
{-Exit/error handler for the unit. Restores all captured interrupt vectors}
begin
ExitProc := SaveExitProc;
RestoreAllVectors;
end;
procedure OpIntInit;
{-This sets up an array of unused ISR records}
var
I : Word;
begin
{initialize the array of ISR records}
for I := 1 to MaxISRs do
with IsrArray[I] do begin
IntNum := 0;
OrigAddr := nil;
NewAddr := nil;
Captured := False;
end;
end;
procedure OPINT_init;
begin
{initialize array of ISR records}
OpIntInit;
{set up exit handler}
SaveExitProc := ExitProc;
ExitProc := @OpIntExit;
end;
{*********************************************************}
{* OPDOS.PAS 1.10 *}
{* Copyright (c) TurboPower Software 1987, 1989. *}
{* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
{* and used under license to TurboPower Software *}
{* All rights reserved. *}
{*********************************************************}
function SetBlock(var Paragraphs : Word) : Boolean;
{-Change size of DOS memory block allocated to this program}
var
Regs : Registers;
begin
with Regs do begin
AH := $4A;
ES := PrefixSeg;
BX := Paragraphs;
MsDos(Regs);
Paragraphs := BX;
SetBlock := not Odd(Flags);
end;
end;
{$F-}