home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCTV3N3.ZIP / 386OPS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-20  |  3.3 KB  |  118 lines
  1. unit _386_Ops;
  2. {Copyright (C) 1991..92, Midnight Beach.  All rights reserved}
  3.  
  4. interface
  5.  
  6. procedure Install_386_Ops;
  7.  
  8. implementation
  9.  
  10. {$ifdef Windows} uses WinProcs; {$endif}
  11.  
  12. {$R-,S-,G+,B-}
  13. {See note under "The replacer" to use this w/ TP 4 through 5.5}
  14.  
  15. {The replacement routines}
  16.  
  17. {$L c:\tpw\&tp6\_386_ops}
  18.  
  19.   procedure LongMul386;         far;    external;
  20.   procedure LongDivMod386;      far;    external;
  21.   procedure LongShr386;                 far;    external;
  22.   procedure LongShl386;                 far;    external;
  23.   procedure TailPtr;            far;    external;
  24.  
  25. {Dummy routine to find RTL entry points}
  26.  
  27. procedure Dummy; near;
  28. var
  29.   A, B: LongInt;
  30. begin
  31.   A := A * B;
  32.   A := A div B;
  33.   A := A shl 5;
  34.   A := A shr 5;
  35. end;
  36.  
  37. {The replacer}
  38.  
  39. const
  40.   ProcPrefixLen = {$ifopt G+} 4 {$else} 6 {$endif};
  41.   MulDivLen     = 13; {Offset of RTL pointer from start of `line'}
  42.   ShxLen        = 12; {Ditto}
  43.   InterOpLen    = 10; {SizeOf(pointer) +                     }
  44.                       {two moves from registers to stack vars}
  45.   {
  46.     The values above are for TP6 and TPW. For TP 4, 5, & 5.5, use:
  47.  
  48.       PrefixLen  =  6;
  49.       MulDivLen  = 11;
  50.       ShxLen     = 11;
  51.       InterOpLen = 10;
  52.   }
  53.   MulOfs = ProcPrefixLen + MulDivLen;
  54.   DivOfs = MulOfs + InterOpLen + MulDivLen;
  55.   ShlOfs = DivOfs + InterOpLen + ShxLen;
  56.   ShrOfs = ShlOfs + InterOpLen + ShxLen;
  57.  
  58. procedure Install_386_Ops;
  59. type
  60.   PtrPtr  = ^ pointer;
  61. var
  62.   Src:      pointer;
  63.   Dst:              record
  64.             case word of
  65.               2: (Ofs, Seg: word);
  66.               4: (Ptr:      pointer);
  67.             end;
  68.   DstPtr:   record
  69.             case word of
  70.               2: (Ofs, Seg: word);
  71.               4: (Ptr:      PtrPtr);
  72.             end;
  73. {$ifdef Windows}
  74. var
  75.   TpwBug: boolean;
  76. {$endif}
  77. begin
  78.   {$ifdef Windows}
  79.     TpwBug := Ofs(Dummy) = (Ofs(Dummy) + MulOfs);
  80.     {Bug is in 1.0 and 1.5, but not in 2.0 (I hope!)}
  81.   {$endif}
  82.   DstPtr.Seg := Seg(Dummy); {Segment of the ptr to the RTL code}
  83.   {multiplication}
  84.     DstPtr.Ofs :=  Ofs(Dummy) + MulOfs;
  85.     {$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, MulOfs); {$endif}
  86.     {Undoubtedly the worst compiler bug I've ever seen in Turbo Pascal!}
  87.     Dst.Ptr := DstPtr.Ptr^; {Read obj code; get ptr to RTL}
  88.     {$ifdef Windows}
  89.       Dst.Seg := AllocCStoDSAlias(Dst.Seg);
  90.       {$ifopt R+} if Dst.Seg = 0 then RunError(201); {$endif}
  91.     {$endif}
  92.     Src := @ LongMul386;
  93.     Move(Src^, Dst.Ptr^, Ofs(LongDivMod386) - Ofs(LongMul386));
  94.   {div and mod}
  95.     DstPtr.Ofs := Ofs(Dummy) + DivOfs;
  96.     {$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, DivOfs); {$endif}
  97.     Dst.Ofs := Ofs(DstPtr.Ptr^^);
  98.     Src := @ LongDivMod386;
  99.     Move(Src^, Dst.Ptr^, Ofs(LongShr386) - Ofs(LongDivMod386));
  100.   {shr}
  101.     DstPtr.Ofs := Ofs(Dummy) + ShrOfs;
  102.     {$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, ShrOfs); {$endif}
  103.     Dst.Ofs := Ofs(DstPtr.Ptr^^);
  104.     Src := @ LongShr386;
  105.     Move(Src^, Dst.Ptr^, Ofs(LongShl386) - Ofs(LongShr386));
  106.   {shl}
  107.     DstPtr.Ofs := Ofs(Dummy) + ShlOfs;
  108.     {$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, ShlOfs); {$endif}
  109.     Dst.Ofs := Ofs(DstPtr.Ptr^^);
  110.     Src := @ LongShl386;
  111.     Move(Src^, Dst.Ptr^, Ofs(TailPtr) - Ofs(LongShl386) );
  112.   {$ifdef Windows}
  113.     FreeSelector(Dst.Seg);
  114.   {$endif}
  115. end;
  116.  
  117. end.
  118.