File: dos\parsera.asm
1 PAGE ,132
2
3 ; Name: PARSERA.ASM
4 ; Author: Chuck Ebbert CompuServe [76306,1226]
5 ; internet: 76306.1226@compuserve.com
6
7 ; Fast floating-point routines for Fractint.
8
9 ; (c) Copyright 1992-1998 Chuck Ebbert. All rights reserved.
10
11 ; This program is an assembler version of the C 'execution engine' part
12 ; of Mark Peterson's FRACTINT Formula Parser. Many of the operator
; functions were copied from Mark's code in the files FPU087.ASM
13 ; and FPU387.ASM. The basic operator functions are assembler versions
14 ; of the code in PARSER.C. Many 'combined' operator functions were
15 ; added to the program as well.
16
17 ; As of 31 Decmember 1993 this is also an in-memory compiler. The code
18 ; generator is in PARSERFP.C. Define the variable COMPILER to
19 ; build the compiler, otherwise the interpreter will be built.
20 ; COMPILER must also be #defined in PARSERFP.C to build compiler.
21
22 ; 5 Dec 1999 bug fix: removed loop unroll because the modified return
23 ; address was skipping over functions that needed to execute.
24
25 ; 1 Dec 1998 speed improvements:
26 ; Functions Clr2, LT2, LodLT2, LTE2, LodLTE2, GT2, LodGT2,
27 ; LodGTE2, AndClr2, OrClr2, LodLTEAnd2 were modified to alter
28 ; their return address on the stack, forcing an exit from
29 ; the evaluation loop. This allows the code to run
30 ; faster because it doesn't have to test for loop end.
; The loop was also unrolled one time for further gains.
; ---------------------------------------------------------------------------
; 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
;
; 5 Dec 1999 JCO Removed loop unroll
; 1 Dec 1998 CAE Speed improvements
; 5 Apr 1998 JCO Added LoadRealPwr (0,0) domain check
; 6 Mar 1997 TIW Added if/else support
; 7 Aug 1996 TIW Added scrnpix constant
; 4 Aug 1996 TIW Added whitesq variable support
; 30 Jun 1996 TIW Added floor, ceil, trunc, and round functions
; 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
31 ; make it easier to make it run later. Added
32 ; old <- z to end of fform_per_pixel to match
33 ; C code.
34
35 ; 30 Dec 1993 CAE Compiler is working
36 ; Changed EXIT_OPER -> ret in 3 operator fns
37 ; Added safety test for fn size in macros
38
39 ; 12 Dec 1993 CAE Compiler additions
40
41 ; 4 Dec 1993 CAE SinhCosh function accuracy improved
42 ; Added LoadImagAdd/Sub/Mul
43
44 ; 19 Nov 1993 CAE Revised macros for compiler mode.
45
46 ; 10 Nov 1993 CAE Changed Exp function for more accuracy.
47
48 ; 06 Nov 93 CAE Added 'LodRealPwr', 'One', 'ORClr2', 'Sqr3'.
49 ; Revised Pwr function to use regs vs. memory.
50 ; Changed many functions to 'included' type.
51
52 ; 31 Oct 93 CAE Added 'Dbl' function.
53
54 ; 09 Oct 1993 CAE Changed SinhCosh to use wider range of 387.
55 ; Most FNINITs changed to FINIT.
56 ; Loop logic revised slightly.
57 ; 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
WHITESQ equ CARG*9+CPFX ; offset of whitesq from start of v
SCRNPIX equ CARG*10+CPFX ; offset of scrnpix from start of v
JCSZ equ 10 ; size of jump_control structure
; ---------------------------------------------------------------------------
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.
58 ; Then a 'fstp st(0)' if needed.
59 POP_STK MACRO StkPop
60 NumToPop = StkPop SHR 1
61 REPT NumToPop
62 fcompp
63 ENDM
64 NumToPop = StkPop - ( NumToPop SHL 1 )
65 REPT NumToPop
66 fstp st(0)
67 ENDM
68 ENDM
69
70 ; Uncomment the following line to enable compiler code generation.
71 ;COMPILER EQU 1
72
73 ; ---------------------------------------------------------------------------
74 ; Generate beginning code for operator fn.
75 BEGN_OPER MACRO OperName
76 ifndef COMPILER
77 ;; only align when no compiler
78 align 4
79 endif
80
81 ;; always generate public and begin of proc (before fixups)
82 public _fStk&OperName
83 _fStk&OperName proc near
84
85 ifdef COMPILER
86 ;; generate the fixups for compiler
87 ;; size of fn. | 8000h to mark it as an OPER instead of an INCL CAE 27Dec93
88 dw Size_&OperName OR 8000h
89 ;; near pointer to the start of actual code CAE 19Dec93
90 dw offset PARSERA_TEXT:Code_&OperName
91 ;; addr of fn to include (undefined if Incl_&OperName==255 below)
92 dw IAddr_&OperName
93 ;; offset of x fixup or 255 if none
94 db XFixup_&OperName
95 ;; offset of y fixup or 255 if none
96 db YFixup_&OperName
97 ;; offset of included(called) fn or 255 if none
98 db Incl_&OperName
99
100 endif
101
102 ;; added label for code begin point CAE 25Nov93
103 Code_&OperName:
104
105 ENDM
106
107 ; ---------------------------------------------------------------------------
108 END_OPER MACRO OperName
109 ; Generate end of operator fn. code.
110
111 ifndef COMPILER
112 ;; gen a return instr.
113 ret
114 else
115
116 ;; gen a jump label
117 End_&OperName:
118
119 ;; generate zero for fixups not generated during fn.
120
121 ifndef Incl_&OperName
122 ;; No included operator. Generate 255 offset, 0 address. CAE 19Nov93
123 Incl_&OperName EQU 255
124 IAddr_&OperName EQU 0
125 endif
126
127 ifndef XFixup_&OperName
128 XFixup_&OperName EQU 255
129 endif
130
131 ifndef YFixup_&OperName
132 YFixup_&OperName EQU 255
133 endif
134
135 endif
136
137 ;; Always gen size of fn (subtract size of header here)
138 Size_&OperName EQU $ - Code_&OperName
139 ;; Make sure fn is of legal size CAE 30DEC93
140 .errnz (Size_&OperName GT 127)
141
142 ;; and end of procedure.
143 _fStk&OperName endp
144 ENDM
145
146 ; ---------------------------------------------------------------------------
147 BEGN_INCL MACRO OperName
148 ;; Generate beginning code for 'included' operator fn.
149 ;; No fixups allowed in one of these functions.
150
151 ;; Safety test: generate an equate here so the INCL_OPER CAE 15Feb95
152 ;; macro can test to see if this really is includable.
153 Is_Incl_&OperName EQU 1
154
155 ;; 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
156 fld st(0) ; x x y
157 fld st(0) ; x x x y
158 fmul st,st(3) ; xy x x y
159 fadd st,st ; 2xy x x y
160 fxch st(3) ; y x x 2xy
161 fadd st(2),st ; y x x+y 2xy
162 fsubp st(1),st ; x-y x+y 2xy
163 fmulp st(1),st ; xx-yy 2xy
164 ENDM
165
166 GEN_SQRT macro ; CAE 15Feb95
167 ; can use a max of 2 regs
168 fld st(1) ; y x y
169 fld st(1) ; x y x y
170 fpatan ; atan x y
171 fdiv __2_ ; theta=atan/2 x y
172 fsincos ; cos sin x y
173 fxch st(3) ; y sin x cos
174 fmul st,st(0) ; yy sin x cos
175 fxch st(2) ; x sin yy cos
176 fmul st,st(0) ; xx sin yy cos
177 faddp st(2),st ; sin xx+yy cos
178 fxch st(2) ; cos xx+yy sin
179 fxch ; xx+yy cos sin
180 fsqrt ; sqrt(xx+yy) cos sin
181 fsqrt ; mag=sqrt(sqrt(xx+yy)) cos sin
182 fmul st(2),st ; mag cos mag*sin
183 fmulp st(1),st ; mag*cos mag*sin
184 ENDM
185
186 ; ---------------------------------------------------------------------------
187 ; CAE 1 Dec 1998 added macro
188
189 ALTER_RET_ADDR macro
190 ;;; mov WORD PTR [sp],offset past_loop
191 pop bx
192 push offset past_loop
193 ENDM
194 ; ---------------------------------------------------------------------------
195 ; external functions
196 extrn _invertz2:far
197
198 ; ---------------------------------------------------------------------------
199 _DATA segment word public use16 'DATA'
200 extrn _invert:WORD
201 extrn _maxit:DWORD
202 extrn _inside:WORD
203 extrn _outside:WORD
204 extrn _coloriter:DWORD
205 extrn _kbdcount:WORD ; keyboard counter
206 extrn _dotmode:WORD
207 extrn __1_:QWORD, _PointFive:QWORD, __2_:QWORD, _infinity:QWORD
208 extrn _LastOp:WORD, _LastInitOp:WORD
209 extrn _InitOpPtr:WORD, _InitStoPtr:WORD, _InitLodPtr:WORD
210 extrn _s:WORD
211 extrn _dy1:DWORD, _dx1:DWORD, _dy0:DWORD, _dx0:DWORD
212 extrn _new:WORD, _old:WORD
213 extrn _overflow:WORD
214 extrn _save_release:WORD
215 extrn _col:WORD, _row:WORD
216 extrn _Arg1:WORD, _Arg2:WORD
217 extrn _pfls:DWORD, _v:DWORD
218 extrn _ldcheck:WORD
219 extrn _jump_index:WORD, _InitJumpIndex:WORD
220 extrn _jump_control:DWORD
221 extrn _delxx:TBYTE
222 extrn _delxx2:TBYTE
223 extrn _delyy:TBYTE
224 extrn _delyy2:TBYTE
225 extrn _xxmin:QWORD
226 extrn _yymax:QWORD
227 extrn _use_grid:WORD
228 _DATA ends
229
230 ; ---------------------------------------------------------------------------
231
232 _BSS segment word public use16 'BSS'
233 _fLastOp label DWORD ; save seg, offset of lastop here
234 dd ?
235 _PtrToZ label WORD ; offset of z
236 dw ?
237 _BSS ends
238
239 DGROUP group _DATA,_BSS
240
241 ; ---------------------------------------------------------------------------
242 ; Operator Functions follow.
243 ; ---------------------------------------------------------------------------
244
245 ; NOTE: None of these operator functions may change any registers but
246 ; ax and si. The exceptions are those functions that update
247 ; the current values of the 'status' regs as needed.
248
249 ; On entry to these functions:
250 ; FPU stack is used as the evaluation stack.
251 ; The FPU stack can overflow into memory. Accuracy is not lost but
252 ; calculations are slower.
253 ; es -> DGROUP
254 ; ds -> parser data
255 ; cx -> lastop
256 ; edx == orbit counter (in fFormulaX)
257 ; di -> stack overflow area, used by push and pull functions and as
258 ; a temporary storage area
259 ; bx -> current operator, operand pair
260 ; [bx] = operator function address, i.e. addr. of current '_fStkXXX'
261 ; [bx+2] = operand pointer or zero if no operand
262 ; si = operand pointer (loaded from [bx+2] before call of operator fn.)
263
264 ; New rules Feb 1993:
265 ; 1. No EXIT_OPER before an INCL_OPER
266 ; (no jumps can be made past an included function.)
267 ; 2. No included fn may include another, or have any fixups.
268 ; 3. Only one included fn. allowed per 'normal' fn.
269
270 ; --------------------------------------------------------------------------
271 ; Put this code in PARSERA_TEXT, not PARSERFP_TEXT CAE 09OCT93
272 PARSERA_TEXT segment para public use16 'CODE'
273 ; Non-standard segment register setup.
274 assume es:DGROUP, ds:nothing, cs:PARSERA_TEXT
275
276 ; --------------------------------------------------------------------------
277 ; Included functions must be before any fns that include them.
278 ; --------------------------------------------------------------------------
279 BEGN_INCL Log ; Log
280 ; From FPU387.ASM
281 ; Log is called by Pwr and is also called directly.
282 ftst
283 fstsw ax
284 sahf
285 jnz short NotBothZero
286 fxch ; y x
287 ftst
288 fstsw ax
289 sahf
290 fxch ; x y
291 jnz short NotBothZero
292 POP_STK 2 ; clear two numbers
293 fldz
294 fldz
295 mov ax, 1 ; domain error (1 in ax)
296 EXIT_OPER Log ; return (0,0)
297 PARSALIGN
298 NotBothZero:
299 xor ax,ax ; no domain error (0 in ax)
300 fld st(1) ; y x y
301 fld st(1) ; x y x y
302 fpatan ; z.y x y
303 fxch st(2) ; y x z.y
304 fmul st,st(0) ; yy x z.y
305 fxch ; x yy z.y
306 fmul st,st(0) ; xx yy z.y
307 fadd ; mod z.y
308 fldln2 ; ln2, mod, z.y
309 fmul _PointFive ; ln2/2, mod, z.y
310 fxch ; mod, ln2/2, z.y
311 fyl2x ; z.x, z.y
312 END_INCL Log
313 ; --------------------------------------------------------------------------
314 BEGN_INCL SinhCosh ; Included fn, Sinh, Cosh of st
315 ; From FPU087.ASM with mods to use less registers & for 387.
316 ; Mod for 387-only after Fractint v18. CAE 09OCT93
317 ; NOTE: Full 80-bit accuracy is *NOT* maintained in this function!
318 ; Only 1 additional register can be used here.
319 ; Changed fn so that rounding errors are less. CAE 04DEC93
320 fstcw _Arg2 ; use arg2 to hold CW
321 fwait
322 fldln2 ; ln(2) x
323 fdivp st(1),st ; x/ln(2), start the fdivr instr.
324 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
mov ax, _jump_index ; InitJumpIndex=jump_index TIW 06Mar97
mov _InitJumpIndex,ax
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
325 GEN_SQR0
326 END_INCL Sqr0
327 ; --------------------------------------------------------------------------
328 BEGN_INCL Mul ; Multiply
329 ; From FPU087.ASM
330 fld st(1) ; y.y, y.x, y.y, x.x, x.y
331 fmul st,st(4) ; y.y*x.y, y.x. y.y, x.x, x.y
332 fld st(1) ; y.x, y.y*x.y, y.x, y.y, x.x, x.y
333 fmul st,st(4) ; y.x*x.x,y.y*x.y,y.x y.y,x.x,x.y
334 fsubr ; newx=y.x*x.x-y.y*x.y,y.x,y.y,x.x,x.y
335 fxch st(3) ; x.x, y.x, y.y, newx, x.y
336 fmulp st(2),st ; y.x, y.y*x.x, newx, x.y
337 fmulp st(3),st ; y.y*x.x, newx, y.x*x.y
338 faddp st(2),st ; newx newy = y.x*x.y + x.x*y.y
339 END_INCL Mul
340 ; --------------------------------------------------------------------------
341 BEGN_OPER LodMul ; Load, Multiply
342 ; This is just load followed by multiply but it saves a fn. call
343 ; and also allows optimizer enhancements.
344 FIXUP LodMul, fld, Y ; y.y x.x x.y
345 FIXUP LodMul, fld, X ; y.x y.y x.x x.y
346 fld st(1) ; y.y, y.x, y.y, x.x, x.y
347 fmul st,st(4) ; y.y*x.y, y.x. y.y, x.x, x.y
348 fld st(1) ; y.x, y.y*x.y, y.x, y.y, x.x, x.y
349 fmul st, st(4) ; y.x*x.x, y.y*x.y, y.x, y.y, x.x, x.y
350 fsubr ; newx=y.x*x.x-y.y*x.y,y.x,y.y,x.x,x.y
351 fxch st(3) ; x.x, y.x, y.y, newx, x.y
352 fmulp st(2), st ; y.x, y.y*x.x, newx, x.y
353 fmulp st(3), st ; y.y*x.x, newx, y.x*x.y
354 faddp st(2), st ; newx newy = y.x*x.y + x.x*y.y
355 END_OPER LodMul
356 ; --------------------------------------------------------------------------
357 BEGN_INCL Div ; Divide
358 ; From FPU087.ASM with speedups
359 fld st(1) ; y.y,y.x,y.y,x.x,x.y
360 fmul st,st ; y.y*y.y,y.x,y.y,x.x,x.y
361 fld st(1) ; y.x,y.y*y.y,y.x,y.y,x.x,x.y
362 fmul st,st ; y.x*y.x,y.y*y.y,y.x,y.y,x.x,x.y
363 fadd ; mod,y.x,y.y,x.x,x.y
364 ftst
365 fstsw ax
366 sahf
367 jz short DivNotOk
368 ; 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)
mov ax,_save_release
cmp ax,1920
jle oldwayD
mov _overflow, 1
oldwayD:
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)
mov ax,_save_release
cmp ax,1920
jle oldwayR
mov _overflow, 1
oldwayR:
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
369 fld st(0) ; x x y
370 FIXUP StoSqr0, fst, X ; store x
371 fld st(0) ; x x x y
372 fmul st,st(3) ; xy x x y
373 fadd st,st ; 2xy x x y
374 fxch st(3) ; y x x 2xy
375 FIXUP StoSqr0, fst, Y ; store y
376 fadd st(2),st ; y x x+y 2xy
377 fsubp st(1),st ; x-y x+y 2xy
378 fmulp st(1),st ; xx-yy 2xy
379 END_OPER StoSqr0
380 ; --------------------------------------------------------------------------
381 BEGN_INCL Mod2 ; Modulus (uses a reg)
382 fmul st,st ; xx y
383 fldz ; 0 xx y
384 fxch st(2) ; y xx 0
385 fmul st,st ; yy xx 0
386 fadd ; mod 0
387 END_INCL Mod2
388 ; --------------------------------------------------------------------------
389 BEGN_OPER LodMod2 ; Load, Modulus (uses a reg)
390 fldz ; 0 ...
391 FIXUP LodMod2, fld, X ; x 0 ...
392 fmul st,st ; xx 0
393 FIXUP LodMod2, fld, Y ; y xx 0
394 fmul st,st ; yy xx 0
395 fadd ; mod 0
396 END_OPER LodMod2
397 ; --------------------------------------------------------------------------
398 BEGN_OPER StoMod2 ; Store, Modulus (uses a reg)
399 FIXUP StoMod2, fst, X ; x y
400 fmul st,st ; xx y
401 fldz ; 0 xx y
402 fxch st(2) ; y xx 0
403 FIXUP StoMod2, fst, Y ; y xx 0
404 fmul st,st ; yy xx 0
405 fadd ; mod 0
406 END_OPER StoMod2
407 ; --------------------------------------------------------------------------
408 BEGN_OPER Clr2 ; Test ST, clear FPU
409 ftst
410 fstsw ax
411 ; CAE 1 Dec 1998
412 ALTER_RET_ADDR ; change return address on stack
413
414 fninit ; fstsw will complete first
415 and ah,01000000b ; return 1 if zf=1
416 shr ax,14 ; AX will be returned by fFormula()
417 END_OPER Clr2
418 ; --------------------------------------------------------------------------
419 BEGN_OPER PLodAdd ; Load, Add (uses no regs)
420 fxch ; y x
421 FIXUP PLodAdd, fadd, Y ; add y from memory
422 fxch ; x y
423 FIXUP PLodAdd, fadd, X ; add x, overlap execution
424 END_OPER PLodAdd
425 ; --------------------------------------------------------------------------
426 BEGN_OPER PLodSub ; Load, Subtract (uses no regs)
427 fxch
428 FIXUP PLodSub, fsub, Y ; sub y from memory
429 fxch ; x y
430 FIXUP PLodSub, fsub, X ; sub x, overlap execution
431 END_OPER PLodSub
432 ; --------------------------------------------------------------------------
433 BEGN_OPER LodDup ; Load, duplicate
434 FIXUP LodDup, fld, Y ; y ...
435 FIXUP LodDup, fld, X ; x y ...
436 fld st(1) ; y x y ...
437 fld st(1) ; x y x y ...
438 END_OPER LodDup
439 ; --------------------------------------------------------------------------
440 BEGN_OPER LodSqr ; Load, square (no save lastsqr)
441 FIXUP LodSqr, fld, Y ; y ...
442 fld st(0) ; y y ...
443 fadd st(1),st ; y 2y ...
444 fld st(0) ; y y 2y
445 FIXUP LodSqr, fld, X ; x y y 2y ...
446 fmul st(3),st ; x y y 2xy ...
447 fadd st(2),st ; x y X+y 2xy ...
448 fsubrp st(1),st ; x-y x+y 2xy ...
449 fmul ; xx-yy 2xy ...
450 END_OPER LodSqr
451 ; --------------------------------------------------------------------------
452 BEGN_OPER LodSqr2 ; Load, square (save lastsqr)
453 FIXUP LodSqr2, fld, Y ; y ...
454 fld st(0) ; y y ...
455 fadd st(1),st ; y 2y ...
456 fmul st,st(0) ; yy 2y ...
457 FIXUP LodSqr2, fld, X ; x yy 2y ...
458 fmul st(2),st ; x yy 2xy ...
459 mov si,WORD PTR _v ; put address of v in si
460 fmul st,st(0) ; xx yy 2xy ...
461 fld st(0) ; xx xx yy 2xy
462 fadd st,st(2) ; mod xx yy 2xy
463 fstp QWORD PTR [si+LASTSQR] ; xx yy 2xy ... (save lastsqr)
464 fsubrp st(1),st ; xx-yy 2xy ...
465 END_OPER LodSqr2
466 ; --------------------------------------------------------------------------
467 BEGN_OPER LodDbl ; Load, double
468 FIXUP LodDbl, fld, Y ; load y
469 fadd st,st(0) ; double it
470 FIXUP LodDbl, fld, X ; same for x
471 fadd st,st(0)
472 END_OPER LodDbl
473 ; --------------------------------------------------------------------------
474 BEGN_INCL Dbl ; Double CAE 31OCT93
475 fxch ; y x ...
476 fadd st,st(0) ; 2y x ...
477 fxch ; x 2y ...
478 fadd st,st(0) ; 2x 2y ...
479 END_INCL Dbl
480 ; --------------------------------------------------------------------------
481 BEGN_INCL Mod ; Modulus (uses no regs)
482 fmul st,st ; x*x y
483 fxch ; y x*x
484 fmul st,st ; y*y x*x
485 fadd ; mod
486 fldz ; 0 mod
487 fxch ; mod 0
488 END_INCL Mod
489 ; --------------------------------------------------------------------------
490 ; The following code was 'discovered' by experimentation. The Intel manuals
491 ; 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 short domainok ; nope
test _ldcheck, 1 ; user wants old pwr?
jnz short domainok ; yup
POP_STK 4 ; clear stack completely
fldz ; 0
fldz ; 0 0
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
cmp ax,1 ; log domain error?
jne short domainok2 ; nope
cmp _ldcheck, 1 ; user wants old lodrealpwr?
je short domainok2 ; yup
POP_STK 2 ; clear stack completely
fldz ; 0
fldz ; 0 0
EXIT_OPER LodRealPwr ; return (0,0)
PARSALIGN
domainok2:
; 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
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 Floor ; Complex floor
fstcw _Arg2 ; use arg2 to hold CW
fwait
mov ax,_Arg2 ; Now do some integer instr.'s
492 push ax ; Save control word on stack
493 and ax,1111001111111111b
494 or ax,0000010000000000b
495 mov _Arg2,ax
496 fldcw _Arg2 ; Now set control to round toward -inf
497 ; Chop toward negative infinity applies now
498 frndint ; floor(x) y
499 fxch ; y floor(x)
500 frndint ; floor(y) floor(x)
501 fxch ; floor(x) floor(y)
502 pop ax ; restore old CW to AX
503 mov _Arg2,ax ; ...then move it to Arg2
504 fldcw _Arg2 ; Restore control word from Arg2
505 ; Normal rounding is in effect again
506 END_OPER Floor
507 ; --------------------------------------------------------------------------
508 BEGN_OPER Ceil ; Complex ceiling
509 fstcw _Arg2 ; use arg2 to hold CW
510 fwait
511 mov ax,_Arg2 ; Now do some integer instr.'s
push ax ; Save control word on stack
and ax,1111001111111111b
or ax,0000100000000000b
mov _Arg2,ax
fldcw _Arg2 ; Now set control to round toward +inf
; Chop toward positive infinity applies now
frndint ; ceil(x) y
fxch ; y ceil(x)
frndint ; ceil(y) ceil(x)
fxch ; ceil(x) ceil(y)
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
END_OPER Ceil
; --------------------------------------------------------------------------
BEGN_OPER Trunc ; Complex truncation
fstcw _Arg2 ; use arg2 to hold CW
fwait
mov ax,_Arg2 ; Now do some integer instr.'s
512 push ax ; Save control word on stack
513 or ax,0000110000000000b
514 mov _Arg2,ax
515 fldcw _Arg2 ; Now set control to round toward zero
516 ; Chop toward zero rounding applies now
517 frndint ; trunc(x) y
518 fxch ; y trunc(x)
519 frndint ; trunc(y) trunc(x)
520 fxch ; trunc(x) trunc(y)
521 pop ax ; restore old CW to AX
522 mov _Arg2,ax ; ...then move it to Arg2
523 fldcw _Arg2 ; Restore control word from Arg2
524 ; Normal rounding is in effect again
525 END_OPER Trunc
526 ; --------------------------------------------------------------------------
527 BEGN_OPER Round ; Complex round to nearest
528 fstcw _Arg2 ; use arg2 to hold CW
529 fwait
530 mov ax,_Arg2 ; Now do some integer instr.'s
push ax ; Save control word on stack
and ax,1111001111111111b
or ax,0000010000000000b
mov _Arg2,ax
fldcw _Arg2 ; Now set control to round toward -inf
; Round toward negative infinity applies now
fadd _PointFive ; x+.5 y
frndint ; round(x) y
fxch ; y round(x)
fadd _PointFive ; y+.5 round(x)
frndint ; round(y) round(x)
fxch ; round(x) round(y)
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
END_OPER Round
; --------------------------------------------------------------------------
; End of new functions. TIW 30Jun96
; --------------------------------------------------------------------------
BEGN_INCL Jump ;
mov ax,JCSZ ; ax = sizeof(jump control struct)
imul _jump_index ; address of jump_control[jump_index]
push es
les bx, _jump_control
add bx,ax
mov ax,WORD PTR es:[bx+8]; jump_index = DestJumpIndex
mov bx,WORD PTR es:[bx+2]; bx = JumpOpPtr
pop es
mov _jump_index,ax
add bx, WORD PTR _pfls ;
END_INCL Jump ;
; --------------------------------------------------------------------------
BEGN_OPER JumpOnTrue ;
ftst ; test Arg1.x
fstsw ax
sahf
jz short NotTrue ; if(Arg1.x != 0)
INCL_OPER JumpOnTrue, Jump ; call Jump
jmp short EndJumpOnTrue
NotTrue:
add _jump_index, 1 ; else jump_index++
EndJumpOnTrue:
END_OPER JumpOnTrue ;
; --------------------------------------------------------------------------
BEGN_OPER JumpOnFalse ;
ftst ; test Arg1.x
fstsw ax
sahf
jnz short True ; if(Arg1.x == 0)
INCL_OPER JumpOnFalse, Jump
jmp short EndJumpOnFalse
True:
add _jump_index, 1 ; else jump_index++
EndJumpOnFalse:
END_OPER JumpOnFalse ;
; --------------------------------------------------------------------------
BEGN_OPER JumpLabel ;
add _jump_index, 1 ; jump_index++
END_OPER JumpLabel ;
; --------------------------------------------------------------------------
; End of new functions. TIW 09Mar97
; --------------------------------------------------------------------------
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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
; CAE 1 Dec 1998
ALTER_RET_ADDR ; change return address on stack
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 ax,WORD PTR _InitJumpIndex
mov WORD PTR _jump_index,ax
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
531 mov di,offset DGROUP:_s ; reset this for stk overflow area
532 mov bx,_InitOpPtr ; bx -> one before first token
533 mov ax,WORD PTR _InitJumpIndex
534 mov WORD PTR _jump_index,ax
535 mov ax,ds ; save ds in ax
536 lds cx,_fLastOp ; ds:cx -> last token
537 mov es,ax ; es -> DGROUP
538 assume es:DGROUP, ds:nothing
539 push si
540
541 ;;;;align 8
542 inner_loop: ; new loop CAE 1 Dec 1998
543 mov si,WORD PTR [bx+2]
544 call WORD PTR [bx]
545 ; mov si,WORD PTR [bx+6] ; now set si to operand pointer
546 ; call WORD PTR [bx+4] ; ...and jump to operator fn
547 ; add bx,8 ; JCO removed loop unroll, 12/5/99
548 add bx,4
549 jmp short inner_loop
550
551 ;;;;align 8
552 past_loop:
553 ; NOTE: AX was set by the last operator fn called.
554 mov si,_PtrToZ ; ds:si -> z
555 mov di,offset DGROUP:_new ; es:di -> new
556 mov cx,4 ; get ready to move 4 dwords
557 rep movsd ; new = z
558 mov bx,es ; put seg dgroup in bx
559 pop si
560 pop di ; restore si, di
561 mov ds,bx ; restore ds from bx before return
562 assume ds:DGROUP, es:nothing
563 ret ; return AX unmodified
564 _fFormula endp
565 ; --------------------------------------------------------------------------
566 public _fform_per_pixel ; called once per pixel
567 align 4
568 _fform_per_pixel proc far
569 FRAME
570 ; if((row+col)&1)
571 mov ax,_row ; ax = row
572 add ax,_col ; ax = row+col
573 and ax,1 ; ax = (row+col)&1
574 les bx,_v ; load pointer to constants
575 cmp ax,0 ; zero?
576 je checker_is_0
577 ; v[9].a.d.x = 1.0; ; not zero, set whitesq.x=1.0
578 fld1 ; constant 1.0 to ST
579 fstp QWORD PTR es:[bx+WHITESQ] ; copy ST to whitesq.x
580 jmp checker_is_1
581 checker_is_0: ; is zero, set whitesq to (0,0)
582 ; v[9].a.d.y = 0.0;
583 fldz ; load constant zero to ST
584 fstp QWORD PTR es:[bx+WHITESQ] ; copy ST to whitesq.x
585 checker_is_1:
586 fldz
587 fstp QWORD PTR es:[bx+WHITESQ+8]
588 ; v[10].a.d.x = (double)col;
589 fild _col ; ST = col
590 fstp QWORD PTR es:[bx+SCRNPIX] ; scrnpix.x = col
591 ; v[10].a.d.y = (double)row;
592 fild _row ; ST = row
593 fstp QWORD PTR es:[bx+SCRNPIX+8] ; scrnpix.y = row
594 mov _jump_index,0 ;jump_index = 0
595 cmp _invert,0 ; inversion support added
596 je skip_invert ; CAE 08FEB95
597 mov si,offset DGROUP:_old
598 push si
599 call far ptr _invertz2
600 add sp,2
601 ; now copy old to v[0].a.d
602 les di,_v ; ds:si already points to old
603 add di,CPFX ; make es:di point to v[0].a.d
604 mov cx,4
605 rep movsd
606 jmp after_load
607 skip_invert:
608 cmp _use_grid,0 ; inversion support added
609 je skip_grid
610 ; v[0].a.d.x = dx0[col]+dShiftx;
611 mov ax,_col
612 shl ax,3
613 les bx,_dx0
614 add bx,ax
615 fld QWORD PTR es:[bx]
616 mov ax,_row
617 shl ax,3
618 les bx,_dx1
619 add bx,ax
620 fadd QWORD PTR es:[bx]
621 les bx,_v
622 fstp QWORD PTR es:[bx+CPFX]
623 ; v[0].a.d.y = dy0[row]+dShifty;
624 mov ax,_row
625 shl ax,3
626 les bx,_dy0
627 add bx,ax
628 fld QWORD PTR es:[bx]
629 mov ax,_col
630 shl ax,3
631 les bx,_dy1
632 add bx,ax
633 fadd QWORD PTR es:[bx]
634 les bx,_v
635 fstp QWORD PTR es:[bx+CPFX+8]
636 jmp after_load
637 skip_grid:
638 ; v[0].a.d.x = (double)(xxmin + col*delxx + row*delxx2);
639 fild WORD PTR _row
640 fld TBYTE PTR _delxx2
641 fmulp st(1),st(0)
642 fild WORD PTR _col
643 fld TBYTE PTR _delxx
644 fmulp st(1),st(0)
645 faddp st(1),st(0)
646 fadd QWORD PTR _xxmin
647 les bx,_v
648 fstp QWORD PTR es:[bx+CPFX]
649 fwait
650 ; v[0].a.d.y = (double)(yymax - row*delyy - col*delyy2); */
651 fild WORD PTR _row
652 fld TBYTE PTR _delyy
653 fmulp st(1),st(0)
654 fsubr QWORD PTR _yymax
655 fild WORD PTR _col
656 fld TBYTE PTR _delyy2
657 fmulp st(1),st(0)
658 fsubp st(1),st(0)
659 les bx,_v
660 fstp QWORD PTR es:[bx+CPFX+8]
661 after_load:
662 mov di,offset DGROUP:_s ; di points to stack overflow area
663 mov ax,ds
664 mov bx,WORD PTR _pfls ; bx -> pfls
665 lds cx,_fLastOp ; cx = offset &f[LastOp],load ds
666 mov es,ax
667 assume es:DGROUP, ds:nothing
668 cmp _LastInitOp,0
669 je short skip_initloop ; no operators to do here
670 mov _LastInitOp,cx ; lastinitop=lastop
671 jmp short pixel_loop
672 align 16
673 pixel_loop:
674 mov si,WORD PTR [bx+2] ; get address of load or store
675 call WORD PTR [bx] ; (*opptr)()
676 add bx,4 ; ++opptr
677 cmp bx,_LastInitOp
678 jb short pixel_loop
679 skip_initloop:
680 mov si,_PtrToZ ; ds:si -> z
681 mov di,offset DGROUP:_old ; es:di -> old
682 mov cx,4 ; get ready to move 4 dwords
683 rep movsd ; old = z
684 mov ax,es
685 mov ds,ax
686 assume ds:DGROUP, es:nothing ; for the rest of the program
687 ;
688 ; ; subtract removed CAE 1 Dec 1998
689 mov _InitOpPtr, bx ; InitOptPtr = OpPtr;
690 UNFRAME
691 xor ax,ax
692 ret
693 _fform_per_pixel endp
694 ; --------------------------------------------------------------------------
695
696 else ; Compiler
697
698 ; --------------------------------------------------------------------------
699 ; . . . and now for the real fun!
700 ; --------------------------------------------------------------------------
701 public _Img_Setup
702 align 2
703 _Img_Setup proc far
704 mov ax,word ptr _v ; build a ptr to Z
705 add ax,3*CARG+CPFX
706 mov _PtrToZ,ax ; and save it
707 ret
708 _Img_Setup endp
709 ; --------------------------------------------------------------------------
710 ; Hybrid orbitcalc/per-pixel routine.
711 ; --------------------------------------------------------------------------
712 public _fFormulaX
713 align 16
714 _fFormulaX proc far
715 push si
716 push di
717 mov edx,_maxit ; edx holds coloriter during loop
718 mov _coloriter,edx ; set coloriter to maxit
719 mov ax,ds ; save ds in ax
720 mov cx,word ptr _pfls+2 ; just get the seg part
721 mov es,ax ; es -> DGROUP
722 mov ds,cx ; ds -> parser data
723 assume es:DGROUP, ds:nothing
724 jmp short skipfirst ; skip bailout test first time
725 align 16
726 outer_loop:
727 or ax,ax ; did bailout occur?
728 jnz short doneloop ; yes, exit
729 skipfirst:
730 dec edx ; ++coloriter, was maxiter reached?
731 jle short doneloop ; yes, exit because of maxiter
732 push offset PARSERA_TEXT:outer_loop
733 mov di,offset DGROUP:_s ; reset this for stk overflow area
734 jmp _compiled_fn_2 ; call the compiled code
735 doneloop:
736 ; NOTE: edx must be preserved here.
737 mov si,_PtrToZ ; ds:si -> z
738 mov di,offset DGROUP:_new ; es:di -> new
739 mov cx,4
740 rep movsd ; new = z
741 mov ax,es
742 pop di
743 pop si
744 mov ds,ax ; restore ds before return
745 assume ds:DGROUP, es:nothing
746 sub _coloriter,edx ; now put new coloriter back from edx
747 ret
748 _fFormulaX endp
749 ; --------------------------------------------------------------------------
750 ; orbitcalc function follows
751 ; --------------------------------------------------------------------------
752 public _fFormula
753 align 16
754 _fFormula proc far
755 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:
cmp _use_grid,0 ; inversion support added
je skip_grid
; 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[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]
jmp after_load
skip_grid:
; v[0].a.d.x = (double)(xxmin + col*delxx + row*delxx2);
fild WORD PTR _row
fld TBYTE PTR _delxx2
fmulp st(1),st(0)
fild WORD PTR _col
fld TBYTE PTR _delxx
fmulp st(1),st(0)
faddp st(1),st(0)
fadd QWORD PTR _xxmin
les bx,_v
fstp QWORD PTR es:[bx+CPFX]
fwait
; v[0].a.d.y = (double)(yymax - row*delyy - col*delyy2); */
fild WORD PTR _row
fld TBYTE PTR _delyy
fmulp st(1),st(0)
fsubr QWORD PTR _yymax
fild WORD PTR _col
fld TBYTE PTR _delyy2
fmulp st(1),st(0)
fsubp st(1),st(0)
les bx,_v
fstp QWORD PTR es:[bx+CPFX+8]
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