Category : Recently Uploaded Files
Archive   : FRASRC19.ZIP
Filename : PARSERA.ASM

PAGE ,132

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

; Fast floating-point routines for Fractint.

; (c) Copyright 1992-1995 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' operator functions were
; added to the program as well.

; As of 31 Decmember 1993 this is also an in-memory compiler. The code
; generator is in PARSERFP.C. Define the variable COMPILER to
; build the compiler, otherwise the interpreter will be built.
; COMPILER must also be #defined in PARSERFP.C to build compiler.


; 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.


; Date Init Change description

; 7 Mar 1995 TIW Added PWR (0,0) domain check
; 21 Feb 1995 TIW Shortened ATanh/ATan for MASM 6 compatibility
; 21 Feb 1995 CAE Changes ATan and ATanh

; 15 Feb 1995 CAE Added safety tests to macros.
; Changed fStkASin, etc. to work with compiler.
; Added fwait to Sto2 function for safety.

; 8 Feb 1995 CAE Removed transparent3d code.
; Added inversion support (compiler untested.)

; 8 Jan 1995 JCO Added fStkASin, fStkASinh, fStkACos, fStkACosh,
; fStkATan, fStkATanh, fStkSqrt, fStkCAbs.

; 31 Dec 1994 JCO Made changes to keep code in line with C code.
; Not necessary, since code isn't called. Will
; make it easier to make it run later. Added
; old <- z to end of fform_per_pixel to match
; C code.

; 30 Dec 1993 CAE Compiler is working
; Changed EXIT_OPER -> ret in 3 operator fns
; Added safety test for fn size in macros

; 12 Dec 1993 CAE Compiler additions

; 4 Dec 1993 CAE SinhCosh function accuracy improved
; Added LoadImagAdd/Sub/Mul

; 19 Nov 1993 CAE Revised macros for compiler mode.

; 10 Nov 1993 CAE Changed Exp function for more accuracy.

; 06 Nov 93 CAE Added 'LodRealPwr', 'One', 'ORClr2', 'Sqr3'.
; Revised Pwr function to use regs vs. memory.
; Changed many functions to 'included' type.

; 31 Oct 93 CAE Added 'Dbl' function.

; 09 Oct 1993 CAE Changed SinhCosh to use wider range of 387.
; Most FNINITs changed to FINIT.
; Loop logic revised slightly.
; Separated code from parserfp.c's codeseg.
; Added fStkStoClr2, fStkZero and fStkIdent.
; New 'pseudo calctype' fn. fFormulaX added.

; 12 Jul 1993 CAE Moved BadFormula to PARSER.C.


.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
ifndef COMPILER
;; only align when no compiler
align 4
endif

;; always generate public and begin of proc (before fixups)
public _fStk&OperName
_fStk&OperName proc near

ifdef COMPILER
;; generate the fixups for compiler
;; size of fn. | 8000h to mark it as an OPER instead of an INCL CAE 27Dec93
dw Size_&OperName OR 8000h
;; near pointer to the start of actual code CAE 19Dec93
dw offset PARSERA_TEXT:Code_&OperName
;; addr of fn to include (undefined if Incl_&OperName==255 below)
dw IAddr_&OperName
;; offset of x fixup or 255 if none
db XFixup_&OperName
;; offset of y fixup or 255 if none
db YFixup_&OperName
;; offset of included(called) fn or 255 if none
db Incl_&OperName

endif

;; added label for code begin point CAE 25Nov93
Code_&OperName:

ENDM

; ---------------------------------------------------------------------------
END_OPER MACRO OperName
; Generate end of operator fn. code.

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 255 offset, 0 address. CAE 19Nov93
Incl_&OperName EQU 255
IAddr_&OperName EQU 0
endif

ifndef XFixup_&OperName
XFixup_&OperName EQU 255
endif

ifndef YFixup_&OperName
YFixup_&OperName EQU 255
endif

endif

;; Always gen size of fn (subtract size of header here)
Size_&OperName EQU $ - Code_&OperName
;; Make sure fn is of legal size CAE 30DEC93
.errnz (Size_&OperName GT 127)

;; and end of procedure.
_fStk&OperName endp
ENDM

; ---------------------------------------------------------------------------
BEGN_INCL MACRO OperName
;; Generate beginning code for 'included' operator fn.
;; No fixups allowed in one of these functions.

