[Win32forth-cvs] win32forth/src CALLBACK.f, 1.18, 1.19 CLASSDBG.F, 1.10, 1.11 Class.f, 1.42, 1.43 D

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

Update of /cvsroot/win32forth/win32forth/src
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv2829

Modified Files:
	CALLBACK.f CLASSDBG.F Class.f Debug.f FLOAT.F Menu.f 
	Primutil.f Window.f 
Log Message:
Tidy up of comments

Index: CALLBACK.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CALLBACK.f,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** CALLBACK.f	20 Nov 2011 19:42:10 -0000	1.18
--- CALLBACK.f	14 Feb 2013 20:05:47 -0000	1.19
***************
*** 170,174 ****
                  BUILD-CALLBACK >R CONSTANT ' R> ! ;

! : CALLBACK:     ( args -<name>- )               \ w32f sys
  \ *G Define a callback function that has n1 arguments.
  \ *P CALLBACK: creates TWO definitions! The first has the name you specify,
--- 170,174 ----
                  BUILD-CALLBACK >R CONSTANT ' R> ! ;

! : CALLBACK:     ( args -"name"- )               \ w32f sys
  \ *G Define a callback function that has n1 arguments.
  \ *P CALLBACK: creates TWO definitions! The first has the name you specify,

Index: Debug.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Debug.f,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** Debug.f	8 Oct 2008 09:15:07 -0000	1.22
--- Debug.f	14 Feb 2013 20:05:47 -0000	1.23
***************
*** 21,27 ****
  \ ------------------------------------------------------------------------------

