Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16167/win32forth/src
Modified Files:
Debug.f FLOAT.F
Log Message:
gah: optimized some code in debug and moved runtime code for float arrays to application space
Index: Debug.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Debug.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Debug.f 21 Dec 2004 00:19:07 -0000 1.1
--- Debug.f 7 Jun 2005 15:59:27 -0000 1.2
***************
*** 161,191 ****
: <STRING> ( ip -- ip' ) CELL+ COUNT + 1+ ALIGNED ;
! : <EXIT> ( ip -- ip' )
! drop nesting @ 0>
! if rtop @ \ unnest level
dup ?name ?dup
if ." Unnesting to: " dup .name cfa-watch
then -1 nesting +!
! else ip0 @ ( done, reset ip for next time )
nesting off
then ;
: <EXITP> ( ip -- ip' )
! drop nesting @ 0>
! if lp @ cell+ @ \ unnest level
! dup ?name ?dup
! if ." Unnesting to: " dup .name cfa-watch
! then -1 nesting +!
! else ip0 @ ( done, reset ip for next time )
! nesting off
! then ;
: <EXITM> ( ip -- ip' )
! drop nesting @ 0>
! if lp @ 2 cells+ @ \ unnest level
! -1 nesting +!
! else ip0 @ ( done, reset ip for next time )
! nesting off
! then ;
: dbg-next ( -- )
--- 161,182 ----
: <STRING> ( ip -- ip' ) CELL+ COUNT + 1+ ALIGNED ;
! : (EXIT) ( ip 'ret -- ip' )
! nip nesting @ 0>
! if @ \ unnest level
dup ?name ?dup
if ." Unnesting to: " dup .name cfa-watch
then -1 nesting +!
! else drop ip0 @ ( done, reset ip for next time )
nesting off
then ;
+ : <EXIT> ( ip -- ip' )
+ rtop (EXIT) ;
+
: <EXITP> ( ip -- ip' )
! lp @ cell+ (EXIT) ;
: <EXITM> ( ip -- ip' )
! lp @ 2 cells+ (EXIT) ;
: dbg-next ( -- )
***************
*** 219,228 ****
['] (.") OF <STRING> ENDOF
['] (ABORT") OF <STRING> ENDOF
- ['] _EXIT OF <EXIT> ENDOF
['] (;CODE) OF <EXIT> ENDOF
['] UNNEST OF <EXIT> ENDOF
- ['] EXITP OF <EXITP> ENDOF
['] UNNESTP OF <EXITP> ENDOF
- ['] EXITM OF <EXITM> ENDOF
['] UNNESTM OF <EXITM> ENDOF
['] init-locals OF 2 cells+ ENDOF
--- 210,216 ----
***************
*** 575,583 ****
_mkey upc \ and wait for next command
ELSE ip @ @
! dup ['] _EXIT = \ if at EXIT
! over ['] UNNEST = or \ or at UNNEST
! over ['] EXITP = or \ or at EXITP
over ['] UNNESTM = or \ or at UNNESTM
- over ['] EXITM = or \ or at EXITM
nip
IF false to ?dbg-cont \ stop continuous
--- 563,569 ----
_mkey upc \ and wait for next command
ELSE ip @ @
! dup ['] UNNEST = \ if at UNNEST
! over ['] UNNESTP = or \ or at UNNESTP
over ['] UNNESTM = or \ or at UNNESTM
nip
IF false to ?dbg-cont \ stop continuous
***************
*** 739,744 ****
- \ in-system
-
: #patchinto ( a1 n1 -<name1 name2>- ) \ patch a1 into name1 at name2
>r \ at occurance n1
--- 725,728 ----
***************
*** 758,762 ****
1 #patchinto ;
- \ in-application
only forth also definitions
--- 742,745 ----
***************
*** 784,785 ****
--- 767,769 ----
+ |
