[Win32forth-cvs] win32forth/src Debug.f,1.1,1.2 FLOAT.F,1.8,1.9

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

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 ----
  
  
+