   PAGE          ,132

;    Name: PARSERA.ASM
;  Author: Chuck Ebbert  CompuServe [76306,1226]
;                         internet: 76306.1226@compuserve.com
;    Date: 12 July 1993

; Fast floating-point routines for Fractint.

;   Copyright (C) 1992, 1993 Chuck Ebbert.  All rights reserved.

; This program is an assembler version of the C 'execution engine' part
;    of Mark Peterson's FRACTINT Formula Parser.  Many of the operator
;    functions were copied from Mark's code in the files FPU087.ASM
;    and FPU387.ASM.  The basic operator functions are assembler versions
;    of the code in PARSER.C.  Many 'combined' operators functions were
;    added to the program as well.

;    This code may be freely distributed and used in non-commercial
;    programs provided the author is credited either during program
;    execution or in the documentation, and this copyright notice
;    is left intact.  Sale of this code, or its use in any commercial
;    product requires permission from the author.  Nominal distribution
;    and handling fees may be charged by shareware and freeware
;    distributors.

;       Chuck Ebbert
;       1915 Blust Ln.
;       Enola, PA  17025

   .386                                ; this only works on a 386
   .387                                ;  with a 387

ifdef ??version
   masm51
   quirks
endif

ARGSZ              equ 16              ; size of complex arg
;;;ARGSZ              equ 32              ; size of hypercomplex arg
CPFX               equ 4               ; size of constarg prefix
CARG               equ CPFX+ARGSZ      ; size of constarg
LASTSQR            equ CARG*4+CPFX     ; offset of lastsqr from start of v

; ---------------------------------------------------------------------------
FRAME              MACRO regs          ; build a stack frame
      push         bp
      mov          bp, sp
   IRP             reg, <regs>
      push         reg
      ENDM
   ENDM

UNFRAME            MACRO regs          ; unframe before return
   IRP             reg, <regs>
      pop          reg
      ENDM
      pop          bp
   ENDM

; ---------------------------------------------------------------------------
; Pop a number of scalars from the FPU stack.
; Generate as many 'fcompp' instr.'s as possible.
; Then a 'fstp st(0)' if needed.
POP_STK            MACRO StkPop
   NumToPop        = StkPop SHR 1
   REPT            NumToPop
      fcompp
      ENDM
   NumToPop        = StkPop - ( NumToPop SHL 1 )
   REPT            NumToPop
      fstp         st(0)
      ENDM
   ENDM

; Uncomment the following line to enable compiler code generation.
;;;COMPILER           EQU 1
; ---------------------------------------------------------------------------
; Generate beginning code for operator fn.
BEGN_OPER          MACRO OperName
   ifdef           COMPILER
;; generate the fixups for compiler
;; size of fn.
      db           Size_&OperName
;; offset of x fixup
      db           XFixup_&OperName
;; offset of y fixup
      db           YFixup_&OperName
;; offset of included(called) fn
      db           Incl_&OperName
;; addr of fn to include
      dw           IAddr_&OperName
;; size of fn to include
      db           ILen_&OperName
   else

;; only align when no compiler
   align           4
   endif

;; always generate public and begin of proc
   public          _fStk&OperName
_fStk&OperName     proc near
   ENDM

; ---------------------------------------------------------------------------
; Generate end of operator fn. code.
;
END_OPER           MACRO OperName
   ifndef          COMPILER
;; gen a return instr.
      ret
   else

;; gen a jump label
End_&OperName:
;; generate zero for fixups not generated during fn.
   ifndef          Incl_&OperName
;; No included operator. Generate zero offset, address, and size.
Incl_&OperName     EQU 0
IAddr_&OperName    EQU 0
ILen_&OperName     EQU 0
   endif
   ifndef          XFixup_&OperName
;; No X fixup.
XFixup_&OperName   EQU 0
   endif
   ifndef          YFixup_&OperName
;; No Y fixup
YFixup_&OperName   EQU 0
   endif
   endif

;; Always gen size of fn
Size_&OperName     EQU $ - _fStk&OperName
;; and end of procedure.
_fStk&OperName     endp
   ENDM

; ---------------------------------------------------------------------------
; Generate beginning code for 'included' operator fn.
; No fixups here.
BEGN_INCL          MACRO OperName
   ifndef          COMPILER
;; No align for 'compiler' mode.
   align           4
   endif

;; Generate public (incl fns. can be called directly) and begin of proc.
   public          _fStk&OperName
_fStk&OperName     proc near
   ENDM

; ---------------------------------------------------------------------------
; Generate end of 'included' operator fn. code.
END_INCL           MACRO OperName
   ifndef          COMPILER
;; generate return
      ret
   else

;; generate label for jump to end of fn.
End_&OperName:
   endif

;; always generate actual size of fn.
   Size_&OperName  EQU $ - _fStk&OperName
;; always generate end-of-proc
_fStk&OperName     endp
   ENDM

; ---------------------------------------------------------------------------
; 'Include' a function inside another one
INCL_OPER          MACRO CallingOper,OperToIncl
   ifdef           COMPILER
;; Offset of include in outer fn.
Incl_&CallingOper  EQU $ - _fStk&CallingOper
;; Address of included fn.
IAddr_&CallingOper EQU _fStk&OperToIncl
;; Length of included fn.
ILen_&CallingOper  EQU Size_&OperToIncl
   else

;; Generate a call to the included fn.
      call         _fStk&OperToIncl
   endif
   ENDM

; ---------------------------------------------------------------------------
; Exit early from an operator function.
EXIT_OPER          MACRO FnToExit
   ifdef           COMPILER
;; jump to end of operator fn
      jmp          short End_&FnToExit
   else

;; return to caller
      ret
   endif
   ENDM

; ---------------------------------------------------------------------------
; Generate an FPU instruction and a fixup.
; AddrToFix is = X or Y
FIXUP              MACRO OperName, InstrToFix, Addr
   ifdef           COMPILER

;; Generate a fixup as an offset from start of fn.
;; This is why no includes allowed before a fixup.
;; Fixup is two bytes into the instruction, thus the '+ 2'.
;; This may not be true for all instructions.
   ifidni          <Addr>, <X>
XFixup_&OperName   EQU $ - _fStk&OperName + 2
   else
;; assume fixup is for y
YFixup_&OperName   EQU $ - _fStk&OperName + 2
   endif
;; Generate a load, store or whatever of any convenient value using DS.
      &InstrToFix  QWORD PTR ds:_fLastOp
   else

   ifidni          <Addr>, <X>
;; Gen load of X using SI.
      &InstrToFix  QWORD PTR [si]
   else
;; Assume fixup is for y, use SI+8.
      &InstrToFix  QWORD PTR [si+8]
   endif
   endif

   ENDM

; ---------------------------------------------------------------------------
; Align 4 if no compiler.
PARSALIGN          macro AlignFn
   ifndef          COMPILER
   align           4
   endif
   ENDM

; ---------------------------------------------------------------------------
; external functions
   extrn           _TranspPerPixel:far

; ---------------------------------------------------------------------------
_DATA              segment word public use16 'DATA'
   extrn           _maxit:WORD
   extrn           _inside:WORD
   extrn           _outside:WORD
   extrn           _color:WORD
   extrn           _realcolor:WORD
   extrn           _kbdcount:WORD      ; keyboard counter
   extrn           _dotmode:WORD
   extrn           __1_:QWORD, _PointFive:QWORD, __2_:QWORD, _infinity:QWORD
   extrn           _LastOp:WORD, _LastInitOp:WORD
   extrn           _InitOpPtr:WORD, _InitStoPtr:WORD, _InitLodPtr:WORD
   extrn           _s:WORD
   extrn           _OpPtr:WORD, _LodPtr:WORD, _StoPtr:WORD
   extrn           _Load:DWORD, _Store:DWORD
   extrn           _FormName:byte
   extrn           _dy1:DWORD, _dx1:DWORD, _dy0:DWORD, _dx0:DWORD
   extrn           _new:WORD, _old:WORD
   extrn           _overflow:WORD
   extrn           _col:WORD, _row:WORD
   extrn           _Transparent3D:WORD
   extrn           _Arg1:WORD, _Arg2:WORD
   extrn           _f:DWORD, _pfls:DWORD, _v:DWORD
_DATA               ends

_BSS               segment word public use16 'BSS'
_fLastOp           label DWORD         ; save seg, offset of lastop here
      dd           ?
