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: George H. <geo...@us...> - 2007-09-11 09:23:25
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17446/win32forth-stc/src Added Files: Shell.f Log Message: gah: modifying to get rid of duplicate shell.f --- NEW FILE: Shell.f --- \ $Id: Shell.f,v 1.5 2007/09/11 09:23:21 georgeahubert Exp $ \ \ SHELL support \ \ Moved here from UTILS.F and partly rewritten by Dirk Busch \ Dienstag, März 29 2005 cr .( Loading Shell Words...) only forth also definitions IN-APPLICATION \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 6 Old original version of $EXEC, superceeded by the following series of words \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ INTERNAL create StartupInfo here 0 , \ cb 0 , \ lpReserved 0 , \ lpDesktop 0 , \ lpTitle 373 , \ dwX 3 , \ dwY 0 , \ dwXSize 0 , \ dwYSize 80 , \ dwXCountChars 50 , \ dwYCountChars 0 , \ dwFillAttribute STARTF_USEPOSITION STARTF_USECOUNTCHARS + STARTF_USESHOWWINDOW + , \ dwFlags SW_SHOWNORMAL W, \ wShowWindow 0 W, \ cbReserved2 0 , \ lpReserved2 0 , \ hStdInput 0 , \ hStdOutput 0 , \ hStdError here over - swap ! create ProcInfo 0 , \ hProcess 0 , \ hThread 0 , \ dwPriocessId 0 , \ dwThreadId 10 proc CreateProcess : (CreateProcess) ( a1 -- f1 ) \ pass to NT without any interpretation \ Note: a1 must point to a zString !!! ProcInfo 4 cells erase \ clear procinfo >r \ null terminated parameter string ProcInfo \ lppiProcInfo StartupInfo \ lpsiStartInfo 0 \ lpszCurDir 0 \ lpvEnvironment 0 \ fdwCreate 0 \ fInheritHandles 0 \ lpsaThread 0 \ lpsaProcess r> \ lpszCommandLine 0 \ lpszImageName call CreateProcess 0= ; 1 proc CloseHandle : EXEC-CLOSE-THREAD-HANDLE ( -- ) ProcInfo cell+ @ call CloseHandle drop ; : EXEC-CLOSE-PROCESS-HANDLE ( -- ) ProcInfo @ call CloseHandle drop ; : EXEC-CLOSE-HANDLES ( -- ) EXEC-CLOSE-THREAD-HANDLE EXEC-CLOSE-PROCESS-HANDLE ; 2 proc WaitForInputIdle 2 proc WaitForSingleObject : (EXEC-PROCESS-WAIT) { hProcess -- } \ Wait for terminating of a process INFINITE hProcess call WaitForInputIdle WAIT_FAILED <> if begin KEY? drop \ keep the Win32Forth message loop alive 1 hProcess call WaitForSingleObject WAIT_OBJECT_0 = until then ; : EXEC-PROCESS-WAIT ( -- ) \ Wait for terminating the process ProcInfo @ (EXEC-PROCESS-WAIT) ; EXTERNAL : zEXEC ( a1 -- f1 ) \ execute a command line (CreateProcess) ; DEPRECATED \ use zEXEC-CMD or zEXEC-CMD-WAIT instead : zEXEC-CMD ( a1 -- f1 ) \ execute a command line (CreateProcess) dup 0= if EXEC-CLOSE-HANDLES then ; : zEXEC-CMD-WAIT ( a1 -- f1 ) \ execute a command line, and wait for terminating of the process (CreateProcess) dup 0= IF EXEC-CLOSE-THREAD-HANDLE \ close the thread handle EXEC-PROCESS-WAIT \ wait for the process EXEC-CLOSE-PROCESS-HANDLE \ and close the process handle then ; : EXEC-CMD ( a1 -- f1 ) dup +null 1+ zEXEC-CMD ; : EXEC-CMD-WAIT ( a1 -- f1 ) dup +null 1+ zEXEC-CMD-WAIT ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ SHELL support with interpreted string replacement for selected words \ %FILENAME %DIR %LINE \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ INTERNAL named-new$ &execbuf variable &linenum &linenum off : execbuf+ ( a1 n1 a2 -- ) \ append to the exec buffer &execbuf 2dup c@ + MAXCOUNTED > abort" Too long for EXEC buffer" +place ; EXTERNAL true value new-prompt? INTERNAL create cur-file maxstring allot \ *** : $EXECBUF-PREPARE ( a1 -- ) \ preprocess for file and line parameters base @ >r decimal &execbuf off \ pre-zero the buffer count begin 2dup ascii % scan dup while 2dup 2>r nip - execbuf+ 2r> over s" %FILENAME" tuck ISTR= if new-prompt? if cur-file count "path-file if cr ." File doesn't exist, create it? [Y/N] (N):" key upc 'Y' <> abort" Aborting" then execbuf+ else cur-file count execbuf+ then 9 /string \ remove %FILENAME else over s" %DIR" tuck ISTR= if &prognam count 2dup "to-pathend" nip - execbuf+ 4 /string \ remove %DIR else over s" %LINE" tuck ISTR= if &linenum @ 0 <# #s #> execbuf+ 5 /string \ remove %LINE else over 1 execbuf+ 1 /string \ remove one % char then then then repeat nip - execbuf+ r> base ! ; EXTERNAL : $EXEC ( a1 -- f1 ) \ Invoke a DOS command string with \ preprocess for file and line parameters \ f1 = TRUE on error $EXECBUF-PREPARE &execbuf EXEC-CMD ; : $EXEC-WAIT ( a1 -- f1 ) \ Invoke a DOS command string with \ preprocess for file and line parameters \ and wait for terminating of the process. \ f1 = TRUE on error $EXECBUF-PREPARE &execbuf EXEC-CMD-WAIT ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ create editor$ ," %DIRWinEd.exe '%FILENAME' %LINE" MAXSTRING allot-to create browse$ ," %DIRWinEd.exe /B '%FILENAME' %LINE" MAXSTRING allot-to create shell$ ," CMD /C " MAXSTRING allot-to create dos$ ," CMD" MAXSTRING allot-to : editor" ( -<string">- ) \ set the editor command string ascii " word count editor$ place ; : browse" ( -<string">- ) \ set the browser command string ascii " word count browse$ place ; : shell" ( -<string">- ) \ set the shell command string ascii " word count shell$ place ; : dos" ( -<string">- ) \ set the dos command string ascii " word count dos$ place dos$ +NULL ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ User specifiable string delimiter utility \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ IN-SYSTEM : .quote ( - ) ascii " emit ; : type-quoted ( adr n - ) .quote type .quote ; : .shell \ display the editor, browser, shell & dos strings cr ." EDITOR: " editor$ count type-quoted cr ." BROWSE: " browse$ count type-quoted cr ." SHELL: " shell$ count type-quoted cr ." DOS: " dos$ count type-quoted ; synonym .editor .shell DEPRECATED synonym .dos .shell DEPRECATED synonym .browse .shell DEPRECATED \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 10 A utility to allow invoking a DOS shell on a following commandline \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ IN-APPLICATION INTERNAL create shell-name$ ," SHELL.BAT" MAXSTRING allot-to create shell-buf MAXSTRING allot 0 value ?shell-pause EXTERNAL : $shell ( a1 -- ) dup c@ if shell-name$ count w/o create-file \ make the file abort" Couldn't create SHELL.BAT" >r \ save file handle ( a1 ) count r@ write-file drop \ write commandline crlf$ count r@ write-file drop \ line terminator ?shell-pause if s" PAUSE" r@ write-file drop \ wait for results crlf$ count r@ write-file drop \ line terminator then r> close-file drop \ close the file shell$ count shell-buf place \ the command shell-name$ count shell-buf +place \ append batch name shell-buf EXEC-CMD drop \ perform command else drop ?shell-pause if dos$ EXEC-CMD drop then then ; : shell ( -<string>- ) true to ?shell-pause 0 word $shell ; : dos ( -<string>- ) false to ?shell-pause 0 word $shell ; synonym ` shell DEPRECATED synonym sys shell DEPRECATED \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 25 HTML linkage support \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 6 proc ShellExecute : ("ShellExecute) { operation addr cnt hWnd -- errorcode } \ open file using default application SW_SHOWNORMAL \ nShowCmd Null \ default directory Null \ parameters addr cnt asciiz \ file name to execute operation \ operation to perform hWnd \ parent Call ShellExecute ; : "ShellExecute { addr cnt hWnd -- errorcode } \ open file using default application z" open" addr cnt hWnd ("ShellExecute) ; : "Web-Link { adr len hWnd \ web$ -- } \ open the Web link supplied, using the web browser LMAXSTRING LocalAlloc: web$ web$ off \ reset buffer initially adr len bl skip -trailing to len to adr \ remove leading & trailing blanks adr len 4 min s" WWW." caps-compare 0= \ if www. present adr len 5 min s" FILE:" caps-compare 0= or \ or http: present adr len 5 min s" HTTP:" caps-compare 0= or \ or http: present adr len 5 min s" NEWS:" caps-compare 0= or \ or news: present adr len 4 min s" FTP:" caps-compare 0= or \ or ftp: present adr len 4 min s" FTP." caps-compare 0= or \ or ftp. present adr len 7 min s" MAILTO:" caps-compare 0= or \ or mailto: present len 0= or \ or NULL string IF adr len web$ LPLACE \ then pass through un-modified ELSE s" www." web$ LPLACE \ else prepend "www." adr len web$ +LPLACE \ append specified string s" .com" web$ +LPLACE \ append ".com" THEN web$ +LNULL \ null terminate string web$ @ \ if there is any thing there IF web$ lcount hwnd "ShellExecute drop \ tell Windows we want this link ELSE beep THEN ; : Web ( -<www.???.com>- ) \ open the Web link specified, using the Web browser bl word count conhndl "Web-Link ; : "file-link ( adr len hWnd -- ) \ open a local file in default browser s" file:" temp$ place \ build string >R Prepend<home>\ temp$ +place \ file:<absolute path>\<file name>.<ext> temp$ count r> "web-link ; \s |
|
From: George H. <geo...@us...> - 2007-09-11 09:21:36
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16653/win32forth-stc/src Removed Files: shell.f Log Message: --- shell.f DELETED --- |
|
From: George H. <geo...@us...> - 2007-09-11 09:20:25
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16206/win32forth-stc/src Removed Files: Shell.f Log Message: --- Shell.f DELETED --- |
|
From: George H. <geo...@us...> - 2007-09-11 09:19:36
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15807/win32forth-stc/src Modified Files: Shell.f Log Message: Index: Shell.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Shell.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Shell.f 11 Sep 2007 09:15:16 -0000 1.2 --- Shell.f 11 Sep 2007 09:19:31 -0000 1.3 *************** *** 5,9 **** \ Moved here from UTILS.F and partly rewritten by Dirk Busch \ Dienstag, März 29 2005 ! cr .( Loading Shell Words...) --- 5,9 ---- \ Moved here from UTILS.F and partly rewritten by Dirk Busch \ Dienstag, März 29 2005 ! cr .( Loading Shell Words...) *************** *** 133,143 **** INTERNAL - create cur-file maxstring allot \ *** - : $EXECBUF-PREPARE ( a1 -- ) \ preprocess for file and line parameters base @ >r decimal &execbuf off \ pre-zero the buffer count ! begin 2dup ascii % scan dup while 2dup 2>r nip - execbuf+ 2r> over s" %FILENAME" tuck ISTR= --- 133,141 ---- INTERNAL : $EXECBUF-PREPARE ( a1 -- ) \ preprocess for file and line parameters base @ >r decimal &execbuf off \ pre-zero the buffer count ! begin 2dup [char] % scan dup while 2dup 2>r nip - execbuf+ 2r> over s" %FILENAME" tuck ISTR= *************** *** 189,202 **** : editor" ( -<string">- ) \ set the editor command string ! ascii " word count editor$ place ; : browse" ( -<string">- ) \ set the browser command string ! ascii " word count browse$ place ; : shell" ( -<string">- ) \ set the shell command string ! ascii " word count shell$ place ; : dos" ( -<string">- ) \ set the dos command string ! ascii " word count dos$ place dos$ +NULL ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 187,200 ---- : editor" ( -<string">- ) \ set the editor command string ! [char] " word count editor$ place ; : browse" ( -<string">- ) \ set the browser command string ! [char] " word count browse$ place ; : shell" ( -<string">- ) \ set the shell command string ! [char] " word count shell$ place ; : dos" ( -<string">- ) \ set the dos command string ! [char] " word count dos$ place dos$ +NULL ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 206,218 **** IN-SYSTEM ! : .quote ( - ) ascii " emit ; ! : type-quoted ( adr n - ) .quote type .quote ; ! : .shell \ display the editor, browser, shell & dos strings ! cr ." EDITOR: " editor$ count type-quoted ! cr ." BROWSE: " browse$ count type-quoted ! cr ." SHELL: " shell$ count type-quoted ! cr ." DOS: " dos$ count type-quoted ! ; synonym .editor .shell DEPRECATED --- 204,226 ---- IN-SYSTEM ! : ,$ ( -< #text#>- ) ! >in @ bl word swap >in ! 1+ c@ ! word count here place here c@ 1+ allot 0 c, align ; ! : .$ ( -< #text#>- ) ! POSTPONE (.") ,$ ; immediate ! ! : s$ ( -< #text#>- ) ! ( -- a1 n1 ) ! POSTPONE (s") ,$ ; immediate ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! : .shell ( -- ) \ display the editor, browser, shell & dos strings ! cr .$ 'EDITOR" ' editor$ count type .$ '"' ! cr .$ 'BROWSE" ' browse$ count type .$ '"' ! cr .$ 'SHELL" ' shell$ count type .$ '"' ! cr .$ 'DOS" ' dos$ count type .$ '"' ; synonym .editor .shell DEPRECATED *************** *** 312,314 **** >R Prepend<home>\ temp$ +place \ file:<absolute path>\<file name>.<ext> temp$ count r> "web-link ; ! \s --- 320,322 ---- >R Prepend<home>\ temp$ +place \ file:<absolute path>\<file name>.<ext> temp$ count r> "web-link ; ! |
|
From: George H. <geo...@us...> - 2007-09-11 09:15:20
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14249/win32forth-stc/src Modified Files: Shell.f Log Message: Index: Shell.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Shell.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Shell.f 7 Jul 2007 14:44:26 -0000 1.1 --- Shell.f 11 Sep 2007 09:15:16 -0000 1.2 *************** *** 5,9 **** \ Moved here from UTILS.F and partly rewritten by Dirk Busch \ Dienstag, März 29 2005 ! cr .( Loading Shell Words...) --- 5,9 ---- \ Moved here from UTILS.F and partly rewritten by Dirk Busch \ Dienstag, März 29 2005 ! cr .( Loading Shell Words...) |
|
From: Alex M. <ale...@us...> - 2007-09-10 19:59:53
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25037 Modified Files: extend.f Added Files: shell.f Log Message: Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.26 retrieving revision 1.27 diff -C2 -d -r1.26 -r1.27 *** extend.f 7 Jul 2007 14:26:15 -0000 1.26 --- extend.f 10 Sep 2007 19:59:49 -0000 1.27 *************** *** 41,45 **** sys-FLOAD src\Dthread.f \ Hash Thread Display. sys-FLOAD src\words.f ! FLOAD src\lib\BROWSEFLD.F \ SHBrowseForFolder() support FLOAD src\Shell.f \ load SHELL utility words --- 41,45 ---- sys-FLOAD src\Dthread.f \ Hash Thread Display. sys-FLOAD src\words.f ! \s FLOAD src\lib\BROWSEFLD.F \ SHBrowseForFolder() support FLOAD src\Shell.f \ load SHELL utility words --- NEW FILE: shell.f --- \ $Id: shell.f,v 1.1 2007/09/10 19:59:49 alex_mcdonald Exp $ \ \ SHELL support \ \ Moved here from UTILS.F and partly rewritten by Dirk Busch \ Dienstag, März 29 2005 cr .( Loading Shell Words...) only forth also definitions IN-APPLICATION \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 6 Old original version of $EXEC, superceeded by the following series of words \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ INTERNAL create StartupInfo here 0 , \ cb 0 , \ lpReserved 0 , \ lpDesktop 0 , \ lpTitle 373 , \ dwX 3 , \ dwY 0 , \ dwXSize 0 , \ dwYSize 80 , \ dwXCountChars 50 , \ dwYCountChars 0 , \ dwFillAttribute STARTF_USEPOSITION STARTF_USECOUNTCHARS + STARTF_USESHOWWINDOW + , \ dwFlags SW_SHOWNORMAL W, \ wShowWindow 0 W, \ cbReserved2 0 , \ lpReserved2 0 , \ hStdInput 0 , \ hStdOutput 0 , \ hStdError here over - swap ! create ProcInfo 0 , \ hProcess 0 , \ hThread 0 , \ dwPriocessId 0 , \ dwThreadId 10 proc CreateProcess : (CreateProcess) ( a1 -- f1 ) \ pass to NT without any interpretation \ Note: a1 must point to a zString !!! ProcInfo 4 cells erase \ clear procinfo >r \ null terminated parameter string ProcInfo \ lppiProcInfo StartupInfo \ lpsiStartInfo 0 \ lpszCurDir 0 \ lpvEnvironment 0 \ fdwCreate 0 \ fInheritHandles 0 \ lpsaThread 0 \ lpsaProcess r> \ lpszCommandLine 0 \ lpszImageName call CreateProcess 0= ; 1 proc CloseHandle : EXEC-CLOSE-THREAD-HANDLE ( -- ) ProcInfo cell+ @ call CloseHandle drop ; : EXEC-CLOSE-PROCESS-HANDLE ( -- ) ProcInfo @ call CloseHandle drop ; : EXEC-CLOSE-HANDLES ( -- ) EXEC-CLOSE-THREAD-HANDLE EXEC-CLOSE-PROCESS-HANDLE ; 2 proc WaitForInputIdle 2 proc WaitForSingleObject : (EXEC-PROCESS-WAIT) { hProcess -- } \ Wait for terminating of a process INFINITE hProcess call WaitForInputIdle WAIT_FAILED <> if begin KEY? drop \ keep the Win32Forth message loop alive 1 hProcess call WaitForSingleObject WAIT_OBJECT_0 = until then ; : EXEC-PROCESS-WAIT ( -- ) \ Wait for terminating the process ProcInfo @ (EXEC-PROCESS-WAIT) ; EXTERNAL : zEXEC ( a1 -- f1 ) \ execute a command line (CreateProcess) ; DEPRECATED \ use zEXEC-CMD or zEXEC-CMD-WAIT instead : zEXEC-CMD ( a1 -- f1 ) \ execute a command line (CreateProcess) dup 0= if EXEC-CLOSE-HANDLES then ; : zEXEC-CMD-WAIT ( a1 -- f1 ) \ execute a command line, and wait for terminating of the process (CreateProcess) dup 0= IF EXEC-CLOSE-THREAD-HANDLE \ close the thread handle EXEC-PROCESS-WAIT \ wait for the process EXEC-CLOSE-PROCESS-HANDLE \ and close the process handle then ; : EXEC-CMD ( a1 -- f1 ) dup +null 1+ zEXEC-CMD ; : EXEC-CMD-WAIT ( a1 -- f1 ) dup +null 1+ zEXEC-CMD-WAIT ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ SHELL support with interpreted string replacement for selected words \ %FILENAME %DIR %LINE \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ INTERNAL named-new$ &execbuf variable &linenum &linenum off : execbuf+ ( a1 n1 a2 -- ) \ append to the exec buffer &execbuf 2dup c@ + MAXCOUNTED > abort" Too long for EXEC buffer" +place ; EXTERNAL true value new-prompt? INTERNAL : $EXECBUF-PREPARE ( a1 -- ) \ preprocess for file and line parameters base @ >r decimal &execbuf off \ pre-zero the buffer count begin 2dup [char] % scan dup while 2dup 2>r nip - execbuf+ 2r> over s" %FILENAME" tuck ISTR= if new-prompt? if cur-file count "path-file if cr ." File doesn't exist, create it? [Y/N] (N):" key upc 'Y' <> abort" Aborting" then execbuf+ else cur-file count execbuf+ then 9 /string \ remove %FILENAME else over s" %DIR" tuck ISTR= if &prognam count 2dup "to-pathend" nip - execbuf+ 4 /string \ remove %DIR else over s" %LINE" tuck ISTR= if &linenum @ 0 <# #s #> execbuf+ 5 /string \ remove %LINE else over 1 execbuf+ 1 /string \ remove one % char then then then repeat nip - execbuf+ r> base ! ; EXTERNAL : $EXEC ( a1 -- f1 ) \ Invoke a DOS command string with \ preprocess for file and line parameters \ f1 = TRUE on error $EXECBUF-PREPARE &execbuf EXEC-CMD ; : $EXEC-WAIT ( a1 -- f1 ) \ Invoke a DOS command string with \ preprocess for file and line parameters \ and wait for terminating of the process. \ f1 = TRUE on error $EXECBUF-PREPARE &execbuf EXEC-CMD-WAIT ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ create editor$ ," %DIRWinEd.exe '%FILENAME' %LINE" MAXSTRING allot-to create browse$ ," %DIRWinEd.exe /B '%FILENAME' %LINE" MAXSTRING allot-to create shell$ ," CMD /C " MAXSTRING allot-to create dos$ ," CMD" MAXSTRING allot-to : editor" ( -<string">- ) \ set the editor command string [char] " word count editor$ place ; : browse" ( -<string">- ) \ set the browser command string [char] " word count browse$ place ; : shell" ( -<string">- ) \ set the shell command string [char] " word count shell$ place ; : dos" ( -<string">- ) \ set the dos command string [char] " word count dos$ place dos$ +NULL ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ User specifiable string delimiter utility \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ IN-SYSTEM : ,$ ( -< #text#>- ) >in @ bl word swap >in ! 1+ c@ word count here place here c@ 1+ allot 0 c, align ; : .$ ( -< #text#>- ) POSTPONE (.") ,$ ; immediate : s$ ( -< #text#>- ) ( -- a1 n1 ) POSTPONE (s") ,$ ; immediate \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : .shell ( -- ) \ display the editor, browser, shell & dos strings cr .$ 'EDITOR" ' editor$ count type .$ '"' cr .$ 'BROWSE" ' browse$ count type .$ '"' cr .$ 'SHELL" ' shell$ count type .$ '"' cr .$ 'DOS" ' dos$ count type .$ '"' ; synonym .editor .shell DEPRECATED synonym .dos .shell DEPRECATED synonym .browse .shell DEPRECATED \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 10 A utility to allow invoking a DOS shell on a following commandline \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ IN-APPLICATION INTERNAL create shell-name$ ," SHELL.BAT" MAXSTRING allot-to create shell-buf MAXSTRING allot 0 value ?shell-pause EXTERNAL : $shell ( a1 -- ) dup c@ if shell-name$ count w/o create-file \ make the file abort" Couldn't create SHELL.BAT" >r \ save file handle ( a1 ) count r@ write-file drop \ write commandline crlf$ count r@ write-file drop \ line terminator ?shell-pause if s" PAUSE" r@ write-file drop \ wait for results crlf$ count r@ write-file drop \ line terminator then r> close-file drop \ close the file shell$ count shell-buf place \ the command shell-name$ count shell-buf +place \ append batch name shell-buf EXEC-CMD drop \ perform command else drop ?shell-pause if dos$ EXEC-CMD drop then then ; : shell ( -<string>- ) true to ?shell-pause 0 word $shell ; : dos ( -<string>- ) false to ?shell-pause 0 word $shell ; synonym ` shell DEPRECATED synonym sys shell DEPRECATED \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 25 HTML linkage support \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 6 proc ShellExecute : ("ShellExecute) { operation addr cnt hWnd -- errorcode } \ open file using default application SW_SHOWNORMAL \ nShowCmd Null \ default directory Null \ parameters addr cnt asciiz \ file name to execute operation \ operation to perform hWnd \ parent Call ShellExecute ; : "ShellExecute { addr cnt hWnd -- errorcode } \ open file using default application z" open" addr cnt hWnd ("ShellExecute) ; : "Web-Link { adr len hWnd \ web$ -- } \ open the Web link supplied, using the web browser LMAXSTRING LocalAlloc: web$ web$ off \ reset buffer initially adr len bl skip -trailing to len to adr \ remove leading & trailing blanks adr len 4 min s" WWW." caps-compare 0= \ if www. present adr len 5 min s" FILE:" caps-compare 0= or \ or http: present adr len 5 min s" HTTP:" caps-compare 0= or \ or http: present adr len 5 min s" NEWS:" caps-compare 0= or \ or news: present adr len 4 min s" FTP:" caps-compare 0= or \ or ftp: present adr len 4 min s" FTP." caps-compare 0= or \ or ftp. present adr len 7 min s" MAILTO:" caps-compare 0= or \ or mailto: present len 0= or \ or NULL string IF adr len web$ LPLACE \ then pass through un-modified ELSE s" www." web$ LPLACE \ else prepend "www." adr len web$ +LPLACE \ append specified string s" .com" web$ +LPLACE \ append ".com" THEN web$ +LNULL \ null terminate string web$ @ \ if there is any thing there IF web$ lcount hwnd "ShellExecute drop \ tell Windows we want this link ELSE beep THEN ; : Web ( -<www.???.com>- ) \ open the Web link specified, using the Web browser bl word count conhndl "Web-Link ; : "file-link ( adr len hWnd -- ) \ open a local file in default browser s" file:" temp$ place \ build string >R Prepend<home>\ temp$ +place \ file:<absolute path>\<file name>.<ext> temp$ count r> "web-link ; |
|
From: wyndham L. <wyn...@ma...> - 2007-09-04 17:46:30
|
Hi bro wyndham wow, i never knew my banger could grow so big Maged Gunderson http://www.dfendme.com/ |
|
From: Esperanza L. <dus...@kf...> - 2007-09-04 07:51:35
|
Good afternoon, buddy! You asked me about this picture! Best Regards. |
|
From: Roar h. <hut...@ak...> - 2007-08-31 08:23:15
|
http://adyms.com/ Hi hutcihns Hey Mr. here is how to score all the women... Capen Fletcher |
|
From: Mihail <ma...@rt...> - 2007-08-23 15:51:08
|
JCXZ compil $67 code wrongly |
|
From: tolga D. <Dow...@at...> - 2007-08-20 19:39:59
|
http://finance.yahoo.com/q?s=3DEXMT.PK |
|
From: Marat H. <Hig...@sa...> - 2007-08-20 03:27:32
|
H,E*R-E WE GO AGAIN_! T'H_E B I'G O N_E BEF ORE T*H E SEP+TEM+BER.RALLY! T.H,E MA*RKET IS AB+OUT TO P_O+P_, A,N_D SO IS E*X+M'T.! Tick,: E*X'M+T 5-d'ay po.ten*tial: 0+.-4.0 Fir+m: EXC*HAN GE M OBILE T+E.L,E (Oth'er O,T,C*: EXMT+.PK) A's_k_: 0,. 1,0 (+25.*,00%) UP TO 2*5.% in 1 day N o-t o n,l_y d*o,e_s t*h'i's f+i.r'm h a+v-e gre+at fu,ndament+als, b*u*t g'etting t*h,i,s opp'o+rtunity at t-h+e r'ight t+i'm'e , rig'ht befo_re t h.e rall*y is w*h_a_t ma,kes t'h,i,s d.e.a-l so swee.t! = T.h i.s a g.reat opportun*it y to at le_ast doubl+e up! T+h.e chie.f of t+h e Gesta po w-a s s_upp_osed to be g*oing by. There , on t'h+e ou'tsid,e, he coul+d sti.ll re'main at le-ast a decen-t = cit_izen', hones_t ly if flabbil',y earni-ng h+i*s p+a.y'. T.h*i-s is t,h*e cli*ent to u-s-e w_i.t-h t*h,e Adm,inistrato'r Ve = rsion. G.e*t*s or s e_t's t h_e p-ara'meter n+ames of t-h'e meth,od c,a l+l-. A.d d unow.ned thre,ad Ho*lder pse.ud*oprocess. |
|
From: sfsd H. <Hue...@ph...> - 2007-08-19 13:16:57
|
H+E.R+E WE GO AGAI-N! T+H_E B,I*G O.N,E BEF+ORE T.H.E SEPTEMBE_R .RALLY! T+H+E MAR*KET IS ABOU-T TO P*O*P-, A-N_D SO IS E X*M.T ! T_ick: E*X.M_T 5- day pot enti,al: 0..+4.0 Firm_: E,XCH-ANGE MOBI_LE T.E'L*E (Ot*her O'T.C : EXMT*.PK) A.s_k,: 0...1+0 (+25_.00%*) UP TO 2.5,% in 1 day N.o+t o-n'l,y d.o'e_s t+h_i+s f-i r,m h-a_v-e gr+eat fundamen't+als, b'u,t ge,tting t_h,i s oppor.tun+ity at t h-e ri'ght t.i_m+e*, r'ight befor-e t+h-e rall-y is w'h,a_t mak,es t'h_i_s d.e'a'l so sw'eet! = T h*i's a grea t o-p portunity to at lea st dou+ble up! T-here w+a_s no d-oubt ab-out it. Re-pre*sents t h-e H'ijri calen_.dar. T'h'i s allo-ws d_a+t*a as*so ciated w,i,t.h poi-,nters to ch,ange = s'i'z.e w-i,t.h t_h,e cha,nge in p-ointer s.i.z,e as applica*tio.ns a,r = e comp*il,ed f o r a 3+2'- or 6,4-bit pla tf_orm. H+o*w m+a.n y d*ocu'ments c'a.n be cached.. If b'i t z+e,r o of al c+ontai.ns z-ero, t+h.e n t+h.e resul+t is = z-e_r*o a.n-d t.h,e t_e s t ope_ra,tion s'e,t_s t+h.e z+e r o f'l+a g,. |
|
From: renaf H. <ren...@sh...> - 2007-08-18 15:33:24
|
T,H_E B*I+G O_N'E BEFOR*E T_H_E SEPTEMBER. _RALLY! H*E*R.E WE GO AGAI.N! T_H,E MARKE+T IS ABO'UT TO P O'P., A'N*D SO IS E-X'M T+! T_ick: E*X+M_T Firm_: EXCH*,ANGE M.OBILE T*E,L-E (Othe*r O.T_C.: EXM.T.PK) 5-da y pote+nti_al: 0'.*4-0 A s,k*: 0 .'1'0 (+*_25.00%) (.U-P TO 2'5 % in 1 d_a.y*) N-o,t o_n.l y d+o-e*s t-h*i's f.i-r m h.a v*e gr_eat f+unda mentals, b u*t getti-ng t-h+i-s op+port,unity at t'h-e righ't t-ime, ri_ght be,fore t-h e ra,lly is w+h.a+t make+s t*h i's d,e-a-l so swee-t! T'h,i+s a grea,t opportu+n'ity to at l_east doubl*e up! T,h_i_s w,a*r h'a's a v'e,r*y di -stinct sm ell of h eroin, b-u-t it wo uld be utte'rly wro*ng to th+ink t+h,a+t t h*e Russ_ian Gove,rnm.ent is s,imply tryin g to c+u*t t+h'e o'l*d drug- ,trafficking ro ots. Dev'elopin g F+i l e Sys'tems 4 A'pril in Bos_ton, MA. Creat+e an arra*y of characte,'rs t_h a.t is 2'6-5 byte*s l_o n+g,. No n-ursery w*o-r k f.o-r h-e-r,, tha.nks. B u,t put.ting up a fen_ce arou nd h-e_r', t*h a*t won_'t w-o.r k'. |
|
From: Eric f. <for...@sp...> - 2007-08-18 05:32:28
|
H_E,R+E WE GO AGAIN.! T,H+E B I,G O+N-E BEFOR,E T.H'E SE PTEMBER.-RALLY! T_H,E MARKE.T IS ABOU-T TO P-O_P_, A.N_D SO IS E_X*M+T.! Fir'm: EXCH*AN,GE MO+BILE T+E*L_E (Ot*her O_T-C+: EX.MT.PK) Ti*ck: E_X+M+T A-s-k : 0_..1 0 (-+25+.00%) (_U,P TO 2+5*% in 1 d a-y+) 5-da.y p'-otential: 0'.+4+0 T'h i,s a g,reat opportun.it+y to at leas t dou,ble up! N.o_t o_n,l.y d'o+e_s t*h_i s f+i,r.m h_a*v+e grea+t funda,men_tals, b_u't getti+ng t+h i+s oppor.tunit y at t'h+e r ight ti'me, r.ight be-fore t*h_e ral_ly is w.h*a*t mak-es t_h+i_s d_e a l so s.weet! Wa'tch it s+o,a+r ! B u*t-, 0 m o's't attent*i_ve of a,l,l yo_uths, I sugge'st we s'i+t d.o_w-n on t*h-i.s benc,h in ord*er t*h*a_t y.o+u_r youn+g l*e g-s d,on't t+i*r.e dur'ing t h+i's l'o'n.g a_n.d m*o.s+t education+a l st.ory. S*h*e t+o'r-e up litt_le b,i*t*s of pa-per a_n'd sho'wer,ed t'h+e.m on to Pyo-tr Leoni'dovic.h w-h'o w-a s l*ying on t,h,e b_e,d,. A t,h*a-t repre.sen ts t-h'e t y'p_e of o_bject t_h a t wa,nts t*h*e lic*ense. A*ctually', I.''m lookin.g f.o,r som*eone. On t,w o AP_Cs, al_ong w*i_t,h t+h_e re con sq-uad I s.e_t o,f,f to p'i-c.k up "*t'h,e clapp*er"+. |
|
From: Kevyn F. <FI...@du...> - 2007-08-17 19:25:04
|
H+E*R+E WE GO AGA+IN! T,H,E B-I+G O_N+E BEFO'RE T+H*E S.EPTEMBER+.RALLY! T'H*E MAR KET IS ABO_UT TO P,O*P*, A N'D SO IS E'X_M+T,! F irm: EX+CHAN,GE MOBI.LE T.E,L+E (O+ther O-T.C': EXMT.P+K) Tic'k: E*X,M-T A+s-k-: 0*.*0+8 5-da'y pote._ntial: 0*. 4.0 T-h.i-s a gre,at oppo,rtuni-ty to at lea+st d-ouble up! N'o*t o,n+l'y d,o+e s t+h i,s f.i*r*m h+a*v*e grea't fu.nd amentals, = b+u_t gettin-g t*h-i s opportu*ni'ty at t*h,e rig+ht time', ri.ght befor = e t+h-e ral+ly is w,h a+t m'akes t-h'i+s d*e*a_l so sw-eet! Wa+tch it s o a.r.! In gen,er*al, y,o*u shou_l'dn't b+other at a l*l w*i t'h thes-e cal-ls = sinc*e MS-DO,S v2. However, , i't+'_s n'o,t docu.'mented a*n'd I haven'+t f_ound a,n_y = reve*rse en-gin*eering of it any,pla'ce. Do_n't m o*v_e or resi_ze w.idows durin+g t'h-e t+est, don,'t do = an-ything*. Type-b+ou'nd proce.-dures (equi va*lent to meth,-ods), rea*d-o*nly = expor,t of v,ariabl+es a+n d recor+d fi-elds, o-p-e n ar-ray = var*iable+s, a-n.d a ' with' sta*tem+ent w-i,t,h var+ian*ts. In t h i.s c+ase, t+h,e y a,r e fra mes wit hin t*h*e me_dia f*i_l e to = s,tart a'n'd s't*o_p pl'ayb_ack. |
|
From: Alex M. <ale...@us...> - 2007-08-17 02:57:26
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17159/src/kernel Modified Files: gkernel.f Log Message: arm: chnages to support forth200x, add lastchar and -trailchar to kernel Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.42 retrieving revision 1.43 diff -C2 -d -r1.42 -r1.43 *** gkernel.f 12 Jul 2007 21:00:18 -0000 1.42 --- gkernel.f 17 Aug 2007 02:57:20 -0000 1.43 *************** *** 1601,1604 **** --- 1601,1609 ---- mov eax, ecx next; + + code lastchar ( str -- char ) \ returns last character from c-string + movzx ecx, byte [eax] + movzx eax, byte [eax] [ecx] + next c; \ --------------------------- Perform --------------------------------------- *************** *** 1939,1943 **** : -trailing ( addr n1 -- addr n2 ) \ remove trailing blanks from addr,n1 bl -trailchars ; ! : -nulls ( addr n1 -- addr n2 ) \ remove trailing nulls from addr,n1 0 -trailchars ; --- 1944,1948 ---- : -trailing ( addr n1 -- addr n2 ) \ remove trailing blanks from addr,n1 bl -trailchars ; ! : -nulls ( addr n1 -- addr n2 ) \ remove trailing nulls from addr,n1 0 -trailchars ; *************** *** 2400,2405 **** then ; : unnest ( -- ) \ generate a return ! $c3 code-c, ; immediate \ -------------------- Various support words -------------------------- --- 2405,2416 ---- then ; + gcode _unnest \ ret code (compile) + ret + ;g + : unnest ( -- ) \ generate a return ! (comp-only) ! compilation> drop ! _unnest (copy-code) ; \ -------------------- Various support words -------------------------- *************** *** 3249,3253 **** code >number ( ud addr len -- ud addr len ) ! 3 3 in/out test eax, eax \ check if anything to convert je short @@4 \ zero, so skip --- 3260,3264 ---- code >number ( ud addr len -- ud addr len ) ! 4 4 in/out test eax, eax \ check if anything to convert je short @@4 \ zero, so skip *************** *** 3267,3276 **** cmp eax, edi jae short @@3 \ out of base range - \ xchg eax, 4 [ebp] \ high word * base mov edx, eax mov eax, 4 [ebp] \ swap eax <-> 4 [ebp] mov 4 [ebp], edx mul edi - \ xchg eax, 8 [ebp] \ low word * base mov edx, eax mov eax, 8 [ebp] \ swap eax <-> 8 [ebp] --- 3278,3285 ---- *************** *** 4262,4266 **** dup code-here swap - swap cell- ! ; : >resolve ( dest -- ) \ fixup relative jump to dest - sync-code code-here - code-here cell- ! ; --- 4271,4274 ---- *************** *** 4578,4582 **** \ EXIT compiles __LOCALFREE, but leaves LOCALSTK alone so that ; can ! \ also compile __LOCALFREE : exit ( -- ) \ exit current word --- 4586,4590 ---- \ EXIT compiles __LOCALFREE, but leaves LOCALSTK alone so that ; can ! \ also compile __LOCALFREE : exit ( -- ) \ exit current word |
|
From: Alex M. <ale...@us...> - 2007-08-17 02:57:26
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17159/src Modified Files: Class.f numconv.f paths.f xfiledlg.f Log Message: arm: chnages to support forth200x, add lastchar and -trailchar to kernel Index: numconv.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/numconv.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** numconv.f 21 May 2007 08:38:46 -0000 1.2 --- numconv.f 17 Aug 2007 02:57:20 -0000 1.3 *************** *** 72,109 **** \ 0 value -ve-num? \ negate value flag - new-chain number?-chain - - : -ifzerothrow ( n -- n ) - dup 0= throw \ -1 throw if zero length - ; - : -ve-test ( addr len -- addr' len' ) \ skip possible - sign, set -ve-num? ! -ifzerothrow \ stop if nothing to convert ! over c@ [char] - = \ check for sign ! if -ve-num? throw \ if already negative, throw true to -ve-num? 1 /string \ bump past - -ifzerothrow \ nothing left is error then ; : run-numchain ( addr len -- d1 ) \ run number chain; ! \ d1 is number, or -13 throw (undefined) ! 2>r \ save string on rstack ! number?-chain \ run the number chain ! begin @ dup ! while num-init \ clear the flags ! dup 2r@ rot \ string xt ! cell+ @ catch \ do the xt ! 0= if \ leave if no error ! 2r> 2drop \ clean the rstack ! rot drop \ drop the address -ve-num? if dnegate then \ make negative if asked to exit then - 2drop \ clear out failed conversion repeat - -13 throw \ failed to convert ; --- 72,102 ---- \ 0 value -ve-num? \ negate value flag : -ve-test ( addr len -- addr' len' ) \ skip possible - sign, set -ve-num? ! dup 0= throw \ stop if nothing to convert ! over c@ [char] - = if \ check for sign ! -ve-num? throw \ if already negative, throw true to -ve-num? 1 /string \ bump past then ; + new-chain number?-chain + : run-numchain ( addr len -- d1 ) \ run number chain; ! number?-chain >r ! begin r> @ dup>r \ save link address ! while num-init \ clear the flags ! 2dup r@ cell+ @ \ work on copy of the string ! base @ >r \ save the base ! catch \ do the xt ! r> base ! \ restore the base ! if 2drop \ failed, so clear out failed try again ! else ! r>drop 2nip \ clean rstack and clear string -ve-num? if dnegate then \ make negative if asked to exit then repeat -13 throw \ failed to convert ; *************** *** 113,127 **** : dotted-number? ( addr len -- d1 ) -ve-test ! 0 0 2SWAP >NUMBER \ convert number ! dup if OVER C@ [CHAR] . = \ next char is a '.' ? ! if ! dup 1- to DPL true to double? 1 /string >number \ convert the rest then - dup 0<> throw \ check no string then ! 2drop \ otherwise, drop string ; --- 106,127 ---- : dotted-number? ( addr len -- d1 ) -ve-test ! 0 0 2swap >number \ convert number ! dup if ! over c@ [char] . = if \ next char is a '.' ? ! dup 1- to dpl true to double? 1 /string >number \ convert the rest then then ! dup 0<> throw \ check no string ! 2drop \ drop string ! ; ! ! : quoted-number? ( addr len -- d1 ) \ 'x' type numbers ! 2 <> throw \ not 3 chars 'x' ! dup c@ swap ! 1+ c@ [char] ' <> throw ! 0 ; *************** *** 133,197 **** \ % -- binary ! : base-tonum ( addr len base -- d1 ) ! base @ >r base ! \ save base, set base ! ['] dotted-number? catch \ convert ! r> base ! \ restore base ! throw \ throw if in error ! ; ! ! : xbase-convert ( addr len base -- d1 ) ! >r 1 /string r> \ past base char ! base-tonum ! ; ! : base-number? ( addr len -- d1 ) \ [-][$&%#][-]n[n*][.n*] -ve-test \ might start with - ! over c@ ! case ! [char] $ of 16 xbase-convert endof ! [char] & of 10 xbase-convert endof ! [char] # of 10 xbase-convert endof ! [char] % of 2 xbase-convert endof ! drop dotted-number? dup ! endcase ! ; ! : new-number ( str len -- d1 ) \ d1 is number, or -13 throw (undefined) ! localbuff >r ! r@ place r> ?uppercase count \ uppercase a copy ! run-numchain ; \ run the chain \ ------------------------ 0x[L] hex number ----------------------------------- - : lastchar ( addr len -- addr len char ) - 2dup 1- + c@ ; - : 0x-number? ( addr len -- d1 ) ! -ve-test \ might start with - ! over 2 s" 0X" str= 0= throw \ start with 0X? 2 /string \ bump past 0x ! -ifzerothrow \ throw if too short ! lastchar [char] L = + \ end in L? trim off if so ! 16 base-tonum \ convert hex string ! ; ! ! \ -------------------------- xH hex number ------------------------------------ ! ! : hex-number? ( addr len -- d1 ) \ xxxxH type numbers ! -ifzerothrow \ throw if too short ! lastchar [char] H <> throw \ end in H? ! 1- 16 base-tonum \ trim off, convert ! ; ! ! \ --------------------------- '.' number -------------------------------------- ! : quoted-number? ( addr len -- d1 ) \ 'x' type numbers ! -ve-test \ might be negative ! 3 <> throw \ not 3 chars 'x' ! dup dup c@ swap 2 + c@ \ fetch first and third chars ! over = swap [char] ' = ! and invert throw \ equal and ', otherwise error ! 1+ c@ 0 \ fetch the character ! ; \ ------------------------ Windows Constant Server ---------------------------- --- 133,165 ---- \ % -- binary ! create base-list 10 , 16 , 2 , 10 , 0 , ! \ # $ % & ' ! : base-number? ( addr len -- d1 ) \ [-][$%#][-]n[n*][.n*] -ve-test \ might start with - ! over c@ [char] # - dup 5 u< if ! base-list +cells @ base ! \ set base ! 1 /string ! else drop then ! base @ 0= if \ convert ! quoted-number? ! else ! dotted-number? ! then ; ! number?-chain chain-add base-number? ! ' run-numchain is number \ replace normal number conversion ! \ with the new chain scheme \ ------------------------ 0x[L] hex number ----------------------------------- : 0x-number? ( addr len -- d1 ) ! dup 3 < throw \ if too short throw ! over 2 s" 0X" istr= 0= throw \ start with 0X? 2 /string \ bump past 0x ! 2dup + 1- c@ upc 'L' = + \ end in L? trim off if so ! 16 base ! dotted-number? ; ! number?-chain chain-add 0x-number? \ ------------------------ Windows Constant Server ---------------------------- *************** *** 200,206 **** winlib-last @ constant WinConLib 3 proc wcFindWin32Constant - \ winproc-last @ constant WinConPtr \ for **WORDS.F** 3 proc wsEnumWin32Constants - \ winproc-last @ constant WinEnumPtr \ for **WORDS.F** : wincon-call ( a1 -- n f ) \ call to find constant --- 168,172 ---- *************** *** 209,216 **** ; ! : wincon-number? ( a1 n1 -- d ) \ find constant; already uppercased ! maxstring localalloc dup>r \ allocate a buffer ! place r@ wincon-call 0= \ find constant ! if drop \ drop returned value s" A" r@ +place \ append an 'A' --- 175,181 ---- ; ! : wincon-number? ( a1 n1 -- d ) \ find constant ! localbuff dup>r place r@ ?uppercase \ uppercase a copy ! wincon-call 0= if \ find constant drop \ drop returned value s" A" r@ +place \ append an 'A' *************** *** 220,257 **** ; - \ ------------------- Dotted IP notation (a.b.c.d) ------------------------------ - - : ip-seg ( addr len -- addr' len' n ) \ IP segment before . - dup >r \ save length - 0 0 2swap >number \ convert to number - 2swap d>s \ save string & convert to single - over r> <> \ check lengths differ before & after - over 0 256 within \ and range check it - and 0= throw \ flag; true=error - ; - - : ip-number? ( addr len -- d ) \ convert ip address - 8 24 do \ 3 dotted segments - ip-seg \ convert up to dot - i lshift \ shift the value, - -rot \ addr string to top - -ifzerothrow \ string too short? - over c@ [char] . <> throw \ check for a dot, error if not - 1 /string \ move past . - -8 +loop \ next shift - ip-seg \ convert what's left - -rot throw \ should be nothing left - drop or or or 0 \ ors to get result, make double - ; - - number?-chain chain-add base-number? - number?-chain chain-add quoted-number? - number?-chain chain-add hex-number? - number?-chain chain-add 0x-number? number?-chain chain-add wincon-number? \ windows constant server - number?-chain chain-add ip-number? \ dotted IP notation - - ' new-number is number \ replace normal number conversion - \ with the new chain scheme \ ------------------- Compatability layer -------------------------------------- --- 185,189 ---- *************** *** 260,264 **** ' 2drop is discard-number \ for doubles; see float.f for floats ! : number? ( addr len -- d f ) \ to support >float num-init ['] dotted-number? catch 0= --- 192,196 ---- ' 2drop is discard-number \ for doubles; see float.f for floats ! : number? ( addr len -- d f ) \ to support >float; should be done in decimal num-init ['] dotted-number? catch 0= *************** *** 316,317 **** --- 248,294 ---- + + (( unused so far + \ ------------------- Dotted IP notation (a.b.c.d) ------------------------------ + : ip-seg ( addr len -- addr' len' n ) \ IP segment before . + dup >r \ save length + 0 0 2swap >number \ convert to number + 2swap d>s \ save string & convert to single + over r> <> \ check lengths differ before & after + over 0 256 within \ and range check it + and 0= throw \ flag; true=error + ; + + : ip-number? ( addr len -- d ) \ convert ip address + 8 24 do \ 3 dotted segments + ip-seg \ convert up to dot + i lshift \ shift the value, + -rot \ addr string to top + -ifzerothrow \ string too short? + over c@ [char] . <> throw \ check for a dot, error if not + 1 /string \ move past . + -8 +loop \ next shift + ip-seg \ convert what's left + -rot throw \ should be nothing left + drop or or or 0 \ ors to get result, make double + ; + + number?-chain chain-add ip-number? \ dotted IP notation + )) + + (( unused so far + \ -------------------------- xH hex number ------------------------------------ + + : hex-tonum ( addr len base -- d1 ) + 16 base ! dotted-number? ; + + : hex-number? ( addr len -- d1 ) \ xxxxH type numbers + -ifzerothrow \ throw if too short + lastchar [char] H <> throw \ end in H? + 1- hex-tonum \ trim off, convert + ; + + number?-chain chain-add hex-number? + )) + + Index: xfiledlg.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/xfiledlg.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** xfiledlg.f 3 May 2007 09:10:51 -0000 1.1 --- xfiledlg.f 17 Aug 2007 02:57:20 -0000 1.2 *************** *** 158,165 **** \ August 31st, 2003 - 12:58 dbu (SF-ID 745382) :M SetDir: ( a1 n1 -- ) \ set the dialog directory string max-handle 2 - min szDir place \ lay in the directory szDir +NULL \ null terminate - \ szDir count upper \ make path uppercase - dbu - szDir ?-\ \ remove trailing \ ;M --- 158,164 ---- \ August 31st, 2003 - 12:58 dbu (SF-ID 745382) :M SetDir: ( a1 n1 -- ) \ set the dialog directory string + '\' -trailchars max-handle 2 - min szDir place \ lay in the directory szDir +NULL \ null terminate ;M Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** Class.f 12 Jul 2007 21:00:18 -0000 1.13 --- Class.f 17 Aug 2007 02:57:20 -0000 1.14 *************** *** 83,87 **** : ?isSel ( str -- str f1 ) \ f1 = true if it's a selector ! dup ':' endchar? ; \ ends in ':' : >selector ( str -- SelID ) \ get a selector from the input stream --- 83,87 ---- : ?isSel ( str -- str f1 ) \ f1 = true if it's a selector ! dup lastchar ':' = ; \ ends in ':' : >selector ( str -- SelID ) \ get a selector from the input stream Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/paths.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** paths.f 6 Jul 2007 09:06:39 -0000 1.8 --- paths.f 17 Aug 2007 02:57:20 -0000 1.9 *************** *** 60,95 **** 2dup "minus-ext" nip /string ; ! : "TO-PATHEND" ( a1 n1 --- a2 n2 ) \ *G return a2 and count=n1 of filename 2dup \ save originals ! MAX_PATH LOCALALLOC ascii-z dup \ make zstring on the stack call PathFindFileName \ find the file part swap - /string \ remove the chars from caller ; ! ! : endchar? ( a1 char -- flag ) ! \ *G check the end character in a c-string ! swap dup c@ + c@ = ; ! ! : ?-\ ( a1 -- ) ! \ *G delete trailing '\' if present ! dup [char] \ endchar? \ end in '\'? ! if -1 swap c+! \ if so, delete it ! else drop \ else discard a1 ! then ; : ?+\ ( a1 -- ) \ *G append a '\' if not already present ! dup [char] \ endchar? \ end in '\'? ! if drop \ discard a1 ! else s" \" rot +place \ if not, append \ ! then ; : ?+; ( a1 -- ) \ *G append a ';' if not already present ! dup [char] ; endchar? \ end in ';'? ! if drop \ discard a1 ! else s" ;" rot +place \ if not, append ; ! then ; \ ------------------------------------------------------------------------ --- 60,81 ---- 2dup "minus-ext" nip /string ; ! : "to-pathend" ( a1 n1 --- a2 n2 ) \ *G return a2 and count=n1 of filename 2dup \ save originals ! max_path localalloc ascii-z dup \ make zstring on the stack call PathFindFileName \ find the file part swap - /string \ remove the chars from caller ; ! ! : ?c+place ( addr char -- ) \ append char if not present ! over lastchar over <> if swap c+place else 2drop then ; : ?+\ ( a1 -- ) \ *G append a '\' if not already present ! '\' ?c+place ; : ?+; ( a1 -- ) \ *G append a ';' if not already present ! ';' ?c+place ; \ ------------------------------------------------------------------------ |
|
From: Alex M. <ale...@us...> - 2007-08-17 02:57:25
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17159 Modified Files: gkernel.exe Log Message: arm: chnages to support forth200x, add lastchar and -trailchar to kernel Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.49 retrieving revision 1.50 diff -C2 -d -r1.49 -r1.50 Binary files /tmp/cvsYy3AKU and /tmp/cvsARP0vP differ |
|
From: Alex M. <ale...@us...> - 2007-08-17 02:56:13
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16779 Modified Files: primutil.f Log Message: arm: correct 2constant, add 2value Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.37 retrieving revision 1.38 diff -C2 -d -r1.37 -r1.38 *** primutil.f 7 Jul 2007 14:26:15 -0000 1.37 --- primutil.f 17 Aug 2007 02:56:08 -0000 1.38 *************** *** 121,126 **** : 2constant ( n m "name" ) ! create , , ! does> 2@ ; : 2+! ( d1 a1 -- ) \ double accumulate --- 121,128 ---- : 2constant ( n m "name" ) ! >system create , , dp> does> 2@ ; ! ! : 2value ( n m name ) ! create , , does> 2@ ; : 2+! ( d1 a1 -- ) \ double accumulate |
|
From: juston M. <Ma...@e-...> - 2007-08-16 10:55:37
|
C,Y_T*V T,akes Investo,+rs F+o*r Secon-d C_limb! Ev_-eryone Is Watchi-n,g C'Y-T.V*! C_HINA YOUT.V C*O,R'P (CYTV,.O-B) $0.4.6 UP F*R'O'M . 3-2 LASTWE-EK C.Y+T.V conti.nu'es i-t-s s teady cl_imb f'o'r t-h e sec'ond w,eek. Sto,ck repo,rtin-g sit'es ac'ross t,h e bo,ard a_r_e issu,ing s-tock w*atch no'*tices. R'e*a,d t h-e new*s, l*o'o*k at t_h,e numbers'-, a.n*d g+e,t on C'Y,T.V as it ke_eps i t+s cl_imb g+oing. Busin+ess NewsNow h-a-s re.lea_sed C,Y-T,V as f eatur+ed S_tockWatc*h. T-h i-s o'n*e is st+ill cook-in-g. Go r*e'a-d t,h_e n+e w.s a.n.d g*e-t on C.Y*T_V Thurs+d-ay 16'th.! Enjo_y t.h_e R,i+d-e as we are.+.... G*O_O D L,U,C'K TR'ADING AT T-H.E TO'P!!! Nam.ing ha*ndle a,n+d h-andle t-y*p*e c,a-n be d.o,n'e v,i_a c'alling N_tQueryObjec t. E''veryone h_a,s a fa iling of s o m-e sor't, b+u_t w_h y l-e't oth_ers reali.se it. It w_a_s he w-h*o tau*ght t_h_e but.ler to s.a,y , "_M_y l a+d_y is served,+," a_n*d w'h'o ins+iste+d on h_anding h e.r la,dysh ip in to din-ner. Pr'es_ervation of t'h-e siz.es of column+s. Pr*es-sing t+h*e butt'ons on t-h*e m a'i-n di-alog w i l l h_a*v e no a-pp-arent ef fect on t'h e ap'plicati-on unles_s the-re a,r e bre akpoin ts in t h_e as+sociate+d c*o-d'e*. |
|
From: Earnestine M. <lin...@bu...> - 2007-08-16 08:12:30
|
|
From: Parikshit N. <Par...@me...> - 2007-08-15 17:04:58
|
T'h-i,s g*e,m is re ally movabl'e,!! T,h_i-s o'n e is re,ally prof_itabl_e!!! H+a.v-e y o'u b+e+e.n watch,in g t,h,i+s f'o.r t+h'e l-a.s t w_e*e.k,? T'a.k+e a l+o_o.k at it: rec,ent n+e+w-s r-_eleases s.e.n-t gen'er ating growin'g in-te,rest in C.Y'T.V C_om,pany: C.HINA YO,UTV C.O-R+P (-O T+C BB:CYT,V.O+B) S t o c k: C*Y.T-V Cu,rrent Pric e: $*..4.9 4't h St-raigh.t d a-y*s we h a.v.e s.e,e'n t,h.i-s cl_imb. (-S'e'e Yah+oo Chart'_-New N*e.w,s rel*ease) T_h i-s o.n-e h_a,s h.a+d n*i-c-e retur+ns f,o,r i'nvestor_s o'v-e.r t*h_e summer,, and n*o.w show,s pr,omise to b.egin a s+econd w a-v,e of r+eturns. K.e.e-p a e.y,e o-u,t ag+ain on Wedne*s,day A_u_g 15..... Anywa.y, n+o.n+e of w+h*a.t t.h-e y thin*k matter*s. If it is ze+ro, a r.eason+able defa ult s+i*z-e is u_s_e d.. Y'o+u don'*t n,e_e d to un d*erstand w_h,a.t t.h-i*s is to g.e_t it to w.o.r k . T h*i.s sam,ple re+qui.res Vis ual B-asic 6. H.i+g'h Ca,pa_city Stor.age Syste+m. |
|
From: Nigel M. <sie...@ar...> - 2007-08-15 15:42:45
|
|
From: Yong H. <pas...@st...> - 2007-08-09 16:33:59
|
1040 messages has been excluded from this view by a project administrator.
