Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Dirk B. <db...@us...> - 2006-02-04 10:40:46
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19124/src Modified Files: GENERIC.F Log Message: Changed DexH to create a glossary file (w32f-glossary.csv) in the doc folder. This file can be used to create a glossary file for win32forth as HTML. Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** GENERIC.F 27 Jan 2006 10:10:25 -0000 1.8 --- GENERIC.F 4 Feb 2006 10:40:35 -0000 1.9 *************** *** 155,159 **** then ;M ! :M Show: ( state -- ) \ use words like SW_SHOWNORMAL \ *G The ShowWindow function sets the specified window's show state. \n \ ** Possible values for state are: --- 155,159 ---- then ;M ! :M Show: ( state -- ) \ *G The ShowWindow function sets the specified window's show state. \n \ ** Possible values for state are: |
|
From: Dirk B. <db...@us...> - 2006-02-04 10:40:46
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19124/src/tools Modified Files: DexH-CreateDocs.f DexH-Glossary.f DexH.f W32fdexh.f Log Message: Changed DexH to create a glossary file (w32f-glossary.csv) in the doc folder. This file can be used to create a glossary file for win32forth as HTML. Index: DexH-Glossary.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-Glossary.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** DexH-Glossary.f 20 Dec 2005 18:00:49 -0000 1.1 --- DexH-Glossary.f 4 Feb 2006 10:40:36 -0000 1.2 *************** *** 1,9 **** ! \ Word2Table.f ! \ Written June 13th, 2003 by di...@sc... (dbu) ! \ last changed on June 15th, 2003 - 10:15 (dbu) ! \ last changed on June 29th, 2003 - 10:16 (dbu) ! ! create OutputFile ," w32f-Glossary.txt" \ **************************************************************************** --- 1,6 ---- ! \ DexH-Glossary.f ! \ Creating a glossary for Win32Forth. + create OutputFile$ ," doc\w32f-glossary.csv" \ **************************************************************************** *************** *** 37,44 **** [UNDEFINED] OutputFileHandle [if] ! 0 value OutputFileHandle \ hold's the handle of the output file [then] ! : output-close ( -- ) \ close output file OutputFileHandle ?dup if close-file drop --- 34,43 ---- [UNDEFINED] OutputFileHandle [if] ! 0 value OutputFileHandle ! \ *G The handle of the output file for the glossary. [then] ! : output-close ( -- ) ! \ *G Close the output file for the glossary. OutputFileHandle ?dup if close-file drop *************** *** 46,76 **** then ; ! : output-open ( -- falg ) \ open output-file ! output-close ! OutputFile count r/w open-file swap to OutputFileHandle ! dup INVALID_HANDLE_VALUE = ! if drop OutputFile count r/w create-file swap to OutputFileHandle ! else drop OutputFileHandle file-append then ; ! : output-string ( addr count -- ) \ write a string to the output-file ! OutputFileHandle write-file drop ! ; ! : output-char ( char -- ) \ write a char to the output-file ! here c! here 1 output-string ! ; ! : output-tab ( -- ) \ write TAB to the output-file ! 9 output-char ! ; ! : output-cr ( -- ) \ write CR to the output-file 13 output-char ! 10 output-char ! ; ! : output-header ( -- ) \ write the header line to the output-file s" Name" output-string output-tab s" Stack" output-string output-tab --- 45,91 ---- then ; ! : OutputFile ( -- addr len ) ! \ *G Get name of output file for the glossary (including path). ! OutputFile$ count Prepend<home>\ ; ! : output-open ( -- f ) ! \ *G Open the output file for the glossary. ! \ ** If the file already exist the append mode for the file is set. ! output-close ! OutputFile r/w open-file swap to OutputFileHandle 0= ! if OutputFileHandle file-append 0= ! else OutputFile r/w create-file swap to OutputFileHandle 0= then ; ! : output-delete ( -- ) ! OutputFile delete-file drop ; ! : (output-string) ( addr count -- ) ! \ *G Write a string to the output-file. ! OutputFileHandle write-file drop ; ! : output-char ( char -- ) ! \ *G Write a char to the output-file. ! here c! here 1 (output-string) ; ! : output-string ( addr count -- ) ! \ *G Write a string to the output-file. ! \ ** The string will be quoated with " . ! [char] " output-char ! (output-string) ! [char] " output-char ; ! ! : output-tab ( -- ) ! \ *G Write TAB to the output-file. ! \ 9 output-char ; ! [char] , output-char ; ! ! : output-cr ( -- ) ! \ *G Write CR to the output-file. 13 output-char ! 10 output-char ; ! : output-header ( -- ) ! \ *G Write the header line to the output-file. s" Name" output-string output-tab s" Stack" output-string output-tab *************** *** 78,84 **** s" Type" output-string output-tab s" Class" output-string output-tab ! s" File" output-string output-cr ! ; \ **************************************************************************** --- 93,105 ---- s" Type" output-string output-tab s" Class" output-string output-tab ! s" File" output-string output-cr ; + : output-new ( -- ) + \ *G Create a new empty glossary file. + output-delete + output-open if + output-header + output-close + then ; \ **************************************************************************** *************** *** 109,113 **** IsCloseingClass? if $class-name off ! then ; : print-line { addr count char fSaveName -- addr' count' } \ write line to output file; stop on char --- 130,135 ---- IsCloseingClass? if $class-name off ! then ! ; : print-line { addr count char fSaveName -- addr' count' } \ write line to output file; stop on char *************** *** 213,223 **** 2dup s" ;CLASS" is-definition-type if 10 set-definition-type false to InClass? exit then 2dup s" ;OBJECT" is-definition-type if 11 set-definition-type false to InClass? exit then ! ; ! \ 2drop ; : print-class-name ( -- ) InClass? IsClass? 0= and if $class-name count ! else s" " then output-string ; --- 235,244 ---- 2dup s" ;CLASS" is-definition-type if 10 set-definition-type false to InClass? exit then 2dup s" ;OBJECT" is-definition-type if 11 set-definition-type false to InClass? exit then ! 2drop ; : print-class-name ( -- ) InClass? IsClass? 0= and if $class-name count ! else s" " then output-string ; Index: DexH-CreateDocs.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-CreateDocs.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** DexH-CreateDocs.f 17 Jan 2006 17:52:00 -0000 1.9 --- DexH-CreateDocs.f 4 Feb 2006 10:40:36 -0000 1.10 *************** *** 10,16 **** \ ** the source files \ classes W32FClassDocs ! \ Windows, dialogs and controls s" src\generic.f" create-doc --- 10,20 ---- \ ** the source files + \ create a new gloassary file if needed + create-glossary-file? + if output-new then + \ classes W32FClassDocs ! \ \ Windows, dialogs and controls s" src\generic.f" create-doc *************** *** 22,34 **** -tr s" src\controls.f" create-doc +tr s" src\lib\excontrols.f" create-doc ! s" src\lib\MdiDialog.f" create-doc s" src\lib\AXControl.F" create-doc ! -tr s" src\lib\HTMLcontrol.F" create-doc +tr s" demos\HtmlControlDemo.f" create-doc -tr s" src\lib\Mdi.F" create-doc +tr s" demos\MdiExample.f" create-doc ! \ GDI class library s" src\gdi\gdiStruct.f" create-doc --- 26,38 ---- -tr s" src\controls.f" create-doc +tr s" src\lib\excontrols.f" create-doc ! \ s" src\lib\MdiDialog.f" create-doc s" src\lib\AXControl.F" create-doc ! \ -tr s" src\lib\HTMLcontrol.F" create-doc +tr s" demos\HtmlControlDemo.f" create-doc -tr s" src\lib\Mdi.F" create-doc +tr s" demos\MdiExample.f" create-doc ! \ \ GDI class library s" src\gdi\gdiStruct.f" create-doc *************** *** 42,57 **** s" src\gdi\gdiWindowDC.f" create-doc s" src\gdi\gdiMetafileDC.f" create-doc ! \ other classes s" src\lib\file.f" create-doc ! \ other documentation W32FDocs ! s" src\lib\AcceleratorTables.f" create-doc ; module cls create-docs --- 46,66 ---- s" src\gdi\gdiWindowDC.f" create-doc s" src\gdi\gdiMetafileDC.f" create-doc ! \ \ other classes s" src\lib\file.f" create-doc ! \ \ other documentation W32FDocs ! \ s" src\lib\AcceleratorTables.f" create-doc + s" src\FLOAT.F" create-doc ; module + \ also hidden + \ debug create-doc + cls create-docs + Index: W32fdexh.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/W32fdexh.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** W32fdexh.f 15 Jan 2006 09:25:50 -0000 1.3 --- W32fdexh.f 4 Feb 2006 10:40:36 -0000 1.4 *************** *** 3,6 **** --- 3,7 ---- needs tools/dexh + anew -w32fdexh.f internal *************** *** 76,80 **** : -tr ( -- ) ! \ *G Stop output of the HTML trailer OLDtrailer 0= if HTMLtrailer to OLDtrailer --- 77,81 ---- : -tr ( -- ) ! \ *G Stop output of the HTML trailer. OLDtrailer 0= if HTMLtrailer to OLDtrailer *************** *** 83,87 **** : +tr ( -- ) ! \ *G Restart output of the HTML trailer OLDtrailer ?DUP if to HTMLtrailer --- 84,88 ---- : +tr ( -- ) ! \ *G Restart output of the HTML trailer. OLDtrailer ?DUP if to HTMLtrailer *************** *** 94,98 **** Prepend<home>\ (dex) ; cr .( DexH -- Document Extractor loaded ) cr ! cr .( Usage:" dex <filename> ) --- 95,123 ---- Prepend<home>\ (dex) ; + internal + in-application + + FileOpenDialog DexFile "Dex Forth File" "Forth Files (*.f)|*.f|All Files (*.*)|*.*|" + + in-system + external + + : DEXF ( -- ) + ( *G Choose a file and convert it to HTML. Output filenames are included in the ) + ( ** source file. ) + conhndl start: DexFile count ?dup + if (dex) + else drop + then ; + + [defined] dexh [if] + ' DEXF is dexh \ link into w32f console menu + [then] + + module + cr .( DexH -- Document Extractor loaded ) cr ! cr .( Usage: " DEX <filename> " to convert the file <filenname> ) ! cr .( or " DEXF " to choose a file and convert it. ) ! Index: DexH.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** DexH.f 22 Jan 2006 10:44:16 -0000 1.3 --- DexH.f 4 Feb 2006 10:40:36 -0000 1.4 *************** *** 44,50 **** \ Set to true when a seperate glossary.txt should be created \ Still work in progress... (dbu) ! 0 constant create-glossary-file? ! ! external ( *P DexH is ANS Forth except for the need for BOUNDS, SCAN, SKIP and LCOUNT. ) --- 44,48 ---- \ Set to true when a seperate glossary.txt should be created \ Still work in progress... (dbu) ! 1 constant create-glossary-file? ( *P DexH is ANS Forth except for the need for BOUNDS, SCAN, SKIP and LCOUNT. ) *************** *** 73,76 **** --- 71,76 ---- : ,| ( <text> -- ) [CHAR] | WORD COUNT -TRAILING (,$) ; + external + CREATE DexHTMLheader ,| <?xml version="1.0"?> | *************** *** 104,107 **** --- 104,109 ---- DexHTMLtrailer value HTMLtrailer + internal + 0 VALUE outfile \ The current output file 0 VALUE infile *************** *** 282,286 **** : gl-open ( -- ) ! \ *G Open glossary File create-glossary-file? if output-open drop --- 284,288 ---- : gl-open ( -- ) ! \ *G Open glossary File. create-glossary-file? if output-open drop *************** *** 288,292 **** : gl-close ( -- ) ! \ *G Close glossary File create-glossary-file? if output-close --- 290,294 ---- : gl-close ( -- ) ! \ *G Close glossary File. create-glossary-file? if output-close *************** *** 294,298 **** : gl-ancor ( -- ) ! \ *G Write ancor number #gl-ancor s>d (D.) out ; --- 296,300 ---- : gl-ancor ( -- ) ! \ *G Write ancor number. #gl-ancor s>d (D.) out ; *************** *** 313,321 **** then ; - \ debug gl-entry - : gl-create-entry ( -- ) - \ cr ." gl-create-entry: " prevline LCOUNT type \ *G Create a glossary entry +n gl-ancor -n prevline LCOUNT outh -a --- 315,321 ---- then ; : gl-create-entry ( -- ) \ *G Create a glossary entry + \ cr ." gl-create-entry: " prevline LCOUNT type +n gl-ancor -n prevline LCOUNT outh -a *************** *** 370,373 **** --- 370,375 ---- ( *S Glossary ) + external + : (dex) ( addr len -- ) ( *G Convert a file or files to HTML. Output filenames are included in the ) *************** *** 398,411 **** BL PARSE (dex) ; - [defined] dexh [if] - ' DEX is dexh \ link into w32f console menu - [then] - : q ( <string> -- ) ( *G Test a single line of text, outputting to the screen. ) 1 TO testing -1 PARSE inbuf OVER ! inbuf CELL+ SWAP MOVE process-line ; ! \ *W <hr /><p>This file generated by <a href="dexh03.F">DexH</a></p> \ *Z module --- 400,414 ---- BL PARSE (dex) ; : q ( <string> -- ) ( *G Test a single line of text, outputting to the screen. ) 1 TO testing -1 PARSE inbuf OVER ! inbuf CELL+ SWAP MOVE process-line ; ! ! \ *W <hr /><p>This file generated by <a href="dexh.F">DexH</a></p> \ *Z module + + \ also hidden + \ debug gl-create-entry + \ dex c:\test.f |
|
From: Jos v.d.V. <jo...@us...> - 2006-02-03 22:55:03
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22415/doc Modified Files: FloadCmdLine.htm Log Message: Jos: The Dex file Index: FloadCmdLine.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/FloadCmdLine.htm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** FloadCmdLine.htm 3 Feb 2006 22:39:48 -0000 1.2 --- FloadCmdLine.htm 3 Feb 2006 22:54:55 -0000 1.3 *************** *** 23,27 **** <br />4.Use change to check it. <br />5.Be sure that Append file is active. ! <br />6.Compile FloadCmdLine.f with a <b>copy</b> of Win32Forth. <br />8.Replace the Win32Forth with Win32Forth from the \src directory. <br />9.Then start the explorer and click right on a *.f file. --- 23,28 ---- <br />4.Use change to check it. <br />5.Be sure that Append file is active. ! <br />6.Make a copy of Win32for.exe ! <br />7.Compile FloadCmdLine.f with the <b>copied</b> Win32for.exe <br />8.Replace the Win32Forth with Win32Forth from the \src directory. <br />9.Then start the explorer and click right on a *.f file. |
|
From: Jos v.d.V. <jo...@us...> - 2006-02-03 22:54:22
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22286/src Modified Files: floadcmdline.f Log Message: Jos: Changed a minor textbug Index: floadcmdline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/floadcmdline.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** floadcmdline.f 3 Feb 2006 22:39:04 -0000 1.2 --- floadcmdline.f 3 Feb 2006 22:54:14 -0000 1.3 *************** *** 16,20 **** \ ** \n4.Use change to check it. \ ** \n5.Be sure that Append file is active. ! \ ** \n6.Compile FloadCmdLine.f with a \bcopy\d of Win32Forth. \ ** \n8.Replace the Win32Forth with Win32Forth from the \src directory. \ ** \n9.Then start the explorer and click right on a *.f file. --- 16,21 ---- \ ** \n4.Use change to check it. \ ** \n5.Be sure that Append file is active. ! \ ** \n6.Make a copy of Win32for.exe ! \ ** \n7.Compile FloadCmdLine.f with the \bcopied\d Win32for.exe \ ** \n8.Replace the Win32Forth with Win32Forth from the \src directory. \ ** \n9.Then start the explorer and click right on a *.f file. |
|
From: Jos v.d.V. <jo...@us...> - 2006-02-03 22:39:56
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16028/doc Modified Files: FloadCmdLine.htm Log Message: Jos: Adapted doc Index: FloadCmdLine.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/FloadCmdLine.htm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FloadCmdLine.htm 3 Feb 2006 19:01:56 -0000 1.1 --- FloadCmdLine.htm 3 Feb 2006 22:39:48 -0000 1.2 *************** *** 23,29 **** <br />4.Use change to check it. <br />5.Be sure that Append file is active. ! <br />6.Compile FloadCmdLine.f with Win32Forth. ! <br />7.Save Win32Forth in a tempory directory and leave Win32Forth. ! <br />8.Replace the Win32Forth in your Win32Forth directory. <br />9.Then start the explorer and click right on a *.f file. <br />10.Choose Win32Forth. --- 23,28 ---- <br />4.Use change to check it. <br />5.Be sure that Append file is active. ! <br />6.Compile FloadCmdLine.f with a <b>copy</b> of Win32Forth. ! <br />8.Replace the Win32Forth with Win32Forth from the \src directory. <br />9.Then start the explorer and click right on a *.f file. <br />10.Choose Win32Forth. |
|
From: Jos v.d.V. <jo...@us...> - 2006-02-03 22:39:12
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15699/src Modified Files: floadcmdline.f Log Message: Jos: An update to save the icon Index: floadcmdline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/floadcmdline.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** floadcmdline.f 3 Feb 2006 19:00:39 -0000 1.1 --- floadcmdline.f 3 Feb 2006 22:39:04 -0000 1.2 *************** *** 16,22 **** \ ** \n4.Use change to check it. \ ** \n5.Be sure that Append file is active. ! \ ** \n6.Compile FloadCmdLine.f with Win32Forth. ! \ ** \n7.Save Win32Forth in a tempory directory and leave Win32Forth. ! \ ** \n8.Replace the Win32Forth in your Win32Forth directory. \ ** \n9.Then start the explorer and click right on a *.f file. \ ** \n10.Choose Win32Forth. --- 16,21 ---- \ ** \n4.Use change to check it. \ ** \n5.Be sure that Append file is active. ! \ ** \n6.Compile FloadCmdLine.f with a \bcopy\d of Win32Forth. ! \ ** \n8.Replace the Win32Forth with Win32Forth from the \src directory. \ ** \n9.Then start the explorer and click right on a *.f file. \ ** \n10.Choose Win32Forth. *************** *** 41,45 **** in-application ! also hidden save-forth 1 pause-seconds bye --- 40,47 ---- in-application ! fsave Win32for ! fload lib\Resources.f ! s" src\res\Win32For.ico" s" Win32for.exe" AddAppIcon ! 1 pause-seconds bye |
|
From: Jos v.d.V. <jo...@us...> - 2006-02-03 19:02:06
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19346/doc Added Files: FloadCmdLine.htm Log Message: Dexfile for FloadCmdLine.f --- NEW FILE: FloadCmdLine.htm --- <?xml version="1.0"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <meta http-equiv="Content-Type" content="text/xml; charset=iso-8859-1" /> <meta name="GENERATOR" content="DexH v03" /> <style type="text/css"> </style> <title> </title> </head> <body> <hr /><h1>Experimental shell integration for Win32Forth </h1><hr /><br />FloadCmdLine allows compiling from the context menu. <br />Use CMenuExtender v1.2.1.2 to create a new context entry. <br />The CMenuExtender can be downloaded from: <br />http://www.monctoncomputerservice.com/revenger_inc/download.html <p><b>How it works:</b> <br />1.Create a menu entry for Win32Forth using CMExtEd. <br />2.Name it Win32Forth. <br />3.Enter FloadCmdLine on the commandline in CMExtEd. <br />4.Use change to check it. <br />5.Be sure that Append file is active. <br />6.Compile FloadCmdLine.f with Win32Forth. <br />7.Save Win32Forth in a tempory directory and leave Win32Forth. <br />8.Replace the Win32Forth in your Win32Forth directory. <br />9.Then start the explorer and click right on a *.f file. <br />10.Choose Win32Forth. </p><p><b>Notes:</b> <br />1.Only testet under XP. <br />2.It is also possible to add WinEd to the context menu. Then leave the commandline in CMExtEd empty. </p><pre><b><a name="0">: FloadCmdLine ( - ) </a></b></pre><p> Compiles the file in the command line. </p> |
|
From: Jos v.d.V. <jo...@us...> - 2006-02-03 19:00:49
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18854/src Added Files: floadcmdline.f Log Message: Jos: Experimental shell integration for Win32Forth --- NEW FILE: floadcmdline.f --- Anew -FloadCmdLine \ *D doc\ \ *! FloadCmdLine \ *T Experimental shell integration for Win32Forth \ ** \nFloadCmdLine allows compiling from the context menu. \ ** \nUse CMenuExtender v1.2.1.2 to create a new context entry. \ ** \nThe CMenuExtender can be downloaded from: \ ** \nhttp://www.monctoncomputerservice.com/revenger_inc/download.html \ *P \bHow it works:\d \ ** \n1.Create a menu entry for Win32Forth using CMExtEd. \ ** \n2.Name it Win32Forth. \ ** \n3.Enter FloadCmdLine on the commandline in CMExtEd. \ ** \n4.Use change to check it. \ ** \n5.Be sure that Append file is active. \ ** \n6.Compile FloadCmdLine.f with Win32Forth. \ ** \n7.Save Win32Forth in a tempory directory and leave Win32Forth. \ ** \n8.Replace the Win32Forth in your Win32Forth directory. \ ** \n9.Then start the explorer and click right on a *.f file. \ ** \n10.Choose Win32Forth. \ *P \bNotes:\d \ ** \n1.Only testet under XP. \ ** \n2.It is also possible to add WinEd to the context menu. \ ** Then leave the commandline in CMExtEd empty. in-system : FloadCmdLine ( - ) \ *G Compiles the file in the command line. cmdline ascii " scan 1 - swap 1+ swap 2dup "path-only" temp$ place temp$ zcount temp$ count "chdir drop count type cr cmdline type cr 1 - "fload ok quit ; in-application also hidden save-forth 1 pause-seconds bye |
|
From: George H. <geo...@us...> - 2006-02-02 10:55:31
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14890/win32forth/src Modified Files: FLOAT.F Log Message: gah: More Dexing (still work in progress) optimizations and bug fixes Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 *** FLOAT.F 1 Feb 2006 12:42:14 -0000 1.30 --- FLOAT.F 2 Feb 2006 10:55:21 -0000 1.31 *************** *** 100,104 **** push ebx xor eax, eax ! fstsw ax mov ebx, eax next, --- 100,104 ---- push ebx xor eax, eax ! fnstsw ax mov ebx, eax next, *************** *** 184,188 **** L$1: fld FSIZE FSTACK_MEMORY fxam ! fstsw ax mov ebx, eax and ebx, # FPU_STATUS_CCF_MASK --- 184,188 ---- L$1: fld FSIZE FSTACK_MEMORY fxam ! fnstsw ax mov ebx, eax and ebx, # FPU_STATUS_CCF_MASK *************** *** 199,213 **** 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 ! [ELSE] and eax, # 0x0eff \ 8 byte mode ! or eax, # 0x0200 ! [THEN] ! mov 0 [esp], eax ! fldcw word 0 [esp] ! lea esp, 4 [esp] next, end-code --- 199,206 ---- fninit mov FSP_MEMORY , edi ! B/FLOAT 10 = 0= [IF] ! fnstcw word -4 [ebp] ! and word -4 [ebp], # 0x0eff \ 8 byte mode ! fldcw word -4 [ebp] [THEN] next, end-code *************** *** 781,785 **** code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Set rounding mode to round to -infinity. push ebx mov bx, # 0x00400 --- 774,779 ---- code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Round r1 to an integral value using the round toward negative infinity rule, ! \ ** giving r2. push ebx mov bx, # 0x00400 *************** *** 789,793 **** code FCEIL ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Set rounding mode to round to +infinity. push ebx mov bx, # 0x00800 --- 783,788 ---- code FCEIL ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Round r1 to an integral value using the round toward positive infinity rule, ! \ ** giving r2. push ebx mov bx, # 0x00800 *************** *** 797,801 **** code FTRUNC ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Set rounding mode to truncate. push ebx mov bx, # 0x00c00 --- 792,796 ---- code FTRUNC ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! \ *G Round r1 to an integral value using the round toward zero rule, giving r2. push ebx mov bx, # 0x00c00 *************** *** 806,810 **** code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Set rounding mode to round to nearest. push ebx mov bx, # 0x00000 --- 801,805 ---- code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating ! \ *G Round r1 to an integral value using the round to nearest rule, giving r2. push ebx mov bx, # 0x00000 *************** *** 908,912 **** macro: (fcomp) ! fstsw ax push ebx mov ebx, eax --- 903,907 ---- macro: (fcomp) ! fnstsw ax push ebx mov ebx, eax *************** *** 1117,1121 **** >FPU L$1: fprem1 ! fstsw ax sahf jp short L$1 --- 1112,1116 ---- >FPU L$1: fprem1 ! fnstsw ax sahf jp short L$1 *************** *** 1132,1136 **** : 1/f ( fs: r1 -- r2 ) \ W32F Floating extra \ *G r2 is the reciprocal of r1. ! -1 f**n ; \ *N Trigonometric functions --- 1127,1131 ---- : 1/f ( fs: r1 -- r2 ) \ W32F Floating extra \ *G r2 is the reciprocal of r1. ! f1.0 fswap f/ ; \ *N Trigonometric functions *************** *** 1230,1234 **** fld FSIZE sq2m1 fcomp st(1) ! fstsw ax sahf jp short L$3 --- 1225,1229 ---- fld FSIZE sq2m1 fcomp st(1) ! fnstsw ax sahf jp short L$3 *************** *** 1236,1240 **** fld FSIZE sq2/2m1 fcomp st(1) ! fstsw ax sahf jb short L$4 --- 1231,1235 ---- fld FSIZE sq2/2m1 fcomp st(1) ! fnstsw ax sahf jb short L$4 *************** *** 1263,1268 **** code FEXP ( fs: r1 -- r2 ) \ ANSI Floating ext fstack-check_1 ! fldl2e \ log base 2 of e \ 1 ! >FPU \ 2 fmulp st(1), st \ modified exponent \ 1 fld st(0) \ duplicate exponent \ 2 --- 1258,1273 ---- code FEXP ( fs: r1 -- r2 ) \ ANSI Floating ext fstack-check_1 ! >FPU \ 1 ! fxam ! fnstsw ax ! and ax, # FPU_STATUS_CCF_MASK ! cmp ax, # FPU_STATUS_CCF_INFINITY ! je short L$2 ! cmp ax, # 0x700 \ FPU_STATUS_CCF_INFINITY FPU_STATUS_CCF_MASK_1 or ! jne short L$1 ! fstp st(0) ! fldz ! jmp short L$2 ! L$1: fldl2e \ log base 2 of e \ 2 fmulp st(1), st \ modified exponent \ 1 fld st(0) \ duplicate exponent \ 2 *************** *** 1277,1281 **** faddp st(1), st \ 2**frac \ 2 fmulp st(1), st \ 2**(int + frac) \ 1 ! FPU> \ 0 float; --- 1282,1286 ---- faddp st(1), st \ 2**frac \ 2 fmulp st(1), st \ 2**(int + frac) \ 1 ! L$2: FPU> \ 0 float; *************** *** 1283,1296 **** fstack-check_1 - fldl2e >fpu fld1 fcom st(1) ! fstsw ax sahf jbe short L$4 fchs fcomp st(1) ! fstsw ax sahf jnc short L$5 --- 1288,1313 ---- fstack-check_1 >fpu + fxam + fnstsw ax + and ax, # FPU_STATUS_CCF_MASK + cmp ax, # FPU_STATUS_CCF_INFINITY + je short L$6 + cmp ax, # 0x700 \ FPU_STATUS_CCF_INFINITY FPU_STATUS_CCF_MASK_1 or + jne short L$1 + fstp st(0) + fld1 + fchs + jmp short L$6 + L$1: fldl2e + fxch fld1 fcom st(1) ! fnstsw ax sahf jbe short L$4 fchs fcomp st(1) ! fnstsw ax sahf jnc short L$5 *************** *** 1298,1303 **** fmulp st(1), st(0) f2xm1 ! (fpu>) ! jmp short L$2 L$4: fstp st(0) \ 2 L$5: fmulp st(1), st(0) \ 1 --- 1315,1319 ---- fmulp st(1), st(0) f2xm1 ! jmp short L$6 L$4: fstp st(0) \ 2 L$5: fmulp st(1), st(0) \ 1 *************** *** 1316,1320 **** fld1 fsubp st(1), st \ Should be fsubrp ??????? ! fpu> jmp short L$2 L$3: fstp st(1) --- 1332,1336 ---- fld1 fsubp st(1), st \ Should be fsubrp ??????? ! L$6: fpu> jmp short L$2 L$3: fstp st(1) *************** *** 1322,1326 **** : f** ( F: r1 r2 -- r3 ) ! fswap fln f* fexp ; synonym f^x f** DEPRECATED --- 1338,1346 ---- : f** ( F: r1 r2 -- r3 ) ! \ fswap fln f* fexp ; ! FDUP FROUND FDUP F>S F- FDUP F0= ! if FDROP F**N ! else FOVER FLN F* FEXP FSWAP F**N F* ! THEN ; synonym f^x f** DEPRECATED *************** *** 1359,1363 **** \ *N Inverse hyperbolic functions ! code FASINH ( fs: r1 -- r2 ) \ Note: well defined for r1 < 0 fstack-check_1 fldln2 --- 1379,1384 ---- \ *N Inverse hyperbolic functions ! code FASINH ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the number whose hyperbolic sine is r1. fstack-check_1 fldln2 *************** *** 1373,1377 **** float; ! code FACOSH ( fs: r1 -- r2 ) \ ANSI Floating ext fstack-check_1 fldln2 --- 1394,1399 ---- float; ! code FACOSH ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the number whose hyperbolic cosine is r1. If r1 < 1.0 then r2 is a NAN. fstack-check_1 fldln2 *************** *** 1387,1391 **** float; ! : FATANH ( f: r1 -- r2 ) \ OK for valid args fdup f1.0 f+ fswap f1.0 fswap f- --- 1409,1414 ---- float; ! : FATANH ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the number whose hyperbolic tangent is r1. IF |r1| > 1.0 then r2 is a NAN. fdup f1.0 f+ fswap f1.0 fswap f- |
|
From: George H. <geo...@us...> - 2006-02-02 10:55:31
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14890/win32forth/doc Modified Files: p-float.htm Log Message: gah: More Dexing (still work in progress) optimizations and bug fixes Index: p-float.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-float.htm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** p-float.htm 1 Feb 2006 12:42:13 -0000 1.6 --- p-float.htm 2 Feb 2006 10:55:20 -0000 1.7 *************** *** 138,148 **** </p><h3>Rounding Modes </h3><pre><b><a name="0">code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating ! </a></b></pre><p>Set rounding mode to round to -infinity. </p><pre><b><a name="0">code FCEIL ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! </a></b></pre><p>Set rounding mode to round to +infinity. </p><pre><b><a name="0">code FTRUNC ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! </a></b></pre><p>Set rounding mode to truncate. </p><pre><b><a name="0">code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating ! </a></b></pre><p>Set rounding mode to round to nearest. </p><h3>Integer to float conversion </h3><pre><b><a name="0">code D>F ( d -- ) ( F: -- r ) \ ANSI Floating --- 138,150 ---- </p><h3>Rounding Modes </h3><pre><b><a name="0">code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating ! </a></b></pre><p>Round r1 to an integral value using the round toward negative infinity rule, ! giving r2. </p><pre><b><a name="0">code FCEIL ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! </a></b></pre><p>Round r1 to an integral value using the round toward positive infinity rule, ! giving r2. </p><pre><b><a name="0">code FTRUNC ( fs: f1 -- fs: f2 ) \ W32F Floating extra ! </a></b></pre><p>Round r1 to an integral value using the round toward zero rule, giving r2. </p><pre><b><a name="0">code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating ! </a></b></pre><p>Round r1 to an integral value using the round to nearest rule, giving r2. </p><h3>Integer to float conversion </h3><pre><b><a name="0">code D>F ( d -- ) ( F: -- r ) \ ANSI Floating *************** *** 244,248 **** </a></b></pre><p>r2 is the hyperbolic tangent of r1, |r2| <= 1. </p><h3>Inverse hyperbolic functions ! </h3><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext </a></b></pre><p>Return the number of significant digits currently used by (F.), (FE.), (FS.), F., --- 246,256 ---- </a></b></pre><p>r2 is the hyperbolic tangent of r1, |r2| <= 1. </p><h3>Inverse hyperbolic functions ! </h3><pre><b><a name="0">code FASINH ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the number whose hyperbolic sine is r1. ! </p><pre><b><a name="0">code FACOSH ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the number whose hyperbolic cosine is r1. If r1 < 1.0 then r2 is a NAN. ! </p><pre><b><a name="0">: FATANH ( f: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the number whose hyperbolic tangent is r1. IF |r1| > 1.0 then r2 is a NAN. ! </p><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext </a></b></pre><p>Return the number of significant digits currently used by (F.), (FE.), (FS.), F., |
|
From: Dirk B. <db...@us...> - 2006-02-01 17:08:44
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17632/src Modified Files: CONTROLS.F Log Message: - New GroupRadioButton class added; and changed ForthForm to use this class. - Some more dexing Index: CONTROLS.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROLS.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** CONTROLS.F 22 Jan 2006 10:44:16 -0000 1.7 --- CONTROLS.F 1 Feb 2006 17:08:25 -0000 1.8 *************** *** 23,27 **** \ *S EditControl class :Class EditControl <Super CONTROL ! \ *G Class for text edit controls. \ pointers to filter function to allow key capturing. --- 23,29 ---- \ *S EditControl class :Class EditControl <Super CONTROL ! \ *G Class for Edit controls. ! \ ** An edit control is a rectangular control window typically used in a dialog ! \ ** box to permit the user to enter and edit text by typing on the keyboard. \ pointers to filter function to allow key capturing. *************** *** 40,43 **** --- 42,46 ---- :M ClassInit: ( -- ) + \ *G Initialise the class. ClassInit: Super 0 to pWmChar *************** *** 47,55 **** :M StartSize: ( -- width height ) ! \ *G Get the start size of the control 100 25 ;M :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control WindowStyle: SUPER [ WS_BORDER WS_TABSTOP OR ES_AUTOHSCROLL OR ] literal OR \ allow horizontal scrolling --- 50,59 ---- :M StartSize: ( -- width height ) ! \ *G Get the start size of the control. Default size is 100 x 25. 100 25 ;M :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control. Default style is: ! \ ** WS_BORDER, WS_TABSTOP and ES_AUTOHSCROLL. WindowStyle: SUPER [ WS_BORDER WS_TABSTOP OR ES_AUTOHSCROLL OR ] literal OR \ allow horizontal scrolling *************** *** 62,82 **** ;M - \ Install these filter functions if you want to capture certain keys, like - \ Return or F3, or whatever. - :M SetWmChar: ( pWmChar -- ) ! \ *G install the WM_CHAR filter function to pWmChar ;M :M SetWmKeyDown: ( pWmKeyDown -- ) ! \ *G install the WM_KEYDOWN filter function to pWmKeyDown ;M :M SetWmKillFocus: ( pWmKillFocus -- ) ! \ *G install the WM_KILLFOCUS filter function to pWmKillFocus ;M :M SubClass: ( hWnd Parent -- ) ! \ *G Subclass this control to parent to hWnd --- 66,86 ---- ;M :M SetWmChar: ( pWmChar -- ) ! \ *G Install the WM_CHAR filter function. to pWmChar ;M :M SetWmKeyDown: ( pWmKeyDown -- ) ! \ *G Install the WM_KEYDOWN filter function. to pWmKeyDown ;M + \ *P Install these filter functions if you want to capture certain keys, like + \ ** Return or F3, or whatever. + :M SetWmKillFocus: ( pWmKillFocus -- ) ! \ *G Install the WM_KILLFOCUS filter function. to pWmKillFocus ;M :M SubClass: ( hWnd Parent -- ) ! \ *G Subclass this control. to parent to hWnd *************** *** 139,143 **** :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control WindowStyle: SUPER [ CBS_DROPDOWN WS_VSCROLL OR WS_TABSTOP OR WS_VISIBLE OR ES_AUTOHSCROLL OR ] literal OR --- 143,148 ---- :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control. The default style is: ! \ ** CBS_DROPDOWN, WS_VSCROLL, WS_TABSTOP, WS_VISIBLE and ES_AUTOHSCROLL. WindowStyle: SUPER [ CBS_DROPDOWN WS_VSCROLL OR WS_TABSTOP OR WS_VISIBLE OR ES_AUTOHSCROLL OR ] literal OR *************** *** 194,198 **** :M Start: ( Parent -- ) ! \ *G Create the control TO Parent z" COMBOBOX" Create-Control --- 199,203 ---- :M Start: ( Parent -- ) ! \ *G Create the control. TO Parent z" COMBOBOX" Create-Control *************** *** 215,219 **** :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control WindowStyle: SUPER CBS_DROPDOWNLIST OR ;M --- 220,224 ---- :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control. The default style is: CBS_DROPDOWNLIST. WindowStyle: SUPER CBS_DROPDOWNLIST OR ;M *************** *** 227,231 **** :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control WindowStyle: SUPER [ WS_VSCROLL LBS_NOTIFY OR LBS_NOINTEGRALHEIGHT OR WS_TABSTOP OR ] literal OR --- 232,237 ---- :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control. The default style is: WS_VSCROLL, ! \ ** LBS_NOTIFY, LBS_NOINTEGRALHEIGHT and WS_TABSTOP. WindowStyle: SUPER [ WS_VSCROLL LBS_NOTIFY OR LBS_NOINTEGRALHEIGHT OR WS_TABSTOP OR ] literal OR *************** *** 233,237 **** :M Start: ( Parent -- ) ! \ *G Create the control TO Parent z" LISTBOX" Create-Control --- 239,243 ---- :M Start: ( Parent -- ) ! \ *G Create the control. TO Parent z" LISTBOX" Create-Control *************** *** 246,257 **** :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control WindowStyle: SUPER BS_GROUPBOX OR ;M :M Start: ( Parent -- ) ! \ *G Create the control ! TO Parent ! z" BUTTON" Create-Control ! ;M ;Class \ *G End of GroupControl class --- 252,261 ---- :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control. The default style is: BS_GROUPBOX. WindowStyle: SUPER BS_GROUPBOX OR ;M :M Start: ( Parent -- ) ! \ *G Create the control. ! TO Parent z" BUTTON" Create-Control ;M ;Class \ *G End of GroupControl class *************** *** 263,267 **** :M Start: ( Parent -- ) ! \ *G Create the control TO Parent z" STATIC" Create-Control --- 267,271 ---- :M Start: ( Parent -- ) ! \ *G Create the control. TO Parent z" STATIC" Create-Control *************** *** 276,280 **** :M WindowStyle: ( -- style ) ! \ *G Get the window style of the control WindowStyle: SUPER [ BS_AUTOCHECKBOX WS_TABSTOP OR ] literal OR --- 280,285 ---- :M WindowStyle: ( -- style ) ! \ *G Get the window style of the control. The default style is: BS_AUTOCHECKBOX, ! \ ** and WS_TABSTOP. WindowStyle: SUPER [ BS_AUTOCHECKBOX WS_TABSTOP OR ] literal OR *************** *** 282,289 **** :M Start: ( Parent -- ) ! \ *G Create the control ! TO Parent ! z" BUTTON" Create-Control ! ;M ;Class --- 287,292 ---- :M Start: ( Parent -- ) ! \ *G Create the control. ! TO Parent z" BUTTON" Create-Control ;M ;Class *************** *** 296,300 **** :M WindowStyle: ( -- style ) ! \ *G Get the window style of the control WindowStyle: SUPER [ BS_AUTORADIOBUTTON WS_TABSTOP OR ] literal OR --- 299,304 ---- :M WindowStyle: ( -- style ) ! \ *G Get the window style of the control. The default style is: BS_AUTORADIOBUTTON, ! \ ** and WS_TABSTOP. WindowStyle: SUPER [ BS_AUTORADIOBUTTON WS_TABSTOP OR ] literal OR *************** *** 302,309 **** :M Start: ( Parent -- ) ! \ *G Create the control ! TO Parent ! z" BUTTON" Create-Control ! ;M ;Class --- 306,311 ---- :M Start: ( Parent -- ) ! \ *G Create the control. ! TO Parent z" BUTTON" Create-Control ;M ;Class *************** *** 318,321 **** --- 320,324 ---- :M ClassInit: ( -- ) + \ *G Initialise the class. ClassInit: super ['] noop to buttonfunc *************** *** 328,332 **** :M WindowStyle: ( -- style ) ! \ *G Get the window style of the control WindowStyle: SUPER [ BS_PUSHBUTTON WS_TABSTOP OR ] literal OR --- 331,336 ---- :M WindowStyle: ( -- style ) ! \ *G Get the window style of the control. The default style is: BS_PUSHBUTTON, ! \ ** and WS_TABSTOP. WindowStyle: SUPER [ BS_PUSHBUTTON WS_TABSTOP OR ] literal OR *************** *** 334,341 **** :M Start: ( Parent -- ) ! \ *G Create the control ! to Parent ! z" BUTTON" Create-Control ! ;M :M WM_LBUTTONUP ( h m w l -- res ) --- 338,343 ---- :M Start: ( Parent -- ) ! \ *G Create the control. ! to Parent z" BUTTON" Create-Control ;M :M WM_LBUTTONUP ( h m w l -- res ) *************** *** 358,362 **** \ *G Base class for windows that contain controls. ! :M ClassInit: ( -- ) ClassInit: super +dialoglist --- 360,365 ---- \ *G Base class for windows that contain controls. ! :M ClassInit: ( -- ) ! \ *G Initialise the class. ClassInit: super +dialoglist |
|
From: Dirk B. <db...@us...> - 2006-02-01 17:08:40
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17632/apps/ForthForm Modified Files: FORMOBJECT.F FORTHFORM.F Log Message: - New GroupRadioButton class added; and changed ForthForm to use this class. - Some more dexing Index: FORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORTHFORM.F,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** FORTHFORM.F 11 Jan 2006 17:45:19 -0000 1.12 --- FORTHFORM.F 1 Feb 2006 17:08:24 -0000 1.13 *************** *** 96,103 **** \+ withbgnd FreeImageWindow BkGndImageWindow \ create instance File MergeFile ! File TheFile \ adapted from WinEd ! 20205 constant fform_version# \ 2.02.05 \ Version numbers: v.ww.rr --- 96,103 ---- \+ withbgnd FreeImageWindow BkGndImageWindow \ create instance File MergeFile ! File TheFile \ adapted from WinEd ! 20206 constant fform_version# \ 2.02.06 \ Version numbers: v.ww.rr *************** *** 116,120 **** : ExitOnError ( f -- ) S" A serious error has occurred in ForthForm!" ?TerminateBox ; ! macro ?abort " if abort then" --- 116,120 ---- : ExitOnError ( f -- ) S" A serious error has occurred in ForthForm!" ?TerminateBox ; ! macro ?abort " if abort then" *************** *** 253,257 **** ActiveControl: Activeform 0= ?exit ChangeControl: ActiveForm ; ! : ChangeControlFont ( -- ) ActiveForm 0= ?exit --- 253,257 ---- ActiveControl: Activeform 0= ?exit ChangeControl: ActiveForm ; ! : ChangeControlFont ( -- ) ActiveForm 0= ?exit *************** *** 260,264 **** IsModified: ActiveForm then ; ! : ResetControlFont ( -- ) ActiveForm 0= ?exit --- 260,264 ---- IsModified: ActiveForm then ; ! : ResetControlFont ( -- ) ActiveForm 0= ?exit *************** *** 267,271 **** IsModified: ActiveForm then ; ! : #Forms ( -- n ) \ return number of open forms FormList --- 267,271 ---- IsModified: ActiveForm then ; ! : #Forms ( -- n ) \ return number of open forms FormList *************** *** 468,472 **** loop ActiveForm ?dup if ?FormNumber 1- 0max SetSelection: FormPicker ! then then ; --- 468,472 ---- loop ActiveForm ?dup if ?FormNumber 1- 0max SetSelection: FormPicker ! then then ; *************** *** 549,555 **** Close: TheFile fsize frmdata-size < ?dup ?exit \ must have at least a form header ! fsize frmdata-size - ctrldata-size mod 0<> \ must be evenly divisible ; ! :NoName ( -- ) \ _NewForm AddNewForm --- 549,555 ---- Close: TheFile fsize frmdata-size < ?dup ?exit \ must have at least a form header ! fsize frmdata-size - ctrldata-size mod 0<> \ must be evenly divisible ; ! :NoName ( -- ) \ _NewForm AddNewForm *************** *** 574,578 **** Start: ThisForm fname fcnt SetFileName: ThisForm ! Load: ThisForm Display: ThisForm doupdate ; is (OpenForm) --- 574,578 ---- Start: ThisForm fname fcnt SetFileName: ThisForm ! Load: ThisForm Display: ThisForm doupdate ; is (OpenForm) *************** *** 618,622 **** ActiveForm 0= ?exit s" anew _frm" evaluate ! ChildState: ActiveForm >r \ we want to see the form if it is a child, so we false IsChildState: Activeform \ save the state and change in case it is hidden GetBuffer: ActiveForm 2drop --- 618,622 ---- ActiveForm 0= ?exit s" anew _frm" evaluate ! ChildState: ActiveForm >r \ we want to see the form if it is a child, so we false IsChildState: Activeform \ save the state and change in case it is hidden GetBuffer: ActiveForm 2drop *************** *** 760,764 **** InitScintillaControl \ for the editor ;M ! :M Canvas: ( -- x y w h ) 0 Height: TheRebar dup>r ( -- x y ) --- 760,764 ---- InitScintillaControl \ for the editor ;M ! :M Canvas: ( -- x y w h ) 0 Height: TheRebar dup>r ( -- x y ) *************** *** 993,997 **** ActiveControl: Activeform if UpdatePropertyWindow ! then then UpdateFormPicker #Forms 2 < --- 993,997 ---- ActiveControl: Activeform if UpdatePropertyWindow ! then then UpdateFormPicker #Forms 2 < *************** *** 1048,1052 **** then then ; ! : FForm ( -- ) init-msg-buffer --- 1048,1052 ---- then then ; ! : FForm ( -- ) init-msg-buffer Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** FORMOBJECT.F 4 Nov 2005 06:40:15 -0000 1.9 --- FORMOBJECT.F 1 Feb 2006 17:08:24 -0000 1.10 *************** *** 170,174 **** <object> 0= ControlList 0= or if false exit ! then >FirstLink: ControlList #controls 1+ 1 ?do Data@: ControlList <object> = --- 170,174 ---- <object> 0= ControlList 0= or if false exit ! then >FirstLink: ControlList #controls 1+ 1 ?do Data@: ControlList <object> = *************** *** 198,202 **** else false then ; ! : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup --- 198,202 ---- else false then ; ! : ?mnu_font ( -- ) \ according to type of control allow changing font ActiveControl dup *************** *** 456,460 **** UpdateStatus: self UpdatePropertyWindow Paint: self ;M ! create spad 100 allot \ temporary sort pad, 24 controls maximum at a time --- 456,460 ---- UpdateStatus: self UpdatePropertyWindow Paint: self ;M ! create spad 100 allot \ temporary sort pad, 24 controls maximum at a time *************** *** 735,742 **** else DrawNormal: FormBox then release-dc ; ! : drawbox ( -- ) 0 (drawbox) ; ! : drawdottedbox ( -- ) 1 (drawbox) ; --- 735,742 ---- else DrawNormal: FormBox then release-dc ; ! : drawbox ( -- ) 0 (drawbox) ; ! : drawdottedbox ( -- ) 1 (drawbox) ; *************** *** 875,885 **** b t - to h \ height w 0< ! if w +to l then h 0< ! if h +to t then l w abs + to r t h abs + to b l t r b SetRect: FormBox ; ! : unclicked ( -- ) hwnd Call ReleaseCapture drop --- 875,885 ---- b t - to h \ height w 0< ! if w +to l then h 0< ! if h +to t then l w abs + to r t h abs + to b l t r b SetRect: FormBox ; ! : unclicked ( -- ) hwnd Call ReleaseCapture drop *************** *** 1147,1151 **** ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >LastLink: ControlList Link#: ControlList over = if drop exitm then \ already in front --- 1147,1151 ---- ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >LastLink: ControlList Link#: ControlList over = if drop exitm then \ already in front *************** *** 1161,1165 **** ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >FirstLink: ControlList Link#: ControlList over = if drop exitm then \ already at back --- 1161,1165 ---- ActiveControl 0= ?exitm #controls 2 < ?exitm ! ActiveControl ?controlnumber >FirstLink: ControlList Link#: ControlList over = if drop exitm then \ already at back *************** *** 1399,1402 **** --- 1399,1409 ---- \ ****************** Definitions to write form information ******************** + : writeGroupStyle ( -- ) \ write WS_GROUP style if needed + Group?: ThisControl + GetType: ThisControl TypeRadioButton <> and + if +crlf 2tabs s" WS_GROUP +Style: " append + GetName: ThisControl append + then ; + : writecommoncode ( -- ) \ startup code common to all controls +crlf *************** *** 1405,1412 **** Dimensions: ThisControl swap #append #append s" Move: " append GetName: ThisControl append ! Group?: ThisControl ! if +crlf 2tabs s" WS_GROUP +Style: " append ! GetName: ThisControl append ! then ; : writetext ( -- ) \ code to set the text of control --- 1412,1417 ---- Dimensions: ThisControl swap #append #append s" Move: " append GetName: ThisControl append ! ! writeGroupStyle ; : writetext ( -- ) \ code to set the text of control *************** *** 1418,1425 **** +crlf 2tabs append s" +Style: " append GetName: ThisControl append ; ! : fontname ( -- name cnt ) GetName: ThisControl pad place s" -font" pad +place pad count ; ! : writefont ( -- ) +crlf 2tabs --- 1423,1430 ---- +crlf 2tabs append s" +Style: " append GetName: ThisControl append ; ! : fontname ( -- name cnt ) GetName: ThisControl pad place s" -font" pad +place pad count ; ! : writefont ( -- ) +crlf 2tabs *************** *** 1430,1434 **** else s" Handle: Winfont SetFont: " append GetName: ThisControl append then ; ! : write-fontfuncs ( -- ) \ create a definition for each font to be changed #controls 0= ?exit --- 1435,1439 ---- else s" Handle: Winfont SetFont: " append GetName: ThisControl append then ; ! : write-fontfuncs ( -- ) \ create a definition for each font to be changed #controls 0= ?exit *************** *** 1459,1463 **** then loop ; ! : write-delete-fonts ( -- ) #controls 0= ?exit --- 1464,1468 ---- then loop ; ! : write-delete-fonts ( -- ) #controls 0= ?exit *************** *** 1570,1574 **** TypePushButton of s" PushButton " endof TypeCheckBox of s" CheckBox " endof ! TypeRadioButton of s" RadioButton " endof TypeBitmapButton of s" BitmapButton " endof TypeListBox of s" ListBox " endof --- 1575,1579 ---- TypePushButton of s" PushButton " endof TypeCheckBox of s" CheckBox " endof ! TypeRadioButton of Group?: ThisControl if s" GroupRadioButton " else s" RadioButton " then endof TypeBitmapButton of s" BitmapButton " endof TypeListBox of s" ListBox " endof *************** *** 1952,1956 **** TheBuffer ;M ! :M UninitedBuffer: ( -- addr len ) WriteToBuffer TheBuffer ;M --- 1957,1961 ---- TheBuffer ;M ! :M UninitedBuffer: ( -- addr len ) WriteToBuffer TheBuffer ;M |
|
From: Dirk B. <db...@us...> - 2006-02-01 17:08:36
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17632/src/lib Modified Files: excontrols.f Log Message: - New GroupRadioButton class added; and changed ForthForm to use this class. - Some more dexing Index: excontrols.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/excontrols.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** excontrols.f 22 Jan 2006 10:51:15 -0000 1.9 --- excontrols.f 1 Feb 2006 17:08:25 -0000 1.10 *************** *** 26,31 **** \ ------------------------------------------------------------------------ :Class TextBox <Super EditControl ! \ *G Class for text edit controls ! \ ** (enhanced Version of the EditControl class) int style --- 26,33 ---- \ ------------------------------------------------------------------------ :Class TextBox <Super EditControl ! \ *G Class for Edit controls. [...1951 lines suppressed...] + GetPrev: hb1 to hb1 + repeat ;M + + :M Enable: { flag \ hb1 -- } + \ *G Enable the control. + hbb to hb1 + begin hb1 + while flag GetID: hb1 EnableDlgitem: self + GetPrev: hb1 to hb1 + repeat ;M + + :M Disable: ( -- ) + \ *G Disable the control. + false Enable: self ;M + + ;Class + \ *G End of HorizButtonBar class + MODULE |
|
From: Dirk B. <db...@us...> - 2006-02-01 17:08:33
|
Update of /cvsroot/win32forth/win32forth/doc/classes In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17632/doc/classes Modified Files: Controls.htm Log Message: - New GroupRadioButton class added; and changed ForthForm to use this class. - Some more dexing Index: Controls.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/classes/Controls.htm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Controls.htm 22 Jan 2006 10:44:14 -0000 1.5 --- Controls.htm 1 Feb 2006 17:08:25 -0000 1.6 *************** *** 1,135 **** ! <?xml version="1.0"?> ! <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" ! "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> ! <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> ! <meta http-equiv="Content-Type" content="text/xml; charset=iso-8859-1" /> ! <meta name="GENERATOR" content="DexH v03" /> ! <style type="text/css"> ! </style> <title> [...2018 lines suppressed...] ! </p><pre><b><a name="344">:M Disable: ( -- ) ! </a></b></pre><p>Disable the control. ! </p><pre><b><a name="345">;Class ! </a></b></pre><p>End of VertButtonBar class ! </p><a name="HorizButtonBar"></a> ! <h2>HorizButtonBar class ! </h2><pre><b><a name="346">:Class HorizButtonBar <super HButtonBar ! </a></b></pre><p>HorizButtonBar control ! </p><p>This is an enhanced Version of the HButtonBar class. ! </p><p>Note: this control isn't one of the standard control of MS windows. ! </p><pre><b><a name="347">:M SetFont: { fonthndl \ hb1 -- } ! </a></b></pre><p>Set the font in the control. ! </p><pre><b><a name="348">:M Enable: { flag \ hb1 -- } ! </a></b></pre><p>Enable the control. ! </p><pre><b><a name="349">:M Disable: ( -- ) ! </a></b></pre><p>Disable the control. ! </p><pre><b><a name="350">;Class ! </a></b></pre><p>End of HorizButtonBar class ! </p><hr><p>Document $Id$</p> </body></html> |
|
From: George H. <geo...@us...> - 2006-02-01 12:42:26
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26990/win32forth/src Modified Files: FLOAT.F Log Message: gah: More Dexing (still work in progress) Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** FLOAT.F 1 Feb 2006 11:44:48 -0000 1.29 --- FLOAT.F 1 Feb 2006 12:42:14 -0000 1.30 *************** *** 1212,1215 **** --- 1212,1217 ---- code FLN ( fs: r1 -- r2 ) \ ANSI Floating ext + \ *G r2 is the natural logarithm of r1. If r1 is ±0 then r2 is -infinity. If r1 + \ ** is infinity then r2 is infinity. If r1 is less than zero then r2 is a NAN. fstack-check_1 fldln2 *************** *** 1220,1224 **** code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G ? error for x <= -1 fstack-check_1 fldln2 --- 1222,1228 ---- code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the natural logarithm of the quantity r1 plus one. If r1 is -1.0 then ! \ ** r2 is -infinity. If r1 is infinity then r2 is infinity. If r1 is less than ! \ ** -1.0 then r2 is a NAN. fstack-check_1 fldln2 |
|
From: George H. <geo...@us...> - 2006-02-01 12:42:23
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26990/win32forth/doc Modified Files: p-float.htm Log Message: gah: More Dexing (still work in progress) Index: p-float.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-float.htm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** p-float.htm 1 Feb 2006 11:44:48 -0000 1.5 --- p-float.htm 1 Feb 2006 12:42:13 -0000 1.6 *************** *** 228,233 **** polar coordinates. </p><h3>Logarithmic functions ! </h3><pre><b><a name="0">code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>? error for x <= -1 </p><h3>Exponential functions </h3><h3>Hyperbolic functions --- 228,238 ---- polar coordinates. </p><h3>Logarithmic functions ! </h3><pre><b><a name="0">code FLN ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the natural logarithm of r1. If r1 is ±0 then r2 is -infinity. If r1 ! is infinity then r2 is infinity. If r1 is less than zero then r2 is a NAN. ! </p><pre><b><a name="0">code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the natural logarithm of the quantity r1 plus one. If r1 is -1.0 then ! r2 is -infinity. If r1 is infinity then r2 is infinity. If r1 is less than ! -1.0 then r2 is a NAN. </p><h3>Exponential functions </h3><h3>Hyperbolic functions |
|
From: George H. <geo...@us...> - 2006-02-01 11:45:15
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv969/win32forth/src Modified Files: FLOAT.F Log Message: gah: More Dexing (still work in progress) Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** FLOAT.F 30 Jan 2006 13:58:10 -0000 1.28 --- FLOAT.F 1 Feb 2006 11:44:48 -0000 1.29 *************** *** 150,154 **** ! \ FEXAM results: \ Class C3 C2 C0 \ Unsupported 0 0 0 --- 150,154 ---- ! \ FXAM results: \ Class C3 C2 C0 \ Unsupported 0 0 0 *************** *** 394,398 **** : FVALUE ( compiling -<name>- -- FS: r -- ; run-time FS: -- r ) \ W32F Floating extra \ *G Define a floating point value initialised from the FP stack. ! create here B/FLOAT allot f! ;code fld fsize 4 [eax] --- 394,398 ---- : FVALUE ( compiling -<name>- -- FS: r -- ; run-time FS: -- r ) \ W32F Floating extra \ *G Define a floating point value initialised from the FP stack. ! create f, ;code fld fsize 4 [eax] *************** *** 433,437 **** \ ** Place r on the floating-point stack. ! create here f! B/FLOAT allot ;code fld fsize 4 [eax] --- 433,437 ---- \ ** Place r on the floating-point stack. ! create f, ;code fld fsize 4 [eax] *************** *** 601,604 **** --- 601,611 ---- float; + + code f0.0 ( FS: -- r ) \ W32F Floating extra + \ *G Push plus zero on to the FP stack. + fldz + FPU> + float; + code f1.0 ( fs: -- r ) \ W32F Floating extra \ *G Push the value 1.0 on to the FP stack. *************** *** 633,641 **** B/FLOAT 10 = nostack [IF] stack-check - \ TODO replace f1.0 fvariable with fconstant - fvariable af0 - 0 af0 ! 0 af0 cell+ ! 0 af0 2 cells+ w! - - : f0.0 af0 f@ ; f0.0 fconstant finf \ infinity --- 640,643 ---- *************** *** 684,691 **** [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. --- 686,689 ---- *************** *** 769,773 **** macro: (fround) fstack-check_1 - >FPU set-rounding-mode --- 767,770 ---- *************** *** 775,779 **** FPU> restore-rounding-mode - endm --- 772,775 ---- *************** *** 822,826 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *N Integer to float coversion code D>F ( d -- ) ( F: -- r ) \ ANSI Floating --- 818,822 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *N Integer to float conversion code D>F ( d -- ) ( F: -- r ) \ ANSI Floating *************** *** 843,847 **** \ ** to fit in a double number then \n -9223372036854775808 is returned. fstack-check_1 - >FPU push ebx --- 839,842 ---- *************** *** 853,872 **** pop ebx xchg ebx, 0 [esp] - float; ! code ZF>D ( -- d ) ( fs: r -- ) \ ? out of range errors ? fstack-check_1 - >FPU sub esp, # 8 fistp qword 0 [esp] xchg ebx, 4 [esp] - float; ! : s>f s>d d>f ; ! : f>s f>d drop ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 848,868 ---- pop ebx xchg ebx, 0 [esp] float; ! code ZF>D ( -- d ) ( fs: r -- ) \ W32F Floating extra fstack-check_1 >FPU sub esp, # 8 fistp qword 0 [esp] xchg ebx, 4 [esp] float; ! : s>f ( n -- ) ( fs: -- r ) \ W32F Floating extra ! \ *G Convert the single number n to floating point number r. ! s>d d>f ; ! : f>s ( -- n ) ( fs: r -- ) \ W32F Floating extra ! \ *G Convert the floating point number r to single number n. ! f>d drop ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 874,879 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! code FS>DS ( -- d ) ( f: r -- ) \ move floating point number bits to ! \ data stack as a 64-bit float fstack-check_1 >fpu --- 870,876 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! code FS>DS ( -- d ) ( f: r -- ) \ W32F Floating extra ! \ *G Move floating point number bits to the data stack as a 64-bit float. ! \ ** This function is for passing floats to DLLs. fstack-check_1 >fpu *************** *** 886,891 **** \ from Jos v.d. Ven ! \ Push the top of the float stack onto the data stack as a 32-bit float ! code SFS>DS ( -- float ) ( fs: r -- ) \ 10 b/float fstack-check_1 >fpu --- 883,890 ---- \ from Jos v.d. Ven ! ! code SFS>DS ( -- float ) ( fs: r -- ) \ W32F Floating extra ! \ *G Push the top of the float stack onto the data stack as a 32-bit float. ! \ ** This function is for passing floats to DLLs. fstack-check_1 >fpu *************** *** 917,937 **** in-application ! code fcomppx ( -- flags ) ( fs: r1 r2 -- ) fstack-check_2 - 2>FPU fcompp (fcomp) - float; ! code ftstp ( -- flags ) ( fs: r1 -- ) fstack-check_1 - >FPU ftst (fcomp) fstp st \ pop - float; --- 916,932 ---- in-application ! code fcomppx ( -- flags ) ( fs: r1 r2 -- ) \ for comparing 2 FP values fstack-check_2 2>FPU fcompp (fcomp) float; ! code ftstp ( -- flags ) ( fs: r1 -- ) \ for comparison with 0.0e0 fstack-check_1 >FPU ftst (fcomp) fstp st \ pop float; *************** *** 940,966 **** \ *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 ) f2dup f< IF fswap THEN fdrop ; ! : FMIN ( fs: r1 r2 -- r3 ) f2dup f> IF fswap THEN fdrop ; --- 935,975 ---- \ *N Comparison operators ! : F0= ( -- f ) ( fs: r -- ) \ ANSI Floating ! \ *G Return true if r equals ±0e0. Returns false for NAN. ftstp FCOMP_EQUAL = ; ! : F0< ( -- f ) ( fs: r -- ) \ ANSI Floating ! \ *G Return true if r is less than ±0e0. Returns false for NAN. ftstp FCOMP_LESS = ; ! : f0> ( -- f ) ( fs: r -- ) \ W32F Floating extra ! \ *G Return true if r is greater than ±0e0. Returns false for NAN. ftstp 0= ; ! : f= ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! \ *G Return true if r1 equals r2. Returns false if either number is a NAN. fcomppx FCOMP_EQUAL = ; ! : F< ( -- f ) ( fs: r1 r2 -- ) \ ANSI Floating ! \ *G Return true if r1 is less than r2. Returns false if either number is a NAN. fcomppx FCOMP_LESS = ; ! : f> ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! \ *G Return true if r1 is greater than r2. Returns false if either number is a NAN. fcomppx 0= ; ! : f<= ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! \ *G Return true if r1 is less than or equal to r2. Returns true if either number ! \ ** is a NAN. f> not ; ! : f>= ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! \ *G Return true if r1 is greater than or equal to r2. Returns true if either number ! \ ** is a NAN. f< not ; ! : FMAX ( fs: r1 r2 -- r3 ) \ ANSI Floating ! \ *G Return r3 the maximum of r1 and r2. If r1 is a NAN then so is r3. If r2 is a NAN ! \ ** then r3=r1. f2dup f< IF fswap THEN fdrop ; ! : FMIN ( fs: r1 r2 -- r3 ) \ ANSI Floating ! \ *G Return r3 the minimum of r1 and r2. If r1 is a NAN then so is r3. If r2 is a NAN ! \ ** then r3=r1. f2dup f> IF fswap THEN fdrop ; *************** *** 969,973 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *N Maths operators code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating --- 978,982 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *N Arithmetic operators code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating *************** *** 1012,1016 **** float; ! code f2/ ( fs: r1 -- r2 ) fstack-check_1 fld1 --- 1021,1026 ---- float; ! code f2/ ( fs: r1 -- r2 ) \ W32F Floating extra ! \ *G Multiply by 2. fstack-check_1 fld1 *************** *** 1022,1026 **** float; ! code f2* ( fs: r1 -- r2 ) \ ? overflow error fstack-check_1 fld1 --- 1032,1037 ---- float; ! code f2* ( fs: r1 -- r2 ) \ W32F Floating extra ! \ *G Divide by 2. fstack-check_1 fld1 *************** *** 1046,1113 **** float; ! code FLN ( fs: r1 -- r2 ) ! fstack-check_1 ! fldln2 ! >FPU ! fabs \ ? error if arg < 0 ! fyl2x ! FPU> ! float; ! code FACOSH ( fs: r1 -- r2 ) \ ? error for x < 1 fstack-check_1 - fldln2 - >FPU - fabs - fld st(0) - fmul st(0), st(0) fld1 ! fsubp st(1), st(0) ! fabs ! fsqrt ! faddp st(1), st(0) ! fyl2x ! FPU> ! float; ! ! code FASINH ( fs: r1 -- r2 ) \ Note: well defined for r1 < 0 ! fstack-check_1 ! ! fldln2 ! >FPU ! fld st(0) fmul st(0), st(0) ! fld1 ! faddp st(1), st(0) ! fsqrt ! faddp st(1), st(0) ! fyl2x ! FPU> ! float; ! internal code (fsin) ( f: r1 -- r2 ) fstack-check_1 - >FPU fsin FPU> - float; code (fcos) ( f: r1 -- r2 ) fstack-check_1 - >FPU fcos FPU> - float; code (fsincos) ( f: r1 -- r2 r3 ) fstack-check_1 - >FPU fsincos --- 1057,1105 ---- float; ! internal ! code f**+n ( f: r1 -- r2 ; n -- ) fstack-check_1 fld1 ! or tos, tos ! je short L$5 ! >fpu ! fxch st(1) ! L$1: shr tos, # 1 ! jnc short L$2 ! fmul st(0), st(1) ! L$2: jz short L$3 ! fxch st(1) fmul st(0), st(0) ! fxch st(1) ! jmp short L$1 ! L$3: fxch st(1) ! fstp st(0) ! L$5: fpu> ! pop tos float; ! : f**n ( F: r1 -- r2 ; n -- ) \ Floating number raised to integer power. ! DUP 0< ! IF ABS F**+N F1.0 FSWAP F/ ! ELSE F**+N ! THEN ; code (fsin) ( f: r1 -- r2 ) fstack-check_1 >FPU fsin FPU> float; code (fcos) ( f: r1 -- r2 ) fstack-check_1 >FPU fcos FPU> float; code (fsincos) ( f: r1 -- r2 r3 ) fstack-check_1 >FPU fsincos *************** *** 1115,1123 **** FPU> FPU> - float; - \ January 13th, 1998 - 9:33 tjz for RLS - \ corrected branch destination for L$3 code frem2pi ( f: r1 -- r2 ) fstack-check_1 --- 1107,1112 ---- *************** *** 1140,1143 **** --- 1129,1137 ---- external + + : 1/f ( fs: r1 -- r2 ) \ W32F Floating extra + \ *G r2 is the reciprocal of r1. + -1 f**n ; + \ *N Trigonometric functions *************** *** 1217,1228 **** \ *N Logarithmic functions code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext \ *G ? error for x <= -1 fstack-check_1 - fldln2 - >FPU - fld FSIZE sq2m1 fcomp st(1) --- 1211,1227 ---- \ *N Logarithmic functions + code FLN ( fs: r1 -- r2 ) \ ANSI Floating ext + fstack-check_1 + fldln2 + >FPU + fyl2x + FPU> + float; + code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext \ *G ? error for x <= -1 fstack-check_1 fldln2 >FPU fld FSIZE sq2m1 fcomp st(1) *************** *** 1237,1243 **** jb short L$4 fyl2xp1 - (FPU>) \ Used to balance branches - jmp short L$2 L$4: fld1 \ add the "1" explicitly --- 1236,1240 ---- *************** *** 1245,1273 **** fabs fyl2x - FPU> - jmp short L$2 L$3: fcompp \ return arg if incomparable - L$2: float; ! code FLOG ( fs: r1 -- r2 ) fstack-check_1 - fldlg2 - fabs \ ? error for x <= 0 >FPU fyl2x FPU> float; ! code FEXPM1 ( fs: r1 -- r2 ) \ ? overflow error ! mov ecx, FSP_MEMORY ! sub ecx, # B/FLOAT ! js short L$1 fldl2e ! fld FSIZE FSTACK_MEMORY fld1 fcom st(1) --- 1242,1284 ---- fabs fyl2x FPU> jmp short L$2 L$3: fcompp \ return arg if incomparable L$2: float; ! code FLOG ( fs: r1 -- r2 ) \ ANSI Floating ext fstack-check_1 fldlg2 >FPU fyl2x FPU> + float; + + \ *N Exponential functions + code FEXP ( fs: r1 -- r2 ) \ ANSI Floating ext + fstack-check_1 + fldl2e \ log base 2 of e \ 1 + >FPU \ 2 + fmulp st(1), st \ modified exponent \ 1 + fld st(0) \ duplicate exponent \ 2 + frndint \ take integer part \ 2 + fsub st(1), st \ get fractional part \ 2 + fld1 \ 3 + fscale \ 2**int \ 3 + fstp st(1) \ remove unneeded part \ 2 + fxch st(1) \ frac \ 2 + f2xm1 \ (2**frac) - 1 \ 2 + fld1 \ 1.0 \ 3 + faddp st(1), st \ 2**frac \ 2 + fmulp st(1), st \ 2**(int + frac) \ 1 + FPU> \ 0 float; ! code FEXPM1 ( fs: r1 -- r2 ) \ ANSI Floating ext ! ! fstack-check_1 fldl2e ! >fpu fld1 fcom st(1) *************** *** 1283,1287 **** fmulp st(1), st(0) f2xm1 ! fstp FSIZE FSTACK_MEMORY jmp short L$2 L$4: fstp st(0) \ 2 --- 1294,1298 ---- fmulp st(1), st(0) f2xm1 ! (fpu>) jmp short L$2 L$4: fstp st(0) \ 2 *************** *** 1290,1297 **** jp short L$3 frndint \ take integer part \ 2 - \ June 5th, 1996 - 16:03 tjz changed to FSUB which should be correct, since - \ the FSUBR instruction was used to correct for a bug in the MPE assembler fsub st(1), st \ get fractional part \ 2 - \ fsubr st(1), st \ get fractional part \ 2 fld1 \ 3 fscale \ 2**int \ 3 --- 1301,1305 ---- *************** *** 1304,1341 **** fld1 fsubp st(1), st \ Should be fsubrp ??????? ! fstp FSIZE FSTACK_MEMORY \ 0 jmp short L$2 L$3: fstp st(1) ! jmp short L$2 ! L$1: mov esi, # ' FSTKUFLO >body ! L$2: next, ! end-code ! code FEXP ( fs: r1 -- r2 ) \ ? error for x too large ! fstack-check_1 ! fldl2e \ log base 2 of e \ 1 ! >FPU \ 2 ! fmulp st(1), st \ modified exponent \ 1 ! fld st(0) \ duplicate exponent \ 2 ! frndint \ take integer part \ 2 ! \ June 5th, 1996 - 16:03 tjz changed to FSUB which should be correct, since ! \ the FSUBR instruction was used to correct for a bug in the MPE assembler ! fsub st(1), st \ get fractional part \ 2 ! \ fsubr st(1), st \ get fractional part \ 2 ! fld1 \ 3 ! fscale \ 2**int \ 3 ! fstp st(1) \ remove unneeded part \ 2 ! fxch st(1) \ frac \ 2 ! f2xm1 \ (2**frac) - 1 \ 2 ! fld1 \ 1.0 \ 3 ! faddp st(1), st \ 2**frac \ 2 ! fmulp st(1), st \ 2**(int + frac) \ 1 ! FPU> \ 0 ! float; ! : FCOSH ( f: r1 -- r2 ) \ ? error for x too large ! fabs fexp f1.0 fover f/ f+ f2/ ; ! : FTANH ( f: r1 -- r2 ) \ should be OK for legal args fdup fabs f1.0 f< IF f2* fexpm1 fdup f2.0 f+ f/ --- 1312,1347 ---- fld1 fsubp st(1), st \ Should be fsubrp ??????? ! fpu> jmp short L$2 L$3: fstp st(1) ! L$2: float; ! : f** ( F: r1 r2 -- r3 ) ! fswap fln f* fexp ; ! synonym f^x f** DEPRECATED ! internal ! ! : (fsinh) ( f: r1 -- r2 ) \ hyperbolic sine, more accurate for positive. ! fexp fdup 1/f f- f2/ ; ! ! external ! ! \ *N Hyperbolic functions ! ! : FSINH ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the hyperbolic sine of r1. ! fdup f0< ! IF fabs (fsinh) fnegate ! ELSE (fsinh) ! THEN ; ! ! : FCOSH ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the hyperbolic cosine of r1. ! fabs fexp fdup 1/f f+ f2/ ; ! ! : FTANH ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the hyperbolic tangent of r1, |r2| <= 1. fdup fabs f1.0 f< IF f2* fexpm1 fdup f2.0 f+ f/ *************** *** 1347,1370 **** THEN ; ! internal ! ! : (fsinh) ( f: r1 -- r2 ) ! fexp f1.0 fover f/ f- f2/ ; ! external ! : FSINH ( f: r1 -- r2 ) \ ? overflow error ? ! fdup f0< ! IF fabs (fsinh) fnegate ! ELSE (fsinh) ! THEN ; : FATANH ( f: r1 -- r2 ) \ OK for valid args ! fdup f1.0 f+ fdup f0= ! IF f2drop finf fnegate EXIT ! THEN ! fswap f1.0 f- fdup f0= ! IF f2drop finf EXIT ! THEN f/ fln f2/ ; --- 1353,1389 ---- THEN ; ! \ *N Inverse hyperbolic functions ! code FASINH ( fs: r1 -- r2 ) \ Note: well defined for r1 < 0 ! fstack-check_1 ! fldln2 ! >FPU ! fld st(0) ! fmul st(0), st(0) ! fld1 ! faddp st(1), st(0) ! fsqrt ! faddp st(1), st(0) ! fyl2x ! FPU> ! float; ! code FACOSH ( fs: r1 -- r2 ) \ ANSI Floating ext ! fstack-check_1 ! fldln2 ! >FPU ! fld st(0) ! fmul st(0), st(0) ! fld1 ! fsubp st(1), st(0) ! fsqrt ! faddp st(1), st(0) ! fyl2x ! FPU> ! float; : FATANH ( f: r1 -- r2 ) \ OK for valid args ! fdup f1.0 f+ ! fswap f1.0 fswap f- f/ fln f2/ ; *************** *** 1501,1550 **** internal - code f**+n ( f: r1 -- r2 ; n -- ) - fstack-check_1 - fld1 - or tos, tos - je short L$5 - >fpu - fxch st(1) - L$1: shr tos, # 1 - jnc short L$2 - fmul st(0), st(1) - L$2: jz short L$3 - fxch st(1) - fmul st(0), st(0) - fxch st(1) - jmp short L$1 - L$3: fxch st(1) - fstp st(0) - L$5: fpu> - pop tos - float; - - : f**n ( F: r1 -- r2 ; n -- ) \ Floating number raised to integer power. - DUP 0< - IF ABS F**+N F1.0 FSWAP F/ - ELSE F**+N - THEN ; - - external - - \ rbs January 26th, 2003 --> - \ : F** ( F: r1 r2 -- r3 ) - \ fdup fround fdup f>s f- \ r1 r4 - \ fdup f0= 0= - \ IF \ non-zero fractional part of exponent - \ fover fabs fln f* fexp fswap f**n f* - \ ELSE fdrop f**n - \ THEN ; - - : f** ( F: r1 r2 -- r3 ) - fswap fln f* fexp ; - - synonym f^x f** DEPRECATED - \ <-- rbs - - internal - fvariable ftemp 128 newuser $ftemp --- 1520,1523 ---- *************** *** 2090,2095 **** synonym fsqr fsqrt deprecated - : 1/f -1 f**n ; - : f>r r> rp@ b/float - rp! rp@ f! >r ; deprecated --- 2063,2066 ---- |
|
From: George H. <geo...@us...> - 2006-02-01 11:45:14
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv969/win32forth/doc Modified Files: p-float.htm Log Message: gah: More Dexing (still work in progress) Index: p-float.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-float.htm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** p-float.htm 30 Jan 2006 13:58:10 -0000 1.4 --- p-float.htm 1 Feb 2006 11:44:48 -0000 1.5 *************** *** 103,106 **** --- 103,108 ---- </h3><pre><b><a name="0">code fpi ( fs: -- r ) \ W32F Floating extra </a></b></pre><p>Push the value 3.141596... on to the FP stack. + </p><pre><b><a name="0">code f0.0 ( FS: -- r ) \ W32F Floating extra + </a></b></pre><p>Push plus zero on to the FP stack. </p><pre><b><a name="0">code f1.0 ( fs: -- r ) \ W32F Floating extra </a></b></pre><p>Push the value 1.0 on to the FP stack. *************** *** 113,118 **** </p><pre><b><a name="0">code fLn2 ( fs: -- r ) \ W32F Floating extra </a></b></pre><p>Push the value of ln 2 (the natural logarithm). - </p><pre><b><a name="0"> f1.0 fconstant f0.0 ( FS: -- r ) \ W32F Floating extra - </a></b></pre><p>Push plus zero. </p><pre><b><a name="0"> f0.0 fconstant finf ( FS: -- r ) \ W32F Floating extra </a></b></pre><p>Push plus infinity. --- 115,118 ---- *************** *** 145,149 **** </p><pre><b><a name="0">code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating </a></b></pre><p>Set rounding mode to round to nearest. ! </p><h3>Integer to float coversion </h3><pre><b><a name="0">code D>F ( d -- ) ( F: -- r ) \ ANSI Floating </a></b></pre><p>Convert double number to floating-point number. --- 145,149 ---- </p><pre><b><a name="0">code FROUND ( fs: f1 -- fs: f2 ) \ ANSI Floating </a></b></pre><p>Set rounding mode to round to nearest. ! </p><h3>Integer to float conversion </h3><pre><b><a name="0">code D>F ( d -- ) ( F: -- r ) \ ANSI Floating </a></b></pre><p>Convert double number to floating-point number. *************** *** 151,156 **** </a></b></pre><p>Convert floating-point number to double number. If the result would be too large to fit in a double number then <br /> -9223372036854775808 is returned. </p><h3>Comparison operators ! </h3><h3>Maths operators </h3><pre><b><a name="0">code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating </a></b></pre><p>Add r1 to r2. --- 151,190 ---- </a></b></pre><p>Convert floating-point number to double number. If the result would be too large to fit in a double number then <br /> -9223372036854775808 is returned. + </p><pre><b><a name="0">: s>f ( n -- ) ( fs: -- r ) \ W32F Floating extra + </a></b></pre><p>Convert the single number n to floating point number r. + </p><pre><b><a name="0">: f>s ( -- n ) ( fs: r -- ) \ W32F Floating extra + </a></b></pre><p>Convert the floating point number r to single number n. + </p><pre><b><a name="0">code FS>DS ( -- d ) ( f: r -- ) \ W32F Floating extra + </a></b></pre><p>Move floating point number bits to the data stack as a 64-bit float. + This function is for passing floats to DLLs. + </p><pre><b><a name="0">code SFS>DS ( -- float ) ( fs: r -- ) \ W32F Floating extra + </a></b></pre><p>Push the top of the float stack onto the data stack as a 32-bit float. + This function is for passing floats to DLLs. </p><h3>Comparison operators ! </h3><pre><b><a name="0">: F0= ( -- f ) ( fs: r -- ) \ ANSI Floating ! </a></b></pre><p>Return true if r equals ±0e0. Returns false for NAN. ! </p><pre><b><a name="0">: F0< ( -- f ) ( fs: r -- ) \ ANSI Floating ! </a></b></pre><p>Return true if r is less than ±0e0. Returns false for NAN. ! </p><pre><b><a name="0">: f0> ( -- f ) ( fs: r -- ) \ W32F Floating extra ! </a></b></pre><p>Return true if r is greater than ±0e0. Returns false for NAN. ! </p><pre><b><a name="0">: f= ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! </a></b></pre><p>Return true if r1 equals r2. Returns false if either number is a NAN. ! </p><pre><b><a name="0">: F< ( -- f ) ( fs: r1 r2 -- ) \ ANSI Floating ! </a></b></pre><p>Return true if r1 is less than r2. Returns false if either number is a NAN. ! </p><pre><b><a name="0">: f> ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! </a></b></pre><p>Return true if r1 is greater than r2. Returns false if either number is a NAN. ! </p><pre><b><a name="0">: f<= ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! </a></b></pre><p>Return true if r1 is less than or equal to r2. Returns true if either number ! is a NAN. ! </p><pre><b><a name="0">: f>= ( -- f ) ( fs: r1 r2 -- ) \ W32F Floating extra ! </a></b></pre><p>Return true if r1 is greater than or equal to r2. Returns true if either number ! is a NAN. ! </p><pre><b><a name="0">: FMAX ( fs: r1 r2 -- r3 ) \ ANSI Floating ! </a></b></pre><p>Return r3 the maximum of r1 and r2. If r1 is a NAN then so is r3. If r2 is a NAN ! then r3=r1. ! </p><pre><b><a name="0">: FMIN ( fs: r1 r2 -- r3 ) \ ANSI Floating ! </a></b></pre><p>Return r3 the minimum of r1 and r2. If r1 is a NAN then so is r3. If r2 is a NAN ! then r3=r1. ! </p><h3>Arithmetic operators </h3><pre><b><a name="0">code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating </a></b></pre><p>Add r1 to r2. *************** *** 163,166 **** --- 197,206 ---- </p><pre><b><a name="0">code FNEGATE ( fs: r1 -- r2 ) \ ANSI Floating </a></b></pre><p>Reverse the sign of r1. + </p><pre><b><a name="0">code f2/ ( fs: r1 -- r2 ) \ W32F Floating extra + </a></b></pre><p>Multiply by 2. + </p><pre><b><a name="0">code f2* ( fs: r1 -- r2 ) \ W32F Floating extra + </a></b></pre><p>Divide by 2. + </p><pre><b><a name="0">: 1/f ( fs: r1 -- r2 ) \ W32F Floating extra + </a></b></pre><p>r2 is the reciprocal of r1. </p><h3>Trigonometric functions </h3><pre><b><a name="0">: FSIN ( f: r1 -- r2 ) \ ANSI Floating ext *************** *** 190,194 **** </h3><pre><b><a name="0">code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext </a></b></pre><p>? error for x <= -1 ! </p><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext </a></b></pre><p>Return the number of significant digits currently used by (F.), (FE.), (FS.), F., --- 230,243 ---- </h3><pre><b><a name="0">code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext </a></b></pre><p>? error for x <= -1 ! </p><h3>Exponential functions ! </h3><h3>Hyperbolic functions ! </h3><pre><b><a name="0">: FSINH ( f: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the hyperbolic sine of r1. ! </p><pre><b><a name="0">: FCOSH ( f: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the hyperbolic cosine of r1. ! </p><pre><b><a name="0">: FTANH ( f: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the hyperbolic tangent of r1, |r2| <= 1. ! </p><h3>Inverse hyperbolic functions ! </h3><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext </a></b></pre><p>Return the number of significant digits currently used by (F.), (FE.), (FS.), F., |
|
From: George H. <geo...@us...> - 2006-01-30 13:58:19
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4801/win32forth/src Modified Files: FLOAT.F Log Message: gah: More Dexing (still work in progress) Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** FLOAT.F 28 Jan 2006 10:28:31 -0000 1.27 --- FLOAT.F 30 Jan 2006 13:58:10 -0000 1.28 *************** *** 396,405 **** create here B/FLOAT allot f! ;code ! push ebx ! lea ebx, 4 [eax] ! fld FSIZE DATASTACK_MEMORY ! FPU> ! ! pop ebx float; --- 396,401 ---- create here B/FLOAT allot f! ;code ! fld fsize 4 [eax] ! FPU> float; *************** *** 430,437 **** : FCONSTANT \ ANSI Floating ! \ *G \b Compiling: ( -<name>- ) ( F: r -- ) \n ! \ ** \b Run-time: ( F: -- r ) \d \n ! \ *P Define an FP constant. ! create here f! B/FLOAT allot does> f@ ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 426,477 ---- : FCONSTANT \ ANSI Floating ! \ *G \b Interpretation: ( -<name>- ) ( F: r -- ) \d \n ! \ ** Define an FP constant. \n ! \ ** \b Compilation: \d \n ! \ ** Append the run-time semantics given below to the current definition. \n ! \ ** \b Run-time: ( F: -- r ) \d \n ! \ ** Place r on the floating-point stack. ! ! create here f! B/FLOAT allot ! ;code ! fld fsize 4 [eax] ! FPU> ! float; ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Floating point literals. We store the 64-bit or 80-bit floating point ! \ literal inline and push to the FP stack at runtime. ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! internal ! ! code flit ( fs: -- r ) ! fld FSIZE 0 [esi] ! FPU> ! ! B/FLOAT 10 = ! [IF] add esi, # 12 \ to keep dword alignment ! ! [ELSE] add esi, # 8 ! [THEN] float; ! ! 0 value &flit ! ' flit to &flit \ for the debugger ! ! external ! ! in-system ! ! : FLITERAL ( fs: r -- ) \ ANSI Floating ! \ *G \b Interpretation: \d \n ! \ ** Interpretation semantics for this word are undefined. \n ! \ ** \b Compilation: ( F: r -- ) \d \n ! \ ** Append the run-time semantics given below to the current definition. \n ! \ ** \b Run-time: ( F: -- r ) \d \n ! \ ** Place r on the floating-point stack. ! postpone flit ! here CELLS/FLOAT cells allot f! ! ; immediate ! ! in-application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 474,478 **** 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 --- 514,518 ---- float; ! code FOVER ( fs: r1 r2 -- r1 r2 r1 ) \ ANSI Floating \ *G Copy the 2nd FP stack number to the top of the FP stack. fstack-check_2 *************** *** 534,538 **** float; ! : F2DUP ( fs: r1 r2 -- r1 r2 r3 r4 ) \ W32F Floating extra \ *G Duplicate the top 2 FP stack entries. fover fover ; --- 574,578 ---- float; ! : F2DUP ( fs: r1 r2 -- r1 r2 r1 r2 ) \ W32F Floating extra \ *G Duplicate the top 2 FP stack entries. fover fover ; *************** *** 586,590 **** code fLn2 ( fs: -- r ) \ W32F Floating extra ! \ *G Push the vlue of ln 2 (the natural logarithm). fldLn2 FPU> --- 626,630 ---- code fLn2 ( fs: -- r ) \ W32F Floating extra ! \ *G Push the value of ln 2 (the natural logarithm). fldLn2 FPU> *************** *** 653,712 **** f1.0 fconstant f2.0 ( FS: -- r ) \ W32F Floating extra ! \ *G Push 2.0 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+ ! ! ! f0.0 fconstant f10.0 \ floating 10.0 ' f10.0 >body 0 over ! 0x40240000 swap cell+ ! ! f1.0 fconstant f0.5 \ floating 0.5 ' f0.5 >body 0 over ! 0x3fe00000 swap cell+ ! ! f0.0 fconstant fbig \ largest non-infinite number ' fbig >body -1 over ! 0x7fefffff swap cell+ ! ! f0.0 fconstant feps \ smallest non-zero number 1 ' feps >body ! ! f1.0 fconstant fsmall ' fsmall >body 0 over ! 0x00100000 swap cell+ ! ! [THEN] ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Floating point literals. We store the 80-bit floating point literal ! \ inline and push to the FP stack at runtime. ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! code flit ( fs: -- r ) ! fld FSIZE 0 [esi] ! FPU> ! ! B/FLOAT 10 = ! [IF] add esi, # 12 \ to keep dword alignment ! ! [ELSE] add esi, # 8 ! [THEN] float; ! 0 value &flit ! ' flit to &flit \ for the debugger ! in-system ! : FLITERAL ( fs: r -- ) ! postpone flit ! here CELLS/FLOAT cells allot f! ! ; immediate ! in-application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 693,736 ---- f1.0 fconstant f2.0 ( FS: -- r ) \ W32F Floating extra ! \ *G Push floating-point 2.0. 0x40000000 ' f2.0 >body cell+ ! ! f0.0 fconstant f10.0 ( FS: -- r ) \ W32F Floating extra ! \ *G Push floating-point 10.0. ' f10.0 >body 0 over ! 0x40240000 swap cell+ ! ! f1.0 fconstant f0.5 ( FS: -- r ) \ W32F Floating extra ! \ *G Push floating-point 0.5. ' f0.5 >body 0 over ! 0x3fe00000 swap cell+ ! ! f0.0 fconstant fbig ( FS: -- r ) \ W32F Floating extra ! \ *G Push the largest non-infinite floating-point number. ' fbig >body -1 over ! 0x7fefffff swap cell+ ! ! f0.0 fconstant feps ( FS: -- r ) \ W32F Floating extra ! \ *G Push the smallest non-zero floating-point number. 1 ' feps >body ! ! f1.0 fconstant fsmall ( FS: -- r ) \ W32F Floating extra ! \ *G Push the smallest non-denormalised floating-point number. ' fsmall >body 0 over ! 0x00100000 swap cell+ ! ! \ *N Variables ! fvariable a2**63 ( -- addr ) \ W32F Floating extra ! \ *G Return the address of a float containing 2**63. ! 0 a2**63 ! 0x43e00000 a2**63 cell+ ! ! fvariable sq2m1 ( -- addr ) \ W32F Floating extra ! \ *G Return the address of a float containing sqrt(2) - 1. ! 0x99fcef34 sq2m1 ! ! 0x3fda8279 sq2m1 cell+ ! ! fvariable sq2/2m1 ( -- addr ) \ W32F Floating extra ! \ *G Return the address of a float containing sqrt(2)/2 - 1. ! 0x33018866 sq2/2m1 ! ! 0xbfd2bec3 sq2/2m1 cell+ ! ! [THEN] \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 800,804 **** \ *N Integer to float coversion ! code D>F ( d -- ) ( F: -- r ) lea esp, -4 [esp] mov ecx, 4 [esp] --- 824,829 ---- \ *N Integer to float coversion ! code D>F ( d -- ) ( F: -- r ) \ ANSI Floating ! \ *G Convert double number to floating-point number. lea esp, -4 [esp] mov ecx, 4 [esp] *************** *** 814,818 **** \ Changed 3/13/99 rls ! code F>D ( -- d ) ( fs: r -- ) \ ? out of range errors ? fstack-check_1 --- 839,845 ---- \ Changed 3/13/99 rls ! code F>D ( -- d ) ( fs: r -- ) \ ANSI Floating ! \ *G Convert floating-point number to double number. If the result would be too large ! \ ** to fit in a double number then \n -9223372036854775808 is returned. fstack-check_1 *************** *** 972,977 **** fstack-check_2 2>FPU ! fxch ! fdivp st(1), st FPU> float; --- 999,1004 ---- fstack-check_2 2>FPU ! \ fxch ! fdivrp st(1), st FPU> float; *************** *** 1095,1099 **** code frem2pi ( f: r1 -- r2 ) fstack-check_1 - fld1 fldpi --- 1122,1125 ---- *************** *** 1107,1111 **** FPU> fstp st(0) - float; --- 1133,1136 ---- *************** *** 1117,1135 **** \ *N Trigonometric functions ! : FSIN ( f: r1 -- r2 ) \ ? error if x > 2**63 ? >a2**63_frem2pi (fsin) ; ! : FCOS ( f: r1 -- r2 ) \ ? error if x > 2**63 ? >a2**63_frem2pi (fcos) ; ! : FSINCOS ( f: r1 -- r2 r3 ) \ ? error if x > 2**63 ? >a2**63_frem2pi (fsincos) ; ! : FTAN ( f: r1 -- r2 ) \ ? error if x > 2**63 ? fsincos f/ ; \ *N Inverse Trigonometric functions ! code FASIN ( fs: r1 -- r2 ) \ result for |x| > 1 is NAN fstack-check_1 >FPU --- 1142,1167 ---- \ *N Trigonometric functions ! : FSIN ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the sine of r1 in radians. >a2**63_frem2pi (fsin) ; ! : FCOS ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the cosine of r1 in radians. >a2**63_frem2pi (fcos) ; ! : FSINCOS ( f: r1 -- r2 r3 ) \ ANSI Floating ext ! \ *G r2 is the sine and r3 the cosine of r1 in radians. This function is more efficient ! \ ** than calling FSIN and FCOS separately. >a2**63_frem2pi (fsincos) ; ! : FTAN ( f: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the tangent of r1 in radians. fsincos f/ ; \ *N Inverse Trigonometric functions ! code FASIN ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the radian angle whose sine is r1. The result for |x| =< 1 is between ±pi/2. ! \ ** The result for |x| > 1 is NAN. fstack-check_1 >FPU *************** *** 1145,1149 **** float; ! code FACOS ( fs: r1 -- r2 ) \ result for |x| > 1 is NAN fstack-check_1 >FPU --- 1177,1183 ---- float; ! code FACOS ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the radian angle whose cosine is r1. The result for |x| =< 1 is between 0 and pi. ! \ ** The result for |x| > 1 is NAN fstack-check_1 >FPU *************** *** 1160,1164 **** float; ! code FATAN ( fs: r1 -- r2 ) \ should be OK for legal args fstack-check_1 >FPU --- 1194,1199 ---- float; ! code FATAN ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G r2 is the radian angle whose tangent is r1. The result is between ±pi/2. fstack-check_1 >FPU *************** *** 1169,1174 **** code FATAN2 ( fs: r1 r2 -- r3 ) \ ANSI Floating ext ! \ *G r3 is the radian angle whose tangent is r1/r2. If r1 and r2 are both zero then r3 ! \ ** is zero. fstack-check_2 2>FPU --- 1204,1211 ---- code FATAN2 ( fs: r1 r2 -- r3 ) \ ANSI Floating ext ! \ *G r3 is the radian angle whose tangent is r1/r2. The result is between ±pi ! \ ** with the same sign as r2. If r1 and r2 are both zero then r3 is ±zero. ! \ ** This function can be used to convert cartesian coordinates into the angle of the ! \ ** polar coordinates. fstack-check_2 2>FPU *************** *** 1178,1182 **** float; ! code FLNP1 ( fs: r1 -- r2 ) \ ? error for x <= -1 fstack-check_1 --- 1215,1222 ---- float; ! \ *N Logarithmic functions ! ! code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext ! \ *G ? error for x <= -1 fstack-check_1 |
|
From: George H. <geo...@us...> - 2006-01-30 13:58:19
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4801/win32forth/doc Modified Files: p-float.htm Log Message: gah: More Dexing (still work in progress) Index: p-float.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-float.htm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** p-float.htm 28 Jan 2006 10:28:30 -0000 1.3 --- p-float.htm 30 Jan 2006 13:58:10 -0000 1.4 *************** *** 61,67 **** POSTPONEd. </p><pre><b><a name="0">: FCONSTANT \ ANSI Floating ! </a></b></pre><p><b> Compiling: ( -<name>- ) ( F: r -- ) <br /> ! </b><b> Run-time: ( F: -- r ) </b> <br /> ! </p><p>Define an FP constant. </p><h3>Stack operations </h3><pre><b><a name="0">code FDROP ( fs: r -- ) \ ANSI Floating --- 61,77 ---- POSTPONEd. </p><pre><b><a name="0">: FCONSTANT \ ANSI Floating ! </a></b></pre><p> <b> Interpretation: ( -<name>- ) ( F: r -- ) </b> <br /> ! Define an FP constant. <br /> ! <b> Compilation: </b> <br /> ! Append the run-time semantics given below to the current definition. <br /> ! <b> Run-time: ( F: -- r ) </b> <br /> ! Place r on the floating-point stack. ! </p><pre><b><a name="0">: FLITERAL ( fs: r -- ) \ ANSI Floating ! </a></b></pre><p> <b> Interpretation: </b> <br /> ! Interpretation semantics for this word are undefined. <br /> ! <b> Compilation: ( F: r -- ) </b> <br /> ! Append the run-time semantics given below to the current definition. <br /> ! <b> Run-time: ( F: -- r ) </b> <br /> ! Place r on the floating-point stack. </p><h3>Stack operations </h3><pre><b><a name="0">code FDROP ( fs: r -- ) \ ANSI Floating *************** *** 71,75 **** </p><pre><b><a name="0">code FSWAP ( fs: r1 r2 -- r2 r1 ) \ ANSI Floating </a></b></pre><p>Exchange the top 2 FP numbers. ! </p><pre><b><a name="0">code FOVER ( fs: r1 r2 -- r1 r2 r3 ) \ ANSI Floating </a></b></pre><p>Copy the 2nd FP stack number to the top of the FP stack. </p><pre><b><a name="0">code FROT ( fs: r1 r2 r3 -- r2 r3 r1 ) \ ANSI Floating --- 81,85 ---- </p><pre><b><a name="0">code FSWAP ( fs: r1 r2 -- r2 r1 ) \ ANSI Floating </a></b></pre><p>Exchange the top 2 FP numbers. ! </p><pre><b><a name="0">code FOVER ( fs: r1 r2 -- r1 r2 r1 ) \ ANSI Floating </a></b></pre><p>Copy the 2nd FP stack number to the top of the FP stack. </p><pre><b><a name="0">code FROT ( fs: r1 r2 r3 -- r2 r3 r1 ) \ ANSI Floating *************** *** 84,88 **** </p><pre><b><a name="0">code F2DROP ( fs: r1 r2 -- ) \ W32F Floating extra </a></b></pre><p>Remove the top 2 FP stack entries. ! </p><pre><b><a name="0">: F2DUP ( fs: r1 r2 -- r1 r2 r3 r4 ) \ W32F Floating extra </a></b></pre><p>Duplicate the top 2 FP stack entries. </p><pre><b><a name="0">: F2SWAP ( fs: r1 r2 r3 r4 -- r3 r4 r2 r1 ) \ W32F Floating extra --- 94,98 ---- </p><pre><b><a name="0">code F2DROP ( fs: r1 r2 -- ) \ W32F Floating extra </a></b></pre><p>Remove the top 2 FP stack entries. ! </p><pre><b><a name="0">: F2DUP ( fs: r1 r2 -- r1 r2 r1 r2 ) \ W32F Floating extra </a></b></pre><p>Duplicate the top 2 FP stack entries. </p><pre><b><a name="0">: F2SWAP ( fs: r1 r2 r3 r4 -- r3 r4 r2 r1 ) \ W32F Floating extra *************** *** 102,106 **** </a></b></pre><p>Push the value of log base 10 of 2. </p><pre><b><a name="0">code fLn2 ( fs: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push the vlue of ln 2 (the natural logarithm). </p><pre><b><a name="0"> f1.0 fconstant f0.0 ( FS: -- r ) \ W32F Floating extra </a></b></pre><p>Push plus zero. --- 112,116 ---- </a></b></pre><p>Push the value of log base 10 of 2. </p><pre><b><a name="0">code fLn2 ( fs: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push the value of ln 2 (the natural logarithm). </p><pre><b><a name="0"> f1.0 fconstant f0.0 ( FS: -- r ) \ W32F Floating extra </a></b></pre><p>Push plus zero. *************** *** 108,112 **** </a></b></pre><p>Push plus infinity. </p><pre><b><a name="0"> f1.0 fconstant f2.0 ( FS: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push 2.0 </p><h3>Rounding Modes </h3><pre><b><a name="0">code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating --- 118,139 ---- </a></b></pre><p>Push plus infinity. </p><pre><b><a name="0"> f1.0 fconstant f2.0 ( FS: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push floating-point 2.0. ! </p><pre><b><a name="0"> f0.0 fconstant f10.0 ( FS: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push floating-point 10.0. ! </p><pre><b><a name="0"> f1.0 fconstant f0.5 ( FS: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push floating-point 0.5. ! </p><pre><b><a name="0"> f0.0 fconstant fbig ( FS: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push the largest non-infinite floating-point number. ! </p><pre><b><a name="0"> f0.0 fconstant feps ( FS: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push the smallest non-zero floating-point number. ! </p><pre><b><a name="0"> f1.0 fconstant fsmall ( FS: -- r ) \ W32F Floating extra ! </a></b></pre><p>Push the smallest non-denormalised floating-point number. ! </p><h3>Variables ! </h3><pre><b><a name="0"> fvariable a2**63 ( -- addr ) \ W32F Floating extra ! </a></b></pre><p>Return the address of a float containing 2**63. ! </p><pre><b><a name="0"> fvariable sq2m1 ( -- addr ) \ W32F Floating extra ! </a></b></pre><p>Return the address of a float containing sqrt(2) - 1. ! </p><pre><b><a name="0"> fvariable sq2/2m1 ( -- addr ) \ W32F Floating extra ! </a></b></pre><p>Return the address of a float containing sqrt(2)/2 - 1. </p><h3>Rounding Modes </h3><pre><b><a name="0">code FLOOR ( fs: f1 -- fs: f2 ) \ ANSI Floating *************** *** 119,123 **** </a></b></pre><p>Set rounding mode to round to nearest. </p><h3>Integer to float coversion ! </h3><h3>Comparison operators </h3><h3>Maths operators </h3><pre><b><a name="0">code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating --- 146,155 ---- </a></b></pre><p>Set rounding mode to round to nearest. </p><h3>Integer to float coversion ! </h3><pre><b><a name="0">code D>F ( d -- ) ( F: -- r ) \ ANSI Floating ! </a></b></pre><p>Convert double number to floating-point number. ! </p><pre><b><a name="0">code F>D ( -- d ) ( fs: r -- ) \ ANSI Floating ! </a></b></pre><p>Convert floating-point number to double number. If the result would be too large ! to fit in a double number then <br /> -9223372036854775808 is returned. ! </p><h3>Comparison operators </h3><h3>Maths operators </h3><pre><b><a name="0">code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating *************** *** 132,139 **** </a></b></pre><p>Reverse the sign of r1. </p><h3>Trigonometric functions ! </h3><h3>Inverse Trigonometric functions ! </h3><pre><b><a name="0">code FATAN2 ( fs: r1 r2 -- r3 ) \ ANSI Floating ext ! </a></b></pre><p>r3 is the radian angle whose tangent is r1/r2. If r1 and r2 are both zero then r3 ! is zero. </p><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext --- 164,193 ---- </a></b></pre><p>Reverse the sign of r1. </p><h3>Trigonometric functions ! </h3><pre><b><a name="0">: FSIN ( f: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the sine of r1 in radians. ! </p><pre><b><a name="0">: FCOS ( f: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the cosine of r1 in radians. ! </p><pre><b><a name="0">: FSINCOS ( f: r1 -- r2 r3 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the sine and r3 the cosine of r1 in radians. This function is more efficient ! than calling FSIN and FCOS separately. ! </p><pre><b><a name="0">: FTAN ( f: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the tangent of r1 in radians. ! </p><h3>Inverse Trigonometric functions ! </h3><pre><b><a name="0">code FASIN ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the radian angle whose sine is r1. The result for |x| =< 1 is between ±pi/2. ! The result for |x| > 1 is NAN. ! </p><pre><b><a name="0">code FACOS ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the radian angle whose cosine is r1. The result for |x| =< 1 is between 0 and pi. ! The result for |x| > 1 is NAN ! </p><pre><b><a name="0">code FATAN ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>r2 is the radian angle whose tangent is r1. The result is between ±pi/2. ! </p><pre><b><a name="0">code FATAN2 ( fs: r1 r2 -- r3 ) \ ANSI Floating ext ! </a></b></pre><p>r3 is the radian angle whose tangent is r1/r2. The result is between ±pi ! with the same sign as r2. If r1 and r2 are both zero then r3 is ±zero. ! This function can be used to convert cartesian coordinates into the angle of the ! polar coordinates. ! </p><h3>Logarithmic functions ! </h3><pre><b><a name="0">code FLNP1 ( fs: r1 -- r2 ) \ ANSI Floating ext ! </a></b></pre><p>? error for x <= -1 </p><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext |
|
From: George H. <geo...@us...> - 2006-01-28 10:28:44
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19199/win32forth/src Modified Files: FLOAT.F Log Message: gah: More Dexing (still work in progress) Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.26 retrieving revision 1.27 diff -C2 -d -r1.26 -r1.27 *** FLOAT.F 24 Jan 2006 09:22:39 -0000 1.26 --- FLOAT.F 28 Jan 2006 10:28:31 -0000 1.27 *************** *** 945,965 **** code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating fstack-check_2 - 2>FPU faddp st(1), st FPU> - float; ! code F- ( fs: r1 r2 -- r3 ) \ ? overflow errors fstack-check_2 2>FPU - \ fxch fsubrp st(1), st FPU> float; ! code F* ( fs: r1 r2 -- r3 ) \ ? overflow errors fstack-check_2 2>FPU --- 945,965 ---- code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating + \ *G Add r1 to r2. fstack-check_2 2>FPU faddp st(1), st FPU> float; ! code F- ( fs: r1 r2 -- r3 ) \ ANSI Floating ! \ *G Subtract r2 from r1. fstack-check_2 2>FPU fsubrp st(1), st FPU> float; ! code F* ( fs: r1 r2 -- r3 ) \ ANSI Floating ! \ *G Multiply r1 by r2. fstack-check_2 2>FPU *************** *** 968,972 **** float; ! code F/ ( fs: r1 r2 -- r3 ) \ ANSI Floating fstack-check_2 2>FPU --- 968,973 ---- float; ! code F/ ( fs: r1 r2 -- r3 ) \ ANSI Floating ! \ *G Divide r1 by r2. fstack-check_2 2>FPU *************** *** 976,988 **** float; ! code FATAN2 ( fs: r1 r2 -- r3 ) \ OK for valid args ! fstack-check_2 ! 2>FPU ! fxch ! fpatan ! FPU> ! float; ! ! code FNEGATE ( fs: r1 -- r2 ) fstack-check_1 >FPU --- 977,982 ---- float; ! code FNEGATE ( fs: r1 -- r2 ) \ ANSI Floating ! \ *G Reverse the sign of r1. fstack-check_1 >FPU *************** *** 1121,1124 **** --- 1115,1120 ---- external + \ *N Trigonometric functions + : FSIN ( f: r1 -- r2 ) \ ? error if x > 2**63 ? >a2**63_frem2pi (fsin) ; *************** *** 1133,1136 **** --- 1129,1181 ---- fsincos f/ ; + \ *N Inverse Trigonometric functions + + code FASIN ( fs: r1 -- r2 ) \ result for |x| > 1 is NAN + fstack-check_1 + >FPU + fld st(0) + fld st(0) + fmulp st(1), st(0) + fld1 + fsubpr st(1), st + fabs + fsqrt + fpatan + FPU> + float; + + code FACOS ( fs: r1 -- r2 ) \ result for |x| > 1 is NAN + fstack-check_1 + >FPU + fld st(0) + fld st(0) + fmulp st(1), st(0) + fld1 + fsubpr st(1), st + fsqrt + fabs + fxch st(1) + fpatan + FPU> + float; + + code FATAN ( fs: r1 -- r2 ) \ should be OK for legal args + fstack-check_1 + >FPU + fld1 + fpatan + FPU> + float; + + code FATAN2 ( fs: r1 r2 -- r3 ) \ ANSI Floating ext + \ *G r3 is the radian angle whose tangent is r1/r2. If r1 and r2 are both zero then r3 + \ ** is zero. + fstack-check_2 + 2>FPU + fxch + fpatan + FPU> + float; + code FLNP1 ( fs: r1 -- r2 ) \ ? error for x <= -1 fstack-check_1 *************** *** 1262,1308 **** THEN ; - code FATAN ( fs: r1 -- r2 ) \ should be OK for legal args - fstack-check_1 - - >FPU - fld1 - fpatan - FPU> - - float; - - code FACOS ( fs: r1 -- r2 ) \ result for |x| > 1 is NAN - fstack-check_1 - - >FPU - fld st(0) - fld st(0) - fmulp st(1), st(0) - fld1 - fsubpr st(1), st - fsqrt - fabs - fxch st(1) - fpatan - FPU> - - float; - - code FASIN ( fs: r1 -- r2 ) \ result for |x| > 1 is NAN - fstack-check_1 - - >FPU - fld st(0) - fld st(0) - fmulp st(1), st(0) - fld1 - fsubpr st(1), st - fabs - fsqrt - fpatan - FPU> - - float; - internal --- 1307,1310 ---- *************** *** 1891,1895 **** \ *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. --- 1893,1897 ---- \ *P The following words are for formatting floating point numbers as counted strings in ! \ ** the buffer whose address is supplied so they can be used for purposes other than printing \ ** the numbers to the console. The string is not null terminated. |
|
From: George H. <geo...@us...> - 2006-01-28 10:28:44
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19199/win32forth/doc Modified Files: p-float.htm Log Message: gah: More Dexing (still work in progress) Index: p-float.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-float.htm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** p-float.htm 24 Jan 2006 09:22:39 -0000 1.2 --- p-float.htm 28 Jan 2006 10:28:30 -0000 1.3 *************** *** 121,125 **** </h3><h3>Comparison operators </h3><h3>Maths operators ! </h3><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext </a></b></pre><p>Return the number of significant digits currently used by (F.), (FE.), (FS.), F., --- 121,140 ---- </h3><h3>Comparison operators </h3><h3>Maths operators ! </h3><pre><b><a name="0">code F+ ( fs: r1 r2 -- r3 ) \ ANSI Floating ! </a></b></pre><p>Add r1 to r2. ! </p><pre><b><a name="0">code F- ( fs: r1 r2 -- r3 ) \ ANSI Floating ! </a></b></pre><p>Subtract r2 from r1. ! </p><pre><b><a name="0">code F* ( fs: r1 r2 -- r3 ) \ ANSI Floating ! </a></b></pre><p>Multiply r1 by r2. ! </p><pre><b><a name="0">code F/ ( fs: r1 r2 -- r3 ) \ ANSI Floating ! </a></b></pre><p>Divide r1 by r2. ! </p><pre><b><a name="0">code FNEGATE ( fs: r1 -- r2 ) \ ANSI Floating ! </a></b></pre><p>Reverse the sign of r1. ! </p><h3>Trigonometric functions ! </h3><h3>Inverse Trigonometric functions ! </h3><pre><b><a name="0">code FATAN2 ( fs: r1 r2 -- r3 ) \ ANSI Floating ext ! </a></b></pre><p>r3 is the radian angle whose tangent is r1/r2. If r1 and r2 are both zero then r3 ! is zero. ! </p><h3>Output conversion. </h3><pre><b><a name="0">: PRECISION ( -- u ) \ ANSI Floating ext </a></b></pre><p>Return the number of significant digits currently used by (F.), (FE.), (FS.), F., *************** *** 133,137 **** </p><h3>Format FP number to a buffer </h3><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. </p><pre><b><a name="0">: (F.) ( addr -- ) ( F: r -- ) \ W32F Floating extra --- 148,152 ---- </p><h3>Format FP number to a buffer </h3><p>The following words are for formatting floating point numbers as counted strings in ! the buffer whose address is supplied so they can be used for purposes other than printing the numbers to the console. The string is not null terminated. </p><pre><b><a name="0">: (F.) ( addr -- ) ( F: r -- ) \ W32F Floating extra |
|
From: George H. <geo...@us...> - 2006-01-27 10:10:33
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29308/win32forth/src Modified Files: GENERIC.F WINMSG.F Log Message: gah: Some optimizations and documenting Index: WINMSG.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/WINMSG.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** WINMSG.F 17 May 2005 22:25:25 -0000 1.3 --- WINMSG.F 27 Jan 2006 10:10:25 -0000 1.4 *************** *** 172,177 **** :Object InfoWindow <Super MSGWINDOW ! Font msgFont int extentx int extenty --- 172,178 ---- :Object InfoWindow <Super MSGWINDOW + \ *G Used for old style tool tips. ! GdiFont msgFont int extentx int extenty *************** *** 188,193 **** 0 to extentx 0 to extenty ! fwidth Width: msgFont ! fheight Height: msgFont s" MS Sans Serif" SetFaceName: msgFont COLOR_INFOBK Call GetSysColor NewColor: TIPCOLOR --- 189,194 ---- 0 to extentx 0 to extenty ! fwidth SetWidth: msgFont ! fheight SetHeight: msgFont s" MS Sans Serif" SetFaceName: msgFont COLOR_INFOBK Call GetSysColor NewColor: TIPCOLOR *************** *** 200,204 **** :M On_Done: ( -- ) ! Delete: msgFont On_Done: super ;M --- 201,205 ---- :M On_Done: ( -- ) ! Destroy: msgFont On_Done: super ;M *************** *** 211,215 **** :M On_Paint: { \ vpos msgmax -- } SaveDC: dc ! Handle: msgFont SetFont: dc &InfoRect GetClientRect: self --- 212,216 ---- :M On_Paint: { \ vpos msgmax -- } SaveDC: dc ! GetHandle: msgFont SetFont: dc &InfoRect GetClientRect: self Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** GENERIC.F 26 Jan 2006 11:20:49 -0000 1.7 --- GENERIC.F 27 Jan 2006 10:10:25 -0000 1.8 *************** *** 137,141 **** :M DestroyWindow: ( -- ) ! \ *G Destroy the window. The handle is always zero after executing this method. hWnd if hWnd Call DestroyWindow ?win-error --- 137,143 ---- :M DestroyWindow: ( -- ) ! \ *G Destroy the window. The handle is always zero after executing this method. In a ! \ ** mult-tasking application this method causes an error if executed by a task that ! \ ** didn't create the window. hWnd if hWnd Call DestroyWindow ?win-error *************** *** 570,580 **** \ *G End of generic-window class ! : zero-windows { \ wlink -- } \ Zero all window handles. ! windows-link @ ! begin dup ! while dup cell+ @ to wlink ! ZeroWindow: wlink ! @ ! repeat drop ; initialization-chain chain-add zero-windows --- 572,581 ---- \ *G End of generic-window class ! : zero-windows ( -- ) \ Zero all window handles. ! windows-link ! begin @ ?dup ! while dup cell+ @ ! ZeroWindow: [ ] ! repeat ; initialization-chain chain-add zero-windows |
|
From: George H. <geo...@us...> - 2006-01-27 10:10:33
|
Update of /cvsroot/win32forth/win32forth/doc/classes In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29308/win32forth/doc/classes Modified Files: Generic.htm Log Message: gah: Some optimizations and documenting Index: Generic.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/classes/Generic.htm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Generic.htm 26 Jan 2006 17:48:46 -0000 1.6 --- Generic.htm 27 Jan 2006 10:10:24 -0000 1.7 *************** *** 58,62 **** objects are zeroed automatically. </p><pre><b><a name="0">:M DestroyWindow: ( -- ) ! </a></b></pre><p>Destroy the window. The handle is always zero after executing this method. </p><pre><b><a name="0">:M Close: ( -- ) </a></b></pre><p>Close the window. --- 58,64 ---- objects are zeroed automatically. </p><pre><b><a name="0">:M DestroyWindow: ( -- ) ! </a></b></pre><p>Destroy the window. The handle is always zero after executing this method. In a ! mult-tasking application this method causes an error if executed by a task that ! didn't create the window. </p><pre><b><a name="0">:M Close: ( -- ) </a></b></pre><p>Close the window. |
|
From: George H. <geo...@us...> - 2006-01-26 17:48:54
|
Update of /cvsroot/win32forth/win32forth/doc/classes In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4101/win32forth/doc/classes Modified Files: Generic.htm Window.htm Log Message: gah: Some optimizations and documenting Index: Generic.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/classes/Generic.htm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Generic.htm 8 Jan 2006 09:28:07 -0000 1.5 --- Generic.htm 26 Jan 2006 17:48:46 -0000 1.6 *************** *** 49,65 **** </p><h3>Methods </h3><pre><b><a name="0">:M Classinit: ( -- ) ! </a></b></pre><p>Init the class </p><pre><b><a name="0">:M GetHandle: ( -- hWnd ) ! </a></b></pre><p>Get the window handle </p><pre><b><a name="0">:M PutHandle: ( hWnd -- ) ! </a></b></pre><p>Set the window handle </p><pre><b><a name="0">:M ZeroWindow: ( -- ) ! </a></b></pre><p>Clear the window handle </p><pre><b><a name="0">:M DestroyWindow: ( -- ) ! </a></b></pre><p>Destroy the window </p><pre><b><a name="0">:M Close: ( -- ) ! </a></b></pre><p>Close the window </p><pre><b><a name="0">:M Paint: ( -- ) ! </a></b></pre><p>force window repaint </p><pre><b><a name="0">:M Show: ( state -- ) \ use words like SW_SHOWNORMAL </a></b></pre><p>The ShowWindow function sets the specified window's show state. <br /> --- 49,66 ---- </p><h3>Methods </h3><pre><b><a name="0">:M Classinit: ( -- ) ! </a></b></pre><p>Initialise the class. </p><pre><b><a name="0">:M GetHandle: ( -- hWnd ) ! </a></b></pre><p>Get the window handle. </p><pre><b><a name="0">:M PutHandle: ( hWnd -- ) ! </a></b></pre><p>Set the window handle. Normally handled by the system. </p><pre><b><a name="0">:M ZeroWindow: ( -- ) ! </a></b></pre><p>Clear the window handle. Normally handled by the system. At start-up all window ! objects are zeroed automatically. </p><pre><b><a name="0">:M DestroyWindow: ( -- ) ! </a></b></pre><p>Destroy the window. The handle is always zero after executing this method. </p><pre><b><a name="0">:M Close: ( -- ) ! </a></b></pre><p>Close the window. </p><pre><b><a name="0">:M Paint: ( -- ) ! </a></b></pre><p>Force window repaint. A WM_PAINT message is posted to the message queue. </p><pre><b><a name="0">:M Show: ( state -- ) \ use words like SW_SHOWNORMAL </a></b></pre><p>The ShowWindow function sets the specified window's show state. <br /> *************** *** 509,513 **** </a></b></pre><p>The SetDlgItemText function sets the title or text of a control in then window. </p><pre><b><a name="0">:M SetDlgItemFocus: ( id -- ) ! </a></b></pre><p>Set the focus to the control (id) in the window </p><pre><b><a name="0">:M SelectDlgItemAll: ( id -- ) </a></b></pre><p>Selects all characters in the edit control (id). You can use this forn an edit control --- 510,514 ---- </a></b></pre><p>The SetDlgItemText function sets the title or text of a control in then window. </p><pre><b><a name="0">:M SetDlgItemFocus: ( id -- ) ! </a></b></pre><p>Set the focus to the control (id) in the window. </p><pre><b><a name="0">:M SelectDlgItemAll: ( id -- ) </a></b></pre><p>Selects all characters in the edit control (id). You can use this forn an edit control *************** *** 555,559 **** </tr> </table><pre><b><a name="0">:M SetAlign: ( flag id -- ) \ DEPRECATED ! </a></b></pre><p>Obsolescent Method use SetDlgItemAlign: instead </p><pre><b><a name="0">:M EnableDlgItem: ( flag id -- ) </a></b></pre><p>Enable or disable a control (id) in the window. --- 556,560 ---- </tr> </table><pre><b><a name="0">:M SetAlign: ( flag id -- ) \ DEPRECATED ! </a></b></pre><p>Obsolescent Method use SetDlgItemAlign: instead. </p><pre><b><a name="0">:M EnableDlgItem: ( flag id -- ) </a></b></pre><p>Enable or disable a control (id) in the window. Index: Window.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/classes/Window.htm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Window.htm 25 Jan 2006 11:10:52 -0000 1.6 --- Window.htm 26 Jan 2006 17:48:46 -0000 1.7 *************** *** 130,134 **** (&PS ivar) and the window device context (DC ivar) are initialized. <br /> Check ps_fErase in your method to see if the background of the window should ! be drawn and use ps_left, ps_top, ps_right and ps_bottom to see whitch part of the window should be painted. <br /> Default does nothing. --- 130,134 ---- (&PS ivar) and the window device context (DC ivar) are initialized. <br /> Check ps_fErase in your method to see if the background of the window should ! be drawn and use ps_left, ps_top, ps_right and ps_bottom to see which part of the window should be painted. <br /> Default does nothing. *************** *** 189,193 **** </a></b></pre><p>Send a message to a window. </p><pre><b><a name="0">: LoadIconFile ( adr len -- hIcon ) \ w32f ! </a></b></pre><p>Load an icon from a icon file. </p><hr><p>Document $Id$</p> </body></html> --- 189,193 ---- </a></b></pre><p>Send a message to a window. </p><pre><b><a name="0">: LoadIconFile ( adr len -- hIcon ) \ w32f ! </a></b></pre><p>Load an icon from an icon file. </p><hr><p>Document $Id$</p> </body></html> |
1040 messages has been excluded from this view by a project administrator.