_PtrToZ            label WORD
      dw           ?
_BSS               ends

DGROUP             group _DATA,_BSS

; ---------------------------------------------------------------------------
; Operator Functions follow.
; ---------------------------------------------------------------------------

; NOTE: None of these operator functions may change any registers but
;       ax and si.  The exceptions are those functions that update
;       the current values of the 'status' regs as needed.

;  On entry to these functions:
;   FPU stack is used as the evaluation stack.
;         The FPU stack can overflow into memory.  Accuracy is not lost but
;         calculations are slower.
;   es -> DGROUP
;   ds -> seg pfls, seg v
;   cx -> lastop
;   dx == orbit counter (if calcfrmfpasm is running)
;   di -> stack overflow area, used by push and pull functions
;   bx -> current operator, operand pair
;    [bx] = operator function address, i.e. addr. of current '_fStkXXX'
;    [bx+2] = operand pointer or zero if no operand
;   si = operand pointer (loaded from [bx+2] before call of operator fn.)

; New rules Feb 1993:
;  1. No EXIT_OPER before an INCL_OPER.
;  2. No jumps can be made past an included function.
;  2. No included fn may include another, or have any fixups.
;  3. Only one included fn. allowed per 'normal' fn.
;  4. Fixups must be before any included fn.

; --------------------------------------------------------------------------
   ;  Put this code in PARSERFP.C's code segment.
PARSERFP_TEXT     segment para public use16 'CODE'
   ;  Non-standard segment register setup.
   assume         es:DGROUP, ds:nothing, cs:PARSERFP_TEXT
; --------------------------------------------------------------------------
; Included functions must be first.
; --------------------------------------------------------------------------
   BEGN_INCL       Log                 ; Log
   ; From FPU387.ASM
   ; Log is called by Pwr and is also called directly.
      ftst
      fstsw        ax
      sahf
      jnz          short NotBothZero
      fxch                             ; y x
      ftst
      fstsw        ax
      sahf
      fxch                             ; x y
      jnz          short NotBothZero
      POP_STK      2                   ; clear two numbers
      fldz
      fldz
      EXIT_OPER    Log                 ; return (0,0)
   PARSALIGN
NotBothZero:
      fld          st(1)               ; y x y
      fld          st(1)               ; x y x y
      fpatan                           ; z.y x y
      fxch         st(2)               ; y x z.y
      fmul         st,st(0)            ; yy x z.y
      fxch                             ; x yy z.y
      fmul         st,st(0)            ; xx yy z.y
      fadd                             ; mod z.y
      fldln2                           ; ln2, mod, z.y
      fmul         _PointFive          ; ln2/2, mod, z.y
      fxch                             ; mod, ln2/2, z.y
      fyl2x                            ; z.x, z.y
   END_INCL        Log
; --------------------------------------------------------------------------
   BEGN_INCL       SinhCosh            ; Included fn, Sinh, Cosh of st
   ; From FPU087.ASM with mods to use less registers.
      fstcw        _Arg2               ; use arg2 to hold CW
      fwait
      fldln2                           ; ln(2) x
      fdivp        st(1),st            ; x/ln(2), start the fdivr instr.
      mov          ax,_Arg2            ; Now do some integer instr.'s
      push         ax                  ; Save control word on stack
      or           ax,0000110000000000b
      mov          _Arg2,ax
      fldcw        _Arg2               ; Set control to round towards zero
      ftst                             ; save the sign of x in ax
      fstsw        ax                  ; sahf instr. is below
      fabs                             ; |x|/ln2
      fld          st                  ; |x|/ln(2), |x|/ln(2)
      frndint                          ; int = integer(|x|/ln(2)), |x|/ln(2)
      fxch                             ; |x|/ln(2), int
      fsub         st,st(1)            ; rem < 1.0, int
      fmul         _PointFive          ; rem/2 < 0.5, int
      f2xm1                            ; (2**(rem/2))-1, int
      fadd         __1_                ; 2**(rem/2), int
      fmul         st,st               ; 2**rem, int
      sahf                             ; ah has result of ftst above
      fscale                           ; e**|x|, int
      fstp         st(1)               ; e**|x|
      jae          short ExitFexp      ; skip divide if x was >= 0

      fdivr        __1_                ; e**x
   PARSALIGN
ExitFexp:
      fld          st                  ; e**x, e**x
      fmul         _PointFive          ; e^x/2 e^x
      fstp         QWORD PTR es:[di]   ; e^x  use overflow stk for temp here
      fdivr        _PointFive          ; e**-x/2
      pop          ax                  ; restore old CW to Arg2 after fdivr
      mov          _Arg2,ax
      fld          st                  ; e**-x/2, e**-x/2
      fadd         QWORD PTR es:[di]   ; coshx, e**-x/2
      fxch                             ; e^-x/2, coshx
      fsubr        QWORD PTR es:[di]   ; sinhx, coshx
      fldcw        _Arg2               ; Restore control word
   END_INCL        SinhCosh
; --------------------------------------------------------------------------
   BEGN_OPER       Conj                ; Complex conjugate
      fxch                             ; y x ...
      fchs                             ; y=-y x ...
      fxch                             ; x y ...
   END_OPER        Conj
; --------------------------------------------------------------------------
   BEGN_OPER       Real                ; Real
      fstp         st(1)               ; x ...
      fldz                             ; 0 x ...
      fxch                             ; x 0 ...
   END_OPER        Real
; --------------------------------------------------------------------------
   BEGN_OPER       RealFlip            ; Real, flip combined.
      fstp         st(1)               ; y=x ...
      fldz                             ; x=0 y ...
   END_OPER        RealFlip
; --------------------------------------------------------------------------
   BEGN_OPER       Add                 ; Add
      faddp        st(2),st            ; Arg2->d.x += Arg1->d.x;
      faddp        st(2),st            ; Arg2->d.y += Arg1->d.y;
   END_OPER        Add
; --------------------------------------------------------------------------
   BEGN_OPER       Sub                 ; Subtract
      fsubp        st(2),st            ; Arg2->d.x -= Arg1->d.x;
      fsubp        st(2),st            ; Arg2->d.y -= Arg1->d.y;
   END_OPER        Sub
; --------------------------------------------------------------------------
   BEGN_OPER       LodRealAdd          ; Load, Real, Add combined
      FIXUP        LodRealAdd, fadd, X ; Add x-value from memory
   END_OPER        LodRealAdd
; --------------------------------------------------------------------------
   BEGN_OPER       LodRealSub          ; Load, Real, Subtract combined
      FIXUP        LodRealSub, fsub, X ; (fsub qword ptr X)
   END_OPER        LodRealSub
; --------------------------------------------------------------------------
   BEGN_OPER       Real2               ; Real value (fast version)
      fldz                             ; 0 x y ... (uses a reg)
      fstp         st(2)               ; x 0 ...
   END_OPER        Real2
; --------------------------------------------------------------------------
   BEGN_OPER       Lod                 ; Load
      FIXUP        Lod, fld, Y         ; y ...
      FIXUP        Lod, fld, X         ; x y ...
   END_OPER        Lod
; --------------------------------------------------------------------------
   BEGN_OPER       Clr1                ; Clear stack
      fninit
   END_OPER        Clr1
; --------------------------------------------------------------------------
   BEGN_OPER       Imag                ; Imaginary value
      POP_STK      1                   ; y
      fldz                             ; 0 y
      fxch                             ; x=y 0
   END_OPER        Imag
; --------------------------------------------------------------------------
   BEGN_OPER       ImagFlip            ; Imaginary value, flip combined
      POP_STK      1                   ; y ...
      fldz                             ; x=0 y ...
   END_OPER        ImagFlip
; --------------------------------------------------------------------------
   BEGN_OPER Abs                       ; Absolute value
      fxch
      fabs
      fxch
      fabs
   END_OPER Abs
; --------------------------------------------------------------------------
   BEGN_OPER       LodRealMul          ; Load, Real, Multiply
      FIXUP        LodRealMul, fld, X  ; y.x x.x x.y
      fmul         st(2),st            ; y.x x.x z.y
      fmul                             ; z.x z.y
   END_OPER        LodRealMul
; --------------------------------------------------------------------------
   BEGN_OPER       Neg                 ; Negative
      fxch
      fchs                             ; Arg1->d.y = -Arg1->d.y;
      fxch
      fchs
   END_OPER        Neg
