Thread: [Win32forth-cvs] win32forth/src CHILDWND.F, 1.9, 1.10 CLASSDBG.F, 1.9, 1.10 Class.f, 1.26, 1.27 GEN

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15535/win32forth/src

Modified Files:
	CHILDWND.F CLASSDBG.F Class.f GENERIC.F PRIMHASH.F 
Log Message:
gah: Added #mlists to enable multiple methods lists (currently set to2).

Index: CHILDWND.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** CHILDWND.F	8 Nov 2006 11:11:24 -0000	1.9
--- CHILDWND.F	16 Apr 2007 08:29:05 -0000	1.10
***************
*** 10,13 ****
--- 10,15 ----
  only forth also definitions

+ needs window.f
+ 
  :CLASS Child-Window     <Super Window
  \ *G Child-Window is the base class for all child windows.

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.26
retrieving revision 1.27
diff -C2 -d -r1.26 -r1.27
*** Class.f	21 Feb 2007 10:13:17 -0000	1.26
--- Class.f	16 Apr 2007 08:29:06 -0000	1.27
***************
*** 66,74 ****

  voc-pfa-size nostack1
! cell field+ MFA        \ method dictionary
! cell field+ IFA        \ instance variable dictionary
! cell field+ DFA        \ data area size in bytes
! cell field+ XFA        \ width of indexed items
! cell field+ SFA        \ pointer to superclass
  constant class-size    \ size of class pfa

--- 66,74 ----

  voc-pfa-size nostack1
! #mlists cells field+ MFA        \ method dictionary
!         cell  field+ IFA        \ instance variable dictionary
!         cell  field+ DFA        \ data area size in bytes
!         cell  field+ XFA        \ width of indexed items
!         cell  field+ SFA        \ pointer to superclass
  constant class-size    \ size of class pfa

***************
*** 247,251 ****
  : VFIND         ( str -- str f OR ^iclass t )
                  ^class
!                 IF      dup count method-hash ^class IFA ((findm))
                          -if  rot drop  then
                  ELSE    0
--- 247,251 ----
  : VFIND         ( str -- str f OR ^iclass t )
                  ^class
!                 IF      dup count method-hash ^class IFA ((findv))
                          -if  rot drop  then
                  ELSE    0
***************
*** 253,257 ****

  : classVFIND    ( str ^class -- str f OR ^iclass t )
!                 >r dup count method-hash r> IFA ((findm))
                  -if  rot drop  then  ;

--- 253,257 ----

  : classVFIND    ( str ^class -- str f OR ^iclass t )
!                 >r dup count method-hash r> IFA ((findv))
                  -if  rot drop  then  ;

***************
*** 634,638 ****
                  ?Class ?Exec
                  dup pocket count rot new-method on add-hash
!                 ^Class MFA link,        \ link
                  ,                       \ name is selector's hashed value
                  m0cfa ,                 \ build methods cfas
--- 634,639 ----
                  ?Class ?Exec
                  dup pocket count rot new-method on add-hash
!                 ^Class MFA over [ #mlists 1- cells ] literal and +
!                 link,        \ link
                  ,                       \ name is selector's hashed value
                  m0cfa ,                 \ build methods cfas
***************
*** 1251,1255 ****
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup>r ] r> cell- Free Abort" Disposing Object failed!" ;

--- 1252,1256 ----
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup ] cell- Free Abort" Disposing Object failed!" ;

Index: GENERIC.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** GENERIC.F	11 Aug 2006 10:09:45 -0000	1.14
--- GENERIC.F	16 Apr 2007 08:29:06 -0000	1.15
***************
*** 395,399 ****
  \ ** The foreground window is the window at the top of the Z order. It is the window that the
  \ ** user is working with. In a preemptive multitasking environment, you should generally let the
! \ ** user control which window is the foreground window. }n
  \ ** Windows 98, Windows 2000: The system restricts which processes can set the foreground window.
  \ ** A process can set the foreground window only if one of the following conditions is true: \n
--- 395,399 ----
  \ ** The foreground window is the window at the top of the Z order. It is the window that the
  \ ** user is working with. In a preemptive multitasking environment, you should generally let the
! \ ** user control which window is the foreground window. \n
  \ ** Windows 98, Windows 2000: The system restricts which processes can set the foreground window.
  \ ** A process can set the foreground window only if one of the following conditions is true: \n
***************
*** 431,438 ****
  \ ** application-defined message and title, plus any combination of predefined icons and push buttons.
  \ *L
! \ *| szText  | Pointer to a null-terminated string that contains the message to be displayed. \n
! \ *| szTitle | Pointer to a null-terminated string that contains the dialog box title. If this parameter is NULL, the default title Error is used. \n
! \ *| Type    | Specifies the contents and behavior of the dialog box. This parameter can be a combination of flags from the following groups of flags.
! \ *P To indicate the buttons displayed in the message box, specify one of the following values.
  \ *L
  \ *| MB_ABORTRETRYIGNORE  | The message box contains three push buttons: Abort, Retry, and Ignore. |
