home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / vbcore / win87em.pas < prev   
Pascal/Delphi Source File  |  1994-05-12  |  8KB  |  319 lines
  1. {
  2.   WIN87EM.DLL Interface unit  version 2.0
  3.               by Juancarlo Anez [73000,1064]
  4.               date 93.07.28
  5.  
  6.   Purpose:
  7.          1) Solve the bug in BP who dosen't mention WIN87EM in a
  8.             $N+ DLL imports section.  Just include this module in
  9.             the DLL's LIBRARY unit's USES clause.
  10.  
  11.          2) Ability to ignore coprocessor exceptions
  12.  
  13.          3) Ability to set your own 80x87 exception handler.
  14.  
  15.          34 All other purposes of an interface unit.
  16.  
  17.  
  18.   This unit can be used form EXE's and DLL's since it does it's own initialization
  19.   and cleanup.  In teh case of EXE's that's redundant with BP for DLL's it is not.
  20.  
  21.   Freeware.  (Though you could send in some bucks if you like<g>)
  22.  
  23.   No garantees expressed or implied.
  24.  
  25.   Enjoy & pay forward
  26.  
  27.   chao, j
  28. }
  29. UNIT WIN87EM;
  30. INTERFACE
  31.   CONST
  32.     SIZE_80x87_AREA = 94;
  33.  
  34.     em87_Ok              = $00;
  35.     em87_StackOveUnder   = $80; {128}
  36.     em87_InvalidOperand  = $81; {129}
  37.     em87_DenormalOperand = $82; {130}
  38.     em87_DivideByZero    = $83; {131}
  39.     em87_Overflow        = $84; {132}
  40.     em87_Underflow       = $85; {133}
  41.     em87_Precision       = $86; {134}
  42.     em87_SqrtNegative    = $88; {136}
  43.  
  44.   CONST
  45.     iee_BitsInSingle   = 8*sizeOf(Single);
  46.     iee_BitsInDouble   = 8*sizeOf(Double);
  47.     iee_BitsInExtended = 8*sizeOf(Extended);
  48.  
  49.     iee_BitsInSExp     =  8;
  50.     iee_BitsInDExp     = 11;
  51.     iee_BitsInEExp     = 15;
  52.   TYPE
  53.     TBitSetForIEESingle   = set of 0..iee_BitsInSingle-1;
  54.     tBitSetForIEEDouble   = set of 0..iee_BitsInDouble-1;
  55.     tBitSetForIEEExtended = set of 0..iee_BitsInExtended-1;
  56.  
  57.   CONST
  58.     IEE_SINGLE_INF_BITS   :  TBitSetForIEESingle   = [23..iee_BitsInSingle-2];
  59.     IEE_DOUBLE_INF_BITS   :  TBitSetForIEEDouble   = [53..iee_BitsInDouble-2];
  60.     IEE_EXTENDED_INF_BITS :  TBitSetForIEEExtended = [64..iee_BitsInExtended-2];
  61.  
  62.     IEE_SINGLE_NAN_BITS   :  TBitSetForIEESingle   = [0..iee_BitsInExtended-2];
  63.     IEE_DOUBLE_NAN_BITS   :  TBitSetForIEEDouble   = [0..iee_BitsInDouble-2];
  64.     IEE_EXTENDED_NAN_BITS :  TBitSetForIEEExtended = [0..iee_BitsInExtended-2];
  65.   VAR
  66.     { representations of special numbers }
  67.     INF :Single absolute IEE_SINGLE_INF_BITS;
  68.     NAN :Single absolute IEE_SINGLE_NAN_BITS;
  69.  
  70.   TYPE
  71.     tEM87Handler = function (code :Byte):Byte;
  72.  
  73.     pWin87EmInfoStruct = ^Win87EmInfoStruct;
  74.     Win87EmInfoStruct = RECORD
  75.         Version,
  76.         SizeSaveArea,
  77.         WinDataSeg,
  78.         WinCodeSeg,
  79.         Havem87,
  80.         Unused          :Word;
  81.     END;
  82.  
  83.  
  84.     pWin87EmSaveArea = ^Win87EmSaveArea;
  85.     Win87EmSaveArea = RECORD
  86.       savem87Area : array[0..SIZE_80x87_AREA-1] of Byte;
  87.       saveEmArea    : array[0..0]                 of Byte;
  88.     END;
  89.  
  90.   procedure  __fpMath;
  91.  
  92.   { this 6 routines are the __fpMath functions }
  93.   {function  0}
  94.   function __fpInit:Boolean;
  95.   {function  1}
  96.   function __fpReset:Boolean;
  97.   {function  2}
  98.   procedure __fpStop;
  99.   {function  3}
  100.   procedure __fpSetHandler(exceptionHandler :Pointer);
  101.   {function 10}
  102.   function  __fpFPStackCount :Word;
  103.   {function 11}
  104.   function  __fp80x87Present :Boolean;
  105.  
  106.   function __Win87EmInfo(pWIS :Pointer; cbWin87EmInfoStruct :Word):Integer;
  107.   function __Win87EmSave(pWin87EmSaveArea:Pointer; cbWin87EmSaveArea:Word):Integer;
  108.   function __Win87EmRestore(pWin87EmSaveArea:Pointer; cbWin87EmSaveArea:Word):Integer;
  109.  
  110.  
  111.   VAR
  112.     Win87EMInfo : Win87EmInfoStruct;
  113.  
  114.   CONST
  115.     { this function is called whenever a 80x87 exception occurs,
  116.       default processing is almost like BP's,
  117.       place your own handling routine here }
  118.     em87Handler :tEM87Handler = nil;
  119.  
  120.     { the folowing variable determines how the default handler handles exceptions,
  121.          TRUE  = runtime error
  122.          FALSE = clear exceptions and carry on }
  123.     EM87AbortOnExceptions :Boolean = FALSE;
  124.  
  125.   { retreives last exception, and clears so next call is always 0 }
  126.   function  em87Exception :Byte;
  127.  
  128.   { set the exception handling to a custom routine,
  129.     the handler should return a non zero value that will be passed to RunError(),
  130.     or zero to clear exceptions and continue.
  131.     The default handler traduces exceptions to runtime errors like BP }
  132.   procedure setEM87ExceptionHandler(const handler :tEM87Handler);
  133.   function  em87DefaultHandler(code :Byte):Byte; far;
  134.  
  135.   procedure initEM87;
  136.  
  137.   function getFPExceptionFilter:Byte;
  138.   function setFPExceptionFilter(filter :Byte):Byte;
  139.   function isNAN(f :Extended):Boolean;
  140.  
  141. IMPLEMENTATION
  142.  
  143.   CONST
  144.     LastException :Byte = 0;
  145.  
  146.   procedure __fpMath; external 'WIN87EM' index 1;
  147.   function __Win87EmInfo(pWIS :Pointer; cbWin87EmInfoStruct :Word):Integer;
  148.   external 'WIN87EM' index 3;
  149.   function __Win87EmSave(pWin87EmSaveArea:Pointer; cbWin87EmSaveArea:Word):Integer;
  150.   external 'WIN87EM' index 5;
  151.   function __Win87EmRestore(pWin87EmSaveArea:Pointer; cbWin87EmSaveArea:Word):Integer;
  152.   external 'WIN87EM' index 4;
  153.  
  154.  
  155.   function __fpInit :Boolean; assembler;
  156.     asm
  157.       xor bx, bx
  158.       call __fpMath
  159.       jc @@1
  160.       xor ax, ax
  161.       jc @@2
  162.     @@1:
  163.       mov ax, 1
  164.     @@2:
  165.     end;
  166.  
  167.   function __fpReset :Boolean; assembler;
  168.     asm
  169.       mov  bx, 1
  170.       call __fpMath
  171.       jc @@1
  172.       xor ax, ax
  173.       jc @@2
  174.     @@1:
  175.       mov ax, 1
  176.     @@2:
  177.     end;
  178.  
  179.   procedure __fpStop; assembler;
  180.     asm
  181.       mov bx, 2
  182.       call __fpMath
  183.     end;
  184.  
  185.   procedure __fpSetHandler(exceptionHandler :Pointer); assembler;
  186.     asm
  187.         MOV   BX, 3
  188.         LES DI, ExceptionHandler
  189.         MOV   AX,DI
  190.         MOV   DX,ES
  191.         CALL   __FPMath
  192.     end;
  193.  
  194.   function __fpFPStackCount :Word; assembler;
  195.     asm
  196.       mov  bx, 10
  197.       call __fpMath
  198.     end;
  199.  
  200.   function __fp80x87Present :Boolean; assembler;
  201.     asm
  202.       mov  bx, 11
  203.       call __fpMath
  204.     end;
  205.  
  206.  
  207.  
  208.  
  209.   { does the same exception-code -> runtime-error-code conversion than BP   }
  210.   function em87DefaultHandler(code :Byte):Byte;
  211.     begin
  212.       case code of
  213.         em87_DivideByZero : em87DefaultHandler := 200;
  214.         em87_Overflow     : em87DefaultHandler := 205;
  215.         em87_Underflow    : em87DefaultHandler := 206;
  216.         else                em87DefaultHandler := 207
  217.       end;
  218.       if not EM87AbortOnExceptions then
  219.         em87DefaultHandler := 0
  220.     end;
  221.  
  222.   procedure setEM87ExceptionHandler(const handler :tEM87Handler);
  223.     begin
  224.        em87Handler := handler;
  225.     end;
  226.  
  227.   function  em87Exception :Byte;
  228.     begin
  229.       em87Exception := LastException;
  230.       LastException   := em87_Ok;
  231.       __fpReset;
  232.       asm  {clear exeptions}
  233.         FNCLEX
  234.         FWAIT
  235.       end;
  236.     end;
  237.  
  238.   function getFPExceptionFilter:Byte;
  239.     var
  240.       temp :Word;
  241.     begin
  242.       asm
  243.         fstcw Temp
  244.         fwait
  245.       end;
  246.       getFPExceptionFilter := temp and $FF
  247.     end;
  248.  
  249.   function setFPExceptionFilter(filter :Byte):Byte;
  250.     var
  251.       temp :Word;
  252.     begin
  253.       temp := getFPExceptionFilter;
  254.       setFPExceptionFilter := Temp;
  255.       temp := (temp and $FF00) or filter;
  256.       asm
  257.         fldcw Temp
  258.         fwait
  259.       end;
  260.     end;
  261.  
  262.   function isNAN(f :Extended):Boolean;
  263.     var
  264.       b :tBitSetForIEEExtended absolute f;
  265.     begin
  266.       isNAN := (IEE_EXTENDED_INF_BITS <= b) and not (b <= IEE_EXTENDED_INF_BITS);
  267.     end;
  268.  
  269.   { our own exception handler,
  270.    calls em87Handler and stops the program on a non 0 result
  271.    otherwise it resets clears the coprocesor exception }
  272.   procedure Exception; FAR;
  273.     var
  274.       code :Byte;
  275.     begin
  276.        asm
  277.          push ds   { restore data segment }
  278.          push SEG [lastException]
  279.          pop  ds
  280.          mov  [lastException], al
  281.        end;
  282.        code := em87Handler(lastException);
  283.        if code <> 0 then
  284.          runError(code)
  285.        else begin
  286.          __fpReset;
  287.          asm
  288.            pop ds  {undo data segment change }
  289.            FNCLEX
  290.            FWAIT
  291.          end; {clear exeptions}
  292.        end
  293.     end;
  294.  
  295.   const
  296.     exitSave :Pointer = nil;
  297.  
  298.   procedure exitEM87; far;
  299.     begin
  300.       __fpStop;
  301.       exitProc := exitSave
  302.     end;
  303.  
  304.  
  305.   procedure initEM87;
  306.    begin
  307.       __fpInit;
  308.       __fpSetHandler(@Exception);
  309.      setEM87ExceptionHandler(em87DefaultHandler);
  310.       __Win87EmInfo(@win87EMInfo, sizeOf(Win87EmInfo));
  311.       exitSave := exitProc;
  312.       exitProc := @exitEM87;
  313.    end;
  314.  
  315.  
  316. BEGIN
  317.   initEM87;
  318. END.
  319.