; --------------------------------------------------------------------------
   BEGN_OPER       EndInit             ; End of initialization expr.
      fninit
      mov          _LastInitOp,bx      ; LastInitOp=OpPtr
   END_OPER        EndInit
; --------------------------------------------------------------------------
   BEGN_OPER       StoClr1             ; Store, clear FPU
      FIXUP        StoClr1, fstp, X    ; y ...
      FIXUP        StoClr1, fst, Y     ; y ...
      finit                            ; use finit, not fninit
   END_OPER        StoClr1
; --------------------------------------------------------------------------
   BEGN_OPER       Sto                 ; Store, leave on ST
      fxch                             ; y x ...
      FIXUP        Sto, fst, Y
      fxch                             ; x y ...
      FIXUP        Sto, fst, X
      fwait                            ; to be safe
   END_OPER        Sto
; --------------------------------------------------------------------------
   BEGN_OPER       Sto2                ; Store, leave on ST (uses a reg)
      fld          st(1)               ; y x y
      FIXUP        Sto2, fstp, Y       ; x y
      FIXUP        Sto2, fst, X
   ; FWAIT should not be needed here since next operator is never Clr.
   END_OPER        Sto2
; --------------------------------------------------------------------------
   BEGN_OPER       LodReal             ; Load a real
      fldz                             ; 0 ...
      FIXUP        LodReal, fld, X     ; x 0 ...
   END_OPER        LodReal
; --------------------------------------------------------------------------
   BEGN_OPER       LodRealC            ; Load real const
      fldz                             ; y=0 ...
      FIXUP        LodRealC, fld, X    ; x 0 ...
   END_OPER        LodRealC
; --------------------------------------------------------------------------
   BEGN_OPER       LodRealFlip         ; Load real, flip
      FIXUP        LodRealFlip, fld, X ; y=x ...
      fldz                             ; x=0 y ...
   END_OPER        LodRealFlip
; --------------------------------------------------------------------------
   BEGN_OPER       LodRealAbs          ; Load real, abs
      fldz                             ; 0 ...
      FIXUP        LodRealAbs, fld, X  ; x 0 ...
      fabs                             ; x=abs(x) 0 ...
   END_OPER        LodRealAbs
; --------------------------------------------------------------------------
   BEGN_OPER       Flip                ; Exchange real, imag
      fxch                             ; x=y y=x ...
   END_OPER        Flip
; --------------------------------------------------------------------------
   BEGN_OPER       LodImag             ; Load, imaginary
      fldz                             ; 0 ...
      FIXUP        LodImag, fld, Y     ; x=y 0
   END_OPER        LodImag
; --------------------------------------------------------------------------
   BEGN_OPER       LodImagFlip         ; Load, imaginary, flip
      FIXUP        LodImagFlip, fld, Y ; y ...
      fldz                             ; 0 y ...
   END_OPER        LodImagFlip
; --------------------------------------------------------------------------
   BEGN_OPER       LodImagAbs          ; Load, imaginary, absolute value
      fldz                             ; 0 ...
      FIXUP        LodImagAbs, fld, Y  ; x=y 0 ...
      fabs                             ; x=abs(y) 0 ...
   END_OPER        LodImagAbs
; --------------------------------------------------------------------------
   BEGN_OPER       LodConj             ; Load, conjugate
      FIXUP        LodConj, fld, Y     ; y ...
      fchs                             ; y=-y ...
      FIXUP        LodConj, fld, X     ; x y ...
   END_OPER        LodConj
; --------------------------------------------------------------------------
   BEGN_OPER       LodAdd              ; Load, Add (uses a reg)
      FIXUP        LodAdd, fadd, X
      FIXUP        LodAdd, fld, Y
      faddp        st(2),st
   END_OPER        LodAdd
; --------------------------------------------------------------------------
   BEGN_OPER       LodSub              ; Load, Subtract (uses a reg)
      FIXUP        LodSub, fsub, X
      FIXUP        LodSub, fld, Y
      fsubp        st(2),st
   END_OPER        LodSub
; --------------------------------------------------------------------------
   BEGN_OPER       StoDup              ; Store, duplicate top operand
      FIXUP        StoDup, fst, X      ; x y
      fld          st(1)               ; y x y
      FIXUP        StoDup, fst, Y      ; y x y
      fld          st(1)               ; x y x y
   END_OPER        StoDup
; --------------------------------------------------------------------------
   BEGN_OPER       StoDbl              ; Store, double (uses a reg)
      FIXUP        StoDbl, fst, X      ; x y (store x)
      fadd         st,st               ; 2x y
      fld          st(1)               ; y 2x y
      FIXUP        StoDbl, fst, Y      ; y 2x y (store y)
      faddp        st(2),st            ; 2x 2y
   END_OPER        StoDbl
; --------------------------------------------------------------------------
   BEGN_OPER       LodSubMod           ; Load, Subtract, Mod
      FIXUP        LodSubMod, fsub, X  ; x.x-y.x  x.y  ...
      fmul         st,st               ; sqr(x.x-y.x) x.y ...
      fldz                             ; 0 sqrx x.y ...
      fxch         st(2)               ; x.y sqrx 0 ...
      FIXUP        LodSubMod, fsub, Y  ; x.y-y.y sqrx 0 ...
      fmul         st,st               ; sqry sqrx 0 ...
      fadd                             ; mod 0
   END_OPER        LodSubMod
; --------------------------------------------------------------------------
   BEGN_OPER       Sqr                 ; Square, save magnitude in LastSqr
      fld          st(0)               ; x x y
      fmul         st(1),st            ; x x*x y
      fmul         st,st(2)            ; xy xx y
      mov          si, WORD PTR _v     ; si -> variables
      fadd         st,st(0)            ; 2xy xx y
      fxch         st(2)               ; y xx 2xy
      fmul         st,st(0)            ; yy xx 2xy
      fld          st(1)               ; xx yy xx 2xy
      fadd         st,st(1)            ; xx+yy yy xx 2xy
      fstp         QWORD PTR [si+LASTSQR] ; yy xx 2xy
      fsubp        st(1),st            ; xx-yy 2xy
   END_OPER        Sqr
; --------------------------------------------------------------------------
   BEGN_OPER       Sqr0                ; Square, don't save magnitude
      fld          st(0)               ; x x y
      fld          st(0)               ; x x x y
      fmul         st,st(3)            ; xy x x y
      fadd         st,st               ; 2xy x x y
      fxch         st(3)               ; y x x 2xy
      fadd         st(2),st            ; y x x+y 2xy
      fsubp        st(1),st            ; x-y x+y 2xy
      fmulp        st(1),st            ; xx-yy 2xy
   END_OPER        Sqr0
; --------------------------------------------------------------------------
   BEGN_OPER       Mul                 ; Multiply
   ; From FPU087.ASM
      fld          st(1)               ; y.y, y.x, y.y, x.x, x.y
      fmul         st,st(4)            ; y.y*x.y, y.x. y.y, x.x, x.y
      fld          st(1)               ; y.x, y.y*x.y, y.x, y.y, x.x, x.y
      fmul         st,st(4)            ; y.x*x.x,y.y*x.y,y.x y.y,x.x,x.y
      fsubr                            ; newx=y.x*x.x-y.y*x.y,y.x,y.y,x.x,x.y
      fxch         st(3)               ; x.x, y.x, y.y, newx, x.y
      fmulp        st(2),st            ; y.x, y.y*x.x, newx, x.y
      fmulp        st(3),st            ; y.y*x.x, newx, y.x*x.y
      faddp        st(2),st            ; newx newy = y.x*x.y + x.x*y.y
   END_OPER        Mul
; --------------------------------------------------------------------------
   BEGN_OPER       LodMul              ; Load, Multiply
   ; This is just load followed by multiply but it saves a fn. call.
      FIXUP        LodMul, fld, Y      ; y.y x.x x.y
      FIXUP        LodMul, fld, X      ; y.x y.y x.x x.y
      fld          st(1)               ; y.y, y.x, y.y, x.x, x.y
      fmul         st,st(4)            ; y.y*x.y, y.x. y.y, x.x, x.y
      fld          st(1)               ; y.x, y.y*x.y, y.x, y.y, x.x, x.y
      fmul         st, st(4)           ; y.x*x.x, y.y*x.y, y.x, y.y, x.x, x.y
      fsubr                            ; newx=y.x*x.x-y.y*x.y,y.x,y.y,x.x,x.y
      fxch         st(3)               ; x.x, y.x, y.y, newx, x.y
      fmulp        st(2), st           ; y.x, y.y*x.x, newx, x.y
      fmulp        st(3), st           ; y.y*x.x, newx, y.x*x.y
      faddp        st(2), st           ; newx newy = y.x*x.y + x.x*y.y
   END_OPER        LodMul