--- 431,438 ----
  \ ** application-defined message and title, plus any combination of predefined icons and push buttons.
  \ *L
! \ *| szText  | Pointer to a null-terminated string that contains the message to be displayed. |
! \ *| szTitle | Pointer to a null-terminated string that contains the dialog box title. If this parameter is NULL, the default title Error is used. |
! \ *| Type    | Specifies the contents and behavior of the dialog box. This parameter can be a combination of flags from the following groups of flags. |
! \ *P To indicate the buttons displayed in the message box, specify one of the following values. |
  \ *L
  \ *| MB_ABORTRETRYIGNORE  | The message box contains three push buttons: Abort, Retry, and Ignore. |

Index: PRIMHASH.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/PRIMHASH.F,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** PRIMHASH.F	5 Jan 2006 11:03:55 -0000	1.4
--- PRIMHASH.F	16 Apr 2007 08:29:06 -0000	1.5
***************
*** 5,8 ****
--- 5,19 ----
  cr .( Loading Primitive Hash...)

+ 7 #vocabulary classes
+ 
+ sys-here ' classes >body -                    \ voc-pfa-size
+           5 cells sys-reserve                 \ extra for a class
+           constant voc-pfa-size
+ 
+ also classes get-current definitions
+ 
+ 2 constant #mlists \ Number of method lists; must a non-zero be a power of 2.
+ 
+ set-current previous

  \ ---------------- 32-bit Hash Function for Objects ----------------
***************
*** 27,30 ****
--- 38,44 ----
  CODE ((FINDM))  ( SelID addr -- 0cfa t | f )
                  pop     eax                     \ selector id
+                 mov     ecx, eax
+                 and     ecx, # also classes #mlists 1- cells previous
+                 add     ebx, ecx
  @@1:            mov     ebx, 0 [ebx]            \ follow link
                  test    ebx, ebx                \ end of list?
***************
*** 37,40 ****
--- 51,65 ----
  @@2:            next    c;

+ CODE ((FINDV))  ( SelID addr -- 0cfa t | f )
+                 pop     eax                     \ selector id
+ @@1:            mov     ebx, 0 [ebx]            \ follow link
+                 test    ebx, ebx                \ end of list?
+                 je      short @@2
+                 cmp     eax, 4 [ebx]            \ selectors match?
+                 jne     short @@1
+                 add     ebx, # 8                \ method cfa
+                 push    ebx
+                 mov     ebx, # -1               \ and true flag
+ @@2:            next    c;

  \ -------------------- Runtime for Methods --------------------
***************
*** 238,247 ****
  ' hashed vcfa>voc constant hash-wid

- 7 #vocabulary classes
- 
- sys-here ' classes >body -                    \ voc-pfa-size
-           5 cells sys-reserve                 \ extra for a class
-           constant voc-pfa-size
- 
  : (unhash)  ( hash-val -- addr len flag )
          hash-wid dup voc#threads cells+ hash-wid  ( hash-wid end to hash-wid )
--- 263,266 ----

Index: CLASSDBG.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CLASSDBG.F,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** CLASSDBG.F	10 Jun 2006 13:17:24 -0000	1.9
--- CLASSDBG.F	16 Apr 2007 08:29:06 -0000	1.10
***************
*** 17,24 ****

  : _methods      ( class_body -- )
!                 MFA
                  begin   @ ?dup
                  while   .method
!                 repeat  ;

  : ?.match       ( n lfa -- n )
--- 17,26 ----

  : _methods      ( class_body -- )
!                 MFA #mlists 0 do
!                 dup i cells+
                  begin   @ ?dup
                  while   .method
!                 repeat
!                 loop drop ;

  : ?.match       ( n lfa -- n )
***************
*** 50,58 ****
                  cr ." New Methods :-" cr
                  ' >body dup
!                 sfa @  swap
!                 mfa over mfa @ to superlist
                  begin   @ dup superlist <>
                  while   .method
                  repeat  drop
                  cr ." Inherited Methods :-" cr
                   _methods ;
--- 52,62 ----
                  cr ." New Methods :-" cr
                  ' >body dup
!                 sfa @ swap
!                 #mlists 0 do 2dup
!                 mfa i cells+ swap mfa i cells+ @ to superlist
                  begin   @ dup superlist <>
                  while   .method
                  repeat  drop
+                 loop    drop
                  cr ." Inherited Methods :-" cr
                   _methods ;

Thread: [Win32forth-cvs] win32forth/src CHILDWND.F, 1.9, 1.10 CLASSDBG.F, 1.9, 1.10 Class.f, 1.26, 1.27 GEN

win32forth-cvs