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: Jos v.d.V. <jo...@us...> - 2007-02-24 13:59:01
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv2629 Modified Files: DumpWindows.f Log Message: Jos: Added a count of the total used windows. That makes it easier to optimize windows. I started with 122 Top-Level-Windows. After cleaning I am "only" using 92 Top-Level-Windows. Index: DumpWindows.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DumpWindows.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** DumpWindows.f 22 Jul 2006 08:32:13 -0000 1.2 --- DumpWindows.f 24 Feb 2007 13:58:54 -0000 1.3 *************** *** 35,39 **** LMAXCOUNTED localalloc: buff$ ! cr hWnd h.8 space hWnd GetProcessId h.8 space --- 35,40 ---- LMAXCOUNTED localalloc: buff$ ! 1 +TO FIRST-LINE? ! cr FIRST-LINE? 3 u,.r space hWnd h.8 space hWnd GetProcessId h.8 space *************** *** 45,49 **** LMAXCOUNTED buff$ hWnd call GetWindowText 0<> if buff$ zcount type else ." <no title>" then - true ; \ default return value --- 46,49 ---- *************** *** 51,61 **** \ *G Dump all Top-Level-Windows to the console. cr cr ." Top-Level-Windows:" ! cr ." hWnd ProcId ThreadId ClassName - WindowTitle" ! 0 \ lParam is passed to the callback funtion by Windows &DumpWindowCallback \ get address of the callback function Call EnumWindows drop \ and use it ! cr ; ' (.Windows) is .Windows --- 51,61 ---- \ *G Dump all Top-Level-Windows to the console. cr cr ." Top-Level-Windows:" ! cr ." # hWnd ProcId ThreadId ClassName - WindowTitle" ! 0 TO FIRST-LINE? 0 \ lParam is passed to the callback funtion by Windows &DumpWindowCallback \ get address of the callback function Call EnumWindows drop \ and use it ! cr ." Total:" FIRST-LINE? 1 u,.r cr ; ' (.Windows) is .Windows |
|
From: Jos v.d.V. <jo...@us...> - 2007-02-21 20:59:36
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9189 Modified Files: w_search.f Log Message: Jos: Removed a backup word. Index: w_search.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/w_search.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** w_search.f 21 Feb 2007 20:49:02 -0000 1.5 --- w_search.f 21 Feb 2007 20:59:32 -0000 1.6 *************** *** 293,309 **** ; - : 0search-window ( adr cnt - hwnd|0 ) - 2>r call GetActiveWindow dup - begin - GW_HWNDNEXT swap call GetWindow dup 0<> - if dup MAXSTRING pad rot call GetWindowText pad swap - 2r@ 2swap 2dup temp$ place false *search rot drop - else never 0 true - then - or - until nip 2r> 2drop - ; - - : search-window ( adr cnt - hwnd|0 ) 2>r call GetActiveWindow dup --- 293,296 ---- |
|
From: Jos v.d.V. <jo...@us...> - 2007-02-21 20:53:01
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6469 Modified Files: FORTHFORM.F Log Message: Jos: Made interactive switching between ForthForm and Win32ForthIDE possible. Index: FORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORTHFORM.F,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** FORTHFORM.F 27 Dec 2006 18:43:57 -0000 1.17 --- FORTHFORM.F 21 Feb 2007 20:52:54 -0000 1.18 *************** *** 22,25 **** --- 22,26 ---- needs excontrols.f \ extended controls for Win32Forth needs ExUtils.f \ general utilities + needs w_search.f needs linklist.f \ very useful utility needs bitmap.f \ bitmap loading routines *************** *** 109,113 **** formwindow-link off ! WM_USER 256 + constant FF_PASTE \ message to tell Win32forthIDE to paste source text ColorObject FormColor \ background form color --- 110,114 ---- formwindow-link off ! WM_USER 256 + constant FF_PASTE \ message to tell Win32forth to paste source text ColorObject FormColor \ background form color *************** *** 192,199 **** : Start-Win32ForthIDE ( -- ) \ start the editor if not already started ! editor-present? not ! if s" Win32ForthIDE.exe" PrePend<Home>\ ! GetHandle: TheMainWindow ExecuteFile ! then ; : Start-ProjectManager ( -- ) \ start the project manager if not started --- 193,201 ---- : Start-Win32ForthIDE ( -- ) \ start the editor if not already started ! editor-present? ! if s" Win32Forth*IDE" "SetToForeground drop ! else s" Win32ForthIDE.exe" PrePend<Home>\ ! GetHandle: TheMainWindow ExecuteFile ! then ; : Start-ProjectManager ( -- ) \ start the project manager if not started |
|
From: Jos v.d.V. <jo...@us...> - 2007-02-21 20:50:25
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5630 Modified Files: EdMenu.f Log Message: Jos: Optimized Start-fform Index: EdMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdMenu.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** EdMenu.f 21 Feb 2007 14:02:09 -0000 1.15 --- EdMenu.f 21 Feb 2007 20:50:16 -0000 1.16 *************** *** 21,28 **** : Start-fform ( -- ) \ Start ForthForm when not started OR ?fform-started \ put ForthForm in front when started. ! if s" ForthForm*." search-window ?dup ! if SW_SHOWNORMAL over call ShowWindow drop ! dup Call SetForegroundWindow drop ! then else s" ForthForm.exe" PrePend<Home>\ GetHandle: MainWindow ExecuteFile --- 21,25 ---- : Start-fform ( -- ) \ Start ForthForm when not started OR ?fform-started \ put ForthForm in front when started. ! if s" ForthForm*." "SetToForeground drop else s" ForthForm.exe" PrePend<Home>\ GetHandle: MainWindow ExecuteFile |
|
From: Jos v.d.V. <jo...@us...> - 2007-02-21 20:49:09
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4836 Modified Files: w_search.f Log Message: Jos: Added "SetToForeground Index: w_search.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/w_search.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** w_search.f 23 Aug 2005 18:29:28 -0000 1.4 --- w_search.f 21 Feb 2007 20:49:02 -0000 1.5 *************** *** 18,21 **** --- 18,24 ---- \ buffer or a specification string has a lenght of 0. + \ February 21st, 2007 + \ - Added "SetToForeground + \ From toolset.f \ load it here when you would like to use it. *************** *** 290,293 **** --- 293,309 ---- ; + : 0search-window ( adr cnt - hwnd|0 ) + 2>r call GetActiveWindow dup + begin + GW_HWNDNEXT swap call GetWindow dup 0<> + if dup MAXSTRING pad rot call GetWindowText pad swap + 2r@ 2swap 2dup temp$ place false *search rot drop + else never 0 true + then + or + until nip 2r> 2drop + ; + + : search-window ( adr cnt - hwnd|0 ) 2>r call GetActiveWindow dup *************** *** 301,304 **** --- 317,328 ---- until nip 2r> 2drop ; + + : "SetToForeground ( adr cnt - hwnd|0 ) + search-window dup \ Search for a window and sets it in the foreground + if SW_SHOWNORMAL over call ShowWindow drop + dup Call SetForegroundWindow drop + then + ; + \s |
|
From: Jos v.d.V. <jo...@us...> - 2007-02-21 14:03:10
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4947 Modified Files: EdMenu.f Log Message: Jos: Added an option to start ForthForm OR put ForthForm in front when it is started. Index: EdMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdMenu.f,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** EdMenu.f 21 Oct 2006 11:11:47 -0000 1.14 --- EdMenu.f 21 Feb 2007 14:02:09 -0000 1.15 *************** *** 17,20 **** --- 17,31 ---- needs src/tools/SdkHelp.f needs ExUtils.f + needs w_search.f + + : Start-fform ( -- ) \ Start ForthForm when not started OR + ?fform-started \ put ForthForm in front when started. + if s" ForthForm*." search-window ?dup + if SW_SHOWNORMAL over call ShowWindow drop + dup Call SetForegroundWindow drop + then + else s" ForthForm.exe" PrePend<Home>\ + GetHandle: MainWindow ExecuteFile + then ; MenuBar MainMenu *************** *** 145,148 **** --- 156,162 ---- :MenuItem mp_showtb "&Show Toolbar" IDM_SHOW_TOOLBAR DoCommand ; \ :MenuItem mp_customizetb "&Customize toolbar" Customize: ControlToolbar ; + MenuSeparator + MenuItem "&Show ForthForm" Start-fform ; + Popup "&Win32Forth" |
|
From: George H. <geo...@us...> - 2007-02-21 10:13:27
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8819/win32forth/src Modified Files: Class.f FLOAT.F Log Message: gah: Minor documentation corrections to Class.f and removal of redundent instruction in FROT Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** Class.f 21 Nov 2006 15:26:19 -0000 1.25 --- Class.f 21 Feb 2007 10:13:17 -0000 1.26 *************** *** 37,41 **** \ ** terminating ]] and then compiles a late-bound call to the method selector \ ** address on the stack. A run-time error will occur if "code to evaluate" does not ! \ ** a valid object address. \n \ ** An compile-time error also occurs if [[ isn't preceeded by a selector. true abort" [[ must be preceeded by a selector " ; IMMEDIATE --- 37,41 ---- \ ** terminating ]] and then compiles a late-bound call to the method selector \ ** address on the stack. A run-time error will occur if "code to evaluate" does not ! \ ** produce a valid object address. \n \ ** An compile-time error also occurs if [[ isn't preceeded by a selector. true abort" [[ must be preceeded by a selector " ; IMMEDIATE *************** *** 704,707 **** --- 704,709 ---- \ 4 = parmTyp -as a named parm \ 5 = parenType -open paren for defer group + \ 6 = defer -late bound call to object address on stack + \ 7 = [self] -as a late bound call to self \ in-application Index: FLOAT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v retrieving revision 1.47 retrieving revision 1.48 diff -C2 -d -r1.47 -r1.48 *** FLOAT.F 7 Nov 2006 11:24:29 -0000 1.47 --- FLOAT.F 21 Feb 2007 10:13:17 -0000 1.48 *************** *** 572,576 **** \ *G Rotate the top 3 FP stack numbers. fstack-check_3 - mov ecx, FSP_MEMORY -fsp-adjust fld FSIZE fsp-adjust +FSTACK_MEMORY --- 572,575 ---- |
|
From: George H. <geo...@us...> - 2007-02-21 09:59:33
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5279/win32forth/src/lib Modified Files: Calendar.f Log Message: gah: Added generic class for common methods Index: Calendar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Calendar.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Calendar.f 29 Aug 2006 08:52:25 -0000 1.4 --- Calendar.f 21 Feb 2007 09:59:29 -0000 1.5 *************** *** 13,16 **** --- 13,42 ---- EXTERNAL + in-system + + |class DateTimeControl <Super Control + \ *G Generic class for methods common to MonthCalendar and DateTimePicker controls. + + in-previous + + int style + + :M ClassInit: ( -- ) + \ *G Initialise the class. + ClassInit: super + 0 to style + ;M + + :M AddStyle: ( n -- ) + \ *G Set any additional style of the control. Must be done before the control + \ ** is created. + to style ;M + + :M WindowStyle: ( -- style ) + \ *G Get the window style of the control. Default style is: WS_BORDER. + WindowStyle: super WS_BORDER or style or ;M + + ;class + #IFNDEF wYear \ Because _SystemTime is a user variable The following need to be set at run time *************** *** 38,89 **** set-time-pointers \ TODO: Move the SystemTime-struct into class. So that every instance of the \ control becomes his own set of values. ! Comment: ! ! wYear ! The year (1601 - 30827). ! ! wMonth ! The month. ! ! January = 1 ! February = 2 ! March = 3 ! April = 4 ! May = 5 ! June = 6 ! July = 7 ! August = 8 ! September = 9 ! October = 10 ! November = 11 ! December = 12 ! ! wDayOfWeek ! The day of the week. ! ! Sunday = 0 ! Monday = 1 ! Tuesday = 2 ! Wednesday = 3 ! Thursday = 4 ! Friday = 5 ! Saturday = 6 ! ! wDay ! The day of the month (0-31). ! wHour ! The hour (0-23). ! wMinute ! The minute (0-59). ! wSecond ! The second (0-59). ! wMilliseconds ! The millisecond (0-999). ! Comment; ! #THEN \ ------------------------------------------------------------------------ --- 64,115 ---- set-time-pointers + #then + \ TODO: Move the SystemTime-struct into class. So that every instance of the \ control becomes his own set of values. ! \ *P The MonthCalendar and TimeDatePicker controls both use the _SystemTime structure ! \ ** defined in the file ANSFILE.F , the members of which are; ! \ *Q wYear ! \ ** The year (1601 - 30827). ! \ ** ! \ ** wMonth ! \ ** The month. ! \ ** ! \ ** January = 1 ! \ ** February = 2 ! \ ** March = 3 ! \ ** April = 4 ! \ ** May = 5 ! \ ** June = 6 ! \ ** July = 7 ! \ ** August = 8 ! \ ** September = 9 ! \ ** October = 10 ! \ ** November = 11 ! \ ** December = 12 ! \ ** ! \ ** wDayOfWeek ! \ ** The day of the week. ! \ ** ! \ ** Sunday = 0 ! \ ** Monday = 1 ! \ ** Tuesday = 2 ! \ ** Wednesday = 3 ! \ ** Thursday = 4 ! \ ** Friday = 5 ! \ ** Saturday = 6 ! \ ** ! \ ** wDay ! \ ** The day of the month (0-31). ! \ ** wHour ! \ ** The hour (0-23). ! \ ** wMinute ! \ ** The minute(s) (0-59). ! \ ** wSecond ! \ ** The second(s) (0-59). ! \ ** wMilliseconds ! \ ** The millisecond(s) (0-999). \ ------------------------------------------------------------------------ *************** *** 91,95 **** \ *S MonthCalendar class \ ------------------------------------------------------------------------ ! :Class MonthCalendar <Super Control \ *G Month Calendar control. \ ** A month calendar control implements a calendar-like user interface. This --- 117,121 ---- \ *S MonthCalendar class \ ------------------------------------------------------------------------ ! :Class MonthCalendar <Super DateTimeControl \ *G Month Calendar control. \ ** A month calendar control implements a calendar-like user interface. This *************** *** 97,113 **** \ ** or selecting a date. - int style - - :M ClassInit: ( -- ) - \ *G Initialise the class. - ClassInit: super - 0 to style - ;M - - :M AddStyle: ( n -- ) - \ *G Set any additional style of the control. Must be done before the control - \ ** is created. - to style ;M - :M Start: ( Parent -- ) \ *G Create the control. --- 123,126 ---- *************** *** 124,131 **** ;M - :M WindowStyle: ( -- style ) - \ *G Get the window style of the control. Default style is: WS_BORDER. - WindowStyle: super WS_BORDER or style or ;M - :M GetDate: ( -- day month year ) \ *G Retrieves the currently selected date. --- 137,140 ---- *************** *** 150,169 **** \ *S DateTimePicker class \ ------------------------------------------------------------------------ ! :Class DateTimePicker <Super Control \ *G Date and Time Picker control - int style - - :M ClassInit: ( -- ) - \ *G Initialise the class. - ClassInit: super - 0 to style - ;M - - :M AddStyle: ( n -- ) - \ *G Set any additional style of the control. Must be done before the control - \ ** is created. - to style ;M - :M Start: ( Parent -- ) \ *G Create the control. --- 159,165 ---- \ *S DateTimePicker class \ ------------------------------------------------------------------------ ! :Class DateTimePicker <Super DateTimeControl \ *G Date and Time Picker control :M Start: ( Parent -- ) \ *G Create the control. *************** *** 173,231 **** ;M ! :M WindowStyle: ( -- style ) ! \ *G Get the window style of the control. Default style is: WS_BORDER. ! WindowStyle: super WS_BORDER or style or ;M ! ! \ *P Date and Time Picker Control Styles \ ** ! \ ** The window styles listed here are specific to date and time picker controls. \ ** ! \ ** Constants ! \ ** DTS_APPCANPARSE ! \ ** Allows the owner to parse user input and take necessary action. It enables users to edit ! \ ** within the client area of the control when they press the F2 key. The control sends ! \ ** DTN_USERSTRING notification messages when users are finished. \ ** ! \ ** DTS_LONGDATEFORMAT \ ** Displays the date in long format. The default format string for this style is ! \ ** defined by LOCALE_SLONGDATEFORMAT, which produces output like "Friday, April 19, 1996". \ ** ! \ ** DTS_RIGHTALIGN \ ** The drop-down month calendar will be right-aligned with the control instead of ! \ ** left-aligned, which is the default. \ ** ! \ ** DTS_SHOWNONE \ ** It is possible to have no date currently selected in the control. With this style, ! \ ** the control displays a check box that users can check once they have entered or selected ! \ ** a date. Until this check box is checked, the application will not be able to retrieve ! \ ** the date from the control because, in essence, the control has no date. This state can ! \ ** be set with the DTM_SETSYSTEMTIME message or queried with the DTM_GETSYSTEMTIME message. \ ** ! \ ** DTS_SHORTDATEFORMAT ! \ ** Displays the date in short format. The default format string for this style is defined ! \ ** by LOCALE_SSHORTDATE, which produces output like "4/19/96". \ ** ! \ ** DTS_SHORTDATECENTURYFORMAT \ ** Version 5.80. Similar to the DTS_SHORTDATEFORMAT style, except the year is a ! \ ** four-digit field. The default format string for this style is based on LOCALE_SSHORTDATE. ! \ ** The output looks like: "4/19/1996". \ ** ! \ ** DTS_TIMEFORMAT \ ** Displays the time. The default format string for this style is defined by ! \ ** LOCALE_STIMEFORMAT, which produces output like "5:31:42 PM". \ ** ! \ ** DTS_UPDOWN ! \ ** Places an up-down control to the right of the DTP control to modify date-time values. ! \ ** This style can be used in place of the drop-down month calendar, which is the default ! \ ** style. \ ** ! \ ** Remarks \ ** ! \ ** The DTS_XXXFORMAT styles that define the display format cannot be combined. If none of ! \ ** the format styles are suitable, use a DTM_SETFORMAT message to define a custom format. ! ! ! ! :M SetCustomFormat: ( z"format" -- ) --- 169,222 ---- ;M ! \ *P Date and Time Picker Control Styles \n \ ** ! \ ** The window styles listed here are specific to date and time picker controls. \n \ ** ! \ ** Constants \n ! \ ** DTS_APPCANPARSE \n ! \ ** Allows the owner to parse user input and take necessary action. It enables users ! \ ** to edit within the client area of the control when they press the F2 key. ! \ ** The control sends DTN_USERSTRING notification messages when users are finished. \n \ ** ! \ ** DTS_LONGDATEFORMAT \n \ ** Displays the date in long format. The default format string for this style is ! \ ** defined by LOCALE_SLONGDATEFORMAT, which produces output like "Friday, April ! \ ** 19, 1996". \n \ ** ! \ ** DTS_RIGHTALIGN \n \ ** The drop-down month calendar will be right-aligned with the control instead of ! \ ** left-aligned, which is the default. \n \ ** ! \ ** DTS_SHOWNONE \n \ ** It is possible to have no date currently selected in the control. With this style, ! \ ** the control displays a check box that users can check once they have entered or ! \ ** selected a date. Until this check box is checked, the application will not be ! \ ** able to retrieve the date from the control because, in essence, the control has ! \ ** no date. This state can be set with the DTM_SETSYSTEMTIME message or queried ! \ ** with the DTM_GETSYSTEMTIME message. \n \ ** ! \ ** DTS_SHORTDATEFORMAT \n ! \ ** Displays the date in short format. The default format string for this style is ! \ ** defined by LOCALE_SSHORTDATE, which produces output like "4/19/96". \n \ ** ! \ ** DTS_SHORTDATECENTURYFORMAT \n \ ** Version 5.80. Similar to the DTS_SHORTDATEFORMAT style, except the year is a ! \ ** four-digit field. The default format string for this style is based on ! \ ** LOCALE_SSHORTDATE. The output looks like: "4/19/1996". \n \ ** ! \ ** DTS_TIMEFORMAT \n \ ** Displays the time. The default format string for this style is defined by ! \ ** LOCALE_STIMEFORMAT, which produces output like "5:31:42 PM". \n \ ** ! \ ** DTS_UPDOWN \n ! \ ** Places an up-down control to the right of the DTP control to modify date-time ! \ ** values. This style can be used in place of the drop-down month calendar, which ! \ ** is the default style. \n \ ** ! \ ** Remarks \n \ ** ! \ ** The DTS_XXXFORMAT styles that define the display format cannot be combined. ! \ ** If none of the format styles are suitable, use a DTM_SETFORMAT message to ! \ ** define a custom format. :M SetCustomFormat: ( z"format" -- ) *************** *** 235,278 **** \ *P Format Strings ! \ ** A DTP format string consists of a series of elements that represent a particular piece of ! \ ** information and define its display format. The elements will be displayed in the order ! \ ** they appear in the format string. \ ** \ ** Date and time format elements will be replaced by the actual date and time. They are ! \ ** defined by the following groups of characters: \ ** ! \ ** Element Description ! \ ** "d" The one- or two-digit day. ! \ ** "dd" The two-digit day. Single-digit day values are preceded by a zero. ! \ ** "ddd" The three-character weekday abbreviation. ! \ ** "dddd" The full weekday name. ! \ ** "h" The one- or two-digit hour in 12-hour format. ! \ ** "hh" The two-digit hour in 12-hour format. Single-digit values are preceded by a zero. ! \ ** "H" The one- or two-digit hour in 24-hour format. ! \ ** "HH" The two-digit hour in 24-hour format. Single-digit values are preceded by a zero. ! \ ** "m" The one- or two-digit minute. ! \ ** "mm" The two-digit minute. Single-digit values are preceded by a zero. ! \ ** "M" The one- or two-digit month number. ! \ ** "MM" The two-digit month number. Single-digit values are preceded by a zero. ! \ ** "MMM" The three-character month abbreviation. ! \ ** "MMMM" The full month name. ! \ ** "t" The one-letter AM/PM abbreviation (that is, AM is displayed as "A"). ! \ ** "tt" The two-letter AM/PM abbreviation (that is, AM is displayed as "AM"). ! \ ** "yy" The last two digits of the year (that is, 1996 would be displayed as "96"). ! \ ** "yyyy" The full year (that is, 1996 would be displayed as "1996"). \ ** ! \ ** To make the information more readable, you can add body text to the format string by ! \ ** enclosing it in single quotes. Spaces and punctuation marks do not need to be quoted. \ ** ! \ ** Note Nonformat characters that are not delimited by single quotes will result in ! \ ** unpredictable display by the DTP control. \ ** \ ** For example, to display the current date with the format \ ** "'Today is: 04:22:31 Tuesday Mar 23, 1996", the format string is ! \ ** "'Today is: 'hh':'m':'s dddd MMM dd', 'yyyy". To include a single quote in your body text, ! \ ** use two consecutive single quotes. For example, "'Don''t forget' MMM dd',' yyyy" produces ! \ ** output that looks like: Don't forget Mar 23, 1996. It is not necessary to use quotes ! \ ** with the comma, so "'Don''t forget' MMM dd, yyyy" is also valid, and produces the same ! \ ** output. :M GetTime: ( -- hrs min secs ) --- 226,273 ---- \ *P Format Strings ! \ ** A DTP format string consists of a series of elements that represent a particular ! \ ** piece of information and define its display format. The elements will be displayed ! \ ** in the order they appear in the format string. \n \ ** \ ** Date and time format elements will be replaced by the actual date and time. They are ! \ ** defined by the following groups of characters: \n \ ** ! \ ** Element Description \n ! \ ** "d" The one- or two-digit day. \n ! \ ** "dd" The two-digit day. Single-digit day values are preceded by a zero. \n ! \ ** "ddd" The three-character weekday abbreviation. \n ! \ ** "dddd" The full weekday name. \n ! \ ** "h" The one- or two-digit hour in 12-hour format. \n ! \ ** "hh" The two-digit hour in 12-hour format. Single-digit values are preceded by ! \ ** a zero. \n ! \ ** "H" The one- or two-digit hour in 24-hour format. \n ! \ ** "HH" The two-digit hour in 24-hour format. Single-digit values are preceded by ! \ ** a zero. \n ! \ ** "m" The one- or two-digit minute. \n ! \ ** "mm" The two-digit minute. Single-digit values are preceded by a zero. \n ! \ ** "M" The one- or two-digit month number. \n ! \ ** "MM" The two-digit month number. Single-digit values are preceded by a zero. \n ! \ ** "MMM" The three-character month abbreviation. \n ! \ ** "MMMM" The full month name. \n ! \ ** "t" The one-letter AM/PM abbreviation (that is, AM is displayed as "A"). \n ! \ ** "tt" The two-letter AM/PM abbreviation (that is, AM is displayed as "AM"). \n ! \ ** "yy" The last two digits of the year (that is, 1996 would be displayed as "96"). \n ! \ ** "yyyy" The full year (that is, 1996 would be displayed as "1996"). \n \ ** ! \ ** To make the information more readable, you can add body text to the format string ! \ ** by enclosing it in single quotes. Spaces and punctuation marks do not need to be ! \ ** quoted. \n \ ** ! \ ** \b Note \d Nonformat characters that are not delimited by single quotes will ! \ ** result in unpredictable display by the DTP control. \n \ ** \ ** For example, to display the current date with the format \ ** "'Today is: 04:22:31 Tuesday Mar 23, 1996", the format string is ! \ ** "'Today is: 'hh':'m':'s dddd MMM dd', 'yyyy". To include a single quote in your ! \ ** body text, use two consecutive single quotes. For example, ! \ ** "'Don''t forget' MMM dd',' yyyy" produces output that looks like: \n ! \ ** Don't forget Mar 23, 1996. \n ! \ ** It is not necessary to use quotes with the comma, so ! \ ** "'Don''t forget' MMM dd, yyyy" is also valid, and produces the same output. :M GetTime: ( -- hrs min secs ) |
|
From: George H. <geo...@us...> - 2007-02-21 09:57:57
|
Update of /cvsroot/win32forth/win32forth/src/lib/Ext_classes In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4435/win32forth/src/lib/Ext_classes Modified Files: ARRAY11.F ORDERED-COL.F Added Files: Objlist.f Sequence.f Log Message: gah: Updated Array11.f and ordered-col.f to match Doug Hoffmans latest versions. Added Sequence.f and Objlist.f --- NEW FILE: Objlist.f --- \ $Id: Objlist.f,v 1.1 2007/02/21 09:57:32 georgeahubert Exp $ \ a dynamically expandable list of objects :class objList <super sequence ptr list var current \ :m ListSize: ( -- n ) \ size: list ;m :m valid?: ( idx0 -- t/f ) nil?: list IF false exitm THEN size: list cell / \ idx0 idxmax+1 < ;m :m ^elem: ( idx -- addr ) cell * get: list + ;m :m at: ( idx -- ^obj ) ^elem: self @ ;m :m add: ( ^class -- ^obj ) >body DUP ?isClass 0= ABORT" Not a class" (heapobj) dup nil?: list IF cell new: list get: list ! \ ^obj ELSE size: list dup cell + resize: list \ ^obj ^obj size get: list + ! THEN ;m :m first?: ( -- ^obj t | f ) nil?: list IF false exitm THEN clear: current 0 at: self true ;m :m next?: ( -- ^obj t | f ) 1 +: current get: current dup valid?: self IF at: self true ELSE drop false THEN ;m :m release: BEGIN each: self WHILE <release REPEAT clear: list clear: current clear: each_started? ;m :m print: BEGIN each: self WHILE cr print: ** REPEAT ;m :m size: ( -- n ) \ number of objects in list size: list cell / ;m ;class Index: ORDERED-COL.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Ext_classes/ORDERED-COL.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ORDERED-COL.F 16 Sep 2006 10:52:04 -0000 1.1 --- ORDERED-COL.F 21 Feb 2007 09:57:32 -0000 1.2 *************** *** 9,14 **** anew -ordered-col.f ! needs var11.f ! needs array11.f \ 06/19/05 dbh code lifted from Mops --- 9,13 ---- anew -ordered-col.f ! needs ext_classes\array11.f \ 06/19/05 dbh code lifted from Mops *************** *** 55,61 **** LOOP ;m ! :m PRINT: ! get: size 0 ?do i at: self cr . loop ;m ;class --- 54,67 ---- LOOP ;m + :m first?: ( -- elem t | f ) + size: self 1 < IF false exitm THEN + clear: current + 0 at: self true ;m ! :m next?: ( -- ^obj t | f ) ! 1 +: current get: current dup size: self < ! IF at: self true ! ELSE drop false ! THEN ;m ;class Index: ARRAY11.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Ext_classes/ARRAY11.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ARRAY11.F 16 Sep 2006 10:52:04 -0000 1.1 --- ARRAY11.F 21 Feb 2007 09:57:32 -0000 1.2 *************** *** 2,74 **** \ Classes for indexed objects ! \ Version 1.0, 4 Feb 1997 \ Andrew McKewan \ mc...@au... \ Win32Forth version, 3 July 2006 G.Hubert (Requires V6.11.10 or later) anew -array11.f ! \ ================================================================== ! \ This is the base class for all indexed objects. It provides the ! \ primitives that are common to all indexed objects. ! :Class IndexedObj <Super Object CELL <Indexed ! \ ( -- addr ) Leave addr of 0th indexed element ! :M IxAddr: idxBase ;M ! \ ( -- limit ) Leave max #elements for array ! :M Limit: limit ;M ! \ ( -- len ) leave width of indexed elements ! :M Width: #width ;M ! \ ( index -- addr ) return then address of an indexed element ! :M ^Elem: ?idx ^elem ;M ! \ ( -- ) Indexed Clear: erases indexed area ! :M Clear: idxBase #width limit * ERASE ;M ;Class ! \ ================================================================== ! \ Basic cell array ! :Class Array <Super IndexedObj \ CELL <Indexed ! :M At: ?idx At4 ;M ( index -- val ) ! :M To: ?idx To4 ;M ( val Index -- ) ! :M +To: ?idx ++4 ;M ( incVal index -- ) ! \ Fill the array with a value ! :M Fill: ( val -- ) limit 0 DO DUP I To4 LOOP DROP ;M ! ;Class ! \ ================================================================== ! \ X-Array can execute its elements. ! :Class X-Array <Super Array \ cell <indexed ! \ ( ind -- ) execute the cfa at Ind ! :M Exec: ?idx At4 DUP 0= ABORT" Null xt" EXECUTE ;M ! :M ClassInit: ['] NOOP Fill: self ;M ;Class ! \ ================================================================== ! \ Basic byte array. ! :Class ByteArray <Super IndexedObj 1 <Indexed ! :M At: ?idx At1 ;M ( index -- val ) ! :M To: ?idx To1 ;M ( val Index -- ) ! :M +To: ?idx ++1 ;M ( incVal index -- ) ! \ Fill the array with a value ! :M Fill: ( val -- ) idxBase limit ROT FILL ;M ;Class --- 2,144 ---- \ Classes for indexed objects ! \ Version 1.2, 4 Feb 1997 \ Andrew McKewan \ mc...@au... \ Win32Forth version, 3 July 2006 G.Hubert (Requires V6.11.10 or later) + \ *P These classes are for one-dimensional arrays. The size of the array is passed to the + \ ** array when it is created, either at compile-time or at run-time for arrays created + \ ** with NEW>. For IVARS the size is passed when the IVAR is declared. + anew -array11.f ! needs ext_classes\sequence.f ! \ *S Glossary ! in-system ! :Class IndexedObj ( #elems -- ) <Super Sequence ! \ *G This is the base class for all indexed objects. It provides the ! \ ** primitives that are common to all indexed objects. ! CELL <Indexed ! in-previous ! :M IxAddr: ( -- addr ) ! \ *G Leave addr of 0th indexed element. ! idxBase ;M ! :M Limit: ( -- limit ) ! \ *G Leave max #elements for array. ! limit ;M ! ! :M Width: ( -- len ) ! \ *G Leave width of indexed elements. ! #width ;M ! ! :M ^Elem: ( index -- addr ) ! \ *G Return the address of an indexed element. ! ?idx ^elem ;M ! ! :M Clear: ( -- ) ! \ *G Indexed Clear: erases indexed area ! idxBase #width limit * ERASE ;M ;Class + \ *G End of class ! :Class Array ( #elems -- ) <Super IndexedObj ! \ *G A standard one-dimensional array of #elems elements. The elements are referenced ! \ ** by a 0 based index. ! var current ! :M At: ( index -- n ) ! \ *G Fetch the element at index. ! ?idx At4 ;M ! :M To: ( n Index -- ) ! \ *G Put n into the element at index. ! ?idx To4 ;M ! :M +To: ( n index -- ) ! \ *G Add n to the element at index. ! ?idx ++4 ;M ! :M Fill: ( n -- ) ! \ *G Fill all the elements of the array with n. ! limit 0 DO DUP I To4 LOOP DROP ;M ! :m first?: ( -- elem t | f ) ! \ *G Return first element and true. ! clear: current ! 0 at: self true ;m ! :m next?: ( -- ^obj t | f ) ! \ *G Return next obj and true if there is a next object; false otherwise. ! 1 +: current get: current dup limit < ! IF at: self true ! ELSE drop false ! THEN ;m ! :m print: ! \ *G Print all elements. ! BEGIN ! each: self ! WHILE cr . ! REPEAT ;m ! ! :m apply: ( xt -- ) ! \ *G Apply xt to each element and store the result in the element. xt should have the ! \ ** stack effect ( n1 -- n2 ). ! >r ! BEGIN ! each: self ! WHILE ! r@ ( elem xt ) execute ! get: current to: self ! REPEAT r> drop ;m ;Class + \ *G End of Class. ! :Class X-Array ( #elems -- ) <Super Array ! \ *G Create an array of execution vectors; i.e. a jump table. ! :M Exec: ( index -- ) ! \ *G Execute the cfa at Index. ! ?idx At4 DUP 0= ABORT" Null xt" EXECUTE ;M ! :M ClassInit: ( -- ) ! \ *G Initialise the class. The elements are set to perform noop. ! ['] NOOP Fill: self ;M ! ;Class ! \ *G End of Class. ! ! :Class ByteArray ( #elems -- ) <Super IndexedObj ! \ *G Array of bytes. ! 1 <Indexed ! ! :M At: ( index -- n ) ! \ *G Fetch the element at index. ! ?idx At1 ;M ! :M To: ( n Index -- ) ! \ *G Put n into the element at index. ! ?idx To1 ;M ! :M +To: ( n index -- ) ! \ *G Add n to the element at index. ! ?idx ++1 ;M ! ! :M Fill: ( n -- ) ! \ *G Fill all the elements of the array with n. ! idxBase limit ROT FILL ;M ;Class + \ *G End of Class. + + \ *Z + --- NEW FILE: Sequence.f --- \ $Id: Sequence.f,v 1.1 2007/02/21 09:57:32 georgeahubert Exp $ \ Originally written by Doug Hoffman \ Ported to W32F Monday, February 19 2007 by George Hubert anew -sequence.f needs ext_classes\var11.f in-system :class SEQUENCE <super object \ *G SEQUENCE is a generic superclass for classes which have multiple items which \ ** frequently need to be looked at in sequence. At present the main function of \ ** Sequence is to implement the EACH: method, which makes it very simple to \ ** deal with each element. The usage is \ *E BEGIN each: <obj> WHILE <do something to the element> REPEAT \ *P Sequence can be a superclass for any class which implements the \ ** FIRST?: and NEXT?: methods. The actual implementation details are quite \ ** irrelevant, as long as these methods are supported. in-previous bool each_started? :m first?: false ;m :m next?: false ;m :m EACH: \ ( -- (varies) T | -- F ) get: each_started? IF \ Subsequent time in: next?: [ self ] IF true ELSE clear: each_started? false THEN ELSE \ First time in: first?: [ self ] 0= IF 0 exitm THEN set: each_started? true \ Yes, we've got the 1st element THEN ;m :m UNEACH: \ Use to terminate an EACH: loop before the end. clear: each_started? ;m :m apply: ( xt -- ) >r BEGIN each: self WHILE r@ ( elem xt ) execute REPEAT r> drop ;m ;class |
|
From: George H. <geo...@us...> - 2007-02-06 11:31:40
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv32034/win32forth/src Modified Files: Utils.f Log Message: gah: Fixed minor bug in copyfile Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Utils.f,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** Utils.f 21 Oct 2006 10:54:55 -0000 1.14 --- Utils.f 6 Feb 2007 11:31:32 -0000 1.15 *************** *** 338,342 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : copyfile { \ from$ to$ -<from to>- } \ copy a file to a directory max-path localAlloc: from$ max-path localAlloc: to$ --- 338,346 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : copyfile ( -<from to>- -- ) \ W32F ! \ *G Copy a file to a directory. The from string is made up of the path (either absolute ! \ ** or relative) and the file name (with extension). The to string is the path (either ! \ ** absolute or relative) only; the filename is taken from the from string. ! { | from$ to$ } max-path localAlloc: from$ max-path localAlloc: to$ |
|
From: George H. <geo...@us...> - 2007-02-03 11:02:59
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29556/win32forth/apps/Win32ForthIDE Modified Files: EdToolbar.f Log Message: gah: Added search previous to toolbar. Index: EdToolbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdToolbar.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** EdToolbar.f 13 Jan 2007 02:20:10 -0000 1.9 --- EdToolbar.f 3 Feb 2007 11:02:53 -0000 1.10 *************** *** 55,59 **** ts," Search... (Ctrl+F)" ts," Search next (F3)" ! ts," Find Text in Files..." ts," Compile" ts," Close file" --- 55,59 ---- ts," Search... (Ctrl+F)" ts," Search next (F3)" ! ts," Find Text in Files... (Ctrl+Shift+F)" ts," Compile" ts," Close file" *************** *** 62,65 **** --- 62,66 ---- ts," Forward" ts," Browse" + ts," Search previous (Shift+F3)" ;ToolStrings *************** *** 84,87 **** --- 85,89 ---- ts," Forward" ts," Browse" + ts," Search previous" ;ToolStrings *************** *** 106,109 **** --- 108,112 ---- 11 IDM_FIND_TEXT TBSTATE_ENABLED TBSTYLE_BUTTON 9 ToolBarButton, 12 IDM_FIND_NEXT TBSTATE_ENABLED TBSTYLE_BUTTON 10 ToolBarButton, + 13 IDM_FIND_PREVIOUS TBSTATE_ENABLED TBSTYLE_BUTTON 18 ToolBarButton, 10 IDM_FIND_IN_FILES TBSTATE_ENABLED TBSTYLE_BUTTON 11 ToolBarButton, SeparatorButton, *************** *** 426,473 **** if ?Modified: ActiveChild 0<> ?BrowseMode: ActiveChild not and IDM_SAVE EnableButton: ControlToolbar ! ?Selection: ActiveChild IDM_CUT EnableButton: ControlToolbar ! ?Selection: ActiveChild IDM_COPY EnableButton: ControlToolbar ! CanPaste: ActiveChild IDM_PASTE EnableButton: ControlToolbar ! CanUndo: ActiveChild IDM_UNDO EnableButton: ControlToolbar ! CanRedo: ActiveChild IDM_REDO EnableButton: ControlToolbar ! GetTextLength: ActiveChild IDM_FIND_TEXT EnableButton: ControlToolbar ! ?Find: ActiveChild IDM_FIND_NEXT EnableButton: ControlToolbar ! GetTextLength: ActiveChild IDM_BROWSE EnableButton: ControlToolbar else ! false IDM_SAVE EnableButton: ControlToolbar ! false IDM_CUT EnableButton: ControlToolbar ! false IDM_COPY EnableButton: ControlToolbar ! false IDM_PASTE EnableButton: ControlToolbar ! false IDM_UNDO EnableButton: ControlToolbar ! false IDM_REDO EnableButton: ControlToolbar ! false IDM_FIND_TEXT EnableButton: ControlToolbar ! false IDM_FIND_NEXT EnableButton: ControlToolbar ! false IDM_REDO EnableButton: ControlToolbar false IDM_BROWSE EnableButton: ControlToolbar then ! true IDM_SAVE_ALL EnableButton: ControlToolbar ! true IDM_CLOSE EnableButton: ControlToolbar ! true IDM_CLOSE_ALL EnableButton: ControlToolbar ! true IDM_BACK EnableButton: ControlToolbar ! true IDM_FORWARD EnableButton: ControlToolbar else ! false IDM_SAVE EnableButton: ControlToolbar ! false IDM_SAVE_ALL EnableButton: ControlToolbar ! false IDM_CLOSE EnableButton: ControlToolbar ! false IDM_CLOSE_ALL EnableButton: ControlToolbar ! false IDM_CUT EnableButton: ControlToolbar ! false IDM_COPY EnableButton: ControlToolbar ! false IDM_PASTE EnableButton: ControlToolbar ! false IDM_UNDO EnableButton: ControlToolbar ! false IDM_FIND_TEXT EnableButton: ControlToolbar ! false IDM_FIND_NEXT EnableButton: ControlToolbar ! false IDM_REDO EnableButton: ControlToolbar ! false IDM_BACK EnableButton: ControlToolbar ! false IDM_FORWARD EnableButton: ControlToolbar then --- 429,479 ---- if ?Modified: ActiveChild 0<> ?BrowseMode: ActiveChild not and IDM_SAVE EnableButton: ControlToolbar ! ?Selection: ActiveChild IDM_CUT EnableButton: ControlToolbar ! ?Selection: ActiveChild IDM_COPY EnableButton: ControlToolbar ! CanPaste: ActiveChild IDM_PASTE EnableButton: ControlToolbar ! CanUndo: ActiveChild IDM_UNDO EnableButton: ControlToolbar ! CanRedo: ActiveChild IDM_REDO EnableButton: ControlToolbar ! GetTextLength: ActiveChild IDM_FIND_TEXT EnableButton: ControlToolbar ! ?Find: ActiveChild IDM_FIND_NEXT EnableButton: ControlToolbar ! ?Find: ActiveChild IDM_FIND_PREVIOUS EnableButton: ControlToolbar ! GetTextLength: ActiveChild IDM_BROWSE EnableButton: ControlToolbar else ! false IDM_SAVE EnableButton: ControlToolbar ! false IDM_CUT EnableButton: ControlToolbar ! false IDM_COPY EnableButton: ControlToolbar ! false IDM_PASTE EnableButton: ControlToolbar ! false IDM_UNDO EnableButton: ControlToolbar ! false IDM_REDO EnableButton: ControlToolbar ! false IDM_FIND_TEXT EnableButton: ControlToolbar ! false IDM_FIND_NEXT EnableButton: ControlToolbar ! false IDM_FIND_PREVIOUS EnableButton: ControlToolbar ! false IDM_REDO EnableButton: ControlToolbar false IDM_BROWSE EnableButton: ControlToolbar then ! true IDM_SAVE_ALL EnableButton: ControlToolbar ! true IDM_CLOSE EnableButton: ControlToolbar ! true IDM_CLOSE_ALL EnableButton: ControlToolbar ! true IDM_BACK EnableButton: ControlToolbar ! true IDM_FORWARD EnableButton: ControlToolbar else ! false IDM_SAVE EnableButton: ControlToolbar ! false IDM_SAVE_ALL EnableButton: ControlToolbar ! false IDM_CLOSE EnableButton: ControlToolbar ! false IDM_CLOSE_ALL EnableButton: ControlToolbar ! false IDM_CUT EnableButton: ControlToolbar ! false IDM_COPY EnableButton: ControlToolbar ! false IDM_PASTE EnableButton: ControlToolbar ! false IDM_UNDO EnableButton: ControlToolbar ! false IDM_FIND_TEXT EnableButton: ControlToolbar ! false IDM_FIND_NEXT EnableButton: ControlToolbar ! false IDM_FIND_PREVIOUS EnableButton: ControlToolbar ! false IDM_REDO EnableButton: ControlToolbar ! false IDM_BACK EnableButton: ControlToolbar ! false IDM_FORWARD EnableButton: ControlToolbar then |
|
From: Alex M. <ale...@us...> - 2007-02-01 23:02:15
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10624 Modified Files: gkernel.f Log Message: arm: improve see based on type system Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 *** gkernel.f 24 Jan 2007 23:48:39 -0000 1.30 --- gkernel.f 1 Feb 2007 23:02:02 -0000 1.31 *************** *** 2800,2806 **** ; \ immediate word, compile only - |: (p") ( -- buff ) \ runtime internal for (x") words - "parse new$ dup>r place r> dup +null ; \ uses temp buffer - |: [s"] ( -<string">- -- a1 n1 ) \ compile: generate the string "parse postpone sliteral ; --- 2800,2803 ---- *************** *** 2812,2815 **** --- 2809,2815 ---- here ," 1+ postpone literal ; + |: (p") ( -- buff ) \ runtime internal for (x") words + "parse new$ dup>r place r> dup +null ; \ uses temp buffer + : s" ( -<string">- -- a1 n1 ) (p") count compilation> drop [s"] ; : c" ( -<string">- -- a1 ) (p") compilation> drop [c"] ; *************** *** 4068,4074 **** : rename-file ( adr1 len adr2 len -- ior ) - \ [ maxbuffer maxbuffer + ] literal _localalloc dup>r \ get 2 buffers - \ ascii-z -rot \ addr2 - \ r> maxcounted + ascii-z \ addr1 _mlocalbuff ascii-z -rot _mlocalbuff ascii-z --- 4068,4071 ---- *************** *** 4279,4283 **** (comp-only) \ compile only compilation> ( -- xt ) drop ! branch >mark 2 ; \ jump will get filled in later : if ( c: -- orig ) \ branch on fl=false --- 4276,4280 ---- (comp-only) \ compile only compilation> ( -- xt ) drop ! branch >mark 2 ; 0 0 in/out \ jump will get filled in later : if ( c: -- orig ) \ branch on fl=false *************** *** 4285,4289 **** (comp-only) \ compile only compilation> ( -- xt ) drop ! ?branch >mark 2 ; \ jump will get filled in later : -if ( c: -- orig ) \ branch on fl=false --- 4282,4286 ---- (comp-only) \ compile only compilation> ( -- xt ) drop ! ?branch >mark 2 ; 1 0 in/out \ jump will get filled in later : -if ( c: -- orig ) \ branch on fl=false *************** *** 4291,4305 **** (comp-only) \ compile only compilation> ( -- xt ) drop ! -?branch >mark 2 ; \ jump will get filled in later : then ( c: orig -- ) \ resolve the forward jump (comp-only) \ compile only compilation> ( -- xt ) drop ! 2 ?pairs <resolve ; : endif ( c: orig -- ) \ resolve the forward jump (comp-only) \ compile only compilation> ( -- xt ) drop ! postpone then ; : else ( c: orig1 -- orig2 ) \ resolve the orig --- 4288,4302 ---- (comp-only) \ compile only compilation> ( -- xt ) drop ! -?branch >mark 2 ; 1 1 in/out \ jump will get filled in later : then ( c: orig -- ) \ resolve the forward jump (comp-only) \ compile only compilation> ( -- xt ) drop ! 2 ?pairs <resolve ; 0 0 in/out : endif ( c: orig -- ) \ resolve the forward jump (comp-only) \ compile only compilation> ( -- xt ) drop ! postpone then ; 0 0 in/out : else ( c: orig1 -- orig2 ) \ resolve the orig *************** *** 4307,4321 **** compilation> ( -- xt ) drop postpone ahead 2swap ! postpone then ; : begin ( c: -- dest ) \ label for until/again/repeat (comp-only) \ compile only compilation> ( -- xt ) drop ! >mark 1 ; : again ( c: dest -- ) \ backward jump (comp-only) \ compile only compilation> ( -- xt ) drop ! 1 ?pairs branch >resolve ; : until ( c: dest -- ) \ backward conditional jump --- 4304,4318 ---- compilation> ( -- xt ) drop postpone ahead 2swap ! postpone then ; 0 0 in/out : begin ( c: -- dest ) \ label for until/again/repeat (comp-only) \ compile only compilation> ( -- xt ) drop ! >mark 1 ; 0 0 in/out : again ( c: dest -- ) \ backward jump (comp-only) \ compile only compilation> ( -- xt ) drop ! 1 ?pairs branch >resolve ; 0 0 in/out : until ( c: dest -- ) \ backward conditional jump *************** *** 4323,4327 **** (comp-only) \ compile only compilation> ( -- xt ) drop ! 1 ?pairs ?branch >resolve ; : while ( c: dest -- orig dest ) --- 4320,4324 ---- (comp-only) \ compile only compilation> ( -- xt ) drop ! 1 ?pairs ?branch >resolve ; 1 0 in/out : while ( c: dest -- orig dest ) *************** *** 4329,4333 **** (comp-only) \ compile only compilation> ( -- xt ) drop ! postpone if 2swap ; : repeat ( c: orig dest -- ) --- 4326,4330 ---- (comp-only) \ compile only compilation> ( -- xt ) drop ! postpone if 2swap ; 1 0 in/out : repeat ( c: orig dest -- ) *************** *** 4335,4339 **** compilation> ( -- xt ) drop postpone again ! postpone then ; : recurse ( -- ) \ cause current definition to execute itself --- 4332,4336 ---- compilation> ( -- xt ) drop postpone again ! postpone then ; 0 0 in/out : recurse ( -- ) \ cause current definition to execute itself *************** *** 4366,4370 **** (comp-only) compilation> drop 0 cs-leave spush ! _do (copy-code) >mark 5 ; \ the repeat location gcode _?do-part1 --- 4363,4367 ---- (comp-only) compilation> drop 0 cs-leave spush ! _do (copy-code) >mark 5 ; 2 0 in/out \ the repeat location gcode _?do-part1 *************** *** 4389,4393 **** 0 cs-leave spush _?do-part1 (copy-code) >mark 4 \ for "don't do this loop" ! _?do-part2 (copy-code) >mark 5 ; \ the repeat location gcode _i --- 4386,4390 ---- 0 cs-leave spush _?do-part1 (copy-code) >mark 4 \ for "don't do this loop" ! _?do-part2 (copy-code) >mark 5 ; 2 0 in/out \ the repeat location gcode _i *************** *** 4405,4410 **** ;g ! : i ( -- ) ( r: -- n ) (comp-only) compilation> drop _i (copy-code) ; ! : j ( -- ) ( r: -- n ) (comp-only) compilation> drop _j (copy-code) ; gcode _unloop --- 4402,4407 ---- ;g ! : i ( -- ) ( r: -- n ) (comp-only) compilation> drop _i (copy-code) ; 0 1 in/out ! : j ( -- ) ( r: -- n ) (comp-only) compilation> drop _j (copy-code) ; 0 1 in/out gcode _unloop *************** *** 4414,4422 **** : unloop ( -- ) ( r: n1 n2 -- ) \ removes loop parameters ! (comp-only) compilation> drop _unloop (copy-code) ; : leave ( -- ) \ forward branch to unloop in loop ( r: n1 n2 -- ) ! (comp-only) compilation> drop branch >mark cs-leave spush ; : ?leave ( f -- ) --- 4411,4419 ---- : unloop ( -- ) ( r: n1 n2 -- ) \ removes loop parameters ! (comp-only) compilation> drop _unloop (copy-code) ; 0 0 in/out : leave ( -- ) \ forward branch to unloop in loop ( r: n1 n2 -- ) ! (comp-only) compilation> drop branch >mark cs-leave spush ; 0 0 in/out : ?leave ( f -- ) *************** *** 4425,4429 **** postpone if postpone leave ! postpone then ; gcode _loop --- 4422,4426 ---- postpone if postpone leave ! postpone then ; 1 0 in/out gcode _loop *************** *** 4457,4469 **** : loop ( c: do-sys -- ) ( r: n1 n2 -- ) ! (comp-only) compilation> drop _loop (loop) ; : +loop ( n -- ) ( c: do-sys -- ) ( r: n1 n2 -- ) ! (comp-only) compilation> drop _+loop (loop) ; : -loop ( n -- ) ( c: do-sys -- ) ( r: n1 n2 -- ) ! (comp-only) compilation> drop _-loop (loop) ; \ -------------------- Eaker CASE statement --------------------------------- --- 4454,4466 ---- : loop ( c: do-sys -- ) ( r: n1 n2 -- ) ! (comp-only) compilation> drop _loop (loop) ; 0 0 in/out : +loop ( n -- ) ( c: do-sys -- ) ( r: n1 n2 -- ) ! (comp-only) compilation> drop _+loop (loop) ; 1 0 in/out : -loop ( n -- ) ( c: do-sys -- ) ( r: n1 n2 -- ) ! (comp-only) compilation> drop _-loop (loop) ; 1 0 in/out \ -------------------- Eaker CASE statement --------------------------------- *************** *** 4566,4570 **** then postpone unnest \ generate the ret (needed; may be a branch target) ! ; : ?exit ( f1 -- ) \ conditional exit --- 4563,4567 ---- then postpone unnest \ generate the ret (needed; may be a branch target) ! ; 0 0 in/out : ?exit ( f1 -- ) \ conditional exit *************** *** 4573,4577 **** postpone if postpone exit ! postpone then ; variable csp \ current stack pointer variable --- 4570,4574 ---- postpone if postpone exit ! postpone then ; 1 0 in/out variable csp \ current stack pointer variable *************** *** 4621,4625 **** ['] ;noname is ; \ set the noname ; word (:noname) ! ; : : ( -<name>- -- ) \ forth's primary function defining word --- 4618,4622 ---- ['] ;noname is ; \ set the noname ; word (:noname) ! ; 0 0 in/out : : ( -<name>- -- ) \ forth's primary function defining word *************** *** 4628,4642 **** ['] ;name is ; \ set the named ; word (:noname) ! ; ! ! : compilation> ( -- xt ) \ for alternative compilation semantics ! (comp-only) \ compile only ! compilation> ( -- xt ) drop ! ?csp \ check no rubbish on the stack ! postpone exit \ stop current definition ! 0 to localstk \ can have its own locals ! cs-leave -stack \ clear the stack used for leave addresses ! code-here latestxt @ (compiles-set) \ make the defined word compile this ! ; : as ( 'name' -- ) \ make name an alias of call last winproc --- 4625,4629 ---- ['] ;name is ; \ set the named ; word (:noname) ! ; 0 0 in/out : as ( 'name' -- ) \ make name an alias of call last winproc *************** *** 4698,4701 **** --- 4685,4689 ---- r> ! \ adjust jump part of xt of create tcol tfa! \ last name is now a colon definition + -1 -1 in/out \ stack effects unknown at this point ; *************** *** 4712,4715 **** --- 4700,4713 ---- ; + : compilation> ( -- xt ) \ for alternative compilation semantics + (comp-only) \ compile only + compilation> ( -- xt ) drop + ?csp \ check no rubbish on the stack + postpone exit \ stop current definition + 0 to localstk \ can have its own locals + cs-leave -stack \ clear the stack used for leave addresses + code-here latestxt @ (compiles-set) \ make the defined word compile this + ; + \ -------------------- Error Handler -------------------------------- *************** *** 4736,4740 **** sp! drop r> ! then ; : abort ( -- ) --- 4734,4738 ---- sp! drop r> ! then ; 1 0 in/out : abort ( -- ) *************** *** 4946,4949 **** --- 4944,4968 ---- defer edit-error ' noop is edit-error ( -- ) \ start editor at error + : (viewinfo) ( nfa -- line# addr ) + \ *G Find source for word. + dup >vfa@ swap >ffa@ \ fetch line #, file name + over 1 < \ view < 1 + over -1 = or \ or file = -1 + if drop (file-console) \ must be console + else dup 0= \ if it's a zero, it's kernel + if drop (file-kernel) then + then ; + + : (viewtype) ( line# c-addr -- ) + s" in file " type count type + dup 0<> if + s" at line " type 10. + else drop then ; + + + : .viewinfo ( nfa -- ) + \ *G Print file & line # + (viewinfo) (viewtype) ; + : ctype ( c-str -- ) \ print message if not null count -if type space else 2drop then ; *************** *** 4967,4975 **** if 2 cells+ ctype ptrnull then \ print the message, set ptr 2 null to stop loop repeat ! loading? if ! c" in file" ctype (srcfile) ctype ! c" at line" ctype sourceline# . ! then ! r> base ! \ restore base ; --- 4986,4991 ---- if 2 cells+ ctype ptrnull then \ print the message, set ptr 2 null to stop loop repeat ! loading? if sourceline# (srcfile) (viewtype) ! then r> base ! \ restore base ; |
|
From: Alex M. <ale...@us...> - 2007-02-01 23:01:48
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10561 Modified Files: dis486.f primutil.f Log Message: arm: improve see based on type system Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** primutil.f 24 Jan 2007 11:48:55 -0000 1.20 --- primutil.f 1 Feb 2007 23:01:39 -0000 1.21 *************** *** 101,105 **** : 2constant ( n m "name" ) ! >system create , , dp> does> 2@ ; --- 101,105 ---- : 2constant ( n m "name" ) ! create , , does> 2@ ; *************** *** 237,266 **** \ ------------------------------------------------------------------------ \ ------------------------------------------------------------------------ in-system - : (viewinfo) ( nfa -- line# addr ) - \ *G Find source for word. - dup >vfa@ swap >ffa@ \ fetch line #, file name - over 1 < \ view < 1 - over -1 = or \ or file = -1 - if drop (file-console) \ must be console - else dup 0= \ if it's a zero, it's kernel - if drop (file-kernel) then - then ; - - : .viewinfo ( nfa -- ) - \ *G Print file & line # - (viewinfo) - ." loaded from " count type 15 ?cr - dup 0<> if - ." at line " 10. - else drop then ; - - \ ------------------------------------------------------------------------ - \ Conditional compiling - \ ------------------------------------------------------------------------ - : \- ( "word" -- ) \ *G Interpret the rest of the line if "word" isn't defined. --- 237,245 ---- \ ------------------------------------------------------------------------ + \ Conditional compiling \ ------------------------------------------------------------------------ in-system : \- ( "word" -- ) \ *G Interpret the rest of the line if "word" isn't defined. Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** dis486.f 24 Jan 2007 23:48:17 -0000 1.11 --- dis486.f 1 Feb 2007 23:01:39 -0000 1.12 *************** *** 546,550 **** : .shift ( n -- ) bits0-2 S" rolrorrclrcrshlshrxxxsar" 3 .ss ; - : shf ( addr op -- addr' ) >r count --- 546,549 ---- *************** *** 1074,1077 **** --- 1073,1078 ---- : describe ( xt -- ) dup>r >name cr + + \ do the header piece dup dup n>tfa c@ case *************** *** 1084,1098 **** tvoc of ." vocabulary " .id endof toff of 0 r@ execute . ." offset " .id endof ! swap ." : " .id endcase dup (in/out@) swap ." ( " desc-stack ." -- " desc-stack ! dup ." ) " oper-col ." \ len=" n>ofa w@ . dup ." type=" n>tfa c@ . dup ." flag=" n>flg c@ h.2 ! dup cr oper-col ." \ file=" >ffa@ .id ! dup >vfa@ 10. ! r>drop drop ; --- 1085,1122 ---- tvoc of ." vocabulary " .id endof toff of 0 r@ execute . ." offset " .id endof ! swap ." : " .id ." ( no type )" endcase + + \ stack effects dup (in/out@) swap ." ( " desc-stack ." -- " desc-stack ! dup ." ) " ! ! \ compile information ! oper-col ." \ " ! r> \ get the xt ! dup >comp @ dup \ fetch the comp xt ! case ! ['] xt-call, of ." call compiled" endof ! ['] xt-inline, of ." compiled inline" endof ! dup show-name ." optimises" ! endcase drop ! ! >ct 2@ dup \ get the xts of the compile words ! case ! ['] compile, of endof ! ['] execute of ." , immediate" endof ! dup ." , " show-name ." is non-std compilation part" ! endcase drop ! drop ! ! \ misc head info ! cr oper-col ." \ len=" n>ofa w@ . dup ." type=" n>tfa c@ . dup ." flag=" n>flg c@ h.2 ! ! \ tell user where the word was loaded ! cr oper-col ." \ " .viewinfo ; |
|
From: Alex M. <ale...@us...> - 2007-02-01 23:01:42
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10506 Modified Files: gkernel.exe Log Message: arm: improve see based on type system Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 Binary files /tmp/cvsWZhT5i and /tmp/cvsv0xjpb differ |
|
From: George H. <geo...@us...> - 2007-01-27 10:32:40
|
Update of /cvsroot/win32forth/win32forth-610old/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9902/win32forth-610old/src Modified Files: EXCEPTIO.F Log Message: gah: Modified to use h. rather than . to prevent recursive exceptions when base is accidently set to 0. Index: EXCEPTIO.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-610old/src/EXCEPTIO.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EXCEPTIO.F 14 Dec 2004 23:53:57 -0000 1.1 --- EXCEPTIO.F 27 Jan 2007 10:32:37 -0000 1.2 *************** *** 13,26 **** Exception Handling V4.0C ------------------------ ! Exception 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 --- 13,26 ---- Exception Handling V4.0C ------------------------ ! Exception 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 *************** *** 45,49 **** 9. Returns to OS to undertake the recovery. ! Trapping Memory Write Errors ---------------------------- --- 45,49 ---- 9. Returns to OS to undertake the recovery. ! Trapping Memory Write Errors ---------------------------- *************** *** 51,58 **** 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. --- 51,58 ---- 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. *************** *** 60,79 **** 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 error and automatically commits the memory and retries the failing instruction. ! For instance: ! PAGE_NOACCESS MEM_RESERVE 0x400000 0 CALL VirtualAlloc ABS>REL 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 --- 60,79 ---- 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 error and automatically commits the memory and retries the failing instruction. ! For instance: ! PAGE_NOACCESS MEM_RESERVE 0x400000 0 CALL VirtualAlloc ABS>REL 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 *************** *** 88,92 **** Here's some sample output: ! 0 @ \ fetch from absolute zero --- 88,92 ---- Here's some sample output: ! 0 @ \ fetch from absolute zero *************** *** 109,113 **** 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. --- 109,113 ---- 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. *************** *** 139,143 **** : (except-io) ; \ basic forth io ! ' (except-io) is EXCEPT-IO --- 139,143 ---- : (except-io) ; \ basic forth io ! ' (except-io) is EXCEPT-IO *************** *** 260,267 **** : .exname ( addr -- ) \ only available in non-turnkeyed apps ! ?name dup .NAME $.viewinfo drop drop ; ! : except-rstack ( a1 -- ) cr ." Backtracking: " --- 260,267 ---- : .exname ( addr -- ) \ only available in non-turnkeyed apps ! ?name dup .NAME $.viewinfo drop drop ; ! : except-rstack ( a1 -- ) cr ." Backtracking: " *************** *** 270,275 **** if i @ here u< if dup >name nfa-count type ! i @ ! swap >body - cell / 1- ." +" . else h. then --- 270,275 ---- if i @ here u< if dup >name nfa-count type ! i @ ! swap >body - cell / 1- ." +" h. else h. then *************** *** 288,292 **** : .exregs ( n -- ) @ 14 col h.8 ; ! : except-presskey ( -- ) cr ." Press any key to exit..." wait ; --- 288,292 ---- : .exregs ( n -- ) @ 14 col h.8 ; ! : except-presskey ( -- ) cr ." Press any key to exit..." wait ; |
|
From: George H. <geo...@us...> - 2007-01-27 10:27:19
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7781/win32forth/src Modified Files: EXCEPTIO.F Log Message: gah: Modified to use h. rather than . to prevent recursive exceptions when base is accidently set to 0. Index: EXCEPTIO.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/EXCEPTIO.F,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** EXCEPTIO.F 29 Aug 2005 15:56:27 -0000 1.6 --- EXCEPTIO.F 27 Jan 2007 10:27:15 -0000 1.7 *************** *** 13,26 **** Exception Handling V4.0C ------------------------ ! Exception 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 --- 13,26 ---- Exception Handling V4.0C ------------------------ ! Exception 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 *************** *** 45,49 **** 9. Returns to OS to undertake the recovery. ! Trapping Memory Write Errors ---------------------------- --- 45,49 ---- 9. Returns to OS to undertake the recovery. ! Trapping Memory Write Errors ---------------------------- *************** *** 51,58 **** 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. --- 51,58 ---- 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. *************** *** 60,79 **** 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 error and automatically commits the memory and retries the failing instruction. ! 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 --- 60,79 ---- 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 error and automatically commits the memory and retries the failing instruction. ! 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 *************** *** 88,92 **** Here's some sample output: ! 0 @ \ fetch from absolute zero --- 88,92 ---- Here's some sample output: ! 0 @ \ fetch from absolute zero *************** *** 109,113 **** 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. --- 109,113 ---- 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. *************** *** 141,145 **** : (except-io) ; \ basic forth io ! ' (except-io) is EXCEPT-IO --- 141,145 ---- : (except-io) ; \ basic forth io ! ' (except-io) is EXCEPT-IO *************** *** 260,267 **** : .exname ( addr -- ) \ only available in non-turnkeyed apps ! ?name dup .NAME $.viewinfo drop drop ; ! : except-rstack ( a1 -- ) cr ." Backtracking: " --- 260,267 ---- : .exname ( addr -- ) \ only available in non-turnkeyed apps ! ?name dup .NAME $.viewinfo drop drop ; ! : except-rstack ( a1 -- ) cr ." Backtracking: " *************** *** 270,275 **** if i @ here u< if dup >name nfa-count type ! i @ ! swap >body - cell / 1- ." +" . else h. then --- 270,275 ---- if i @ here u< if dup >name nfa-count type ! i @ ! swap >body - cell / 1- ." +" h. else h. then *************** *** 288,292 **** : .exregs ( n -- ) @ 14 col h.8 ; ! : except-presskey ( -- ) cr ." Press any key to exit..." wait ; --- 288,292 ---- : .exregs ( n -- ) @ 14 col h.8 ; ! : except-presskey ( -- ) cr ." Press any key to exit..." wait ; |
|
From: Alex M. <ale...@us...> - 2007-01-24 23:48:42
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18516 Modified Files: gkernel.f Log Message: arm: 3rd pass: corrections for type system Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** gkernel.f 22 Jan 2007 21:51:40 -0000 1.29 --- gkernel.f 24 Jan 2007 23:48:39 -0000 1.30 *************** *** 410,466 **** : (comp-only) ( -- ) throw_componly throw ; \ compile only message ! \ -------------------- Cell Operators --------------------------------- ! code cells ( n1 -- n1*cell ) \ multiply n1 by the cell size 1 1 in/out ! lea eax, [eax*4] next; ! code cells+ ( a1 n1 -- a1+n1*cell ) \ multiply n1 by the cell size and add [...1143 lines suppressed...] *** 2532,2536 **** : variable ( "name") \ compile time ( -- n ) \ run time ! create 0 , ['] (comp-cons) compiles-last 0 1 in/out --- 2511,2515 ---- : variable ( "name") \ compile time ( -- n ) \ run time ! ['] dovar tvar dogen 0 , ['] (comp-cons) compiles-last 0 1 in/out *************** *** 4718,4721 **** --- 4697,4701 ---- - cell- \ make relative r> ! \ adjust jump part of xt of create + tcol tfa! \ last name is now a colon definition ; |
|
From: Alex M. <ale...@us...> - 2007-01-24 23:48:20
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18497 Modified Files: dis486.f extend.f Log Message: arm: 3rd pass: corrections for type system Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** dis486.f 24 Jan 2007 11:48:54 -0000 1.10 --- dis486.f 24 Jan 2007 23:48:17 -0000 1.11 *************** *** 1079,1082 **** --- 1079,1083 ---- tcon of r@ execute . ." constant " .id endof tvar of ." variable " .id ." ( is " r@ execute @ 10. ." ) " endof + tcre of ." create " .id ." ( addr " r@ execute $. ." ) " endof tcol of ." : " .id endof tdef of ." defer " .id ." ( is " r@ defer@ .name ." )" endof Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** extend.f 30 Oct 2006 09:15:14 -0000 1.15 --- extend.f 24 Jan 2007 23:48:17 -0000 1.16 *************** *** 52,55 **** --- 52,56 ---- .olly + \ sys-fload src\optliterals \ literals optimiser |
|
From: Alex M. <ale...@us...> - 2007-01-24 23:48:10
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18307 Modified Files: gkernel.exe Log Message: arm: 3rd pass: corrections for type system Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 Binary files /tmp/cvsAl63Hw and /tmp/cvs9BdAVI differ |
|
From: Alex M. <ale...@us...> - 2007-01-24 23:44:40
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17376 Modified Files: gkernel.exe Log Message: arm: 3rd pass: corrections for type system Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 Binary files /tmp/cvsx9A8rM and /tmp/cvsDoAAXi differ |
|
From: Alex M. <ale...@us...> - 2007-01-24 23:36:57
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14872 Modified Files: gkernel.exe Log Message: Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 Binary files /tmp/cvsLerdB1 and /tmp/cvsGYyt9P differ |
|
From: George H. <geo...@us...> - 2007-01-24 11:49:19
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21076/win32forth-stc/src Modified Files: dis486.f primutil.f Log Message: gah: Modified to correctly see offsets. Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** primutil.f 13 Nov 2006 13:01:37 -0000 1.19 --- primutil.f 24 Jan 2007 11:48:55 -0000 1.20 *************** *** 125,129 **** : offset ( n1 <-name-> -- ) \ compiling ( n2 -- n3 ) \ runtime n3=n1+n2 ! (offset) ['] (comp-offs) compiles-last ; : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 --- 125,130 ---- : offset ( n1 <-name-> -- ) \ compiling ( n2 -- n3 ) \ runtime n3=n1+n2 ! (offset) ['] (comp-offs) compiles-last ! toff tfa! 1 1 in/out ; : field+ ( n1 n2 <-name-> -- n3 ) \ compiling n3=n1+n2 stored offset=n1 Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** dis486.f 22 Jan 2007 21:51:11 -0000 1.9 --- dis486.f 24 Jan 2007 11:48:54 -0000 1.10 *************** *** 1082,1085 **** --- 1082,1086 ---- tdef of ." defer " .id ." ( is " r@ defer@ .name ." )" endof tvoc of ." vocabulary " .id endof + toff of 0 r@ execute . ." offset " .id endof swap ." : " .id endcase |
|
From: Alex M. <ale...@us...> - 2007-01-22 21:51:43
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30472 Modified Files: gkernel.f gmeta-compiler.f Log Message: arm: 2nd pass: more support for type system Index: gmeta-compiler.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-compiler.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** gmeta-compiler.f 15 Dec 2006 12:21:48 -0000 1.11 --- gmeta-compiler.f 22 Jan 2007 21:51:40 -0000 1.12 *************** *** 545,548 **** --- 545,556 ---- ; + : t-tfa! ( type -- ) \ set the type + last-h @ n>tfa tsys-c! ; + + : in/out ( n m -- ) + 2dup + ste-o ! ste-i ! + last-h @ n>ste dup>r 1+ tsys-c! r> tsys-c! ; + \ resolution of cts \ points to execute and compile, *************** *** 666,669 **** --- 674,678 ---- init-assembler tcode-here to ofa-h \ save code address in ofa + tcol t-tfa! ; *************** *** 681,686 **** tcode-, ; \ the value ! : t-dogen ( xt <-name-> -- ) \ generate do code ! >r code r> t-align t-here t-ecxaddr make-tjmp, \ name -> mov ecx, # here | jmp xt macro[ c; ]macro --- 690,696 ---- tcode-, ; \ the value ! : t-dogen ( xt type-of-name <-name-> -- ) \ generate do code ! 2>r code 2r> ! t-tfa! \ type t-align t-here t-ecxaddr make-tjmp, \ name -> mov ecx, # here | jmp xt macro[ c; ]macro *************** *** 726,729 **** --- 736,741 ---- ]macro r>drop in-application + 0 0 in/out + tvoc t-tfa! ; *************** *** 1005,1015 **** : variable ( -<name>- ) \ create a variable (changable) t-align t-here meta-constant ! s" 't-ptr dovar" evaluate t-dogen 0 t-, ; : create ( -<name>- ) \ create a ptr to here t-align t-here meta-constant ! s" 't-ptr dovar" evaluate t-dogen ; --- 1017,1029 ---- : variable ( -<name>- ) \ create a variable (changable) t-align t-here meta-constant ! s" 't-ptr dovar" evaluate tvar t-dogen 0 t-, + 0 1 in/out ; : create ( -<name>- ) \ create a ptr to here t-align t-here meta-constant ! s" 't-ptr dovar" evaluate tvar t-dogen ! 0 1 in/out ; *************** *** 1017,1027 **** dup meta-constant >r code r@ t-literal macro[ next c; ]macro r>drop ; : value ( n -<name>- ) \ create a self fetching changeable value ! s" 't-ptr doval" evaluate t-dogen t-, ; --- 1031,1044 ---- dup meta-constant >r code + tcon t-tfa! r@ t-literal macro[ next c; ]macro r>drop + 0 1 in/out ; : value ( n -<name>- ) \ create a self fetching changeable value ! s" 't-ptr doval" evaluate tval t-dogen t-, + 0 1 in/out ; *************** *** 1057,1060 **** --- 1074,1079 ---- next c; \ this can be called in interpreter ]macro r> drop + tusr t-tfa! + 0 1 in/out ; *************** *** 1069,1072 **** --- 1088,1092 ---- c; ]macro r> drop ofa-meta + tdef t-tfa! ; *************** *** 1096,1099 **** --- 1116,1121 ---- next c; \ this can be called in interpreter ]macro r> drop + toff t-tfa! + 0 1 in/out ; *************** *** 1110,1118 **** ; - : in/out ( n m -- ) - 2dup - ste-o ! ste-i ! - last-h @ n>ste dup>r 1+ tsys-c! r> tsys-c! ; - \ ====================================================================== \ Meta compiler Branching & Looping --- 1132,1135 ---- Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** gkernel.f 15 Dec 2006 12:21:48 -0000 1.28 --- gkernel.f 22 Jan 2007 21:51:40 -0000 1.29 *************** *** 2480,2486 **** 7 constant tcol 8 constant tvoc ! 9 constant tflt ! 10 constant tstr ! 11 constant tobj : mov-tos,#n ( n -- ) \ generate a mov eax, # n --- 2480,2487 ---- 7 constant tcol 8 constant tvoc ! 9 constant toff ! 10 constant tflt ! 11 constant tstr ! 12 constant tobj : mov-tos,#n ( n -- ) \ generate a mov eax, # n *************** *** 2533,2538 **** create 0 , ['] (comp-cons) compiles-last ! 0 0 in/out ! ; 0 1 in/out : (comp-val) ( n -- ) --- 2534,2539 ---- create 0 , ['] (comp-cons) compiles-last ! 0 1 in/out ! ; 0 0 in/out : (comp-val) ( n -- ) *************** *** 3647,3651 **** : user ( n -<name>- ) \ create a user variable ['] dousr tusr dogen , ! ; : newuser ( n -<name>- ) \ creates a user. a user can be --- 3648,3653 ---- : user ( n -<name>- ) \ create a user variable ['] dousr tusr dogen , ! 0 1 in/out ! ; 1 0 in/out : newuser ( n -<name>- ) \ creates a user. a user can be *************** *** 4905,4909 **** : lexicon ( -- ) \ like a vocabulary, but in app space ! lexthreads #lexicon ; : #vocabulary ( #threads -<name>- ) --- 4907,4913 ---- : lexicon ( -- ) \ like a vocabulary, but in app space ! lexthreads #lexicon ! 0 0 in/out ! ; 0 0 in/out : #vocabulary ( #threads -<name>- ) *************** *** 4913,4917 **** : vocabulary ( -- ) ! vthreads #vocabulary ; : case-asis ( -- ) \ case insenstive vocabulary --- 4917,4923 ---- : vocabulary ( -- ) ! vthreads #vocabulary ! 0 0 in/out ! ; 0 0 in/out : case-asis ( -- ) \ case insenstive vocabulary |
|
From: Alex M. <ale...@us...> - 2007-01-22 21:51:15
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30440 Modified Files: dis486.f Log Message: arm: 2nd pass: more support for type system Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** dis486.f 2 Dec 2006 12:21:22 -0000 1.8 --- dis486.f 22 Jan 2007 21:51:11 -0000 1.9 *************** *** 1067,1080 **** repeat 3drop ; - \ create ttable - \ tval , ," value" - \ tvar - \ tcon - \ tusr - \ tdef - \ tloc - \ tcol - - : desc-stack ( n -- ) dup 0< if drop ." ? " else . then ; --- 1067,1070 ---- *************** *** 1101,1105 **** dup ." flag=" n>flg c@ h.2 dup cr oper-col ." \ file=" >ffa@ .id ! dup ." @ " >vfa@ 10. r>drop drop ; --- 1091,1095 ---- dup ." flag=" n>flg c@ h.2 dup cr oper-col ." \ file=" >ffa@ .id ! dup >vfa@ 10. r>drop drop ; |
|
From: Alex M. <ale...@us...> - 2007-01-22 21:51:09
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30010 Modified Files: gkernel.exe Log Message: arm: 2nd pass: more support for type system Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 Binary files /tmp/cvsFn5HFQ and /tmp/cvswXwqVB differ |
1040 messages has been excluded from this view by a project administrator.