;; Safety test: generate an equate here so the INCL_OPER CAE 15Feb95
;; macro can test to see if this really is includable.
Is_Incl_&OperName EQU 1

;; Don't bother with align in compiler mode.
ifndef COMPILER
align 4
endif

;; Generate public (incl fns. can be called directly) and begin of proc.
public _fStk&OperName
_fStk&OperName proc near

ifdef COMPILER
;; Size of included fn. changed to word CAE 27Dec93
dw Size_&OperName
endif

;; added label for code begin point CAE 25Nov93
Code_&OperName:

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. (subtract hdr. size)
Size_&OperName EQU $ - Code_&OperName
;; Make sure fn is of legal size CAE 30DEC93
.errnz (Size_&OperName GT 127)
;; always generate end-of-proc
_fStk&OperName endp
ENDM

; ---------------------------------------------------------------------------
; 'Include' a function inside another one
INCL_OPER MACRO CallingOper,OperToIncl

;; Make sure the included fn was defined with the BEGN_INCL macro.
ifndef Is_Incl_&OperToIncl ; CAE 15Feb95
.error "Included function was not defined with BEGN_INCL macro"
endif

;; Gen equate for offset of include in outer fn.
;; Always generate this to prevent >1 include even when not CAE 15FEB95
;; building the compiler.
Incl_&CallingOper EQU $ - Code_&CallingOper
ifdef COMPILER
;; Address of included fn.
IAddr_&CallingOper EQU _fStk&OperToIncl
;; Gen 1 1-byte placeholder for the included fn to make codegen easier
db 0ffH
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.
;; Fixup is two bytes into the instruction, thus the '+ 2'.
;; This may not be true for all instructions.
ifidni ,
XFixup_&OperName EQU $ - Code_&OperName + 2
else
;; assume fixup is for y
YFixup_&OperName EQU $ - Code_&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

; CAE added macros for common operations Feb 1995

GEN_SQR0 macro
;; square the stack top, don't save magnitude in lastsqr CAE 15FEB95
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
ENDM

GEN_SQRT macro ; CAE 15Feb95
; can use a max of 2 regs
fld st(1) ; y x y
fld st(1) ; x y x y
fpatan ; atan x y
fdiv __2_ ; theta=atan/2 x y
fsincos ; cos sin x y
fxch st(3) ; y sin x cos
fmul st,st(0) ; yy sin x cos
fxch st(2) ; x sin yy cos
fmul st,st(0) ; xx sin yy cos
faddp st(2),st ; sin xx+yy cos
fxch st(2) ; cos xx+yy sin
fxch ; xx+yy cos sin
fsqrt ; sqrt(xx+yy) cos sin
fsqrt ; mag=sqrt(sqrt(xx+yy)) cos sin
fmul st(2),st ; mag cos mag*sin
fmulp st(1),st ; mag*cos mag*sin
ENDM
; ---------------------------------------------------------------------------
; external functions
extrn _invertz2:far

; ---------------------------------------------------------------------------
_DATA segment word public use16 'DATA'
extrn _invert:WORD
extrn _maxit:DWORD
extrn _inside:WORD
extrn _outside:WORD
extrn _coloriter:DWORD
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 _Arg1:WORD, _Arg2:WORD
extrn _f:DWORD, _pfls:DWORD, _v:DWORD
extrn _debugflag:WORD
_DATA ends

; ---------------------------------------------------------------------------

