unit MathCopr;
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}
interface



const

  InvalidOp     = $01;

  DenormalOp    = $02;

  ZeroDivide    = $04;

  Overflow      = $08;

  Underflow     = $10;

  Precision     = $20;

  StackFault    = $40;

  StackOverflow = $200;



function Get87CtrlWord: word;



procedure Set87CtrlWord(NewCtrlWord: word);



procedure MathCoprMaskUnderflow;



implementation



function Get87CtrlWord: word; assembler;

var

  CtrlWord: word;

asm

        fstcw   CtrlWord

        mov     ax,CtrlWord

end;



procedure Set87CtrlWord(NewCtrlWord: word); assembler;

var

  CtrlWord: word;

asm

        mov     ax,NewCtrlWord

        mov     CtrlWord,ax

        fldcw   CtrlWord

end;



function Get87StatusWord: word; assembler;

var

  StatusWord: word;

asm

        fstsw   StatusWord

        mov     ax,StatusWord

end;



procedure MathCoprMaskUnderflow;

var

  CtrlWord: word;

begin

  CtrlWord:=Get87CtrlWord;

  CtrlWord:=CtrlWord or Underflow or Precision;

  Set87CtrlWord(CtrlWord);

end;



(*

var

  Ctrl, Status: word;

  X, Y: double;



begin

  Ctrl := Get87CtrlWord;

  Set87CtrlWord(Ctrl or Overflow); {Setting a bit masks the exception}

  X := 1e308; Y := X * X;

  Status := Get87StatusWord;

  Set87CtrlWord(Ctrl);

  if (Status and Overflow) <> 0    {A set bit indicates an exception}

    then WriteLn('Overflow flag set')

    else WriteLn('Overflow flag clear');

end.

*)



end.

