[Win32forth-cvs] win32forth-stc/src extend.f, 1.13, 1.14 optinline.f, 1.3, 1.4 optliterals.f, 1.4, 1.5 primutil.f, 1.13, 1.14

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

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

Modified Files:
	extend.f optinline.f optliterals.f primutil.f 
Log Message:
Ported: block.f, ctype.f, enum.f, soundvolume.f, array.f and binsearch.f

Index: primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** primutil.f	25 Oct 2006 10:13:32 -0000	1.13
--- primutil.f	28 Oct 2006 09:07:08 -0000	1.14
***************
*** 13,17 ****
  \
  \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
! \                       Dirk Busch    (dirk.yahoo @ schneider-busch.de)
  \                       George Hubert (georgeahubert at yahoo.co.uk)
  \
--- 13,17 ----
  \
  \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
! \                       Dirk Busch    (dirk at win32forth.org)
  \                       George Hubert (georgeahubert at yahoo.co.uk)
  \
***************
*** 42,53 ****
  in-application
  
! : NOSTACK1                      ; immediate     \ *** to be done ***
! : DEPRECATED                    ; immediate     \ *** to be done ***
  : ANEW          BL WORD DROP    ; immediate     \ *** to be done ***
  : IS-DEFAULT    BL WORD 2DROP   ; immediate     \ *** to be done ***
! : DPR-WARNING-ON                ; immediate     \ *** to be done ***
! : DPR-WARNING-OFF               ; immediate     \ *** to be done ***
! 0 value DPR-WARNING?            \ null value      *** to be done ***
  : CHECKSTACK                    ; immediate     \ *** to be done ***
  
  \ ------------------------------------------------------------------------
--- 42,59 ----
  in-application
  
! 0 value DPR-WARNING?            \ null value      *** to be done ***
! 
! in-system
! 
  : ANEW          BL WORD DROP    ; immediate     \ *** to be done ***
  : IS-DEFAULT    BL WORD 2DROP   ; immediate     \ *** to be done ***
! : DEPRECATED                    ; immediate     \ *** to be done ***
! : DPR-WARNING-ON  1 to DPR-WARNING? ; immediate \ *** to be done ***
! : DPR-WARNING-OFF 0 to DPR-WARNING? ; immediate \ *** to be done ***
! : NOSTACK                       ; immediate     \ *** to be done ***
! : NOSTACK1                      ; immediate     \ *** to be done ***
  : CHECKSTACK                    ; immediate     \ *** to be done ***
+ : dbg ' execute                 ; immediate     \ *** to be done ***
+ : ?COMP                         ; immediate     \ *** to be done ***
  
  \ ------------------------------------------------------------------------
***************
*** 100,103 ****
--- 106,112 ----
                  does> 2@ ;
  
+ : 2+!           ( d1 a1 -- )            \ double accumulate
+                 dup>r 2@ d+ r> 2! ;
+ 
  ' dpl       alias dp-location
  ' postpone  alias compile
***************
*** 120,123 ****
--- 129,136 ----
                  over offset + ;
  
+ : ascii    char          state @ if postpone literal then ; immediate
+ : alt      char 4096  or state @ if postpone literal then ; immediate
+ : ctrl     char   31 and state @ if postpone literal then ; immediate
+ 
  \ ------------------------------------------------------------------------
  \ -------------------------- Chain definitions ---------------------------
***************
*** 153,157 ****
                  reset-stack-chain do-chain ; is reset-stacks \ install in kernel word
  
! \ ---------------- Operating System Checking --------------------------
  
  1 PROC GetVersionEx
--- 166,172 ----
                  reset-stack-chain do-chain ; is reset-stacks \ install in kernel word
  
! \ ------------------------------------------------------------------------
! \ ---------------- Operating System Checking -----------------------------
! \ ------------------------------------------------------------------------
  
  1 PROC GetVersionEx
