Category : C Source Code
Archive   : FRASRC18.ZIP
Filename : PARSERA.ASM

PAGE ,132

; Name: PARSERA.ASM
; Author: Chuck Ebbert CompuServe [76306,1226]
; internet: [email protected]
; Date: 22 MAR 1993

; Fast floating-point routines for Fractint.

; (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,
push reg
ENDM
ENDM

UNFRAME MACRO regs ; unframe before return
IRP reg,
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 ,
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 ,
;; 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 ' * ( < )'
; 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 ' * ( <= )'
; 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 &&
; 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
; 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
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
; --------------------------------------------------------------------------
public _BadFormula
_BadFormula proc far
mov ax,1
ret
_BadFormula endp
; --------------------------------------------------------------------------
PARSERFP_TEXT ends
end