[Win32forth-cvs] win32forth-stc/src/kernel gkernel.f,1.15,1.16

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth-stc/src/kernel
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv19782/src/kernel

Modified Files:
	gkernel.f 
Log Message:
"HOLD added

Index: gkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** gkernel.f	6 Oct 2006 12:16:34 -0000	1.15
--- gkernel.f	8 Oct 2006 14:41:26 -0000	1.16
***************
*** 531,535 ****
  code nip        ( n1 n2 -- n2 ) \ discard second item on data stack
       2 1 in/out
!                 next; 
  
  code tuck       ( n1 n2 -- n2 n1 n2 ) \ copy top data stack to under second item
--- 531,535 ----
  code nip        ( n1 n2 -- n2 ) \ discard second item on data stack
       2 1 in/out
!                 next;
  
  code tuck       ( n1 n2 -- n2 n1 n2 ) \ copy top data stack to under second item
***************
*** 2427,2431 ****
              >system                           \ constant value in system space
              ['] doval dogen ,
!             dp>                     
              ['] (comp-cons) name-compiles     \ make the defined word compile this
              ;
--- 2427,2431 ----
              >system                           \ constant value in system space
              ['] doval dogen ,
!             dp>
              ['] (comp-cons) name-compiles     \ make the defined word compile this
              ;
***************
*** 2650,2655 ****
  : char      ( -- char ) parse-word drop c@ ;
  
! : [char]    ( -- char ) 
!             (comp-only) compilation> drop char postpone literal ; 
  
  : /parse    ( -- addr u )
--- 2650,2655 ----
  : char      ( -- char ) parse-word drop c@ ;
  
! : [char]    ( -- char )
!             (comp-only) compilation> drop char postpone literal ;
  
  : /parse    ( -- addr u )
***************
*** 3274,3277 ****
--- 3274,3278 ----
                  next;
  
+ : "HOLD         ( addr len -- )   dup negate hld +! hld @ swap move ;
  : #s            ( d1 -- d2 )      begin # 2dup or 0= until ;
  : (d.)          ( d -- addr len ) tuck dabs <# #s rot sign #> ;
***************
*** 4259,4263 ****
                  add     0 [ebp], eax
                  mov     eax, ecx
!                 next; 
  
  create cs-leave 16 cells allot                      \ for leave only
--- 4260,4264 ----
                  add     0 [ebp], eax
                  mov     eax, ecx
!                 next;
  
  create cs-leave 16 cells allot                      \ for leave only
***************
*** 5443,5450 ****
  
  : action-of ( "name" )                        \ get action for defer
!             ' defer@ 
              compilation> drop
                ' >body postpone literal postpone @ ;
!               
  ' to alias is immediate                       \ is or to works with defer & value
  
--- 5444,5451 ----
  
  : action-of ( "name" )                        \ get action for defer
!             ' defer@
              compilation> drop
                ' >body postpone literal postpone @ ;
! 
  ' to alias is immediate                       \ is or to works with defer & value
  
***************
*** 5865,5869 ****
          repeat drop
          .olly-fileid close-file drop r> base ! ;
!         
  in-application
  
--- 5866,5870 ----
          repeat drop
          .olly-fileid close-file drop r> base ! ;
! 
  in-application