_BSS segment word public use16 'BSS'
_fLastOp label DWORD ; save seg, offset of lastop here
dd ?
_PtrToZ label WORD ; offset of z
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 -> parser data
; cx -> lastop
; edx == orbit counter (in fFormulaX)
; di -> stack overflow area, used by push and pull functions and as
; a temporary storage area
; 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
; (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.

; --------------------------------------------------------------------------
; Put this code in PARSERA_TEXT, not PARSERFP_TEXT CAE 09OCT93
PARSERA_TEXT segment para public use16 'CODE'
; Non-standard segment register setup.
assume es:DGROUP, ds:nothing, cs:PARSERA_TEXT

; --------------------------------------------------------------------------
; Included functions must be before any fns that include them.
; --------------------------------------------------------------------------
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
mov ax, 1 ; domain error (1 in ax)
EXIT_OPER Log ; return (0,0)
PARSALIGN
NotBothZero:
xor ax,ax ; no domain error (0 in ax)
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 & for 387.
; Mod for 387-only after Fractint v18. CAE 09OCT93
; NOTE: Full 80-bit accuracy is *NOT* maintained in this function!
; Only 1 additional register can be used here.
; Changed fn so that rounding errors are less. CAE 04DEC93
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
fld st ; x/ln(2), x/ln(2)
fldcw _Arg2 ; Now set control to round toward zero
; Chop toward zero rounding applies now CAE 4DEC93
frndint ; int = integer(x/ln(2)), x/ln(2)
pop ax ; restore old CW to AX
mov _Arg2,ax ; ...then move it to Arg2
fldcw _Arg2 ; Restore control word from Arg2
; Normal rounding is in effect again CAE 4DEC93
fxch ; x/ln(2), int
fsub st,st(1) ; -1 < rem < 1.0, int
f2xm1 ; 2**rem-1, int
fadd __1_ ; 2**rem, int
fscale ; e**x, int
fstp st(1) ; e**x
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
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 (fsubr pending)
END_INCL SinhCosh
; --------------------------------------------------------------------------
BEGN_INCL Ident ; Ident CAE 09OCT93
END_INCL Ident
; --------------------------------------------------------------------------
BEGN_INCL Sqr3 ; Sqr3 CAE 06NOV93
fmul st,st(0) ; Magnitude/sqr of a real# on st
END_INCL Sqr3 ; x^2 0 ...
; --------------------------------------------------------------------------
BEGN_INCL Conj ; Complex conjugate
fxch ; y x ...
fchs ; -y x ...
fxch ; x -y ...
END_INCL Conj
; --------------------------------------------------------------------------
BEGN_INCL Conj2 ; Complex conjugate (uses a reg)
fldz ; 0 x y ... CAE 20Nov93
fsubrp st(2),st ; x -y ...
END_INCL Conj2
; --------------------------------------------------------------------------
BEGN_INCL Real ; Real
fstp st(1) ; x ...
fldz ; 0 x ...
fxch ; x 0 ...
END_INCL Real
; --------------------------------------------------------------------------
BEGN_INCL RealFlip ; Real, flip combined.
fstp st(1) ; y=x ...
fldz ; x=0 y ...
END_INCL RealFlip
; --------------------------------------------------------------------------
BEGN_INCL Add ; Add
faddp st(2),st ; Arg2->d.x += Arg1->d.x;
faddp st(2),st ; Arg2->d.y += Arg1->d.y;
END_INCL Add
; --------------------------------------------------------------------------
BEGN_INCL Sub ; Subtract
fsubp st(2),st ; Arg2->d.x -= Arg1->d.x;
fsubp st(2),st ; Arg2->d.y -= Arg1->d.y;
END_INCL 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 LodImagAdd ; Load, Imag, Add combined CAE 4DEC93
FIXUP LodImagAdd, fadd, Y ; Add x-value from memory
END_OPER LodImagAdd
; --------------------------------------------------------------------------
BEGN_OPER LodImagSub ; Load, Imag, Sub combined CAE 4DEC93
FIXUP LodImagSub, fsub, Y ; (fsub qword ptr X)
END_OPER LodImagSub
; --------------------------------------------------------------------------
BEGN_INCL Real2 ; Real value (fast version)
fldz ; 0 x y ... (uses a reg)
fstp st(2) ; x 0 ...
END_INCL Real2
; --------------------------------------------------------------------------
BEGN_OPER Lod ; Load
FIXUP Lod, fld, Y ; y ...
FIXUP Lod, fld, X ; x y ...
END_OPER Lod
; --------------------------------------------------------------------------
BEGN_INCL Clr1 ; Clear stack
finit ; changed from fninit CAE 09OCT93
END_INCL Clr1
; --------------------------------------------------------------------------
BEGN_INCL Imag ; Imaginary value
POP_STK 1 ; y
fldz ; 0 y
fxch ; x=y 0
END_INCL Imag
; --------------------------------------------------------------------------
BEGN_INCL ImagFlip ; Imaginary value, flip combined
POP_STK 1 ; y ...
fldz ; x=0 y ...
END_INCL ImagFlip
; --------------------------------------------------------------------------
BEGN_INCL Abs ; Absolute value
fxch
fabs
fxch
fabs
END_INCL 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 LodImagMul ; Load, Imag, Multiply CAE 4DEC93
FIXUP LodImagMul, fld, Y ; y.y x.x x.y
fmul st(2),st ; y.y x.x z.y
fmul ; z.x z.y
END_OPER LodImagMul
; --------------------------------------------------------------------------
BEGN_INCL Neg ; Negative
fxch
fchs ; Arg1->d.y = -Arg1->d.y;
fxch
fchs
END_INCL Neg
; --------------------------------------------------------------------------
BEGN_OPER EndInit ; End of initialization expr.
ifndef COMPILER ; this instr not needed CAE 30DEC93
mov _LastInitOp,bx ; LastInitOp=OpPtr
endif
finit ; changed from fninit CAE 09OCT93
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 StoClr2 ; Store, clear FPU CAE 09OCT93
FIXUP StoClr2, fstp, X ; y
FIXUP StoClr2, fstp, Y ; (store pending)

END_OPER StoClr2
; --------------------------------------------------------------------------
BEGN_OPER Sto ; Store, leave on ST
; Revised to do store first, then exchange. CAE 10NOV93
FIXUP Sto, fst, X
fxch ; y x ...
FIXUP Sto, fst, Y
fxch ; x y ...
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 ; CAE added fwait for safety 15Feb95
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_INCL Flip ; Exchange real, imag
fxch ; x=y y=x ...
END_INCL 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_INCL Zero ; Zero CAE 09OCT93
POP_STK 2 ; ...
fldz ; 0 ...
fldz ; 0 0 ...
END_INCL Zero
; --------------------------------------------------------------------------
BEGN_INCL One ; One CAE 06NOV93
POP_STK 2 ; ...
fldz ; 0 ...
fld1 ; 1 0 ...
END_INCL One
; --------------------------------------------------------------------------
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_INCL 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_INCL Sqr
; --------------------------------------------------------------------------
BEGN_INCL Sqr0 ; Square, don't save magnitude
GEN_SQR0
END_INCL Sqr0
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL Mul
; --------------------------------------------------------------------------
BEGN_OPER LodMul ; Load, Multiply
; This is just load followed by multiply but it saves a fn. call
; and also allows optimizer enhancements.
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_INCL 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_INCL Div
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL 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_INCL 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_INCL 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 ; fstsw will complete first
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_INCL Dbl ; Double CAE 31OCT93
fxch ; y x ...
fadd st,st(0) ; 2y x ...
fxch ; x 2y ...
fadd st,st(0) ; 2x 2y ...
END_INCL Dbl
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL Mod
; --------------------------------------------------------------------------
; The following code was 'discovered' by experimentation. The Intel manuals
; really don't help much in writing this kind of code.
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL Push2
; --------------------------------------------------------------------------
BEGN_INCL Pull2 ; Pull stack up from 2 to 4
fld tbyte PTR es:[di-10] ; oldy x y
sub di,20 ; adjust di now
fxch st(2) ; y x oldy
fld tbyte PTR es:[di] ; oldx y x oldy
fxch st(2) ; x y oldx oldy
END_INCL Pull2
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL Push4
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL Push2a
; --------------------------------------------------------------------------
; End of stack overflow/underflow code.
; --------------------------------------------------------------------------
BEGN_INCL Exp ; Exponent
; From FPU387.ASM with mods to use less registers.
; Modified to preserve 80-bit accuracy. CAE 10NOV93
fldln2 ; ln2 x y
fdivp st(1),st ; x/ln2 y
fstp TBYTE PTR es:[di] ; y
fsincos ; cosy, siny
fld1 ; 1 cos sin
fld TBYTE PTR es:[di] ; x/ln2 1 cos sin
fprem ; prem, 1, cos, sin
f2xm1 ; e**prem-1, 1, cos, sin
fadd ; e**prem, cos, sin
fld TBYTE 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_INCL 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
cmp ax,1 ; log domain error?
jne domainok ; nope
cmp _debugflag, 94 ; user wants old pwr?
je domainok ; yup
POP_STK 2 ; clear two numbers
fldz
fldz
EXIT_OPER Pwr ; return (0,0)
PARSALIGN
domainok:
; 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. 4 regs are free here.
; Modified to use the regs instead of memory. CAE 06NOV93
fldln2 ; ln2 x y
fdiv ; x/ln2 y
fxch ; y x/ln2
fsincos ; cosy, siny, x/ln2
fxch ; sin, cos, x/ln2
fxch st(2) ; x/ln2, cos, sin
fld1 ; 1, x/ln2, cos, sin
fld st(1) ; x/ln2, 1, x/ln2, cos, sin
fprem ; prem, 1, x/ln2, cos, sin
f2xm1 ; e**prem-1, 1, x/ln2, cos, sin
fadd ; e**prem, 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 LodRealPwr ; lod, real, power CAE 6NOV93
; First take the log of the # on st.
INCL_OPER LodRealPwr, Log ; l.x l.y
; Inline multiply by a real.
FIXUP LodRealPwr, fld, X ; y.x, x.x, x.y
fmul st(2),st ; y.x, x.x, z.y
fmulp st(1),st ; z.x z.y
; Exp function from FPU387.ASM. 4 regs are free here, so use them.
fldln2 ; ln2 x y
fdiv ; x/ln2 y
fxch ; y x/ln2
fsincos ; cosy, siny, x/ln2
fxch ; sin, cos, x/ln2
fxch st(2) ; x/ln2, cos, sin
fld1 ; 1, x/ln2, cos, sin
fld st(1) ; x/ln2, 1, x/ln2, cos, sin
fprem ; prem, 1, x/ln2, cos, sin
f2xm1 ; e**prem-1, 1, x/ln2, cos, sin
fadd ; e**prem, 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 LodRealPwr
; --------------------------------------------------------------------------
BEGN_OPER Cosh ; Cosh
INCL_OPER Cosh, SinhCosh ; sinhx coshx y
fxch st(2) ; y coshx sinhx
fsincos ; cosy siny coshx sinhx
fmulp st(2),st ; siny x=cosy*coshx sinhx
fmulp st(2),st ; x y=sinhx*siny
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
; --------------------------------------------------------------------------
; JCO added Sqrt .. CAbs for version 19.
; CAE updated them 15Feb94 to work with compiler mode.
; --------------------------------------------------------------------------
BEGN_OPER Sqrt ; Sqrt
GEN_SQRT
END_OPER Sqrt
; --------------------------------------------------------------------------
BEGN_OPER ASin ; ArcSin
fld st(1) ; y x y
fld st(1) ; x y x y
GEN_SQR0 ; tz1.x tz1.y x y
fxch st(1) ; tz1.y tz1.x x y
fchs ; -tz1.y tz1.x x y
fxch st(1) ; tz1.x -tz1.y x y
fsubr __1_ ; 1-tz1.x -tz1.y x y
GEN_SQRT ; tz1.x tz1.y x y
fsubrp st(3),st ; tz1.y x tz1.x-y
fadd ; tz1.y+x tz1.x-y
fxch st(1) ; tz1.x-y tz1.y+x
INCL_OPER ASin, Log ; l.x l.y
fchs ; -l.x l.y
fxch st(1) ; l.y -l.x ;; rz = (-i)*l
END_OPER ASin
; --------------------------------------------------------------------------
BEGN_OPER ACos ; ArcCos
fld st(1) ; y x y
fld st(1) ; x y x y
GEN_SQR0 ; tz1.x tz1.y x y
fsub __1_ ; tz1.x-1 tz1.y x y
GEN_SQRT ; tz.x tz.y x y
faddp st(2),st ; tz.y tz.x+x y
faddp st(2),st ; tz.x+x tz.y+y
INCL_OPER ACos, Log ; l.x l.y
fchs ; -l.x l.y
fxch st(1) ; l.y -l.x ;; rz = (-i)*l
END_OPER ACos
; --------------------------------------------------------------------------
BEGN_OPER ASinh ; ArcSinh
fld st(1) ; y x y
fld st(1) ; x y x y
GEN_SQR0 ; tz1.x tz1.y x y
fadd __1_ ; tz1.x+1 tz1.y x y
GEN_SQRT ; tz.x tz.y x y
faddp st(2),st ; tz.y tz.x+x y
faddp st(2),st ; tz.x+x tz.y+y
INCL_OPER ASinh, Log ; l.x l.y
END_OPER ASinh
; --------------------------------------------------------------------------
BEGN_OPER ACosh ; ArcCosh
fld st(1) ; y x y
fld st(1) ; x y x y
GEN_SQR0 ; tz1.x tz1.y x y
fsub __1_ ; tz1.x+1 tz1.y x y
GEN_SQRT ; tz.x tz.y x y
faddp st(2),st ; tz.y tz.x+x y
faddp st(2),st ; tz.x+x tz.y+y
INCL_OPER ACosh, Log ; l.x l.y
END_OPER ACosh
; --------------------------------------------------------------------------
BEGN_OPER ATanh ; ArcTanh
fld st(1) ; y x y
fchs ; -y x y
fld st(1) ; x -y x y
fld1 ; 1 x -y x y
fadd st(3),st ; 1 x -y 1+x y
fsubr ; 1-x -y 1+x y
INCL_OPER ATanh, Div ; d.x d.y
; From FPU387.ASM
; Log is called by Pwr and is also called directly.
ftst
fstsw ax
sahf
jnz short ATanh_NotBothZero
fxch ; y x
ftst
fstsw ax
sahf
fxch ; x y
jnz short ATanh_NotBothZero
POP_STK 2 ; clear two numbers
fldz
fldz
jmp SHORT End_Log_ATanh ; return (0,0)
PARSALIGN
ATanh_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_Log_ATanh:
fld _PointFive ; .5 l.x l.y
fmul st(1),st ; .5 l.x/2 l.y
fmulp st(2),st ; l.x/2 l.y/2
END_OPER ATanh
; --------------------------------------------------------------------------
BEGN_OPER ATan ; ArcTan
fxch ; y x
fld st(1) ; x y x
fchs ; -x y x
fxch st(2) ; x y -x
fld st(1) ; y x y -x
fld1 ; 1 y x y -x
fadd st(3),st ; 1 y x 1+y -x
fsubr ; 1-y x 1+y -x
INCL_OPER ATan, Div ; d.x d.y
; CAE put log fn inline 15Feb95
ftst
fstsw ax
sahf
jnz short ATan_NotBothZero
fxch ; y x
ftst
fstsw ax
sahf
fxch ; x y
jnz short ATan_NotBothZero
POP_STK 2 ; clear two numbers
fldz
fldz
jmp short End_Log_ATan ; return (0,0)
PARSALIGN
ATan_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_Log_ATan:
fld _PointFive ; .5 l.x l.y
fmul st(1),st ; .5 z.y=l.x/2 l.y
fmulp st(2),st ; z.y l.y/2
fxch ; l.y/2 z.y
fchs ; z.x=-l.y/2 z.y
END_OPER ATan
; --------------------------------------------------------------------------
BEGN_OPER CAbs ; Complex Absolute Value
fmul st,st ; x*x y
fxch ; y x*x
fmul st,st ; y*y x*x
fadd ; y*y+x*x
fsqrt ; mag=sqrt(yy+xx)
fldz ; 0 mag
fxch ; mag 0
END_OPER CAbs
; --------------------------------------------------------------------------
; End of new functions. CAE 15Feb95
; --------------------------------------------------------------------------
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_INCL 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_INCL 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_INCL 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_INCL GT
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL 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_INCL 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_INCL LTE
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL 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 stk)
; 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
ret ; changed EXIT_OPER->ret CAE 30DEC93
LTEA2RFalse:
fninit
LTEA2LFalse:
mov ax,1 ; return ax=1 for condition false
END_OPER LodLTEAnd2
; --------------------------------------------------------------------------
BEGN_INCL 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_INCL 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_INCL 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_INCL 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_INCL 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_INCL 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_INCL 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_INCL OR
; --------------------------------------------------------------------------
BEGN_INCL 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
PARSALIGN
Arg1False:
POP_STK 2 ; ...
fldz ; 0 ...
Arg2False:
fldz ; 0 0 ...
END_INCL AND
; --------------------------------------------------------------------------
BEGN_INCL 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
ret ; changed EXIT_OPER->ret CAE 30DEC93
Arg1False2:
fninit
Arg2False2:
mov ax,1
END_INCL ANDClr2
; --------------------------------------------------------------------------
BEGN_INCL ORClr2 ; Or, test ST, clear FPU CAE 6NOV93
; 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
jnz short ORArg1True
fxch st(2) ; x.x y.y y.x x.y
ftst
fstsw ax
sahf
fninit
jnz short ORArg2True
ORNeitherTrue:
mov ax,1
ret ; changed EXIT_OPER->ret CAE 30DEC93
ORArg1True:
fninit
ORArg2True:
xor ax,ax
END_INCL ORClr2

