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
|
