{ Improved Delay routine
  For TP 6.0 and TP/BP 7.00/7.01 (real and protected mode).
  Copyright (C) 1996-99 by Frank Heckenbach

  Version 1.00, released 29-09-97

  (Note: The code itself has NOT changed since version 0.96!
         I just thought it was about time to finish beta stage and make a
         version 1.00)

  Please send any BUG REPORTS, COMMENTS and other FEEDBACK to me:
  frank(at)pascal.gnu.de or fjf(at)gmx.de

  Especially the accuracy probably still is to be improved a little. If
  someone wants to do that (using a high-precision timer - NOT the Bios system
  timer, or the GetTime procedure), please send me the results.

  The code is uncommented (as you will see yourself...), and I admit, some
  parts of it are probably not so easy to understand.
  If someone urgently needs some comments, I might write some.

 Copyright:
  Partially based on the Delay routine in the unit Crt,
   Copyright (C) 1988,91 Borland International.

  The rest of the code is copyright 1996-2001 by Frank Heckenbach.
  It is released as free software; the author gives unlimited
  permission to copy and/or distribute it, with or without
  modifications, as long as this notice is preserved and these
  comments from the beginning up to `***' are not modified!

  If you think you made an improvement, please contact me at the
  address shown above.

 Disclaimer:
  This code is provided "as is", in the hope that it will be useful,
  but WITHOUT ANY WARRANTY, to the extent permitted by law; without
  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
  PARTICULAR PURPOSE. I shall not be liable for any damages, whether
  direct, indirect, special, incidental or consequential arising
  from the use of the software or from the inability to use the
  software or from a failure of the software to operate in a manner
  desired by the user.

  In short: Use this code totally at your own risk!

 Features:

  * DelayCnt changed from Word to Longint to avoid overflow on a 200+ MHz CPU.

  * No init code necessary (unlike Crt) - at least for BP 7.0, if you don't
    use runtime patching (see below). Delay is initialized when first called.
    This saves about 1/18s and some bytes in programs that don't use Delay.
    Thus, the first delay will be a bit inaccurate (+/- 1/36.4 s).
    You can call Delay(0) at the start of the program to initialize Delay
    and avoid this inaccuracy.

  * Tries to avoid busy waiting by giving up timeslices via INT $2F,$1680 when
    running on a 80386 or above in a multitasking environment (as MS-Windows
    or Linux). E.g., in Linux, the CPU usage during a Delay dropped from
    about 90% with the old Delay code to under 0.1% with this replacement.

    In such an environment, of course, the delay may get inaccurate,
    especially longer than intended (with the old code as well as with
    this replacement).

    Credits to Walter Koch (walterk@ddorf.rhein-ruhr.de) for pointing me to
    this interrupt function.

  * Can patch Crt at runtime and prevent a runtime error caused by Crt's init
    code on a fast CPU.

  * Tested under NWDOS 7.0, MS-Windows 3.1 and the Linux DosEmu by the author.

    Dan Dumbrill <73170.1423@CompuServe.COM> says:
    `... on a PPro200 with Windows 95 ...  the code seems to
     work fine with both protected and real modes.'

    Michael Hermann <hermann@fmi.uni-passau.de> says:
    `I tried the fix, and it works also under OS/2 and Win95.'

    Further feedback about the behaviour under OS/2 and Win95 is wanted.

 History:
  0.90 06-10-96 First release
  0.91 20-10-96 Minor improvement in Delay
  0.92 16-11-96 TP 6.0 compatibility added
  0.93 18-11-96 Crt patching added
  0.94 27-11-96 Added comments confirming OS/2 and Win95 compatibility
  0.95 00-00-00 Skipped this version number! :-)
  0.96 21-01-97 Added comments about using Make to modify Crt
  1.00 29-09-97 Added comments about Linux (DosEmu) compatibility
                Officially ended beta stage

 Bug (possibly):
  Ralf Brown's interrupt list says about int $2f,$1680:
  `When called very often without intermediate screen output under Win 3+,
   the VM will go into an idle-state and will not receive the next slice
   before 8 seconds. This time can be changed in system.ini through
   `IdleVMWakeUpTime=<seconds>'. Setting to zero results in a long wait.'
  However, I could not see this effect, so my routine does nothing to prevent
  this problem. If you encounter this problem, please contact me (address:
  see above).

 ***

 Using this unit together with Crt
 Choose one of the three solutions described below:

 FIRST solution
 + Easiest
 - Requires changing all your units and programs
 - Does not fix the 200 MHz problem

  Use NewDelay AFTER Crt in the uses clause (`uses ..., Crt, NewDelay, ...')
  of the main program and of ALL units that use Crt, otherwise Crt's Delay
  routine will be used instead of the new one.
  On a 200+ MHz CPU, Crt's init code related to Delay will produce a runtime
  error. Using this unit in this way won't help against that.

 SECOND solution
 + "Clean" solution
 + No programs or other units have to be modified
 + Other units don't even have to be recompiled
 - only for BP 7.0
 - Needs RTL source
 - Most work

  Modify Crt and rebuild your RTL. (Even if you are not afraid of the 200 MHz
  problem, it might be a good idea to change Crt, if you have the RTL source.)
  This is done as follows (Note: since Crt is copyrighted by Borland, I cannot
  distribute a modified version of it, nor will you be allowed to give away
  your modified version.):

  Preparations:
  * Read all of the following steps before you start. If there's anything you
    don't understand, don't start!
  * Of course you will make BACKUPS of any files you change during the
    following process (BEFORE you change anything)!
  * You must have BP7.0 with the RTL sources. If you only have TP 6.0 or
    TP 7.0, you can't use this solution.
  * Did I mention BACKUPS already?
  * You should have a bit more than basic experience working with BP, or have
    someone experienced to assist you in case of unexpected problems.
  * If you lose some important data without having made BACKUPS, you'll get
    some problems - so make BACKUPS NOW!

  Main part:
  * Remove all delay related parts from crt.asm (in the rtl\crt directory).
    (Search for the string `delay' in the file, and keep your eyes open!
     Note: In the procedure `Initialize' it's the part from the line
     `MOV ES,Seg0040' to the line `MOV DelayCnt,AX', inclusively.)
  * Insert the implementation part of this unit - up to, but not including the
    line with `$ifdef PATCHCRT' - into the implementation of crt.pas (same
    directory), and remove the line `procedure Delay; external;' from it.
    Don't change anything in the interface part of crt.pas.
  * Instead of the next two or three steps, you can change into the RTL
    directory and call `make \bp\rtl\bin\tpu\crt.tpu' and
    `make \bp\rtl\bin\tpp\crt.tpp' or simply `make', respectively.
    However, this may not work if your directories aren't set up exactly as
    the makefile expects them to.
  * Assemble crt.asm (with `-d_DPMI_' to crt.obp for protected mode, and
    without this option to crt.obj for real mode) with tasm.
  * Compile crt.pas to crt.tpu and crt.tpp with bpc.
  * Update crt.tpu and crt.tpp in turbo.tpl and tpp.tpl, respectively, with
    tpumover (or, alternatively: remove them from turbo/tpp.tpl and include
    the path to either crt.pas or crt.tp? into your unit directories, and in
    the former case also the path to crt.ob? into your object directories).
  * After modifying Crt this way, you don't have to use NewDelay in your
    programs, of course.

 THIRD solution
 + Easy
 + No RTL source needed
 + Only the program - no other units - has to be modified and recompiled
 - Kind of a workaround
 - Not for protected mode

  This method patches Crt at runtime, i.e. the code in the Crt unit is
  modified whenever a program compiled with this unit is started. However,
  Crt's Delay procedure is not really fixed, just "redirected" to this unit's
  Delay procedure. Therefore, two versions of Delay will exist in the
  executable file, making it bigger than actually necessary.
  Additionally, an interrupt handler is installed to trap the `division by
  zero' error caused by Crt's init code. This works only for real mode.
  However, MS-Windows does not have Crt at all (and WinCrt does not have
  Delay), and protected mode is only available with BP 7.0 which comes with
  the RTL source, so you can use the second solution in this case. It should
  be obvious that installing a (temporary) interrupt handler is also not a
  very "clean" solution, and makes the executable bigger than necessary, but
  anyway it works.

  How to do it:
  * Define the symbol PATCHCRT in this unit, i.e. remove the # in the
    following line:
    } {#$define PATCHCRT} {
  * Use NewDelay IMMEDIATELY BEFORE Crt, and before any units that use Crt in
    the uses clause of the main program (`uses NewDelay, Crt, ...')
  * Insert the following line at the start of the main program:
    PatchCrt (Crt.Delay); }

{$ifdef WINDOWS}
This unit is not for MS-Windows!
{$endif}

unit NewDelay;

interface

{$ifdef PATCHCRT}

uses {$ifdef WINDOWS} WinProcs {$else} Dos {$endif};

type TCrtDelay = procedure (ms: Word);

procedure PatchCrt (CrtDelay: TCrtDelay);

{$endif}

{$ifdef VER60}

const
  Seg0040: Word = $40;
  Test8086: Byte = 0;  { Will be set to 2 if processor is 80386 or above }

{$endif}

procedure Delay (ms: Word);

implementation

const TimeSlice = 100;  { Threshold (in ms), above which Delay tries to give up
                          time slices. Can be changed. }

procedure DelayLoop; near; Assembler;  { Internal! }
asm
@1:sub  ax, 1
   sbb  dx, 0
   jc   @2
   cmp  bl, es:[di]
   je   @1
@2:
end;

procedure Delay (ms: Word); Assembler;
type LongRec = record Lo, Hi: Word end;
const DelayCnt: LongInt = 0;  { 0 means unitialized }
const op32 = $66;  { Prefix for 32bit operations }
asm
   mov  es, Seg0040
   mov  cx, ms
   mov  si, $6c
   mov  ax, DelayCnt.LongRec.Lo
   or   ax, DelayCnt.LongRec.Hi
   jne  @2
   mov  di, si
   mov  bl, es:[di]
@1:cmp  bl, es:[di]
   je   @1
   mov  bl, es:[di]
   mov  ax, -28
   cwd
   call DelayLoop
   not  ax
   not  dx
   mov  bx, ax
   mov  ax, dx
   xor  dx, dx
   mov  cx, 55
   div  cx
   mov  DelayCnt.LongRec.Hi, ax
   mov  ax, bx
   div  cx
   mov  DelayCnt.LongRec.Lo, ax
   mov  cx, ms
   sub  cx, 83
   jbe  @x
@2:jcxz @x
   xor  di, di
   mov  bl, es:[di]
   cmp  Test8086, 2
   jnb  @4
@3:xor  si, si
@4:mov  bh, es:[si]
@5:mov  ax, DelayCnt.LongRec.Lo
   mov  dx, DelayCnt.LongRec.Hi
   call DelayLoop
   cmp  bh, es:[si]
   jne  @7
@6:loop @5
   jmp  @x
@7:cmp  cx, TimeSlice
   jb   @6
   db   op32; mov dx, es:[si]
@8:mov  ax, $1680
   int  $2f
   or   al, al
   jnz  @3
   db   op32; Mov ax, dx
   db   op32; mov dx, es:[si]
   db   op32; sub ax, dx
   jbe  @9
   db   op32; mov ax, dx
   jmp  @a
@9:db   op32; neg ax
@a:db   op32; cmp ax, $4a7; dw 0  { cmp eax,$10000 div 55 }
   ja   @x
   push dx
   push cx
   mov  cx, 55
   mul  cx
   pop  cx
   pop  dx
   sub  cx, ax
   jbe  @x
   cmp  cx, TimeSlice
   jnb  @8
   jmp  @3
@x:
end;

{$ifdef PATCHCRT}
procedure Patch (OldProc, NewProc: Pointer);
{ General patch procedure.
  Patch writes a far jump to NewProc at the beginning of OldProc, thus
  directing all calls to OldProc to NewProc.
  OldProc and NewProc must both be pointers to far procedures/functions with
  the same number, order and type of parameters and the same return type (if
  functions). If they are different, no immediate error is generated, but most
  likely the program will crash when OldProc is called.
  Should also work with procedures/functions in overlaid units. }
type
  TFarJmp = record
    OpCode: Byte;
    Operand: Pointer
  end;
begin
  { Get a writeable pointer to OldProc }
  {$ifdef DPMI}
  OldProc := Ptr (Seg (OldProc^) + SelectorInc, Ofs (OldProc^));
  {$endif}
  {$ifdef WINDOWS}
  OldProc := Ptr (AllocCStoDSAlias (Seg (OldProc^)), Ofs (OldProc^));
  {$endif}
  with TFarJmp (OldProc^) do
    begin
      OpCode := $ea;  { jmp far ptr }
      Operand := NewProc
    end;
  {$ifdef WINDOWS}
  FreeSelector (Seg (OldProc^))
  {$endif}
end;

{$ifdef MSDOS}
const OldInt0P: Pointer = nil;
var OldInt0: procedure (Flags: Word) absolute OldInt0P;
{ `const OldInt0: procedure (Flags: Word) = nil' does not work in TP 6.0! }
{$endif}

procedure PatchCrt (CrtDelay: TCrtDelay);
begin
  Patch (@CrtDelay, @Delay);
  {$ifdef MSDOS}
  if @OldInt0 <> nil then SetIntVec (0, @OldInt0)  { No init bug has occurred! }
  {$endif}
end;

{$ifdef MSDOS}

procedure NewInt0 (Flags, cs, ip, ax, bx, cx, dx, si, di, ds, es, bp: Word); interrupt;
begin
  { Not a foolproof check, but should be sufficient, since NewDelay should
    be used IMMEDIATELY before Crt }
  if MemW [cs:ip] = $f1f7 then  { div cx }
    begin
      Writeln ('Crt init bug trapped!');
      SetIntVec (0, @OldInt0);
      @OldInt0 := nil;
      dx := cx - 1
    end
  else
    OldInt0 (Flags)
end;

begin
  GetIntVec (0, @OldInt0);
  SetIntVec (0, @NewInt0);
{$endif}
{$endif}

{$ifdef VER60}
begin
asm  { Check for 80386 }
   pushf
   pop  ax
   or   ah, $f0
   push ax
   popf
   pushf
   pop  ax
   and  ah, $f0
   je   @1
   mov  Test8086, 2
@1:
end
{$ifdef PATCHCRT}
{$ifdef MSDOS}
end
{$endif}
{$endif}
{$endif}
end.