! \ theese chains are used to later add new words types to be debugged
! new-chain dbg-nest-chain        ( cfa flag -- cfa false | true )
! new-chain .word-type-chain
  new-chain dbg-next-cell         ( ip cfa -- ip' cfa )

--- 21,27 ----
  \ ------------------------------------------------------------------------------

! \ these chains are used to later add new words types to be debugged
! new-chain dbg-nest-chain        ( i*x cfa flag --  i*x cfa false | true )
! new-chain .word-type-chain      ( cfa flag -- cfa false | true )
  new-chain dbg-next-cell         ( ip cfa -- ip' cfa )

Index: FLOAT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/FLOAT.F,v
retrieving revision 1.56
retrieving revision 1.57
diff -C2 -d -r1.56 -r1.57
*** FLOAT.F	27 Feb 2012 15:04:53 -0000	1.56
--- FLOAT.F	14 Feb 2013 20:05:47 -0000	1.57
***************
*** 427,435 ****
  in-system

! : FVARIABLE     ( compiling -<name>-  -- ; run-time -- addr) \ ANSI        Floating
  \ *G Define a floating-point variable in the dictionary. The contents are undefined.
                  create B/FLOAT allot ;

! : FVALUE  ( compiling -<name>- -- ; fs: r -- ; run-time FS: -- r  ) \ W32F    Floating extra
  \ *G Define a floating point value initialised from the FP stack.
                  create f,
--- 427,435 ----
  in-system

! : FVARIABLE     ( compiling "name"  -- ; run-time -- addr) \ ANSI        Floating
  \ *G Define a floating-point variable in the dictionary. The contents are undefined.
                  create B/FLOAT allot ;

! : FVALUE  ( compiling "name" -- ; fs: r -- ; run-time FS: -- r  ) \ W32F    Floating extra
  \ *G Define a floating point value initialised from the FP stack.
                  create f,
***************
*** 464,469 ****
  in-previous

! : FCONSTANT      ( -<name>- ; fs: r -- )      \ ANSI               Floating
! \ *G      \b Interpretation: ( -<name>- ; fs: r -- ) \d \n
  \ ** Define an FP constant. \n
  \ **      \b Compilation: \d \n
--- 464,469 ----
  in-previous

! : FCONSTANT      ( "name" -- ; fs: r -- )      \ ANSI               Floating
! \ *G      \b Interpretation: ( "name" ; fs: r -- ) \d \n
  \ ** Define an FP constant. \n
  \ **      \b Compilation: \d \n
***************
*** 1512,1516 ****
  in-system

! : float-array   ( n1 -<name>- )         \ compile time
                  ( -- a1 )               \ runtime
                  create floats allot ;
--- 1512,1516 ----
  in-system

! : float-array   ( n1 "name" -- )         \ compile time
                  ( -- a1 )               \ runtime
                  create floats allot ;
***************
*** 1560,1591 ****
  external

! : ^float        ( a1 -<name>- )         \ compile time          64-bits
                  ( fs: -- r )      \ runtime
                  header ^float@ , ^float! , ^float+! , ( a1 ) , ;

! : #^float-array ( n1 -<name>- )         \ compile time          64-bits
                  ( n1 -- ; fs: -- r )   \ runtime
                  header ^#float@ , ^#float! , ^#float+! , ( n1 ) , ;

! : FLOAT         ( -<name>- )            \ compile time          64-bits
                  ( -- ; fs: -- r )   \ runtime
                  header float@ , float! , float+! ,
                  1 floats here over erase allot ;

! : #float-array  ( n1 -<name>- )         \ compile time          64-bits
                  ( n1 -- ; fs: -- r )   \ runtime
                  header #float@ , #float! , #float+! ,
                  ( n1 ) 1+ floats here over erase allot ;

! : f->           ( n1 -<name>- )         \ store a value into a float
                  ' ?float  1 cells+ cfa-comp, ; immediate

! : f+>           ( n1 -<name>- )         \ increment the value of a float
                  ' ?float  2 cells+ cfa-comp, ; immediate

! : f#->          ( n1 -<name>- )         \ store a value into a float
                  ' ?#float  1 cells+ cfa-comp, ; immediate

! : f#+>          ( n1 -<name>- )         \ increment the value of a float
                  ' ?#float  2 cells+ cfa-comp, ; immediate

--- 1560,1591 ----
  external

! : ^float        ( a1 "name" -- )         \ compile time          64-bits
                  ( fs: -- r )      \ runtime
                  header ^float@ , ^float! , ^float+! , ( a1 ) , ;

! : #^float-array ( n1 "name" -- )         \ compile time          64-bits
                  ( n1 -- ; fs: -- r )   \ runtime
                  header ^#float@ , ^#float! , ^#float+! , ( n1 ) , ;

! : FLOAT         ( "name" -- )            \ compile time          64-bits
                  ( -- ; fs: -- r )   \ runtime
                  header float@ , float! , float+! ,
                  1 floats here over erase allot ;

! : #float-array  ( n1 "name" -- )         \ compile time          64-bits
                  ( n1 -- ; fs: -- r )   \ runtime
                  header #float@ , #float! , #float+! ,
                  ( n1 ) 1+ floats here over erase allot ;

! : f->           ( n1 "name" -- )         \ store a value into a float
                  ' ?float  1 cells+ cfa-comp, ; immediate

! : f+>           ( n1 "name" -- )         \ increment the value of a float
                  ' ?float  2 cells+ cfa-comp, ; immediate

! : f#->          ( n1 "name" -- )         \ store a value into a float
                  ' ?#float  1 cells+ cfa-comp, ; immediate

! : f#+>          ( n1 "name" -- )         \ increment the value of a float
                  ' ?#float  2 cells+ cfa-comp, ; immediate

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.42
retrieving revision 1.43
diff -C2 -d -r1.42 -r1.43
*** Class.f	26 Feb 2012 16:43:58 -0000	1.42
--- Class.f	14 Feb 2013 20:05:47 -0000	1.43
***************
*** 1010,1014 ****
  0 value BeginningOfRecordAddress

! : Record:       ( -<name>- )  \ W32F             Class
  \ *G Define a word that returns the starting address of a group of data fields that
  \ ** need to be contiguous. Object IVARS have their class pointer suppressed if used
--- 1010,1014 ----
  0 value BeginningOfRecordAddress

! : Record:       ( -"name"- )  \ W32F             Class
  \ *G Define a word that returns the starting address of a group of data fields that
  \ ** need to be contiguous. Object IVARS have their class pointer suppressed if used
***************
*** 1025,1029 ****
                  0 to contiguous-data? ;

! : ;RecordSize:  ( -<name>- )  \ W32F             Class
  \ *G End a group of data fields that need to be contiguous and create a name with the
  \ ** size of the record.
--- 1025,1029 ----
                  0 to contiguous-data? ;

! : ;RecordSize:  ( -"name"- )  \ W32F             Class
  \ *G End a group of data fields that need to be contiguous and create a name with the
  \ ** size of the record.
***************
*** 1032,1036 ****
  \ -------------------- Instance Variables --------------------

! : bytes         ( n -<name>- )         \ W32F          Class
  \ *G n-Bytes instance variable (array of bytes)
                  header
--- 1032,1036 ----
  \ -------------------- Instance Variables --------------------

! : bytes         ( n -"name"- )         \ W32F          Class
  \ *G n-Bytes instance variable (array of bytes)
                  header
***************
*** 1044,1048 ****
  :noname 0 bytes ; is ivar-name

! : byte          ( -<name>- )           \ W32F          Class
  \ *G Byte (8bit) size instance variable.
                  header
--- 1044,1048 ----
  :noname 0 bytes ; is ivar-name

! : byte          ( -"name"- )           \ W32F          Class
  \ *G Byte (8bit) size instance variable.
                  header
***************
*** 1088,1092 ****
  in-system

! : bits          { nbits -- -<name>- }   \ W32F          Class
  \ *G Define an 'nbits' bit field in prev data item.
  \ *E Example:
--- 1088,1092 ----
  in-system

! : bits          { nbits -- -"name"- }   \ W32F          Class
  \ *G Define an 'nbits' bit field in prev data item.
  \ *E Example:
***************
*** 1113,1118 ****
                  nbits class-bitallot ;

! : short         ( -<name>- )             \ W32F          Class
! \ *G Word integer (16bit) instance variable. When -<name>- is executed the value of -<name>-
  \ ** is zero-extended before pushing onto the stack.
                  header
--- 1113,1118 ----
                  nbits class-bitallot ;

! : short         ( -"name"- )             \ W32F          Class
! \ *G Word integer (16bit) instance variable. When -"name"- is executed the value of -"name"-
  \ ** is zero-extended before pushing onto the stack.
                  header
***************
*** 1124,1128 ****
                  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.
--- 1124,1128 ----
                  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.
***************
*** 1135,1139 ****
                  cell class-allot ;

! : dint          ( -<name>- )              \ W32F          Class
  \ *G Double (64bit) instance variable.
                  header
--- 1135,1139 ----
                  cell class-allot ;

! : dint          ( -"name"- )              \ W32F          Class
  \ *G Double (64bit) instance variable.
                  header
***************
*** 1213,1217 ****
   THROW_INDEX_OFR throw ;

! \ : int-array    ( size -<name>- )
  \                header
  \                (iv[]@) ,
--- 1213,1217 ----
   THROW_INDEX_OFR throw ;

! \ : int-array    ( size -"name"- )
  \                header
  \                (iv[]@) ,

Index: Window.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -d -r1.27 -r1.28
*** Window.f	9 Jun 2012 18:45:47 -0000	1.27
--- Window.f	14 Feb 2013 20:05:48 -0000	1.28
***************
*** 454,463 ****
  :M SetParent:   ( hWndParent -- )
  \ *G Set handle of the owner window (0 if no parent).
! \ *P NOTE: This method is depreacted. Use SetParentWindow: instead.
                  to hWndParent ;M DEPRECATED

  :M ParentWindow: ( -- hWndParent )
  \ *G Get the handle of the owner window (0 if no parent).
! \ *P NOTE: This method is depreacted. Use GetParentWindow: instead.
                  hWndParent ;M DEPRECATED

--- 454,463 ----
  :M SetParent:   ( hWndParent -- )
  \ *G Set handle of the owner window (0 if no parent).
! \ *P NOTE: This method is deprecated. Use SetParentWindow: instead.
                  to hWndParent ;M DEPRECATED

  :M ParentWindow: ( -- hWndParent )
  \ *G Get the handle of the owner window (0 if no parent).
! \ *P NOTE: This method is deprecated. Use GetParentWindow: instead.
                  hWndParent ;M DEPRECATED

Index: Primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v
retrieving revision 1.54
retrieving revision 1.55
diff -C2 -d -r1.54 -r1.55
*** Primutil.f	3 Mar 2012 09:15:14 -0000	1.54
--- Primutil.f	14 Feb 2013 20:05:48 -0000	1.55
***************
*** 616,620 ****

  : IN-SYS-SPACE?   ( addr -- flag )
!                 SYS-ORIGIN SYS-HERE WITHIN SYS-SIZE AND ;

  : IN-CODE-SPACE?   ( addr -- flag )
--- 616,620 ----

  : IN-SYS-SPACE?   ( addr -- flag )
!                 SYS-ORIGIN SYS-HERE WITHIN SYS-SIZE AND 0<> ;

  : IN-CODE-SPACE?   ( addr -- flag )
***************
*** 827,831 ****
  : MessageLoop ( -- )
  \ This word launches a message loop. It will exit only when receiving a
! \ WM_QUIT message. Used with programms TURNKEYed without console.
                  BEGIN  0 0 0 MessageStructure  Call GetMessage
                  WHILE  MessageStructure  HandleMessages drop
--- 827,831 ----
  : MessageLoop ( -- )
  \ This word launches a message loop. It will exit only when receiving a
! \ WM_QUIT message. Used with programs TURNKEYed without console.
                  BEGIN  0 0 0 MessageStructure  Call GetMessage
                  WHILE  MessageStructure  HandleMessages drop

Index: Menu.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Menu.f,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** Menu.f	26 Jun 2010 08:24:15 -0000	1.8
--- Menu.f	14 Feb 2013 20:05:48 -0000	1.9
***************
*** 435,444 ****
                  ;

  in-application

  \in-system-ok :M ClassInit: (ClassInit) ;M

- : m"text"       ( -<"text">- )
-                 here to mtext ,"text" ;

  :M Check:       ( f1 -- )
--- 435,445 ----
                  ;

+ : m"text"       ( -<"text">- )
+                 here to mtext ,"text" ;
+ 
  in-application

  \in-system-ok :M ClassInit: (ClassInit) ;M

  :M Check:       ( f1 -- )

Index: CLASSDBG.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CLASSDBG.F,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** CLASSDBG.F	16 Apr 2007 08:29:06 -0000	1.10
--- CLASSDBG.F	14 Feb 2013 20:05:47 -0000	1.11
***************
*** 82,88 ****

! : matches   ( -<name>- )                 \ W32F      Class debug
  \ *G Print out all the method selectors and IVAR names that have the same hash value as
! \ ** -<name>- will be assigned. If -<name>- is already in use as a selector or an IVAR name
  \ ** then it will appear in the list.
              bl word count "matches ;
--- 82,88 ----

! : matches   ( -"name"- )                 \ W32F      Class debug
  \ *G Print out all the method selectors and IVAR names that have the same hash value as
! \ ** -"name"- will be assigned. If -"name"- is already in use as a selector or an IVAR name
  \ ** then it will appear in the list.
              bl word count "matches ;

[Win32forth-cvs] win32forth/src CALLBACK.f, 1.18, 1.19 CLASSDBG.F, 1.10, 1.11 Class.f, 1.42, 1.43 D

[Win32forth-cvs] win32forth/src CALLBACK.f, 1.18, 1.19 CLASSDBG.F, 1.10, 1.11 Class.f, 1.42, 1.43 Debug.f, 1.22, 1.23 FLOAT.F, 1.56, 1.57 Menu.f, 1.8, 1.9 Primutil.f, 1.54, 1.55 Window.f, 1.27, 1.28