; --------------------------------------------------------------------------
   BEGN_OPER       Div                 ; Divide
   ; From FPU087.ASM with speedups
      fld          st(1)               ; y.y,y.x,y.y,x.x,x.y
      fmul         st,st               ; y.y*y.y,y.x,y.y,x.x,x.y
      fld          st(1)               ; y.x,y.y*y.y,y.x,y.y,x.x,x.y
      fmul         st,st               ; y.x*y.x,y.y*y.y,y.x,y.y,x.x,x.y
      fadd                             ; mod,y.x,y.y,x.x,x.y
      ftst
      fstsw        ax
      sahf
      jz           short DivNotOk
                                       ; can't do this divide until now
      fdiv         st(1),st            ; mod,y.x=y.x/mod,y.y,x.x,x.y
      fdivp        st(2),st            ; y.x,y.y=y.y/mod,x.x,x.y
      fld          st(1)               ; y.y,y.x,y.y,x.x,x.y
      fmul         st,st(4)            ; y.y*x.y,y.x,y.y,x.x,x.y
      fld          st(1)               ; y.x,y.y*x.y,y.x,y.y,x.x,x.y
      fmul         st,st(4)            ; y.x*x.x,y.y*x.y,y.x,y.y,x.x,x.y
      fadd                             ; y.x*x.x+y.y*x.y,y.x,y.y,x.x,x.y
      fxch         st(3)               ; x.x,y.x,y.y,newx,x.y
      fmulp        st(2),st            ; y.x,y.y*x.x,newx,x.y
      fmulp        st(3),st            ; x.x*y.y,newx,y.x*x.y
      fsubp        st(2),st            ; newx,newy
      EXIT_OPER    Div
DivNotOk:
      POP_STK      5                   ; clear 5 from stack (!)
      fld          _infinity           ; return a very large number
      fld          st(0)
   END_OPER        Div
; --------------------------------------------------------------------------
   BEGN_OPER       Recip               ; Reciprocal
   ; From FPU087.ASM
      fld          st(1)               ; y, x, y
      fmul         st,st               ; y*y, x, y
      fld          st(1)               ; x, y*y, x, y
      fmul         st,st               ; x*x, y*y, x, y
      fadd                             ; mod, x, y
      ftst
      fstsw        ax
      sahf
      jz           short RecipNotOk
      fdiv         st(1),st            ; mod, newx=x/mod, y
      fchs                             ; -mod newx y
      fdivp        st(2),st            ; newx, newy=y/-mod
      EXIT_OPER    Recip
RecipNotOk:
      POP_STK      3                   ; clear three from stack
      fld          _infinity           ; return a very large number
      fld          st(0)
   END_OPER        Recip
; --------------------------------------------------------------------------
   BEGN_OPER       StoSqr              ; Sto, Square, save magnitude
      fld          st(0)               ; x x y
      FIXUP        StoSqr, fst, X      ;   "   (store x)
      fmul         st(1),st            ; x x*x y
      fmul         st,st(2)            ; xy xx y
      fadd         st,st(0)            ; 2xy xx y
      fxch         st(2)               ; y xx 2xy
      FIXUP        StoSqr, fst, Y      ;    "     (store y)
      fmul         st,st(0)            ; yy xx 2xy
   ; It is now safe to overlay si here
      mov          si, WORD PTR _v     ; si -> variables
      fld          st(1)               ; xx yy xx 2xy
      fadd         st,st(1)            ; xx+yy yy xx 2xy
      fstp         QWORD PTR [si+LASTSQR] ; yy xx 2xy
      fsubp        st(1),st            ; xx-yy 2xy
   END_OPER        StoSqr
; --------------------------------------------------------------------------
   BEGN_OPER       StoSqr0             ; Sto, Square, don't save magnitude
      fld          st(0)               ; x x y
      FIXUP        StoSqr0, fst, X     ; store x
      fld          st(0)               ; x x x y
      fmul         st,st(3)            ; xy x x y
      fadd         st,st               ; 2xy x x y
      fxch         st(3)               ; y x x 2xy
      FIXUP        StoSqr0, fst, Y     ; store y
      fadd         st(2),st            ; y x x+y 2xy
      fsubp        st(1),st            ; x-y x+y 2xy
      fmulp        st(1),st            ; xx-yy 2xy
   END_OPER        StoSqr0
; --------------------------------------------------------------------------
   BEGN_OPER       Mod2                ; Modulus (uses a reg)
      fmul         st,st               ; xx y
      fldz                             ; 0 xx y
      fxch         st(2)               ; y xx 0
      fmul         st,st               ; yy xx 0
      fadd                             ; mod 0
   END_OPER        Mod2
; --------------------------------------------------------------------------
   BEGN_OPER       LodMod2             ; Load, Modulus (uses a reg)
      fldz                             ; 0 ...
      FIXUP        LodMod2, fld, X     ; x 0 ...
      fmul         st,st               ; xx 0
      FIXUP        LodMod2, fld, Y     ; y xx 0
      fmul         st,st               ; yy xx 0
      fadd                             ; mod 0
   END_OPER        LodMod2
; --------------------------------------------------------------------------
   BEGN_OPER       StoMod2             ; Store, Modulus (uses a reg)
      FIXUP        StoMod2, fst, X     ; x y
      fmul         st,st               ; xx y
      fldz                             ; 0 xx y
      fxch         st(2)               ; y xx 0
      FIXUP        StoMod2, fst, Y     ; y xx 0
      fmul         st,st               ; yy xx 0
      fadd                             ; mod 0
   END_OPER        StoMod2
; --------------------------------------------------------------------------
   BEGN_OPER       Clr2                ; Test ST, clear FPU
      ftst
      fstsw        ax
      fninit
      and          ah,01000000b        ; return 1 if zf=1
      shr          ax,14               ; AX will be returned by fFormula()
   END_OPER        Clr2
; --------------------------------------------------------------------------
   BEGN_OPER       PLodAdd             ; Load, Add (uses no regs)
      fxch                             ; y x
      FIXUP        PLodAdd, fadd, Y    ; add y from memory
      fxch                             ; x y
      FIXUP        PLodAdd, fadd, X    ; add x, overlap execution
   END_OPER        PLodAdd
; --------------------------------------------------------------------------
   BEGN_OPER       PLodSub             ; Load, Subtract (uses no regs)
      fxch
      FIXUP        PLodSub, fsub, Y    ; sub y from memory
      fxch                             ; x y
      FIXUP        PLodSub, fsub, X    ; sub x, overlap execution
   END_OPER        PLodSub
; --------------------------------------------------------------------------
   BEGN_OPER       LodDup              ; Load, duplicate
      FIXUP        LodDup, fld, Y      ; y ...
      FIXUP        LodDup, fld, X      ; x y ...
      fld          st(1)               ; y x y ...
      fld          st(1)               ; x y x y ...
   END_OPER        LodDup
; --------------------------------------------------------------------------
   BEGN_OPER       LodSqr              ; Load, square (no save lastsqr)
      FIXUP        LodSqr, fld, Y      ; y ...
      fld          st(0)               ; y y ...
      fadd         st(1),st            ; y 2y ...
      fld          st(0)               ; y y 2y
      FIXUP        LodSqr, fld, X      ; x y y 2y ...
      fmul         st(3),st            ; x y y 2xy ...
      fadd         st(2),st				; x y X+y 2xy ...
      fsubrp       st(1),st            ; x-y x+y 2xy ...
      fmul                             ; xx-yy 2xy ...
   END_OPER        LodSqr
