Menu
▾
▴
[Win32forth-cvs] win32forth/src FLOAT.F,1.21,1.22
|
From: George H. <geo...@us...> - 2006-01-03 08:26:28
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9502/win32forth/src Modified Files: FLOAT.F Log Message: gah: Minor bug fixes and optimisations. Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.21 retrieving revision 1.22 diff -C2 -d -r1.21 -r1.22 *** FLOAT.F 16 Nov 2005 09:11:38 -0000 1.21 --- FLOAT.F 3 Jan 2006 08:26:17 -0000 1.22 *************** *** 160,165 **** mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$1 ! fld FSIZE FSTACK_MEMORY fxam fstsw ax --- 160,167 ---- mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! jns short L$1 ! mov ebx, # FPU_STATUS_CCF_EMPTY ! jmp short L$2 ! L$1: fld FSIZE FSTACK_MEMORY fxam fstsw ax *************** *** 167,185 **** and ebx, # FPU_STATUS_CCF_MASK fstp st(0) - jmp short L$2 - L$1: mov ebx, # FPU_STATUS_CCF_EMPTY L$2: next, end-code ! code finit ( -- ) \ clears fp stack & sets appropriate byte mode ! finit ! xor eax, eax ! mov FSP_MEMORY , eax ! mov ecx, ebx ! xor ebx, ebx ! push ebx ! mov ebx, esp ! fstcw word 0 [ebx] ! pop eax B/FLOAT 10 = [IF] or eax, # 0x0300 \ 10 byte mode --- 169,186 ---- and ebx, # FPU_STATUS_CCF_MASK fstp st(0) L$2: next, end-code ! code finit ( -- ) \ W32F Float extra ! \ *G Clears the floating-point stack & sets the appropriate byte mode. ! \ ** It is executed by the system on start-up and by the default exception handler. ! \ ** Users generally don't need to call this word in a single-task program. ! \ ** Tasks in a multi-task program should execute this word before executing any ! \ ** other floating-point words. ! fninit ! mov FSP_MEMORY , edi ! lea esp, -4 [esp] ! fnstcw word 0 [esp] ! mov eax, 0 [esp] B/FLOAT 10 = [IF] or eax, # 0x0300 \ 10 byte mode *************** *** 187,195 **** or eax, # 0x0200 [THEN] ! push eax ! mov ebx, esp ! fldcw word 0 [ebx] ! pop ebx ! mov ebx, ecx next, end-code --- 188,194 ---- or eax, # 0x0200 [THEN] ! mov 0 [esp], eax ! fldcw word 0 [esp] ! lea esp, 4 [esp] next, end-code *************** *** 261,266 **** js short L$1 ret \ stack is fine, return to caller ! L$1: mov esi, # ' FSTKUFLO >body \ throw underflow error ! next \ doesn't return to caller !!! end-code --- 260,265 ---- js short L$1 ret \ stack is fine, return to caller ! L$1: mov eax, # ' FSTKUFLO \ throw underflow error ! exec \ doesn't return to caller !!! end-code *************** *** 350,354 **** FPU> ! pop bx float; --- 349,353 ---- FPU> ! pop tos float; *************** *** 358,362 **** code (f@) ( F: -- r ; addr -- ) \ ??? fld FSIZE DATASTACK_MEMORY ! pop ebx float; DEPRECATED --- 357,361 ---- code (f@) ( F: -- r ; addr -- ) \ ??? fld FSIZE DATASTACK_MEMORY ! pop tos float; DEPRECATED *************** *** 428,433 **** sub FSP_MEMORY , # B/FLOAT ! next, ! end-code code FDUP ( fs: r -- r r ) --- 427,431 ---- sub FSP_MEMORY , # B/FLOAT ! float; code FDUP ( fs: r -- r r ) *************** *** 521,531 **** sub FSP_MEMORY , # B/FLOAT 2* ! next, ! end-code : F2DUP ( fs: r1 r2 -- r1 r2 r3 r4 ) fover fover ; ! : F2SWAP ( fs: r1 r2 -- r2 r1 ) { \ ftemp -- } B/FLOAT LocalAlloc: ftemp \ hold a floating point number --- 519,529 ---- sub FSP_MEMORY , # B/FLOAT 2* ! float; : F2DUP ( fs: r1 r2 -- r1 r2 r3 r4 ) fover fover ; ! : F2SWAP ( fs: r1 r2 r3 r4 -- r3 r4 r2 r1 ) \ W32F Float extra ! \ *G Swap the top pair of floating-point numbers with the second pair. { \ ftemp -- } B/FLOAT LocalAlloc: ftemp \ hold a floating point number *************** *** 579,583 **** [IF] stack-check \ TODO replace f1.0 fvariable with fconstant ! f1.0 fvariable af0 0 af0 ! 0 af0 cell+ ! 0 af0 2 cells+ w! --- 577,581 ---- [IF] stack-check \ TODO replace f1.0 fvariable with fconstant ! fvariable af0 0 af0 ! 0 af0 cell+ ! 0 af0 2 cells+ w! *************** *** 591,605 **** 1 ' f2.0 >body 2 cells+ w+! ! f1.0 fvariable a2**63 0 a2**63 ! 0x80000000 a2**63 cell+ ! 0x403e a2**63 2 cells+ w! \ January 13th, 1998 - 9:32 tjz for RLS \ per suggestion from Pierre Abbat ! f1.0 fvariable sq2m1 \ sqrt(2) - 1 0xe7799210 sq2m1 ! 0xd413cccf sq2m1 cell+ ! 0x3ffd sq2m1 2 cells+ w! ! f1.0 fvariable sq2/2m1 \ sqrt(2)/2 - 1 0x0c4336f8 sq2/2m1 ! 0x95f61998 sq2/2m1 cell+ ! --- 589,603 ---- 1 ' f2.0 >body 2 cells+ w+! ! fvariable a2**63 0 a2**63 ! 0x80000000 a2**63 cell+ ! 0x403e a2**63 2 cells+ w! \ January 13th, 1998 - 9:32 tjz for RLS \ per suggestion from Pierre Abbat ! fvariable sq2m1 \ sqrt(2) - 1 0xe7799210 sq2m1 ! 0xd413cccf sq2m1 cell+ ! 0x3ffd sq2m1 2 cells+ w! ! fvariable sq2/2m1 \ sqrt(2)/2 - 1 0x0c4336f8 sq2/2m1 ! 0x95f61998 sq2/2m1 cell+ ! *************** *** 621,625 **** 1 ' feps >body ! ! f0.0 fvariable afsmall 0 afsmall ! 0x80000000 afsmall cell+ ! 1 afsmall 2 cells+ w! --- 619,623 ---- 1 ' feps >body ! ! fvariable afsmall 0 afsmall ! 0x80000000 afsmall cell+ ! 1 afsmall 2 cells+ w! *************** *** 638,649 **** 0x40000000 ' f2.0 >body cell+ ! ! f1.0 fvariable a2**63 0 a2**63 ! 0x43e00000 a2**63 cell+ ! ! f1.0 fvariable sq2m1 \ sqrt(2) - 1 0x99fcef34 sq2m1 ! 0x3fda8279 sq2m1 cell+ ! ! f1.0 fvariable sq2/2m1 \ sqrt(2)/2 - 1 0x33018866 sq2/2m1 ! 0xbfd2bec3 sq2/2m1 cell+ ! --- 636,647 ---- 0x40000000 ' f2.0 >body cell+ ! ! fvariable a2**63 0 a2**63 ! 0x43e00000 a2**63 cell+ ! ! fvariable sq2m1 \ sqrt(2) - 1 0x99fcef34 sq2m1 ! 0x3fda8279 sq2m1 cell+ ! ! fvariable sq2/2m1 \ sqrt(2)/2 - 1 0x33018866 sq2/2m1 ! 0xbfd2bec3 sq2/2m1 cell+ ! *************** *** 778,786 **** code D>F ( d -- ) ( F: -- r ) ! xchg ebx, 0 [esp] ! push ebx fild qword 0 [esp] ! add esp, # 8 ! pop ebx FPU> --- 776,786 ---- code D>F ( d -- ) ( F: -- r ) ! lea esp, -4 [esp] ! mov ecx, 4 [esp] ! mov 0 [esp], ecx ! mov 4 [esp], tos fild qword 0 [esp] ! mov tos, 8 [esp] ! lea esp, 12 [esp] FPU> *************** *** 1512,1526 **** code f>bcd ( f: r -- ) ( addr -- ) ! mov ecx, FSP_MEMORY ! sub ecx, # B/FLOAT ! js short L$4 ! mov FSP_MEMORY , ecx ! fld FSIZE FSTACK_MEMORY fbstp DATASTACK_MEMORY ! jmp short L$5 ! L$4: mov esi, # ' FSTKUFLO >body ! L$5: pop ebx ! next, ! end-code : bcd-char@ ( n -- char ) --- 1512,1520 ---- code f>bcd ( f: r -- ) ( addr -- ) ! fstack-check_1 ! >fpu fbstp DATASTACK_MEMORY ! pop tos ! float; : bcd-char@ ( n -- char ) *************** *** 1988,1992 **** ['] (g.) (fp.) ; ! SYNONYM FS. E. ( f: r -- r ) \ display fp # in scientific notation --- 1982,1986 ---- ['] (g.) (fp.) ; ! SYNONYM FS. E. ( f: r -- ) \ display fp # in scientific notation |
