home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / win87emu / win87em.pas < prev   
Pascal/Delphi Source File  |  1993-03-29  |  7KB  |  253 lines
  1. {-----------------------------------------------------}
  2. {  WIN87EM.PAS - A Protected mode WIN87EM "simulator" }
  3. {  Copyright (c) 1993, Pat Ritchey  CIS:[70007,4660]  }
  4. {-----------------------------------------------------}
  5.  
  6. {$N+} { This is turned on so that the FP asm statements will compile }
  7.  
  8. {$IFNDEF DPMI}
  9.   !! Error: This is a Protected mode DLL.
  10. {$ENDIF}
  11.  
  12. Library Win87EM;
  13. {$C FIXED,PRELOAD,PERMANENT}      { Match SYSTEM unit attrib. }
  14. {$D WIN87EM DOS Protected mode code}
  15. {$S 65535}                        { All code in one segment }
  16.  
  17. uses WinAPI;
  18.  
  19. const
  20.   emDataSize = 230+16;  { from EI86.ASM }
  21.   npuDataSize = 108;    { Some references say 94 others say 108 }
  22.   SaveDataSize = emDataSize+npuDataSize;
  23.  
  24.   LibName = 'WIN87EM';
  25.  
  26.   EmulatorError =
  27.     'Emulator code not present, compile calling program with $N+'+
  28.      #13#10'         and include a floating point statement';
  29.  
  30.   FloatInstErr =
  31.     'A DLL has performed a floating point operation in its outer block.'+
  32.     #13#10'          This DLL is not useable in DOS protected mode.';
  33.  
  34.   NotWindowsErr =
  35.     'This DLL is not a Windows DLL.  It is a DOS Protected mode DLL';
  36.  
  37. function EmulatorWillInstall : boolean;
  38. { A hack to determine if the calling app will install the
  39.   emulator/FP support code.  The logic is:
  40.   1.  Find the limit of the stack segment.
  41.   2.  The return address to the APP will be at Stack's seg limit - 3.
  42.   3.  This return address will point to the FAR call that
  43.       calls SYSTEM.InitTurbo.
  44.   4.  IF the instruction following the APP's call to SYSTEM.InitTurbo
  45.       is another FAR call to code in the same segment, it is call to
  46.       SYSTEM.InitEM8x and the FP code will be installed.
  47.   5.  IF the instruction is NOT a FAR call or is a FAR call to a different
  48.       segment then the FP code will NOT be installed.
  49.  
  50.   Caveats:
  51.   --------
  52.   This routine assumes that WIN87EM.DLL is being loaded due to an implicit
  53.   reference to the DLL.  If this DLL is loaded via a LoadLibrary() call in
  54.   a calling app the stack will not be in the "as expected" state and the
  55.   result of this function is undefined
  56. }
  57. type
  58.   TFarCallInst = record
  59.      Opcode : byte;
  60.      Offset : word;
  61.      Segment : word;
  62.      end;
  63.   PAppEntry = ^TAppEntry;
  64.   TAppEntry = record
  65.      InitTurbo : TFarCallInst;
  66.      InitEM8x  : TFarCallInst;
  67.      end;
  68. var
  69.   SegLimit : word;
  70.   AppEntry : PAppEntry;
  71. const
  72.   CallFar = $9A;
  73. begin
  74.   EmulatorWillInstall := false;
  75.   asm
  76.     mov ax,ss
  77.     lsl ax,ax
  78.     mov SegLimit,ax
  79.   end;
  80.   AppEntry := PAppEntry(Ptr(SSeg,SegLimit-3)^);
  81.   With AppEntry^ do begin
  82.     If (InitTurbo.Opcode <> CallFar) or (InitEM8x.Opcode <> CallFar) then exit;
  83.     EmulatorWillInstall := InitTurbo.Segment = InitEM8x.Segment;
  84.     end;
  85. end;
  86.  
  87. procedure InvalidOp; far;
  88. begin
  89.    asm
  90.     sti
  91.     mov ax,Seg @DATA
  92.     mov ds,ax
  93.    end;
  94.    MessageBox(0,FloatInstErr,LibName,MB_OK);
  95.    RunError(207);
  96. end;
  97.  
  98. procedure InstallIntVect; assembler;
  99. { Yet another hack.  This procedure points all of the FP emulator interrupts
  100.   to the InvalidOp procedure.  This allows WIN87EM to trap floating point
  101.   operations that occur prior to the installation of the Borland floating
  102.   point code (ie: A DLL that does a FP op in it's LibMain code).  InvalidOp
  103.   displays a more user-friendly message than the "Unexpected interrupt" dump
  104.   produced by RTM.  The only remaing problem is how to handle DLLs produced
  105.   by BP7 (either Pmode or Windows) that have FP code in its outer block.
  106.   BP7 does not generate a call to __FPMATH in a Windows target DLL.
  107. }
  108. asm
  109.   push ds
  110.   push cs
  111.   pop  ds
  112.   mov  dx,OFFSET InvalidOp
  113.   mov  cx,11
  114.   mov  ax,$2534
  115.  @1:
  116.   int  $21
  117.   inc  ax
  118.   loop @1
  119.   pop  ds
  120. end;
  121.  
  122. function __FPMATH : word; export; external;
  123. {$L WIN87EM }
  124. {  __FPMATH is passed its parameters in the CPU registers.  Since one
  125.    of the parameters is passed in AX, BASM can't be used to implement
  126.    this function (the stack setup code would trash AX).  The external
  127.    code simply pushes the registers on the stack, establishes DS
  128.    addressability and calls FPMATH (see below). }
  129.  
  130. function FPMATH(Fn : word; DXReg : word; AXReg: word) : word; far;
  131. { __FPMATH has 13 functions.  Some (such as 0, 2 and 3) are already handled
  132.   by the Borland emulator.  Some MS DLLs/EXEs call function 11 to determine
  133.   if an NPU is present, so this function is supported.  The others MIGHT need
  134.   to be implemented.  Function 4 was easy to reverse engineer, so it's
  135.   included here. }
  136. begin
  137.   FPMATH := 0; { assume success }
  138.   case fn of
  139.     0:     ; { Initialize }
  140.     1:     ;
  141.     2:     ; { Cleanup }
  142.     3:     ; { set Exception Vector }
  143.     4:     begin
  144.             asm
  145.               and AXReg,$FF3C
  146.               fldcw AXReg
  147.             end;
  148.             FPMATH := AXReg;
  149.            end;
  150.     5:     ;
  151.     6:     ;
  152.     7:     ;
  153.     8:     ;
  154.     9:     ;
  155.    10:     ;
  156.    11:     FPMath := Test8087;
  157.    12:     ;
  158.    else
  159.      FPMATH := $FFFF; { invalid function }
  160.    end;
  161. end;
  162.  
  163. function __WIN87EMINFO(var InfoBuff; BuffLen : word) : wordbool; export;
  164. var
  165.   IB : array[0..5] of word absolute InfoBuff;
  166. begin
  167.   __WIN87EMINFO := true;
  168.   if BuffLen = 12 then
  169.      begin
  170.      IB[0] := $0600;        { I'm not sure what this value signifies ?? }
  171.      IB[1] := SaveDataSize;
  172.      IB[2] := SSeg;
  173.      IB[3] := CSeg;
  174.      IB[4] := word(Test8087);
  175.      IB[5] := 0;
  176.      __Win87EMInfo := false;
  177.     end;
  178. end;
  179.  
  180. function __WIN87EMRESTORE(var SaveBuff; BuffLen : word): wordbool; export;
  181. begin
  182.   __Win87EMRestore := true; { assume failure }
  183.   if BuffLen <> SaveDataSize then exit;
  184.   asm
  185.     mov  dl,Test8087
  186.     push ds
  187.     lds  si,SaveBuff
  188.     or   dl,dl
  189.     jz   @1
  190.     db   $9B     { wait }
  191.     db   $DD,$24 { frstor [si] }
  192.     @1:
  193.     add  si,npuDataSize
  194.     push ss
  195.     pop  es
  196.     mov  di,0
  197.     mov  cx,emDataSize
  198.     rep  movsb
  199.     pop  ds
  200.   end;
  201.   __Win87EMRestore := false;
  202. end;
  203.  
  204. function __WIN87EMSAVE(var SaveBuff; BuffLen : word) : wordbool; export;
  205. begin
  206.   __Win87EMSave := true;   { assume failure }
  207.   if BuffLen <> SaveDataSize then exit;
  208.   asm
  209.     les di,SaveBuff;
  210.     cmp Test8087,0
  211.     jz @1
  212.     db $9B          { wait }
  213.     db $26,$DD,$35  { fsave es:[di] }
  214.     @1:
  215.     add di,npuDataSize
  216.     push ds
  217.     mov ax,ss
  218.     mov ds,ax
  219.     xor ax,ax
  220.     mov cx,emDataSize
  221.     rep movsb
  222.     pop ds
  223.   end;
  224.   __Win87EMSave := false;
  225. end;
  226.  
  227.  
  228. exports
  229.  __FPMATH             index 1
  230. ,__WIN87EMINFO        index 3
  231. ,__WIN87EMRESTORE     index 4
  232. ,__WIN87EMSAVE        index 5
  233. ;
  234.  
  235.  
  236. begin
  237.    if GetWinFlags and wf_DPMI = 0 then
  238.       begin
  239.       MessageBox(0,NotWindowsErr,LibName,MB_OK);
  240.       halt;
  241.       end;
  242.    if not EmulatorWillInstall then
  243.       begin
  244.       MessageBox(0,EmulatorError,LibName,MB_OK);
  245.       RunError(207);
  246.       end;
  247.    InstallIntVect;
  248.    { A DLL doesn't link in the FP library, so Test8087 must be initialized
  249.      "manually" }
  250.    if GetWinFlags and wf_80x87 <> 0 then
  251.       Test8087 := 1;
  252. end.
  253.