[Win32forth-cvs] win32forth-stc/src Class.f,1.1,1.2

[George H. <geo...@us...>]

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

Modified Files:
	Class.f 
Log Message:
gah:Added INT plus temporary hack to support TO and +TO

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Class.f	24 Apr 2007 09:00:17 -0000	1.1
--- Class.f	25 Apr 2007 09:41:53 -0000	1.2
***************
*** 727,731 ****
                  if      dup find                           \ if its defined
                          if      dup >name n>tfa c@ tCon =  \ and a constant
!                                 if      nip execute        \ then user its value
                                  else    drop >selector  \ else get selector
                                  then
--- 727,731 ----
                  if      dup find                           \ if its defined
                          if      dup >name n>tfa c@ tCon =  \ and a constant
!                                 if      nip execute        \ then use its value
                                  else    drop >selector  \ else get selector
                                  then
***************
*** 1196,1211 ****
                  16 bitmax               \ verify & set bit field finished & new max
                  2 class-allot ;
  
  : int           ( -<name>- )              \ W32F          Class
  \ *G Long integer (32bit) instance variable. When used as an object variable has the same
  \ ** behaviour as VALUEs.
!                 header
!                 (iv@) ,
!                 ^Class DFA @ ,
!                 (iv!) ,
!                 (iv+!) ,
!                 32 bitmax               \ verify & set bit field finished & new max
!                 cell class-allot ;
  
  : dint          ( -<name>- )              \ W32F          Class
  \ *G Double (64bit) instance variable.
--- 1196,1222 ----
                  16 bitmax               \ verify & set bit field finished & new max
                  2 class-allot ;
+ ))
+ 
+ : DoInt
+                 does> @ self + @ ;
  
  : int           ( -<name>- )              \ W32F          Class
  \ *G Long integer (32bit) instance variable. When used as an object variable has the same
  \ ** behaviour as VALUEs.
! \                 header
! \                 (iv@) ,
! \                 ^Class DFA @ ,
! \                 (iv!) ,
! \                 (iv+!) ,
! \                 32 bitmax               \ verify & set bit field finished & new max
! \                 cell class-allot ;
!                 Create ^Class dfa @ ,
!                 cell class-allot
!                 DoInt
!                 tint tfa! ;
! 
! 
  
+ ((
  : dint          ( -<name>- )              \ W32F          Class
  \ *G Double (64bit) instance variable.
***************
*** 1218,1221 ****
--- 1229,1258 ----
                  2 cells class-allot ;
  ))
+ 
+ in-system
+ 
+ 
+ \ Total Hack to be removed when TO and +TO are properly sorted.
+ 
+ code oldto call ' to >ct @ next ;c
+ 
+ : (classto)     ( n -<value>- -- )
+                 >in @ ^class if bl word count ^class (search-self)
+                 ?dup if  dup n>tfa c@ tint = if name>xt nip nip
+                 >body @ postpone ^base postpone literal postpone + postpone !
+                 exit else drop then then then >in ! oldto ;
+ 
+ ' (classto) compiles-for to
+ 
+ code old+to call ' +to >ct @ next ;c
+ 
+ : (class+to)     ( n -<value>- -- )
+                 >in @ ^class if bl word count ^class (search-self)
+                 ?dup if  dup n>tfa c@ tint = if name>xt nip nip
+                 >body @ postpone ^base postpone literal postpone + postpone +!
+                 exit else drop then then then >in ! old+to ;
+ 
+ ' (class+to) compiles-for +to
+ 
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ Primatives for cell sized objects.
***************
*** 1432,1436 ****
  
  ;Class
! \s
  :Class Rectangle  <Super Object
  \ *G Class for rectangles for passing to the OS.
--- 1469,1473 ----
  
  ;Class
! 
  :Class Rectangle  <Super Object
  \ *G Class for rectangles for passing to the OS.
***************
*** 1480,1484 ****
  RECTANGLE temprect      \ a sample rectangle object, used by the system sometimes
  
! 
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ display all classes in the system
--- 1517,1521 ----
  RECTANGLE temprect      \ a sample rectangle object, used by the system sometimes
  
! \s
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ display all classes in the system