; --------------------------------------------------------------------------
assume ds:DGROUP, es:nothing
; --------------------------------------------------------------------------

ifndef COMPILER

; --------------------------------------------------------------------------
; called once per image
; --------------------------------------------------------------------------
public _Img_Setup
align 2
; Changed to FAR, FRAME/UNFRAME added by CAE 09OCT93
_Img_Setup proc far
FRAME
les si,_pfls ; es:si = &pfls[0]

mov di,_LastOp ; load index of lastop

dec di ; flastop now points at last operator
; above added by CAE 09OCT93 because of loop logic changes

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
UNFRAME
ret
_Img_Setup endp
; --------------------------------------------------------------------------
; Hybrid orbitcalc/per-pixel routine (tested, but not implemented.)
;
; To implement, stick the following code in calcfrac.c around line 788,
; just before the line that says "while (++coloriter < maxit)".
; --------------------------------------------------------------------------
; if (curfractalspecific->orbitcalc == fFormula /* 387 parser */
; && periodicitycheck == 0
; && !show_orbit
; && inside >= -5
; && attractors == 0
; && !distest ){
; fFormulaX(); /* orbit till done */
; } else
; --------------------------------------------------------------------------
public _fFormulaX ; CAE 09OCT93
align 16
_fFormulaX proc far
push si
push di
mov edx,_maxit ; edx holds coloriter during loop
mov _coloriter,edx ; set coloriter to maxit
mov ax,ds ; save ds in ax
lds cx,_fLastOp ; ds:cx -> one past last token
mov es,ax ; es -> DGROUP
assume es:DGROUP, ds:nothing ; swap es, ds before any fn. calls
jmp short skipfirst ; skip bailout test first time
align 16
outer_loop:
or ax,ax ; did bailout occur?
jnz short doneloop ; yes, exit
skipfirst:
dec edx ; ++coloriter
jle short doneloop ; yes, exit because of maxiter
mov bx,_InitOpPtr ; bx -> one before first token
mov di,offset DGROUP:_s ; reset stk overflow ptr
align 16
inner_loop2:
cmp bx,cx ; time to quit yet?
jae short outer_loop ; yes, bx points to last function
add bx,4 ; point to next pointer pair
push offset PARSERA_TEXT:inner_loop2 ; do this first
mov si,WORD PTR [bx+2] ; set si to operand pointer
jmp WORD PTR [bx] ; jmp to operator fn
align 16
doneloop:
; NOTE: edx must be preserved here.
mov si,_PtrToZ ; ds:si -> z
mov di,offset DGROUP:_new ; es:di -> new
mov cx,4
rep movsd ; new = z
mov ax,es
pop di
pop si
mov ds,ax ; restore ds before return
assume ds:DGROUP, es:nothing
sub _coloriter,edx ; now put new coloriter back from edx
ret
_fFormulaX 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 -> last token
mov es,ax ; es -> DGROUP
assume es:DGROUP, ds:nothing
align 16 ; already aligned 16
push si ; 1-byte instruction
inner_loop: ; loop revised CAE 09OCT93
cmp bx,cx ; time to quit yet?
jae short past_loop ; yes, bx points to last token
add bx,4 ; point to next token
push offset PARSERA_TEXT:inner_loop ; push return addr first
mov si,WORD PTR [bx+2] ; now set si to operand pointer
jmp WORD PTR [bx] ; ...and jump to operator fn
past_loop: ; 15-byte loop
; NOTE: AX was set by the last operator fn called.
mov si,_PtrToZ ; ds:si -> z
mov di,offset DGROUP:_new ; es:di -> new
mov cx,4 ; get ready to move 4 dwords
rep movsd ; new = z
mov bx,es ; put seg dgroup in bx
pop si
pop di ; restore si, di
mov ds,bx ; restore ds from bx 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
cmp _invert,0 ; inversion support added
je skip_invert ; CAE 08FEB95
mov si,offset DGROUP:_old
push si
call far ptr _invertz2
add sp,2
; now copy old to v[0].a.d
les di,_v ; ds:si already points to old
add di,CPFX ; make es:di point to v[0].a.d
mov cx,4
rep movsd
jmp after_load
skip_invert:
; /* 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]
; /* 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
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
jmp short pixel_loop
align 16
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 si,_PtrToZ ; ds:si -> z
mov di,offset DGROUP:_old ; es:di -> old
mov cx,4 ; get ready to move 4 dwords
rep movsd ; old = z
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
_fform_per_pixel endp
; --------------------------------------------------------------------------

else ; Compiler

; --------------------------------------------------------------------------
; . . . and now for the real fun!
; --------------------------------------------------------------------------
public _Img_Setup
align 2
_Img_Setup proc far
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
; --------------------------------------------------------------------------
; Hybrid orbitcalc/per-pixel routine.
; --------------------------------------------------------------------------
public _fFormulaX
align 16
_fFormulaX proc far
push si
push di
mov edx,_maxit ; edx holds coloriter during loop
mov _coloriter,edx ; set coloriter to maxit
mov ax,ds ; save ds in ax
mov cx,word ptr _pfls+2 ; just get the seg part
mov es,ax ; es -> DGROUP
mov ds,cx ; ds -> parser data
assume es:DGROUP, ds:nothing
jmp short skipfirst ; skip bailout test first time
align 16
outer_loop:
or ax,ax ; did bailout occur?
jnz short doneloop ; yes, exit
skipfirst:
dec edx ; ++coloriter, was maxiter reached?
jle short doneloop ; yes, exit because of maxiter
push offset PARSERA_TEXT:outer_loop
mov di,offset DGROUP:_s ; reset this for stk overflow area
jmp _compiled_fn_2 ; call the compiled code
doneloop:
; NOTE: edx must be preserved here.
mov si,_PtrToZ ; ds:si -> z
mov di,offset DGROUP:_new ; es:di -> new
mov cx,4
rep movsd ; new = z
mov ax,es
pop di
pop si
mov ds,ax ; restore ds before return
assume ds:DGROUP, es:nothing
sub _coloriter,edx ; now put new coloriter back from edx
ret
_fFormulaX 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 ax,ds ; save ds in ax
mov cx,WORD PTR _pfls+2 ; just load seg value
mov es,ax ; es -> DGROUP
mov ds,cx ; ds -> parser data
assume es:DGROUP, ds:nothing
push si ; compiled_fn modifies si
call _compiled_fn_2 ; call the compiled code
; NOTE: AX was set by the compiled code and must be preserved here.
mov si,_PtrToZ ; ds:si -> z
mov di,offset DGROUP:_new ; es:di -> new
mov cx,4 ; get ready to move 4 dwords
rep movsd ; new = z
mov bx,es ; put seg dgroup in bx
pop si
pop di ; restore si, di
mov ds,bx ; restore ds from bx 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
cmp _invert,0 ; inversion support added
je skip_invert ; CAE 08FEB95
mov si,offset DGROUP:_old
push si
call far ptr _invertz2
add sp,2
; now copy old to v[0].a.d
les di,_v ; ds:si already points to old
add di,CPFX ; make es:di point to v[0].a.d
mov cx,4
rep movsd
jmp after_load
skip_invert:
; /* 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]
; /* 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
after_load:
mov di,offset DGROUP:_s ; di points to stack overflow area
mov ax,ds
mov cx,word ptr _pfls+2 ; just to load ds
mov es,ax ; es -> DGROUP
mov ds,cx ; ds -> parser data
assume es:DGROUP, ds:nothing
call _compiled_fn_1 ; call compiled code
mov ax,es
mov ds,ax
assume ds:DGROUP, es:nothing ; for the rest of the program
UNFRAME
xor ax,ax
ret
_fform_per_pixel endp

align 16
public _compiled_fn_1
_compiled_fn_1 proc near
retn ; compiled code will be put here
db 1023 DUP (?)
_compiled_fn_1 endp

align 16
public _compiled_fn_2
_compiled_fn_2 proc near
retn ; ...and here
db 1023 DUP (?)
_compiled_fn_2 endp
; --------------------------------------------------------------------------

endif ; COMPILER

; --------------------------------------------------------------------------


PARSERA_TEXT ends
end