; --------------------------------------------------------------------------
   BEGN_OPER       LodSqr2             ; Load, square (save lastsqr)
      FIXUP        LodSqr2, fld, Y     ; y ...
      fld          st(0)               ; y y ...
      fadd         st(1),st            ; y 2y ...
      fmul         st,st(0)            ; yy 2y ...
      FIXUP        LodSqr2, fld, X     ; x yy 2y ...
      fmul         st(2),st            ; x yy 2xy ...
      mov          si,WORD PTR _v      ; put address of v in si
      fmul         st,st(0)            ; xx yy 2xy ...
      fld          st(0)               ; xx xx yy 2xy
      fadd         st,st(2)            ; mod xx yy 2xy
      fstp         QWORD PTR [si+LASTSQR] ; xx yy 2xy ... (save lastsqr)
      fsubrp       st(1),st            ; xx-yy 2xy ...
   END_OPER        LodSqr2
; --------------------------------------------------------------------------
   BEGN_OPER       LodDbl              ; Load, double
      FIXUP        LodDbl, fld, Y      ; load y
      fadd         st,st(0)            ; double it
      FIXUP        LodDbl, fld, X      ; same for x
      fadd         st,st(0)
   END_OPER        LodDbl
; --------------------------------------------------------------------------
   BEGN_OPER       Mod                 ; Modulus (uses no regs)
      fmul         st,st               ; x*x y
      fxch                             ; y x*x
      fmul         st,st               ; y*y x*x
      fadd                             ; mod
      fldz                             ; 0 mod
      fxch                             ; mod 0
   END_OPER        Mod
; --------------------------------------------------------------------------
; The following code was 'discovered' by experimentation.  The Intel manuals
;   really don't help much in writing this kind of code.
; --------------------------------------------------------------------------
   BEGN_OPER       Push2               ; Push stack down from 8 to 6
      fdecstp                          ; roll the stack
      fdecstp                          ; ...
      fstp         tbyte PTR es:[di]   ; store x on overflow stack
      fstp         tbyte PTR es:[di+10] ; and y (ten bytes each)
      add          di,20               ; adjust di
   END_OPER        Push2
; --------------------------------------------------------------------------
   BEGN_OPER       Pull2               ; Pull stack up from 2 to 4
      fld          tbyte PTR es:[di-10] ; oldy x y
      sub          di,20               ; adjust di
      fxch         st(2)               ; y x oldy
      fld          tbyte PTR es:[di]   ; oldx y x oldy
      fxch         st(2)               ; x y oldx oldy
   END_OPER        Pull2
; --------------------------------------------------------------------------
   BEGN_OPER       Push4               ; Push stack down from 8 to 4
      fdecstp                          ; roll the stack four times
      fdecstp
      fdecstp
      fdecstp
      fstp         tbyte PTR es:[di+20] ; save the bottom four numbers
      fstp         tbyte PTR es:[di+30] ; save full precision on overflow
      fstp         tbyte PTR es:[di]
      fstp         tbyte PTR es:[di+10]
      add          di,40                ; adjust di
   END_OPER        Push4
; --------------------------------------------------------------------------
   BEGN_OPER       Push2a              ; Push stack down from 6 to 4
      fdecstp                          ; roll the stack 4 times
      fdecstp
      fdecstp
      fdecstp
      fstp         tbyte PTR es:[di]   ; save only two numbers
      fstp         tbyte PTR es:[di+10]
      add          di, 20
      fincstp                          ; roll back 2 times
      fincstp
   END_OPER        Push2a
; --------------------------------------------------------------------------
; End of stack overflow/underflow code.
; --------------------------------------------------------------------------
   BEGN_OPER       Exp                 ; Exponent
   ; From FPU387.ASM with mods to use less registers.
      fstp         QWORD PTR es:[di]   ; y
      fsincos                          ; cosy, siny
      fld1                             ; 1, cos, sin
      fldln2                           ; ln2, 1, cos, sin
      fdivr        QWORD PTR es:[di]   ; x.x/ln2, 1, cos, sin
      fst          QWORD PTR es:[di]
      fprem                            ; prem, 1, cos, sin
      f2xm1                            ; e**prem-1, 1, cos, sin
      fadd                             ; e**prem, cos, sin
      fld          QWORD PTR es:[di]   ; x.x/ln2, e**prem, cos, sin
      fxch                             ; e**prem, x.x/ln2, cos, sin
      fscale                           ; e**x.x, x.x/ln2, cos, sin
      fstp         st(1)               ; e**x.x, cos, sin
      fmul         st(2),st            ; e**x.x, cos, z.y
      fmul                             ; z.x, z.y
   END_OPER        Exp
; --------------------------------------------------------------------------
   BEGN_OPER       Pwr                 ; Power
   ; First exchange the top two complex numbers.
      fxch         st(2)               ; x.x y.y y.x x.y
      fxch                             ; y.y x.x y.x x.y
      fxch         st(3)               ; x.y x.x y.x y.y
      fxch                             ; x.x x.y y.x y.y
   ; Now take the log of the # on st.
      INCL_OPER    Pwr, Log            ; l.x l.y y.x y.y
   ; Inline multiply function from FPU087.ASM instead of include.
      fld          st(1)               ; y.y, y.x, y.y, x.x, x.y
      fmul         st,st(4)            ; y.y*x.y, y.x. y.y, x.x, x.y
      fld          st(1)               ; y.x, y.y*x.y, y.x, y.y, x.x, x.y
      fmul         st,st(4)            ; y.x*x.x, y.y*x.y, y.x, y.y, x.x, x.y
      fsubr                            ; newx = y.x*x.x - y.y*x.y, y.x, y.y, x.x, x.y
      fxch         st(3)               ; x.x, y.x, y.y, newx, x.y
      fmulp        st(2),st            ; y.x, y.y*x.x, newx, x.y
      fmulp        st(3),st            ; y.y*x.x, newx, y.x*x.y
      faddp        st(2),st            ; newx newy = y.x*x.y + x.x*y.y
   ; Exp function from FPU387.ASM with mods to use less registers.
      fstp         QWORD PTR es:[di]   ; y
      fsincos                          ; cosy, siny
      fld1                             ; 1, cos, sin
      fldln2                           ; ln2, 1, cos, sin
      fdivr        QWORD PTR es:[di]   ; x.x/ln2, 1, cos, sin
      fst          QWORD PTR es:[di]
      fprem                            ; prem, 1, cos, sin
      f2xm1                            ; e**prem-1, 1, cos, sin
      fadd                             ; e**prem, cos, sin
      fld          QWORD PTR es:[di]   ; x.x/ln2, e**prem, cos, sin
      fxch                             ; e**prem, x.x/ln2, cos, sin
      fscale                           ; e**x.x, x.x/ln2, cos, sin
      fstp         st(1)               ; e**x.x, cos, sin
      fmul         st(2),st            ; e**x.x, cos, z.y
      fmul                             ; z.x, z.y
   END_OPER        Pwr
; --------------------------------------------------------------------------
   BEGN_OPER       Cosh                ; Cosh
      INCL_OPER    Cosh, SinhCosh      ; sinhx coshx y
      fxch         st(2)               ; y coshx sinhx
      fsincos                          ; cosy siny coshx sinhx
      fxch                             ; siny cosy coshx sinhx
      fmulp        st(3),st            ; cosy coshx y=sinhx*siny
      fmulp        st(1),st            ; x=cosy*coshx y
   END_OPER        Cosh
; --------------------------------------------------------------------------
   BEGN_OPER       Sinh                ; Sinh
      INCL_OPER    Sinh, SinhCosh      ; sinhx coshx y
      fxch         st(2)               ; y coshx sinhx
      fsincos                          ; cosy siny coshx sinhx
      fmulp        st(3),st            ; siny coshx x=sinhx*cosy
      fmulp        st(1),st            ; y=coshx*siny x
      fxch                             ; x y
   END_OPER        Sinh
; --------------------------------------------------------------------------
   BEGN_OPER       Sin                 ; Sin
      fsincos                          ; cosx sinx y
      fxch         st(2)               ; y sinx cosx
      INCL_OPER    Sin, SinhCosh       ; sinhy coshy sinx cosx
      fmulp        st(3),st            ; coshy sinx y=cosx*sinhy
      fmulp        st(1),st            ; x=sinx*coshy y
   END_OPER        Sin
; --------------------------------------------------------------------------
   BEGN_OPER       Cos                 ; Cos
      fsincos                          ; cosx sinx y
      fxch         st(2)               ; y sinx cosx
      INCL_OPER    Cos, SinhCosh       ; sinhy coshy sinx cosx
      fchs                             ; -sinhy coshy sinx cosx
      fmulp        st(2),st            ; coshy y=-sinhy*sinx cosx
      fmulp        st(2),st            ; y x=cosx*coshy
      fxch                             ; x y
   END_OPER        Cos
