Menu
▾
▴
[Win32forth-cvs] win32forth-stc/src Class.f, 1.8, 1.9 numconv.f, 1.1, 1.2 primhash.f, 1.3, 1.4 words.f, 1.3, 1.4
|
From: George H. <geo...@us...> - 2007-05-21 08:38:50
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26852/win32forth-stc/src Modified Files: Class.f numconv.f primhash.f words.f Log Message: gah:increased no of method lists to 4, moved MethodExecute and MethodCatch to Forth vocabulary and enabled constants (after fixing bug). Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Class.f 20 May 2007 15:09:13 -0000 1.8 --- Class.f 21 May 2007 08:38:46 -0000 1.9 *************** *** 1363,1383 **** IF idxBase 2 - w@ ( #elems ) * + CELL+ THEN ; - \ -------------------------------------------------------------------- - \ ------------- Support for windows procedures etc ------------------- - \ -------------------------------------------------------------------- - - : MethodExecute ( i*x ^obj methodXT -- j*x ) - \ *G Version of execute for objects and methods. - (comp-only) - compilation> drop postpone swap postpone PushOP postpone OP postpone ! - postpone execute postpone PopOP ; - - : MethodCatch ( i*x ^obj methodXT -- j*x 0 | i*x ^obj n ) - \ *G Version of catch for objects and methods. - (comp-only) - compilation> drop postpone swap postpone PushOP postpone OP postpone ! - postpone catch postpone dup postpone if postpone self postpone swap - postpone then postpone PopOP ; - \ ==================================================================== \ Support for 2 dimensional arrays --- 1363,1366 ---- *************** *** 1427,1430 **** --- 1410,1424 ---- ~: [ dup>r ] r> cell- Free Abort" Disposing Object failed!" ; + \ -------------------------------------------------------------------- + \ ------------- Support for windows procedures etc ------------------- + \ -------------------------------------------------------------------- + + : MethodExecute ( i*x ^obj methodXT -- j*x ) + \ *G Version of execute for objects and methods. + swap PushOP OP ! execute PopOP ; + + : MethodCatch ( i*x ^obj methodXT -- j*x 0 | i*x ^obj n ) + \ *G Version of catch for objects and methods. + swap PushOP OP ! catch -if self swap then PopOP ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Index: words.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/words.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** words.f 20 May 2007 15:53:23 -0000 1.3 --- words.f 21 May 2007 08:38:46 -0000 1.4 *************** *** 94,103 **** then nuf? 0= ; ! (( : count-constants ( -- n1 ) \ count the constants available to system constant-tot 0= \ only count if not counted... ! if WinConPtr proc>cfa @ dodefer = \ Leave if 'wcFindWin32Constant' ! if 0 EXIT then \ hasn't already been resolved ! &.WinConstantCount 0 here CALL wcEnumWin32Constants DROP ! then constant-tot ; )) EXTERNAL --- 94,103 ---- then nuf? 0= ; ! : count-constants ( -- n1 ) \ count the constants available to system constant-tot 0= \ only count if not counted... ! if WinConlib load-dll 0= \ Leave if wincon.dll ! if 0 EXIT then \ isn't present ! ['] .WinConstantCount 0 here CALL wcEnumWin32Constants DROP ! then constant-tot ; EXTERNAL *************** *** 130,138 **** ( cr count-constants 6 u,.r ." Windows Constants available") ; ! (( : CONSTANTS ( -<optional_name>- ) cr 0 to constant-cnt ! WinConPtr proc>cfa @ dodefer = \ Leave if 'wcFindWin32Constant' ! if ." WINCON.DLL missing" EXIT then \ hasn't already been resolved cr ." ----------- Windows Constants " --- 130,138 ---- ( cr count-constants 6 u,.r ." Windows Constants available") ; ! : CONSTANTS ( -<optional_name>- ) cr 0 to constant-cnt ! WinConlib load-dll 0= \ Leave if wincon.dll ! if ." WINCON.DLL missing" EXIT then \ isn't present cr ." ----------- Windows Constants " *************** *** 141,149 **** bl word ?uppercase count words-pocket place bl word ?uppercase drop ! &.WinConstant 0 here CALL wcEnumWin32Constants DROP cr horizontal-line cr ." Displayed " constant-cnt . ." of the " ! count-constants . ." Windows Constants in the system." ; )) : with-address ( -- ) --- 141,149 ---- bl word ?uppercase count words-pocket place bl word ?uppercase drop ! ['] .WinConstant 0 here CALL wcEnumWin32Constants DROP cr horizontal-line cr ." Displayed " constant-cnt . ." of the " ! count-constants . ." Windows Constants in the system." ; : with-address ( -- ) Index: primhash.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primhash.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** primhash.f 24 Apr 2007 09:00:16 -0000 1.3 --- primhash.f 21 May 2007 08:38:46 -0000 1.4 *************** *** 16,19 **** --- 16,21 ---- \ Dirk Busch (dirk at win32forth.org) \ George Hubert (georgeahubert at yahoo.co.uk) + \ Jos V d Ven + \ Tom Dixon \ The original Win32Forth system was public domain; this kernel (and \ currently the kernel alone) is GPL. Although the basic structure of *************** *** 54,59 **** 7 #vocabulary classes ! sys-here ' classes >body - \ voc-pfa-size ! 2 dup 4 + cells sys-reserve \ extra for a class swap constant voc-pfa-size --- 56,61 ---- 7 #vocabulary classes ! sys-here ' classes >body - \ voc-pfa-size ! 4 dup \ Number of method lists; used below 4 + cells sys-reserve \ extra for a class swap constant voc-pfa-size Index: numconv.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/numconv.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** numconv.f 21 Sep 2006 16:26:33 -0000 1.1 --- numconv.f 21 May 2007 08:38:46 -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) Tom Zimmer --- 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) Tom Zimmer *************** *** 21,34 **** 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. ! ------------------------------------------------------------------------ --- 21,34 ---- 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. ! ------------------------------------------------------------------------ *************** *** 54,58 **** \ has been detected in each routine separately. ! \ Floating point numbers are returned in the floating point stack; there is \ no return value, and the variable FLOAT? is set. See FLOAT.F for details; \ the code is in that file, not here. NOTE - even floating point routines must --- 54,58 ---- \ has been detected in each routine separately. ! \ Floating point numbers are returned in the floating point stack; there is \ no return value, and the variable FLOAT? is set. See FLOAT.F for details; \ the code is in that file, not here. NOTE - even floating point routines must *************** *** 198,202 **** library wincon.dll ! \ winlib-last @ constant WinConLib 3 proc wcFindWin32Constant \ winproc-last @ constant WinConPtr \ for **WORDS.F** --- 198,202 ---- library wincon.dll ! winlib-last @ constant WinConLib 3 proc wcFindWin32Constant \ winproc-last @ constant WinConPtr \ for **WORDS.F** *************** *** 262,266 **** : number? ( addr len -- d f ) \ to support >float num-init ! ['] dotted-number? catch 0= double? 0= and \ october 1st, 1996 - 10:51 tjz & am ; \ double exponent not allowed --- 262,266 ---- : number? ( addr len -- d f ) \ to support >float num-init ! ['] dotted-number? catch 0= double? 0= and \ october 1st, 1996 - 10:51 tjz & am ; \ double exponent not allowed |
