Update of /cvsroot/win32forth/win32forth-stc/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22869/win32forth-stc/src
Modified Files:
POINTER.F forget.f
Log Message:
gah: Bugfixes to switching between application and system.
Index: POINTER.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/POINTER.F,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** POINTER.F 15 Mar 2007 17:55:15 -0000 1.5
--- POINTER.F 24 Apr 2007 09:15:01 -0000 1.6
***************
*** 24,33 ****
: Pointer ( bytes -<name>- ) \ make a pointer "name"
! in-application in-application \ always in app space
128 max \ at least 160 bytes
create 0 , \ initialize to unallocated
PHEAD link, \ link into chain
, \ lay in size in bytes
! in-application does> \ back to where we came from
dup @ if @ exit then \ ok, straight fetch
dup (pointerlock)
--- 24,33 ----
: Pointer ( bytes -<name>- ) \ make a pointer "name"
! >application \ always in app space
128 max \ at least 160 bytes
create 0 , \ initialize to unallocated
PHEAD link, \ link into chain
, \ lay in size in bytes
! dp> does> \ back to where we came from
dup @ if @ exit then \ ok, straight fetch
dup (pointerlock)
***************
*** 129,162 ****
in-system
! \ These words need to be compile\interpret words
!
!
! \ : UnPointer> ( name -- ) \ deallocate a pointer name following
! \ ' STATE @
! \ IF POSTPONE LITERAL
! \ POSTPONE %UNPOINTER
! \ ELSE %UNPOINTER
! \ THEN ; IMMEDIATE
!
! : UnPointer> ( name -- ) \ deallocate a pointer name following
' %unpointer compilation> drop ' postpone literal postpone %unpointer ;
! : SizeOf!> ( bytes | name -- ) \ set size of the following pointer
! \ ' STATE @
! \ IF POSTPONE LITERAL
! \ POSTPONE %SIZEOF!
! \ ELSE %SIZEOF!
! \ THEN ; IMMEDIATE
! ' %sizeof! compilation> drop ' postpone literal postpone %sizeof! ;
! : SizeOf@> ( -<name>- bytes ) \ get size of the following pointer
! \ ' STATE @
! \ IF POSTPONE LITERAL
! \ POSTPONE %SIZEOF@
! \ ELSE %SIZEOF@
! \ THEN ; IMMEDIATE
! ' %sizeof@ compilation> drop ' postpone literal postpone %sizeof@ ;
! : named-new$ ( -<name>- ) \ a semi-static buffer of MAXSTRING length
MAXSTRING Pointer ;
--- 129,142 ----
in-system
! : UnPointer> ( "name" -- ) \ deallocate a pointer name following
' %unpointer compilation> drop ' postpone literal postpone %unpointer ;
! : SizeOf!> ( bytes "name" -- ) \ set size of the following pointer
! ' %sizeof! compilation> drop ' >pointer postpone literal postpone ! ;
! : SizeOf@> ( "name" -- bytes ) \ get size of the following pointer
! ' %sizeof@ compilation> drop ' >pointer postpone literal postpone @ ;
! : named-new$ ( "name" -- ) \ a semi-static buffer of MAXSTRING length
MAXSTRING Pointer ;
Index: forget.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/forget.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** forget.f 30 Oct 2006 09:15:14 -0000 1.2
--- forget.f 24 Apr 2007 09:15:01 -0000 1.3
***************
*** 176,193 ****
: mark ( -<name>- )
! in-previous in-system create last @ ,
get-current get-order only forth also definitions
Get-marking-info rot >forget-extra 2 cells+
get-order dup>r 0 ?do drop loop r> cells+ -rot save-marking-info
save-search-order set-order set-current
! do-marker in-previous ;
: marker ( -<name>- ) ( ANS)
! in-previous in-system
\ WARNING @ WARNING OFF
Get-marking-info create last @ , Save-marking-info
\ WARNING !
\ save-source here body> ,
! save-search-order do-marker in-previous ;
: POSSIBLY ( "name" -- )
--- 176,193 ----
: mark ( -<name>- )
! get-section 2>r in-system create last @ ,
get-current get-order only forth also definitions
Get-marking-info rot >forget-extra 2 cells+
get-order dup>r 0 ?do drop loop r> cells+ -rot save-marking-info
save-search-order set-order set-current
! do-marker 2r> set-section ;
: marker ( -<name>- ) ( ANS)
! get-section 2>r in-system
\ WARNING @ WARNING OFF
Get-marking-info create last @ , Save-marking-info
\ WARNING !
\ save-source here body> ,
! save-search-order do-marker 2r> set-section ;
: POSSIBLY ( "name" -- )
|
