From: Dirk B. <db...@us...> - 2006-09-23 10:18:41
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv19498/src Modified Files: callback.f exception.f extend.f paths.f primutil.f Removed Files: console.f lineedit.f Log Message: Proted the latest Console-code and the LineEditor. Index: exception.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/exception.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** exception.f 21 Sep 2006 16:26:33 -0000 1.1 --- exception.f 23 Sep 2006 10:18:34 -0000 1.2 *************** *** 7,17 **** arm 15/08/2005 22:56:45 First version 0.1 STC based kernel - ! ------------------------- End Change Block ----------------------------- ! Experimental: a fully optimising, STC based, ANS Forth compliant kernel ! Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) --- 7,17 ---- arm 15/08/2005 22:56:45 First version 0.1 STC based kernel ! ! ------------------------- End Change Block ----------------------------- ! Experimental: a fully optimising, STC based, ANS Forth compliant kernel ! Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) *************** *** 20,33 **** Free Software Foundation; either version 2 of the License, or <at your option> any later version. ! This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ! ------------------------------------------------------------------------ --- 20,33 ---- Free Software Foundation; either version 2 of the License, or <at your option> any later version. ! This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ! ------------------------------------------------------------------------ *************** *** 40,53 **** Exception Handling ------------------ ! Exeption handling now uses a process wide exception handler to trap all OS generated errors in Win32Forth. The sequence of events is as follows: ! 1. Exception handler set by call to SET-EXCEPT SET-EXCEPT points to a callbnack IN-EXCEPT that does most of the work. ! 2. Code executes, hits some error IN-EXCEPT gets called with 1 parameter. This points to two words: ! DWORD Exception Record DWORD Context Record --- 40,53 ---- Exception Handling ------------------ ! Exeption handling now uses a process wide exception handler to trap all OS generated errors in Win32Forth. The sequence of events is as follows: ! 1. Exception handler set by call to SET-EXCEPT SET-EXCEPT points to a callbnack IN-EXCEPT that does most of the work. ! 2. Code executes, hits some error IN-EXCEPT gets called with 1 parameter. This points to two words: ! DWORD Exception Record DWORD Context Record *************** *** 72,76 **** 9. Returns to OS to undertake the recovery. ! Trapping Memory Write Errors ---------------------------- --- 72,76 ---- 9. Returns to OS to undertake the recovery. ! Trapping Memory Write Errors ---------------------------- *************** *** 78,85 **** This code supports RESERVEing memory using VirtualAlloc, without COMMITting it first. ! First, reserve a range of a process's virtual address space. Reserving address space ! does not allocate any physical storage, but it prevents other allocation operations ! from using the specified range. Reserving pages prevents needless consumption of ! physical storage, while allowing a process to reserve a range of its address space into which a dynamic data structure can grow. Reserved but uncommitted memory will cause ACCESS VIOLATIONS if it is addressed. --- 78,85 ---- This code supports RESERVEing memory using VirtualAlloc, without COMMITting it first. ! First, reserve a range of a process's virtual address space. Reserving address space ! does not allocate any physical storage, but it prevents other allocation operations ! from using the specified range. Reserving pages prevents needless consumption of ! physical storage, while allowing a process to reserve a range of its address space into which a dynamic data structure can grow. Reserved but uncommitted memory will cause ACCESS VIOLATIONS if it is addressed. *************** *** 87,91 **** Once the memory is then committed, it is backed by swap pages and is mapped into the virtual address space. Now it can be used (written and read). ! The support provided here allows storage be reserved only. If a block of storage is reserved, and it is then written to, the exception handler traps the --- 87,91 ---- Once the memory is then committed, it is backed by swap pages and is mapped into the virtual address space. Now it can be used (written and read). ! The support provided here allows storage be reserved only. If a block of storage is reserved, and it is then written to, the exception handler traps the *************** *** 93,106 **** For instance: ! PAGE_NOACCESS MEM_RESERVE 0x400000 0 CALL VirtualAlloc CONSTANT LARGEAREA This reserves but does not consume memory resources. ! 10 LARGEAREA 0x4000 + ! This causes an exception, the memory is COMMITed as PAGE_EXECUTE_READWRITE. Only the page (4K) at LARGEAREA 0x4000 + requires swap and memory resources. ! Catching Errors --- 93,106 ---- For instance: ! PAGE_NOACCESS MEM_RESERVE 0x400000 0 CALL VirtualAlloc CONSTANT LARGEAREA This reserves but does not consume memory resources. ! 10 LARGEAREA 0x4000 + ! This causes an exception, the memory is COMMITed as PAGE_EXECUTE_READWRITE. Only the page (4K) at LARGEAREA 0x4000 + requires swap and memory resources. ! Catching Errors *************** *** 115,119 **** Here's some sample output: ! 0 @ \ fetch from absolute zero --- 115,119 ---- Here's some sample output: ! 0 @ \ fetch from absolute zero *************** *** 136,140 **** Invoking word CONSOLE-STATUSBAR-INTERPRET loaded from: ...SRC\CONSOLE\CONSOLESTATBAR.F at line: 92 fails at word _INTERPRET loaded from: SRC\FKERNEL.F at line: 4238 ! For TURNKEYed applications, only the registers are shown. --- 136,140 ---- Invoking word CONSOLE-STATUSBAR-INTERPRET loaded from: ...SRC\CONSOLE\CONSOLESTATBAR.F at line: 92 fails at word _INTERPRET loaded from: SRC\FKERNEL.F at line: 4238 ! For TURNKEYed applications, only the registers are shown. *************** *** 161,166 **** -1 CONSTANT EXCEPTION_CONTINUE_EXECUTION - : \IN-SYSTEM-OK ; immediate \ temporary - 9998 CONSTANT THROW_WINEXCEPT \ " Windows exception trapped" THROW_MSGS LINK, THROW_WINEXCEPT , ," Windows exception trapped" --- 161,164 ---- *************** *** 316,320 **** &except @ 0= if cr ." * No exception has occurred *" ! else except-io cr .version --- 314,318 ---- &except @ 0= if cr ." * No exception has occurred *" ! else except-io cr .version *************** *** 327,333 **** if ." WRITE" else ." READ" then ." violation" then ! context-buffer ! cr ." Registers:" cr dup eax ." eax" .exreg --- 325,331 ---- if ." WRITE" else ." READ" then ." violation" then ! context-buffer ! cr ." Registers:" cr dup eax ." eax" .exreg Index: callback.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/callback.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** callback.f 21 Sep 2006 16:26:33 -0000 1.1 --- callback.f 23 Sep 2006 10:18:34 -0000 1.2 *************** *** 12,16 **** \ When Windows calls back into user code, the address passed as one of the \ parameters to the call to windows is the address of a routine to handle ! \ the callback. We must save the caller's registers, and set up the new data \ stack. --- 12,16 ---- \ When Windows calls back into user code, the address passed as one of the \ parameters to the call to windows is the address of a routine to handle ! \ the callback. We must save the caller's registers, and set up the new data \ stack. *************** *** 24,35 **** \ of cells passed as parameters. Sets up the stacks to meet \ the internal requirements of Win32Forth. The word <ExternalName> ! \ is not callable directly from Forth, and is defined in a \ case-sensitive vocabulary; but call-proc can be used \ to test the word. See the example. ! \ Because of the way the callback restores registers on exit, the stack does \ not need to be clean on exit; the value on the top of the stack is taken as \ the return value. There is a limit of around 4K or 1024 parameters maximum ! \ on the stack (referenced by ebp), so be carefule that very deep nesting may \ well overrun the stack. --- 24,35 ---- \ of cells passed as parameters. Sets up the stacks to meet \ the internal requirements of Win32Forth. The word <ExternalName> ! \ is not callable directly from Forth, and is defined in a \ case-sensitive vocabulary; but call-proc can be used \ to test the word. See the example. ! \ Because of the way the callback restores registers on exit, the stack does \ not need to be clean on exit; the value on the top of the stack is taken as \ the return value. There is a limit of around 4K or 1024 parameters maximum ! \ on the stack (referenced by ebp), so be carefule that very deep nesting may \ well overrun the stack. *************** *** 98,102 **** call xt \ call the code n cb-exit ! ]macro r> set-current previous \ original definitions postpone ; ; \ back to compiler --- 98,102 ---- call xt \ call the code n cb-exit ! ]macro r> set-current previous \ original definitions postpone ; ; \ back to compiler *************** *** 108,111 **** --- 108,112 ---- -1 value WM_WIN32FORTH + library gdi32.dll 1 PROC TranslateMessage 1 PROC DispatchMessage Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** extend.f 23 Sep 2006 07:32:38 -0000 1.3 --- extend.f 23 Sep 2006 10:18:34 -0000 1.4 *************** *** 9,19 **** fload src\numconv.f \ general number conversions - : nostack1 ; immediate - sys-fload src\486asm.f \ jim's 486 assembler sys-fload src\asmmac.f \ jim's 486 macros sys-fload src\asmwin32.f \ next for win32forth ! fload src\console.f \ console i/o extracted from primutil.f sys-fload src\dotwords.f \ dot support words sys-fload src\imageman.f \ fsave, application & turnkey words --- 9,19 ---- fload src\numconv.f \ general number conversions sys-fload src\486asm.f \ jim's 486 assembler sys-fload src\asmmac.f \ jim's 486 macros sys-fload src\asmwin32.f \ next for win32forth ! fload src\console\console.f \ console i/o extracted from primutil.f ! fload src\console\console2.f \ console i/o extracted from primutil.f sys-fload src\dotwords.f \ dot support words + FLOAD src\paths.f \ multi path support words sys-fload src\imageman.f \ fsave, application & turnkey words *************** *** 25,31 **** FLOAD src\float.f \ floating point support ! : DEPRECATED ; immediate ! ! FLOAD src\paths.f \ multi path support words .olly --- 25,30 ---- FLOAD src\float.f \ floating point support ! FLOAD src\console\keyboard.f \ function and special key constants ! FLOAD src\console\lineedit.f \ a line editor utility .olly Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/paths.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** paths.f 23 Sep 2006 07:32:38 -0000 1.1 --- paths.f 23 Sep 2006 10:18:34 -0000 1.2 *************** *** 8,12 **** cr .( Loading Path Functions...) ! \ anew -paths.f internal --- 8,12 ---- cr .( Loading Path Functions...) ! anew -paths.f internal *************** *** 473,479 **** loaded? 0= if postpone \ then ; ! : NEEDS ( -<name>- ) \ *G Conditionally load file "name" if not loaded. ! >in @ loaded? 0= if >in ! fload else drop then ; synonym Require needs --- 473,479 ---- loaded? 0= if postpone \ then ; ! \ : NEEDS ( -<name>- ) \ *G Conditionally load file "name" if not loaded. ! \ >in @ loaded? 0= if >in ! fload else drop then ; synonym Require needs --- lineedit.f DELETED --- --- console.f DELETED --- Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** primutil.f 21 Sep 2006 16:26:33 -0000 1.1 --- primutil.f 23 Sep 2006 10:18:34 -0000 1.2 *************** *** 5,15 **** \ arm 15/08/2005 22:56:45 \ First version 0.1 STC based kernel - \ \ ! \ \ ------------------------- End Change Block ----------------------------- ! \ \ Experimental: a fully optimising, STC based, ANS Forth compliant kernel ! \ \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) \ Dirk Busch (dirk.yahoo @ schneider-busch.de) --- 5,15 ---- \ arm 15/08/2005 22:56:45 \ First version 0.1 STC based kernel \ ! \ ! \ \ ------------------------- End Change Block ----------------------------- ! \ \ Experimental: a fully optimising, STC based, ANS Forth compliant kernel ! \ \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) \ Dirk Busch (dirk.yahoo @ schneider-busch.de) *************** *** 19,32 **** \ Free Software Foundation; either version 2 of the License, or <at your \ option> any later version. ! \ \ This program is distributed in the hope that it will be useful, but \ WITHOUT ANY WARRANTY; without even the implied warranty of \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU \ General Public License for more details. ! \ \ You should have received a copy of the GNU General Public License along \ with this program; if not, write to the Free Software Foundation, Inc., \ 675 Mass Ave, Cambridge, MA 02139, USA. ! \ \ ------------------------------------------------------------------------ --- 19,32 ---- \ Free Software Foundation; either version 2 of the License, or <at your \ option> any later version. ! \ \ This program is distributed in the hope that it will be useful, but \ WITHOUT ANY WARRANTY; without even the implied warranty of \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU \ General Public License for more details. ! \ \ You should have received a copy of the GNU General Public License along \ with this program; if not, write to the Free Software Foundation, Inc., \ 675 Mass Ave, Cambridge, MA 02139, USA. ! \ \ ------------------------------------------------------------------------ *************** *** 35,41 **** decimal \ start everything in decimal ! in-system \ Some comment words gleaned from various Forths, and C of course. : _commeof \ ( flag -- ) --- 35,54 ---- decimal \ start everything in decimal ! \ ------------------------------------------------------------------------ ! \ Some words that must be ported some time... ! \ ------------------------------------------------------------------------ ! ! in-application + : NOSTACK1 ; immediate \ *** to be done *** + : DEPRECATED ; immediate \ *** to be done *** + : ANEW BL WORD DROP ; immediate \ *** to be done *** + : IS-DEFAULT BL WORD 2DROP ; immediate \ *** to be done *** + + \ ------------------------------------------------------------------------ \ Some comment words gleaned from various Forths, and C of course. + \ ------------------------------------------------------------------------ + + in-system : _commeof \ ( flag -- ) *************** *** 57,61 **** : comment \ -<char>- char _comment ; immediate ! : "comment ( a1 n1 -- ) \ everything is a comment up to the string a1,n1 begin --- 70,74 ---- : comment \ -<char>- char _comment ; immediate ! : "comment ( a1 n1 -- ) \ everything is a comment up to the string a1,n1 begin *************** *** 77,83 **** : doc s" enddoc" "comment ; immediate \ comment till enddoc ! ! \ ----------------------- Various support words -------------------------- ' included alias "fload --- 90,96 ---- : doc s" enddoc" "comment ; immediate \ comment till enddoc ! \ ------------------------------------------------------------------------ \ ----------------------- Various support words -------------------------- + \ ------------------------------------------------------------------------ ' included alias "fload *************** *** 101,105 **** --- 114,120 ---- over offset + ; + \ ------------------------------------------------------------------------ \ -------------------------- Chain definitions --------------------------- + \ ------------------------------------------------------------------------ new-chain initialization-chain \ chain of things to initialize *************** *** 134,138 **** reset-stack-chain do-chain ; is reset-stacks \ install in kernel word ! : (viewinfo) ( nfa -- line# addr ) \ find source for word dup >vfa@ swap >ffa@ \ fetch line #, file name over 1 < \ view < 1 --- 149,157 ---- reset-stack-chain do-chain ; is reset-stacks \ install in kernel word ! \ ------------------------------------------------------------------------ ! \ ------------------------------------------------------------------------ ! ! : (viewinfo) ( nfa -- line# addr ) ! \ *G Find source for word. dup >vfa@ swap >ffa@ \ fetch line #, file name over 1 < \ view < 1 *************** *** 143,147 **** then ; ! : .viewinfo ( nfa -- ) \ print file & line # (viewinfo) ." loaded from " count type 15 ?cr --- 162,167 ---- then ; ! : .viewinfo ( nfa -- ) ! \ *G Print file & line # (viewinfo) ." loaded from " count type 15 ?cr *************** *** 150,151 **** --- 170,193 ---- else drop then ; + \ ------------------------------------------------------------------------ + \ ------------------------------------------------------------------------ + + : \- ( "word" -- ) + \ *G Interpret the rest of the line if "word" isn't defined. + defined nip + if POSTPONE \ + then ; immediate + + : \+ ( "word" -- ) + \ *G Interpret the rest of the line if "word" is defined. + defined nip 0= + if POSTPONE \ + then ; immediate + + : \IN-SYSTEM-OK ( -<line_to_interpret>- ) + \ *G Suppress in-system warnings for the rest of the current line, restoring the previous + \ ** state of the sys-warning? flag afterwards, even if an error occurs. + sys-warning? >r + sys-warning-off + ['] interpret catch + r> to sys-warning? throw ; immediate |