***************
*** 207,215 ****
  winver-init
  
- in-system
- 
  \ ------------------------------------------------------------------------
  \ ------------------------------------------------------------------------
  
  : (viewinfo)    ( nfa -- line# addr )
  \ *G Find source for word.
--- 222,230 ----
  winver-init
  
  \ ------------------------------------------------------------------------
  \ ------------------------------------------------------------------------
  
+ in-system
+ 
  : (viewinfo)    ( nfa -- line# addr )
  \ *G Find source for word.
***************
*** 231,234 ****
--- 246,250 ----
  
  \ ------------------------------------------------------------------------
+ \ Conditional compiling
  \ ------------------------------------------------------------------------
  
***************
*** 255,263 ****
  in-application
  
! \ needed by ansfile.
  
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \       Some case insensitive version of search and compare
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  \ enhanced caps-search for source string > 255 bytes
--- 271,289 ----
  in-application
  
! \ ------------------------------------------------------------------------
! \ Some memory allocation words...
! \ ------------------------------------------------------------------------
  
! \ needed by array.f
! 
! : reserve     ( n1 )
! \ *G Allot some bytes initialized to NULL.
!                 0max here over allot swap erase ;
! 
! \ ------------------------------------------------------------------------
  \       Some case insensitive version of search and compare
! \ ------------------------------------------------------------------------
! 
! \ needed by ansfile.f
  
  \ enhanced caps-search for source string > 255 bytes
***************
*** 301,307 ****
                  st1 count st2 count compare ;
  
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \       Locking for Windows
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  defer (controllock)
--- 327,333 ----
                  st1 count st2 count compare ;
  
! \ ------------------------------------------------------------------------
  \       Locking for Windows
! \ ------------------------------------------------------------------------
  
  defer (controllock)
***************
*** 336,339 ****
--- 362,389 ----
  initialization-chain chain-add init-system-locks-off
  
+ \ ------------------------------------------------------------------------
+ \  Delay Time Words
+ \ ------------------------------------------------------------------------
+ 
+ \ DEFER MS        ( n1 -- )
+ \ *G Delay n1 milli-seconds or forever if n1 = -1.
+ 
+ :noname         ( n1 -- )
+                 call Sleep drop ; is MS
+ 
+ : SECONDS       ( n1 -- )
+ \ *G Delay n1 seconds break when a key is pressed.
+                 0max 0
+                 ?do  10 0
+                      do   100 ms
+                           key?
+                           if   key drop
+                                unloop
+                                unloop
+                                EXIT
+                           then
+                      loop
+                 loop ;
+ 
  \s
  

Index: extend.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** extend.f	24 Oct 2006 12:41:42 -0000	1.13
--- extend.f	28 Oct 2006 09:07:08 -0000	1.14
***************
*** 39,42 ****
--- 39,49 ----
      FLOAD src\registry.f    \ Win32 Registry support
  
+ \     FLOAD src\lib\array.f       \ Array words
+ \     FLOAD src\lib\binsearch.f   \ Binary search
+ \     FLOAD src\lib\block.f       \ Block file support
+ \     FLOAD src\lib\ctype.f       \ C-ish ctype macros
+ \     FLOAD src\lib\enum.f        \ Enum support
+ \     FLOAD src\lib\SoundVolume.f \ Turn sound on/off
+ 
  .olly
  
***************
*** 51,57 ****
  \s
  
!                                                                         
  sys-FLOAD src\see.f
- sys-FLOAD src\ctype.f       \ 'c' style character typing
  sys-FLOAD src\res\resforth.h \ load the headerfile with a few constants
  sys-FLOAD src\debug.f
--- 58,63 ----
  \s
  
! 
  sys-FLOAD src\see.f
  sys-FLOAD src\res\resforth.h \ load the headerfile with a few constants
  sys-FLOAD src\debug.f

Index: optliterals.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** optliterals.f	28 Oct 2006 06:34:32 -0000	1.4
--- optliterals.f	28 Oct 2006 09:07:08 -0000	1.5
***************
*** 9,13 ****
  \
  \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
! \                       Dirk Busch    (dirk.yahoo @ schneider-busch.de)
  \                       George Hubert (georgeahubert at yahoo.co.uk)
  \
--- 9,13 ----
  \
  \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
! \                       Dirk Busch    (dirk at win32forth.org)
  \                       George Hubert (georgeahubert at yahoo.co.uk)
  \

Index: optinline.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/optinline.f,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** optinline.f	23 Oct 2006 14:28:50 -0000	1.3
--- optinline.f	28 Oct 2006 09:07:08 -0000	1.4
***************
*** 9,13 ****
  \
  \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
! \                       Dirk Busch    (dirk.yahoo @ schneider-busch.de)
  \                       George Hubert (georgeahubert at yahoo.co.uk)
  \
--- 9,13 ----
  \
  \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
! \                       Dirk Busch    (dirk at win32forth.org)
  \                       George Hubert (georgeahubert at yahoo.co.uk)
  \
***************
*** 29,33 ****
  \
  \ Simple inline optimiser
! \ 
  \ Inlining increases the space required in the code sections by around
  \ 10%; but shows a 200% improvement in performance.
--- 29,33 ----
  \
  \ Simple inline optimiser
! \
  \ Inlining increases the space required in the code sections by around
  \ 10%; but shows a 200% improvement in performance.
***************
*** 42,46 ****
                  dup >name n>ofa                 \ get the length
                  w@ copy-code ;                  \ and copy the code
!                 
  previous definitions also optimise
  
--- 42,46 ----
                  dup >name n>ofa                 \ get the length
                  w@ copy-code ;                  \ and copy the code
! 
  previous definitions also optimise
  
***************
*** 49,53 ****
                    ['] xt-inline, compiles-last
                  then ;
!                 
  definitions
  
--- 49,53 ----
                    ['] xt-inline, compiles-last
                  then ;
! 
  definitions
  
***************
*** 61,65 ****
  ' (comp-cons) compiles-for -cell
  
! \ set the words we will inline  
  
  ' xt-inline, compiles-for cells
--- 61,65 ----
  ' (comp-cons) compiles-for -cell
  
! \ set the words we will inline
  
  ' xt-inline, compiles-for cells
***************
*** 71,173 ****
  ' xt-inline, compiles-for -cells
  ' xt-inline, compiles-for char+
! ' xt-inline, compiles-for drop       
  ' xt-inline, compiles-for dup
  ' xt-inline, compiles-for swap
! ' xt-inline, compiles-for over       
! ' xt-inline, compiles-for rot        
! ' xt-inline, compiles-for -rot       
! ' xt-inline, compiles-for ?dup       
! ' xt-inline, compiles-for nip        
! ' xt-inline, compiles-for tuck       
! ' xt-inline, compiles-for pick       
! ' xt-inline, compiles-for 2drop      
  ' xt-inline, compiles-for 2nip
! ' xt-inline, compiles-for 2dup       
! ' xt-inline, compiles-for 2swap      
! ' xt-inline, compiles-for 2over      
! ' xt-inline, compiles-for @          
! ' xt-inline, compiles-for !          
! ' xt-inline, compiles-for +!         
! ' xt-inline, compiles-for c@         
! ' xt-inline, compiles-for sc@        
  ' xt-inline, compiles-for c!
! ' xt-inline, compiles-for c+!        
! ' xt-inline, compiles-for w@         
! ' xt-inline, compiles-for sw@        
! ' xt-inline, compiles-for w!         
! ' xt-inline, compiles-for w+!        
! ' xt-inline, compiles-for 2@         
! ' xt-inline, compiles-for 2!         
  ' xt-inline, compiles-for 0=
  ' xt-inline, compiles-for not
! ' xt-inline, compiles-for 0<>        
! ' xt-inline, compiles-for 0<         
! ' xt-inline, compiles-for 0>         
! ' xt-inline, compiles-for =          
! ' xt-inline, compiles-for <>         
! ' xt-inline, compiles-for <          
! ' xt-inline, compiles-for >          
! ' xt-inline, compiles-for <=         
! ' xt-inline, compiles-for >=         
! ' xt-inline, compiles-for u<         
! ' xt-inline, compiles-for u>         
! ' xt-inline, compiles-for min        
! ' xt-inline, compiles-for max        
  ' xt-inline, compiles-for 0max
! ' xt-inline, compiles-for umin       
! ' xt-inline, compiles-for umax       
! ' xt-inline, compiles-for and        
! ' xt-inline, compiles-for or         
! ' xt-inline, compiles-for xor        
! ' xt-inline, compiles-for invert     
  ' xt-inline, compiles-for lshift
  ' xt-inline, compiles-for rshift
  ' xt-inline, compiles-for arshift
! ' xt-inline, compiles-for incr       
! ' xt-inline, compiles-for decr       
! ' xt-inline, compiles-for cincr      
! ' xt-inline, compiles-for cdecr      
! ' xt-inline, compiles-for on         
! ' xt-inline, compiles-for off        
! ' xt-inline, compiles-for toggle     
! ' xt-inline, compiles-for d=         
! ' xt-inline, compiles-for d0<        
! ' xt-inline, compiles-for d0=        
! ' xt-inline, compiles-for d<         
! ' xt-inline, compiles-for d>         
! ' xt-inline, compiles-for d<>        
! ' xt-inline, compiles-for +          
! ' xt-inline, compiles-for negate     
! ' xt-inline, compiles-for -          
! ' xt-inline, compiles-for under+     
! ' xt-inline, compiles-for abs        
! ' xt-inline, compiles-for 2*         
! ' xt-inline, compiles-for 2/         
! ' xt-inline, compiles-for u2/        
! ' xt-inline, compiles-for 1+         
! ' xt-inline, compiles-for 1-         
! ' xt-inline, compiles-for 2+         
! ' xt-inline, compiles-for 2-         
! ' xt-inline, compiles-for d2*        
! ' xt-inline, compiles-for d2/        
! ' xt-inline, compiles-for um*        
! ' xt-inline, compiles-for um/mod     
! ' xt-inline, compiles-for m*         
! ' xt-inline, compiles-for sm/rem     
! ' xt-inline, compiles-for *          
! ' xt-inline, compiles-for /mod       
! ' xt-inline, compiles-for /          
! ' xt-inline, compiles-for mod        
! ' xt-inline, compiles-for */         
! ' xt-inline, compiles-for */mod      
! ' xt-inline, compiles-for d+         
! ' xt-inline, compiles-for d-         
! ' xt-inline, compiles-for dnegate    
! ' xt-inline, compiles-for s>d        
! ' xt-inline, compiles-for d>s        
! ' xt-inline, compiles-for count      
! ' xt-inline, compiles-for wcount     
! ' xt-inline, compiles-for lcount     
! ' xt-inline, compiles-for zcount 
  ' xt-inline, compiles-for perform
  ' xt-inline, compiles-for bounds
--- 71,173 ----
  ' xt-inline, compiles-for -cells
  ' xt-inline, compiles-for char+
! ' xt-inline, compiles-for drop
  ' xt-inline, compiles-for dup
  ' xt-inline, compiles-for swap
! ' xt-inline, compiles-for over
! ' xt-inline, compiles-for rot
! ' xt-inline, compiles-for -rot
! ' xt-inline, compiles-for ?dup
! ' xt-inline, compiles-for nip
! ' xt-inline, compiles-for tuck
! ' xt-inline, compiles-for pick
! ' xt-inline, compiles-for 2drop
  ' xt-inline, compiles-for 2nip
! ' xt-inline, compiles-for 2dup
! ' xt-inline, compiles-for 2swap
! ' xt-inline, compiles-for 2over
! ' xt-inline, compiles-for @
! ' xt-inline, compiles-for !
! ' xt-inline, compiles-for +!
! ' xt-inline, compiles-for c@
! ' xt-inline, compiles-for sc@
  ' xt-inline, compiles-for c!
! ' xt-inline, compiles-for c+!
! ' xt-inline, compiles-for w@
! ' xt-inline, compiles-for sw@
! ' xt-inline, compiles-for w!
! ' xt-inline, compiles-for w+!
! ' xt-inline, compiles-for 2@
! ' xt-inline, compiles-for 2!
  ' xt-inline, compiles-for 0=
  ' xt-inline, compiles-for not
! ' xt-inline, compiles-for 0<>
! ' xt-inline, compiles-for 0<
! ' xt-inline, compiles-for 0>
! ' xt-inline, compiles-for =
! ' xt-inline, compiles-for <>
! ' xt-inline, compiles-for <
! ' xt-inline, compiles-for >
! ' xt-inline, compiles-for <=
! ' xt-inline, compiles-for >=
! ' xt-inline, compiles-for u<
! ' xt-inline, compiles-for u>
! ' xt-inline, compiles-for min
! ' xt-inline, compiles-for max
  ' xt-inline, compiles-for 0max
! ' xt-inline, compiles-for umin
! ' xt-inline, compiles-for umax
! ' xt-inline, compiles-for and
! ' xt-inline, compiles-for or
! ' xt-inline, compiles-for xor
! ' xt-inline, compiles-for invert
  ' xt-inline, compiles-for lshift
  ' xt-inline, compiles-for rshift
  ' xt-inline, compiles-for arshift
! ' xt-inline, compiles-for incr
! ' xt-inline, compiles-for decr
! ' xt-inline, compiles-for cincr
! ' xt-inline, compiles-for cdecr
! ' xt-inline, compiles-for on
! ' xt-inline, compiles-for off
! ' xt-inline, compiles-for toggle
! ' xt-inline, compiles-for d=
! ' xt-inline, compiles-for d0<
! ' xt-inline, compiles-for d0=
! ' xt-inline, compiles-for d<
! ' xt-inline, compiles-for d>
! ' xt-inline, compiles-for d<>
! ' xt-inline, compiles-for +
! ' xt-inline, compiles-for negate
! ' xt-inline, compiles-for -
! ' xt-inline, compiles-for under+
! ' xt-inline, compiles-for abs
! ' xt-inline, compiles-for 2*
! ' xt-inline, compiles-for 2/
! ' xt-inline, compiles-for u2/
! ' xt-inline, compiles-for 1+
! ' xt-inline, compiles-for 1-
! ' xt-inline, compiles-for 2+
! ' xt-inline, compiles-for 2-
! ' xt-inline, compiles-for d2*
! ' xt-inline, compiles-for d2/
! ' xt-inline, compiles-for um*
! ' xt-inline, compiles-for um/mod
! ' xt-inline, compiles-for m*
! ' xt-inline, compiles-for sm/rem
! ' xt-inline, compiles-for *
! ' xt-inline, compiles-for /mod
! ' xt-inline, compiles-for /
! ' xt-inline, compiles-for mod
! ' xt-inline, compiles-for */
! ' xt-inline, compiles-for */mod
! ' xt-inline, compiles-for d+
! ' xt-inline, compiles-for d-
! ' xt-inline, compiles-for dnegate
! ' xt-inline, compiles-for s>d
! ' xt-inline, compiles-for d>s
! ' xt-inline, compiles-for count
! ' xt-inline, compiles-for wcount
! ' xt-inline, compiles-for lcount
! ' xt-inline, compiles-for zcount
  ' xt-inline, compiles-for perform
  ' xt-inline, compiles-for bounds