From: George H. <geo...@us...> - 2006-01-24 09:13:32
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23232/win32forth/src Modified Files: Class.f FLOAT.F Log Message: gah: Further documentation and dexing (work in progress) Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** Class.f 14 Jan 2006 14:03:32 -0000 1.12 --- Class.f 24 Jan 2006 09:13:22 -0000 1.13 *************** *** 205,209 **** : ?isParen ( cfa -- f ) ! >name nfa-count drop c@ ascii [ = ; \ ERROR if not compiling a new class definition --- 205,209 ---- : ?isParen ( cfa -- f ) ! >name nfa-count drop c@ [char] [ = ; \ ERROR if not compiling a new class definition *************** *** 971,979 **** : ;Record ( -- ) \ W32F Class ! \ *G End a group of data fields that need to contiguous. 0 to contiguous-data? ; : ;RecordSize: ( -<name>- ) \ W32F Class ! \ *G End a group of data fields that need to contiguous and create a name with the \ ** size of the record. 0 to contiguous-data? --- 971,979 ---- : ;Record ( -- ) \ W32F Class ! \ *G End a group of data fields that need to be contiguous. 0 to contiguous-data? ; : ;RecordSize: ( -<name>- ) \ W32F Class ! \ *G End a group of data fields that need to be contiguous and create a name with the \ ** size of the record. 0 to contiguous-data? Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** FLOAT.F 16 Jan 2006 15:47:50 -0000 1.24 --- FLOAT.F 24 Jan 2006 09:13:24 -0000 1.25 *************** *** 463,477 **** float; ! code FSWAP ( fs: r1 r2 -- r2 r1 ) fstack-check_2 - \ TODO optimize 2>FPU ! fxch FPU> FPU> ! float; ! code FOVER ( fs: r1 r2 -- r1 r2 r3 ) fstack-check_2 fld FSIZE b/float 2* negate +FSTACK_MEMORY --- 463,479 ---- float; ! code FSWAP ( fs: r1 r2 -- r2 r1 ) \ ANSI Floating ! \ *G Exchange the top 2 FP numbers. fstack-check_2 2>FPU ! +fsp-adjust FPU> + -fsp-adjust -fsp-adjust FPU> ! +fsp-adjust float; ! code FOVER ( fs: r1 r2 -- r1 r2 r3 ) \ ANSI Floating ! \ *G Copy the 2nd FP stack number to the top of the FP stack. fstack-check_2 fld FSIZE b/float 2* negate +FSTACK_MEMORY *************** *** 480,484 **** float; ! code FROT ( fs: r1 r2 r3 -- r2 r3 r1 ) fstack-check_3 mov ecx, FSP_MEMORY --- 482,487 ---- float; ! code FROT ( fs: r1 r2 r3 -- r2 r3 r1 ) \ ANSI Floating ! \ *G Rotate the top 3 FP stack numbers. fstack-check_3 mov ecx, FSP_MEMORY *************** *** 498,502 **** float; ! code FPICK ( n -- ) ( fs: -- r ) \ W32F Floating extra \ *G Copy the n'th number from the FP stack. mov eax, ebx --- 501,505 ---- float; ! code FPICK ( n -- ) ( fs: -- r ) \ W32F Floating extra \ *G Copy the n'th number from the FP stack. mov eax, ebx *************** *** 516,528 **** float; ! : FNIP ( fs: r1 r2 -- r2 ) FSWAP FDROP ; ! code F2DROP ( fs: r1 r2 -- ) fstack-check_2 sub FSP_MEMORY , # B/FLOAT 2* float; ! : F2DUP ( fs: r1 r2 -- r1 r2 r3 r4 ) fover fover ; --- 519,539 ---- float; ! : FNIP ( fs: r1 r2 -- r2 ) \ W32F Floating extra ! \ *G Remove the 2nd FP stack entry. FSWAP FDROP ; ! \ *N FP Stack operations on pairs of entries ! ! \ *P The following words can be used for pairs of FP numbers and are useful for dealing ! \ ** with complex numbers or 2-dimensional vectors on the FP stack. ! ! code F2DROP ( fs: r1 r2 -- ) \ W32F Floating extra ! \ *G Remove the top 2 FP stack entries. fstack-check_2 sub FSP_MEMORY , # B/FLOAT 2* float; ! : F2DUP ( fs: r1 r2 -- r1 r2 r3 r4 ) \ W32F Floating extra ! \ *G Duplicate the top 2 FP stack entries. fover fover ; *************** *** 534,538 **** FROT ftemp f@ ; \ recover saved float ! : F2NIP ( fs: r1 r2 r3 r4 -- r3 r4 ) f2swap f2drop ; --- 545,550 ---- FROT ftemp f@ ; \ recover saved float ! : F2NIP ( fs: r1 r2 r3 r4 -- r3 r4 ) \ W32F Floating extra ! \ *G Remove the 2nd pair of FP stack entries. f2swap f2drop ; *************** *** 561,580 **** float; ! code fL2e ( fs: -- r ) \ log base 2 of e fldL2e FPU> - float; ! code fLog2 ( fs: -- r ) \ log base 10 of 2 fldLg2 FPU> - float; ! code fLn2 ( fs: -- r ) \ ln 2 natural logarithm fldLn2 FPU> - float; --- 573,592 ---- float; ! code fL2e ( fs: -- r ) \ W32F Floating extra ! \ *G Push the value of log base 2 of e. fldL2e FPU> float; ! code fLog2 ( fs: -- r ) \ W32F Floating extra ! \ *G Push the value of log base 10 of 2. fldLg2 FPU> float; ! code fLn2 ( fs: -- r ) \ W32F Floating extra ! \ *G Push the vlue of ln 2 (the natural logarithm). fldLn2 FPU> float; *************** *** 632,642 **** [ELSE] ( 8 byte mode ) stack-check ! f1.0 fconstant f0.0 ' f0.0 >body 0 over ! 0 swap cell+ ! ! f0.0 fconstant finf \ infinity ' finf >body 0 over ! 0x7ff00000 swap cell+ ! ! f1.0 fconstant f2.0 0x40000000 ' f2.0 >body cell+ ! --- 644,657 ---- [ELSE] ( 8 byte mode ) stack-check ! f1.0 fconstant f0.0 ( FS: -- r ) \ W32F Floating extra ! \ *G Push plus zero. ' f0.0 >body 0 over ! 0 swap cell+ ! ! f0.0 fconstant finf ( FS: -- r ) \ W32F Floating extra ! \ *G Push plus infinity. ' finf >body 0 over ! 0x7ff00000 swap cell+ ! ! f1.0 fconstant f2.0 ( FS: -- r ) \ W32F Floating extra ! \ *G Push 2.0 0x40000000 ' f2.0 >body cell+ ! *************** *** 896,909 **** external ! : F0= ( -- f ) ( fs: r -- ) ftstp FCOMP_EQUAL = ; ! : F0< ( -- f ) ( fs: r -- ) ftstp FCOMP_LESS = ; ! : f0> ( -- f ) ( fs: r -- ) ftstp 0= ; ! : f= ( -- f ) ( fs: r1 r2 -- ) fcomppx FCOMP_EQUAL = ; ! : F< ( -- f ) ( fs: r1 r2 -- ) fcomppx FCOMP_LESS = ; ! : f> ( -- f ) ( fs: r1 r2 -- ) fcomppx 0= ; ! : f<= ( -- f ) ( fs: r1 r2 -- ) f> not ; ! : f>= ( -- f ) ( fs: r1 r2 -- ) f< not ; : FMAX ( fs: r1 r2 -- r3 ) --- 911,934 ---- external ! \ *N Comparison operators ! : F0= ( -- f ) ( fs: r -- ) ! ftstp FCOMP_EQUAL = ; ! : F0< ( -- f ) ( fs: r -- ) ! ftstp FCOMP_LESS = ; ! : f0> ( -- f ) ( fs: r -- ) ! ftstp 0= ; ! : f= ( -- f ) ( fs: r1 r2 -- ) ! fcomppx FCOMP_EQUAL = ; ! : F< ( -- f ) ( fs: r1 r2 -- ) ! fcomppx FCOMP_LESS = ; ! : f> ( -- f ) ( fs: r1 r2 -- ) ! fcomppx 0= ; ! ! : f<= ( -- f ) ( fs: r1 r2 -- ) ! f> not ; ! : f>= ( -- f ) ( fs: r1 r2 -- ) ! f< not ; : FMAX ( fs: r1 r2 -- r3 ) *************** *** 917,921 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! code F+ ( fs: r1 r2 -- r3 ) \ ? overflow errors ? fstack-check_2 --- 942,948 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *N Maths operators ! ! code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating fstack-check_2 *************** *** 941,945 **** float; ! code F/ ( fs: r1 r2 -- r3 ) \ ? error for ofl or /0 ? fstack-check_2 2>FPU --- 968,972 ---- float; ! code F/ ( fs: r1 r2 -- r3 ) \ ANSI Floating fstack-check_2 2>FPU *************** *** 1824,1828 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Output conversion. \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1851,1855 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *N Output conversion. \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 1831,1842 **** B/FLOAT 10 = [IF] 18 [ELSE] 16 [THEN] constant maxsig ! : PRECISION ( -- n ) sigdigits @ ; ! : SET-PRECISION ( n -- ) sigdigits ! ; ! : min-precision ( n -- ) ! precision max set-precision ; internal --- 1858,1875 ---- B/FLOAT 10 = [IF] 18 [ELSE] 16 [THEN] constant maxsig ! : PRECISION ( -- u ) \ ANSI Floating ext ! \ *G Return the number of significant digits currently used by (F.), (FE.), (FS.), F., ! \ ** FE., or FS. as u. sigdigits @ ; ! : SET-PRECISION ( u -- ) \ ANSI Floating ext ! \ *G Set the number of significant digits currently used by (F.), (FE.), (FS.), F., ! \ ** FE., or FS. to u. sigdigits ! ; ! : min-precision ( u -- ) \ W32F Floating extra ! \ *G Set the number of significant digits currently used by (F.), (FE.), (FS.), F., ! \ ** FE., or FS. to u if it is greater than the present setting. ! precision umax set-precision ; internal *************** *** 1855,1859 **** external ! : (F.) ( addr F: r -- ) \ convert fp # into a string { $buf -- } $buf off --- 1888,1900 ---- external ! \ *N Format FP number to a buffer ! ! \ *P The following words are for formatting floating point numbers as counted strings in ! \ ** the buffer whose address supplied so they can be used for purposes other than printing ! \ ** the numbers to the console. The string is not null terminated. ! ! : (F.) ( addr -- ) ( F: r -- ) \ W32F Floating extra ! \ *G Format the top number on the floating-point stack using fixed-point notation: ! \ *E [-] <digits>.<digits0> { $buf -- } $buf off |