; --------------------------------------------------------------------------
   BEGN_OPER       CosXX               ; CosXX
      fsincos                          ; cosx sinx y
      fxch         st(2)               ; y sinx cosx
      INCL_OPER    CosXX, SinhCosh     ; sinhy coshy sinx cosx
      ; note missing fchs here
      fmulp        st(2),st            ; coshy y=sinhy*sinx cosx
      fmulp        st(2),st            ; y x=cosx*coshy
      fxch                             ; x y
   END_OPER        CosXX
; --------------------------------------------------------------------------
   BEGN_OPER       Tan                 ; Tan
      fadd         st,st               ; 2x y
      fsincos                          ; cos2x sin2x y
      fxch         st(2)               ; y sin2x cos2x
      fadd         st,st               ; 2y sin2x cos2x
      INCL_OPER    Tan, SinhCosh       ; sinh2y cosh2y sin2x cos2x
      fxch                             ; cosh2y sinh2y sin2x cos2x
      faddp        st(3),st            ; sinhy sinx denom=cos2x+cosh2y
      fld          st(2)               ; denom sinh2y sin2x denom
      fdivp        st(2),st            ; sinh2y x=sin2x/denom denom
      fdivrp       st(2),st            ; x y=sinh2y/denom
   END_OPER        Tan
; --------------------------------------------------------------------------
   BEGN_OPER       CoTan               ; CoTan
      fadd         st,st               ; 2x y
      fsincos                          ; cos2x sin2x y
      fxch         st(2)               ; y sin2x cos2x
      fadd         st,st               ; 2y sin2x cos2x
      INCL_OPER    CoTan, SinhCosh     ; sinh2y cosh2y sin2x cos2x
      fxch                             ; cosh2y sinh2y sin2x cos2x
      fsubrp       st(3),st            ; sinh2y sin2x denom=cosh2y-cos2x
      fld          st(2)               ; denom sinh2y sin2x denom
      fdivp        st(2),st            ; sinh2y x=sin2x/denom denom
      fchs                             ; -sinh2y x denom
      fdivrp       st(2),st            ; x y=-sinh2y/denom
   END_OPER        CoTan
; --------------------------------------------------------------------------
   BEGN_OPER       Tanh                ; Tanh
      fadd         st,st               ; 2x y
      INCL_OPER    Tanh, SinhCosh      ; sinh2x cosh2x y
      fxch         st(2)               ; y cosh2x sinh2x
      fadd         st,st               ; 2y cosh2x sinh2x
      fsincos                          ; cos2y sin2y cosh2x sinh2x
      faddp        st(2),st            ; sin2y denom=cos2y+cosh2x sinh2x
      fxch                             ; denom sin2y sinh2x
      fdiv         st(1),st            ; denom y=sin2y/denom sinh2x
      fdivp        st(2),st            ; y x=sinh2x/denom
      fxch                             ; x y
   END_OPER        Tanh
; --------------------------------------------------------------------------
   BEGN_OPER       CoTanh              ; CoTanh
      fadd         st,st               ; 2x y
      INCL_OPER    CoTanh, SinhCosh    ; sinh2x cosh2x y
      fxch         st(2)               ; y cosh2x sinh2x
      fadd         st,st               ; 2y cosh2x sinh2x
      fsincos                          ; cos2y sin2y cosh2x sinh2x
      fsubp        st(2),st            ; sin2y denom=cosh2x-cos2y sinh2x
      fchs                             ; -sin2y denom sinh2x
      fxch                             ; denom -sin2y sinh2x
      fdiv         st(1),st            ; denom y=-sin2y/denom sinh2x
      fdivp        st(2),st            ; y x=sinh2x/denom
      fxch                             ; x y
   END_OPER CoTanh
; --------------------------------------------------------------------------
   BEGN_OPER       LT                  ; <
   ; Arg2->d.x = (double)(Arg2->d.x < Arg1->d.x);
      fcomp        st(2)               ; y.y, x.x, x.y, comp arg1 to arg2
      fstsw        ax
      POP_STK      3
      sahf
      fldz                             ; 0 (Arg2->d.y = 0.0;)
      jbe          short LTfalse       ; jump if arg1 <= arg2
      fld1                             ; 1 0 (return arg2 < arg1)
      EXIT_OPER    LT
LTfalse:
      fldz                             ; 0 0
   END_OPER        LT
; --------------------------------------------------------------------------
   BEGN_OPER       LT2                 ; LT, set AX, clear FPU
   ; returns !(Arg2->d.x < Arg1->d.x) in ax
      fcom         st(2)               ; compare arg1, arg2
      fstsw        ax
      fninit
      sahf
      setbe        al                  ; return (Arg1 <= Arg2) in AX
      xor          ah,ah
   END_OPER        LT2
; --------------------------------------------------------------------------
   BEGN_OPER       LodLT               ; load, LT
   ; return (1,0) on stack if arg2 < arg1
      FIXUP        LodLT, fcomp, X     ; compare arg2 to arg1, pop st
      fstsw        ax                  ; y ...
      POP_STK      1                   ; ...
      sahf
      fldz                             ; 0 ...
      jae          short LodLTfalse    ; jump when arg2 >= arg1
      fld1                             ; 1 0 ...
      EXIT_OPER    LodLT
LodLTfalse:
      fldz                             ; 0 0 ...
   END_OPER        LodLT
; --------------------------------------------------------------------------
   BEGN_OPER       LodLT2              ; Lod, LT, set AX, clear FPU
   ; returns !(Arg2->d.x < Arg1->d.x) in ax
      FIXUP        LodLT2, fcom, X     ; compare arg2, arg1
      fstsw        ax
      fninit                           ; clear fpu
      sahf
      setae        al                  ; set al when arg2 >= arg1
      xor          ah,ah               ; clear ah
   END_OPER        LodLT2              ; ret 0 in ax for true, 1 for false
; --------------------------------------------------------------------------
   BEGN_OPER       LodLTMul            ; Lod, LT, Multiply (needs 4 on stack)
   ; for '<expr> * ( <expr> < <var> )'
   ; return number on stack if arg2 < arg1
      FIXUP        LodLTMul, fcomp, X  ; comp Arg2 to Arg1, pop st
      fstsw        ax                  ; save status
      POP_STK      1                   ; clear 1 from stack
      sahf
      jae          short LodLTMulfalse ; jump if arg2 >= arg1
      EXIT_OPER    LodLTMul            ; return value on st
   PARSALIGN
LodLTMulfalse:
      POP_STK      2                   ; return (0,0)
      fldz
      fldz
   END_OPER        LodLTMul
; --------------------------------------------------------------------------
   BEGN_OPER       GT                  ; >
   ; Arg2->d.x = (double)(Arg2->d.x > Arg1->d.x);
      fcomp        st(2)               ; compare arg1, arg2
      fstsw        ax
      POP_STK      3
      sahf
      fldz                             ; 0 (Arg2->d.y = 0.0;)
      jae          short GTfalse       ; jump if Arg1 >= Arg2
      fld1                             ; 1 0, return arg2 > arg1
      EXIT_OPER    GT
GTfalse:
      fldz                             ; 0 0
   END_OPER        GT
; --------------------------------------------------------------------------
   BEGN_OPER       GT2                 ; GT, set AX, clear FPU
   ; returns !(Arg2->d.x > Arg1->d.x) in ax
      fcom         st(2)               ; compare arg1, arg2
      fstsw        ax
      fninit
      sahf
      setae        al                  ; return (Arg1 >= Arg2) in AX
      xor          ah,ah
   END_OPER        GT2
; --------------------------------------------------------------------------
   BEGN_OPER       LodGT               ; load, GT
   ; return (1,0) on stack if arg2 > arg1
      FIXUP        LodGT, fcomp, X     ; compare arg2 to arg1, pop st
      fstsw        ax                  ; y ...
      POP_STK      1                   ; ...
      sahf
      fldz                             ; 0 ...
      jbe          short LodGTfalse    ; jump when arg2 <= arg1
      fld1                             ; 1 0 ...
      EXIT_OPER    LodGT
LodGTfalse:
      fldz                             ; 0 0 ...
   END_OPER        LodGT
