ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TPFORT18.ZIP/OPRO.INC

Text File | 1992-03-08 | 7.9 KB | 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 [e-mail] 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-}