[Win32forth-cvs] win32forth/src Class.f, 1.37, 1.38 paths.f, 1.36, 1.37

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

Update of /cvsroot/win32forth/win32forth/src
In directory vz-cvs-4.sog:/tmp/cvs-serv8097

Modified Files:
	Class.f paths.f 
Log Message:
Made PATH: thread-safe plus more work on class errors (still work in progress).

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.37
retrieving revision 1.38
diff -C2 -d -r1.37 -r1.38
*** Class.f	21 Jul 2011 18:26:21 -0000	1.37
--- Class.f	18 Aug 2011 15:28:47 -0000	1.38
***************
*** 97,101 ****
  : class-bitallot ( n -- )
                  bitmaxval 0=
!                 abort" Bit fields are not allowed on this data type"
                  dup 0=
                  abort" Zero length bit fields are not allowed"
--- 97,101 ----
  : class-bitallot ( n -- )
                  bitmaxval 0=
!                 THROW_NO_BITS ?throw
                  dup 0=
                  abort" Zero length bit fields are not allowed"
***************
*** 1210,1214 ****
  : ?range  ( index -- index )  \ range check
   DUP idxBase CELL - 2 + w@ ( #elems )  U< IF EXIT THEN
!  TRUE ABORT" Index out of range" ;
  
  \ : int-array    ( size -<name>- )
--- 1210,1214 ----
  : ?range  ( index -- index )  \ range check
   DUP idxBase CELL - 2 + w@ ( #elems )  U< IF EXIT THEN
!  THROW_INDEX_OFR throw ;
  
  \ : int-array    ( size -<name>- )
***************
*** 1240,1244 ****
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup>r ] r> cell- Free Abort" Disposing Object failed!" ;
  
  \ --------------------------------------------------------------------
--- 1240,1244 ----
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup>r ] r> cell- Free THROW_DISPOSE_ERR ?throw ;
  
  \ --------------------------------------------------------------------
***************
*** 1456,1460 ****
  : GetMethod     { \ m0cfa -- -<method: object>- m0cfa }  \ W32F        Class
  \ *G Return the xt of method. Used in interpretive mode or to create parsing words.
!                 @word _msgFind 1 <> abort" Undefined Method"
                  TRUE to get-reference?  \ tell do_message to return method
                  depth >r
--- 1456,1460 ----
  : GetMethod     { \ m0cfa -- -<method: object>- m0cfa }  \ W32F        Class
  \ *G Return the xt of method. Used in interpretive mode or to create parsing words.
!                 @word _msgFind 1 <>  THROW_UNDEF_METH ?throw
                  TRUE to get-reference?  \ tell do_message to return method
                  depth >r

Index: paths.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v
retrieving revision 1.36
retrieving revision 1.37
diff -C2 -d -r1.36 -r1.37
*** paths.f	18 Aug 2011 12:31:47 -0000	1.36
--- paths.f	18 Aug 2011 15:28:47 -0000	1.37
***************
*** 53,68 ****
  \ ** followed by null. \n
  \ ** At runtime it returns address of the counted string of a path.
! 
! \ *P NOTE: Path: defines global search paths wich are not thread-safe so require locking for use in
! \ ** multi-tasking applications.
!         create  -1 , 0 , MAX-PATH 1+ allot  does>   \ run-time: ( -- path )
!         [ 2 cells ] literal +
          ;
  
  INTERNAL
  
! -2 cells offset path-source   ( path  -- 2variable_path-source )
  \ *G Path-source points to a substring in a path. \n
  \ ** Path-source returns this address.
  
  EXTERNAL
--- 53,66 ----
  \ ** followed by null. \n
  \ ** At runtime it returns address of the counted string of a path.
!         create  next-user @ , 2 cells next-user +! MAX-PATH 1+ allot  does>   \ run-time: ( -- path )
!         cell +
          ;
  
  INTERNAL
  
! : path-source   ( path  -- 2variable_path-source )
  \ *G Path-source points to a substring in a path. \n
  \ ** Path-source returns this address.
+         cell- @ up@ + ;
  
  EXTERNAL