; --------------------------------------------------------------------------
   BEGN_OPER       LodGT2              ; Lod, GT, set AX, clear FPU
   ; returns !(Arg2->d.x > Arg1->d.x) in AX
      FIXUP        LodGT2, fcom, X     ; compare arg2, arg1
      fstsw        ax
      fninit                           ; clear fpu
      sahf
      setbe        al                  ; set al when arg2 <= arg1
      xor          ah,ah               ; clear ah
   END_OPER        LodGT2              ; ret 0 in ax for true, 1 for false
; --------------------------------------------------------------------------
   BEGN_OPER       LTE                 ; <=
   ; Arg2->d.x = (double)(Arg2->d.x <= Arg1->d.x);
      fcomp        st(2)               ; y x y, comp Arg1 to Arg2
      fstsw        ax                  ; save status now
      POP_STK      3
      fldz                             ; 0 (Arg2->d.y = 0.0;)
      sahf
      jb           short LTEfalse      ; jump if arg1 > arg2
      fld1                             ; 1 0, ret arg2 <= arg1
      EXIT_OPER    LTE
LTEfalse:
      fldz                             ; 0 0
   END_OPER        LTE
; --------------------------------------------------------------------------
   BEGN_OPER       LTE2                ; LTE, test ST, clear
   ; return !(Arg2->d.x <= Arg1->d.x) in AX
      fcom         st(2)               ; comp Arg1 to Arg2
      fstsw        ax
      fninit                           ; clear stack
      and          ah,1                ; mask cf
      shr          ax,8                ; ax=1 when arg1 < arg1
   END_OPER        LTE2                ; return (Arg1 < Arg2),
; --------------------------------------------------------------------------
   BEGN_OPER       LodLTE              ; load, LTE
   ; return (1,0) on stack if arg2 <= arg1
      FIXUP        LodLTE, fcomp, X    ; compare arg2 to arg1, pop st
      fstsw        ax                  ; y ...
      POP_STK      1                   ; ...
      sahf
      fldz                             ; 0 ...
      ja           short LodLTEfalse   ; jump when arg2 > arg1
      fld1                             ; 1 0 ...
      EXIT_OPER    LodLTE
LodLTEfalse:
      fldz                             ; 0 0 ...
   END_OPER        LodLTE
; --------------------------------------------------------------------------
   BEGN_OPER       LodLTE2             ; Load, LTE, test ST, clear
   ; return !(Arg2->d.x <= Arg1->d.x) in AX
      FIXUP        LodLTE2, fcom, X    ; comp Arg2 to Arg1
      fstsw        ax
      fninit
      sahf
      seta         al
      xor          ah,ah               ; ax=1 for expr. false
   END_OPER        LodLTE2             ; return (Arg2 > Arg1)
; --------------------------------------------------------------------------
   BEGN_OPER       LodLTEMul           ; Lod, LTE, Multiply (needs 4 on stack)
   ; for '<expr> * ( <expr> <= <var> )'
   ; return number on stack if arg2 <= arg1
      FIXUP        LodLTEMul, fcomp, X ; comp Arg2 to Arg1, pop st
      fstsw        ax                  ; save status
      POP_STK      1                   ; clear 1 from stack
      sahf
      ja           short LodLTEMulfalse ; jump if arg2 > arg1
      EXIT_OPER    LodLTEMul           ; return value on st
   PARSALIGN
LodLTEMulfalse:
      POP_STK      2                   ; return (0,0)
      fldz
      fldz
   END_OPER        LodLTEMul
; --------------------------------------------------------------------------
   BEGN_OPER       LodLTEAnd2          ; Load, LTE, AND, test ST, clear
   ; this is for 'expression && (expression <= value)'
   ; stack has {arg2.x arg2.y logical.x junk} on entry (arg1 in memory)
   ; Arg2->d.x = (double)(Arg2->d.x <= Arg1->d.x);
      FIXUP        LodLTEAnd2, fcom, X ; comp Arg2 to Arg1
      fstsw        ax
      sahf
      fxch         st(2)               ; logical.x arg2.y arg2.x junk ...
      ja           LTEA2RFalse         ; right side is false, Arg2 > Arg1
      ftst                             ; now see if left side of expr is true
      fstsw        ax
      sahf
      fninit                           ; clear fpu
      jz           LTEA2LFalse         ; jump if left side of && is false
      xor          ax,ax               ; return zero in ax for expr true
      EXIT_OPER    LodLTEAnd2
LTEA2RFalse:
      fninit
LTEA2LFalse:
      mov          ax,1                ; return ax=1 for condition false
   END_OPER        LodLTEAnd2
; --------------------------------------------------------------------------
   BEGN_OPER       GTE                 ; >=
   ; Arg2->d.x = (double)(Arg2->d.x >= Arg1->d.x);
      fcomp        st(2)               ; y x y (compare arg1,arg2)
      fstsw        ax
      POP_STK      3                   ; clear 3 from stk
      sahf
      fldz                             ; 0 (Arg2->d.y = 0.0;)
      ja           short GTEfalse      ; jmp if arg1 > arg2
      fld1                             ; 1 0 (return arg2 >= arg1 on stack)
      EXIT_OPER    GTE
GTEfalse:
      fldz                             ; 0 0
   END_OPER        GTE
; --------------------------------------------------------------------------
   BEGN_OPER       LodGTE              ; load, GTE
   ; return (1,0) on stack if arg2 >= arg1
      FIXUP        LodGTE, fcomp, X    ; compare arg2 to arg1, pop st
      fstsw        ax                  ; y ...
      POP_STK      1                   ; ...
      fldz                             ; 0 ...
      sahf
      jb           short LodGTEfalse   ; jump when arg2 < arg1
      fld1                             ; 1 0 ...
      EXIT_OPER    LodGTE
LodGTEfalse:
      fldz                             ; 0 0 ...
   END_OPER        LodGTE
; --------------------------------------------------------------------------
   BEGN_OPER       LodGTE2             ; Lod, GTE, set AX, clear FPU
   ; return !(Arg2->d.x >= Arg1->d.x) in AX
      FIXUP        LodGTE2, fcom, X    ; compare arg2, arg1
      fstsw        ax
      fninit                           ; clear fpu
      and          ah,1                ; mask cf
      shr          ax,8                ; shift it (AX = 1 when arg2 < arg1)
   END_OPER        LodGTE2             ; ret 0 in ax for true, 1 for false
; --------------------------------------------------------------------------
   BEGN_OPER       EQ                  ; ==
   ; Arg2->d.x = (double)(Arg2->d.x == Arg1->d.x);
      fcomp        st(2)               ; compare arg1, arg2
      fstsw        ax
      POP_STK      3
      sahf
      fldz                             ; 0 (Arg2->d.y = 0.0;)
      jne          short EQfalse       ; jmp if arg1 != arg2
      fld1                             ; 1 0 (ret arg2 == arg1)
      EXIT_OPER    EQ
EQfalse:
      fldz
   END_OPER        EQ
; --------------------------------------------------------------------------
   BEGN_OPER       LodEQ               ; load, EQ
   ; return (1,0) on stack if arg2 == arg1
      FIXUP        LodEQ, fcomp, X     ; compare arg2 to arg1, pop st
      fstsw        ax                  ; y ...
      POP_STK      1                   ; ...
      fldz                             ; 0 ...
      sahf
      jne          short LodEQfalse    ; jump when arg2 != arg1
      fld1                             ; 1 0 ... (return arg2 == arg1)
      EXIT_OPER    LodEQ
LodEQfalse:
      fldz                             ; 0 0 ...
   END_OPER        LodEQ
; --------------------------------------------------------------------------
   BEGN_OPER       NE                  ; !=
   ; Arg2->d.x = (double)(Arg2->d.x != Arg1->d.x);
      fcomp        st(2)               ; compare arg1,arg2
      fstsw        ax
      POP_STK      3
      sahf
      fldz
      je           short NEfalse       ; jmp if arg1 == arg2
      fld1                             ; ret arg2 != arg1
      EXIT_OPER    NE
NEfalse:
      fldz
   END_OPER        NE
; --------------------------------------------------------------------------
   BEGN_OPER       LodNE               ; load, NE
   ; return (1,0) on stack if arg2 != arg1
      FIXUP        LodNE, fcomp, X     ; compare arg2 to arg1, pop st
      fstsw        ax                  ; y ...
      POP_STK      1                   ; ...
      fldz                             ; 0 ...
      sahf
      je           short LodNEfalse    ; jump when arg2 == arg1
   ; CAE changed above 'jne' to 'je' 9 MAR 1993
      fld1                             ; 1 0 ...
      EXIT_OPER    LodNE
