Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29799/win32forth/src
Modified Files:
POINTER.F Primutil.f
Log Message:
gah:Made pointers thread-safe and improved initialisation.
Index: Primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** Primutil.f 3 Aug 2006 13:08:22 -0000 1.15
--- Primutil.f 5 Aug 2006 12:30:52 -0000 1.16
***************
*** 865,874 ****
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! defer (controllock) ' noop is (controllock)
! defer (controlunlock) ' noop is (controlunlock)
! defer (dialoglock) ' noop is (dialoglock)
! defer (dialogunlock) ' noop is (dialogunlock)
! defer (classnamelock) ' noop is (classnamelock)
! defer (classnameunlock) ' noop is (classnameunlock)
\s
--- 865,898 ----
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! defer (controllock)
! defer (controlunlock)
! defer (dialoglock)
! defer (dialogunlock)
! defer (classnamelock)
! defer (classnameunlock)
! defer (pointerlock)
! defer (pointerunlock)
! defer (dynlock)
! defer (dynunlock)
!
! : init-system-locks-off ( -- )
! \ *G Set all the system deferred words for locking to noops. This is done automatically
! \ ** by the system at start-up so code that uses it will work correctly before the locks
! \ ** are initialised.
! ['] noop is (controllock)
! ['] noop is (controlunlock)
! ['] noop is (dialoglock)
! ['] noop is (dialogunlock)
! ['] noop is (classnamelock)
! ['] noop is (classnameunlock)
! ['] noop is (pointerlock)
! ['] noop is (pointerunlock)
! ['] noop is (dynlock)
! ['] noop is (dynunlock)
! ;
!
! init-system-locks-off
!
! initialization-chain chain-add init-system-locks-off
\s
Index: POINTER.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/POINTER.F,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** POINTER.F 4 Aug 2006 09:48:43 -0000 1.5
--- POINTER.F 5 Aug 2006 12:30:52 -0000 1.6
***************
*** 82,99 ****
drop FALSE \ things went just fine.
EXIT \ April 15th, 1999 - 10:51 tjz corrected
! THEN
dup r@ @ realloc 0=
if r> ! FALSE
else drop r>drop TRUE
! then ;
: DOES>Pointer ( -- address ) \ it's location
DOES>
! dup @
! if @ exit then \ ok, straight fetch
dup 2 cells+ @ malloc
-if dup off \ set first cell to zeros
! dup>r swap ! r>
! else 1-
abort" Failed to allocate POINTER"
then ;
--- 82,100 ----
drop FALSE \ things went just fine.
EXIT \ April 15th, 1999 - 10:51 tjz corrected
! THEN (pointerlock)
dup r@ @ realloc 0=
if r> ! FALSE
else drop r>drop TRUE
! then (pointerunlock) ;
: DOES>Pointer ( -- address ) \ it's location
DOES>
! dup @ if @ exit then \ ok, straight fetch
! (pointerlock)
! dup @ if @ (pointerunlock) exit then \ another task won the race
dup 2 cells+ @ malloc
-if dup off \ set first cell to zeros
! tuck swap ! (pointerunlock)
! else (pointerunlock) 1-
abort" Failed to allocate POINTER"
then ;
***************
*** 144,148 ****
\ released when the program terminates.
! 8192 constant max-dyn-string \ dynamic string space is this big
max-dyn-string Pointer dyn-ptr \ the dynamic string buffer
--- 145,149 ----
\ released when the program terminates.
! 32768 constant max-dyn-string \ dynamic string space is this big (increased for tasks)
max-dyn-string Pointer dyn-ptr \ the dynamic string buffer
***************
*** 153,161 ****
\ return a1 a buffer of n1 bytes
dup
! max-dyn-string 4 / > \ limit one string to 1/4 of total
abort" Can't allocate a dynamic string this large"
! dyn-offset over + max-dyn-string >=
if 0 to dyn-offset
! then dyn-ptr dyn-offset + swap +to dyn-offset ;
: _new$ ( -- a1 ) \ allocate the next MAXSTRING buffer
--- 154,162 ----
\ return a1 a buffer of n1 bytes
dup
! max-dyn-string 16 / > \ limit one string to 1/16 of total
abort" Can't allocate a dynamic string this large"
! (dynlock) dyn-offset over + max-dyn-string >=
if 0 to dyn-offset
! then dyn-ptr dyn-offset + swap +to dyn-offset (dynunlock) ;
: _new$ ( -- a1 ) \ allocate the next MAXSTRING buffer
|