LodNEfalse:
      fldz                             ; 0 0 ...
   END_OPER        LodNE
; --------------------------------------------------------------------------
   BEGN_OPER       OR                  ; Or
   ; Arg2->d.x = (double)(Arg2->d.x || Arg1->d.x);
      ftst                             ; a1.x a1.y a2.x a2.y ...
      fstsw        ax
      sahf
      POP_STK      2                   ; a2.x a2.y ...
      jnz          short Arg1True
      ftst
      fstsw        ax
      sahf
      POP_STK      2                   ; ...
      fldz                             ; 0 ...
      jz           short NoneTrue
      fld1                             ; 1 0 ...
      EXIT_OPER    OR
   PARSALIGN
Arg1True:
      POP_STK      2                   ; ...
      fldz                             ; 0 ...
      fld1                             ; 1 0 ...
      EXIT_OPER    OR
NoneTrue:                              ; 0 ...
      fldz                             ; 0 0 ...
   END_OPER        OR
; --------------------------------------------------------------------------
   BEGN_OPER       AND                 ; And
   ; Arg2->d.x = (double)(Arg2->d.x && Arg1->d.x);
      ftst                             ; a1.x a1.y a2.x a2.y ...
      fstsw        ax
      sahf
      POP_STK      2                   ; a2.x a2.y ...
      jz           short Arg1False
      ftst
      fstsw        ax
      sahf
      POP_STK      2                   ; ...
      fldz                             ; 0 ...
      jz           short Arg2False
      fld1                             ; 1 0 ...
      EXIT_OPER    AND
Arg1False:
      POP_STK      2                   ; ...
      fldz                             ; 0 ...
Arg2False:
      fldz                             ; 0 0 ...
   END_OPER        AND
; --------------------------------------------------------------------------
   BEGN_OPER       ANDClr2           ; And, test ST, clear FPU
   ; for bailouts using <condition> && <condition>
   ;  Arg2->d.x = (double)(Arg2->d.x && Arg1->d.x);
   ;  Returns !(Arg1 && Arg2) in ax
      ftst                             ; y.x y.y x.x x.y
      fstsw        ax
      sahf
      jz           short Arg1False2
      fxch         st(2)               ; x.x y.y y.x x.y
      ftst
      fstsw        ax
      sahf
      fninit
      jz           short Arg2False2
BothTrue2:
      xor          ax,ax
      EXIT_OPER    ANDClr2
Arg1False2:
      fninit
Arg2False2:
      mov           ax, 1
   END_OPER        ANDClr2

; --------------------------------------------------------------------------
   assume          ds:DGROUP, es:nothing
; called once per image
   public          _Img_Setup
   align           4
_Img_Setup         proc near
      les          si,_pfls            ; es:si = &pfls[0]
      mov          di,_LastOp          ; load index of lastop
      shl          di,2                ; convert to offset
      mov          bx,offset DGROUP:_fLastOp ; set bx for store
      add          di,si               ; di = offset lastop
      mov          WORD PTR [bx],di    ; save value of flastop
      mov          ax,es               ; es has segment value
      mov          WORD PTR [bx+2],ax  ; save seg for easy reload
      mov          ax,word ptr _v      ; build a ptr to Z
      add          ax,3*CARG+CPFX
      mov          _PtrToZ,ax          ; and save it
      ret
_Img_Setup         endp
; --------------------------------------------------------------------------
;	orbitcalc function follows
; --------------------------------------------------------------------------
   public          _fFormula
   align           16
_fFormula          proc far
      push         di                  ; don't build a frame here
      mov          di,offset DGROUP:_s ; reset this for stk overflow area
      mov          bx,_InitOpPtr       ; bx -> one before first token
      mov          ax,ds               ; save ds in ax
      lds          cx,_fLastOp         ; ds:cx -> one past last token
      mov          es,ax
   assume          es:DGROUP, ds:nothing ; swap es, ds before any fn. calls
      push         si
inner_loop:
      add          bx,4                ; point to next pointer pair
      cmp          bx,cx               ; time to quit yet?
      jae          short past_loop
      mov          si,WORD PTR [bx+2]  ; set si to operand pointer
      push         offset PARSERFP_TEXT:inner_loop
      jmp          WORD PTR [bx]       ; jmp to operator fn
past_loop:
   ; NOTE: AX is set by the last operator fn that was called.
      mov          si,_PtrToZ          ; ds:si -> z
      mov          di,offset DGROUP:_new ; es:di -> new
      mov          cx,4
      rep          movsd               ; new = z
      mov          bx,es
      pop          si
      pop          di                  ; restore si, di
      mov          ds,bx               ; restore ds before return
   assume          ds:DGROUP, es:nothing
      ret                              ; return AX unmodified
_fFormula          endp
; --------------------------------------------------------------------------
   public          _fform_per_pixel    ; called once per pixel
   align           4
_fform_per_pixel   proc far
      FRAME        <si, di>
   ; if(!Transparent3D){
      cmp          _Transparent3D,0
      jne           abNormal_Pixel
   ;   /* v[5].a.d.x = */ (v[0].a.d.x = dx0[col]+dShiftx);
      mov          ax,_col
      shl          ax,3
      les          bx,_dx0
      add          bx,ax
      fld          QWORD PTR es:[bx]
      mov          ax,_row
      shl          ax,3
      les          bx,_dx1
      add          bx,ax
      fadd         QWORD PTR es:[bx]
      les          bx,_v
      fstp         QWORD PTR es:[bx+CPFX]
   ;;;;;;;;;fstp    QWORD PTR es:[bx+104]  kill this & prev=fstp
   ;   /* v[5].a.d.x = */ (v[0].a.d.y = dy0[row]+dShifty);
      mov          ax,_row
      shl          ax,3
      les          bx,_dy0
      add          bx,ax
      fld          QWORD PTR es:[bx]
      mov          ax,_col
      shl          ax,3
      les          bx,_dy1
      add          bx,ax
      fadd         QWORD PTR es:[bx]
      les          bx,_v
      fstp         QWORD PTR es:[bx+CPFX+8] ; make this an fstp
   ;;;;;;;;;fstp    QWORD PTR es:[bx+104]	; kill this
after_load:
      mov          di,offset DGROUP:_s ; di points to stack overflow area
      mov          ax,ds
      mov          bx,WORD PTR _pfls   ; bx -> pfls
      lds          cx,_fLastOp         ; cx = offset &f[LastOp],load ds
      mov          es,ax
   assume          es:DGROUP, ds:nothing
      cmp          _LastInitOp,0
      je           short skip_initloop ; no operators to do here
      mov          _LastInitOp,cx      ; lastinitop=lastop
   align           4
pixel_loop:
      mov          si,WORD PTR [bx+2]  ; get address of load or store
      call         WORD PTR [bx]       ; (*opptr)()
      add          bx,4                ; ++opptr
      cmp          bx,_LastInitOp
      jb           short pixel_loop
skip_initloop:
      mov          ax,es
      mov          ds,ax
   assume          ds:DGROUP, es:nothing ; for the rest of the program
      sub          bx,4                ; make initopptr point 1 token b4 1st
      mov          _InitOpPtr, bx      ; InitOptPtr = OpPtr;
      UNFRAME      <di, si>
      xor          ax,ax
      ret

abNormal_Pixel:
   ;   TranspPerPixel(MathType, &v[5].a, &v[6].a);
      mov          ax,WORD PTR _v
      add          ax,6*CARG+CPFX      ;v[6].a
      push         WORD PTR _v+2
      push         ax
      mov          ax,WORD PTR _v
      add          ax,5*CARG+CPFX      ;v[5].a
      push         WORD PTR _v+2
      push         ax
      push         1                   ;_MathType
      call         far PTR _TranspPerPixel
      add          sp,10
   ;   v[0].a = v[5].a;
      les          bx,_v
      fld          QWORD PTR es:[bx+5*CARG+CPFX]
      fstp         QWORD PTR es:[bx+CPFX]
      fld          QWORD PTR es:[bx+5*CARG+CPFX+8]
      fstp         QWORD PTR es:[bx+CPFX+8]
   ; }
      jmp          short after_load
_fform_per_pixel   endp
; --------------------------------------------------------------------------
PARSERFP_TEXT      ends
   end

