win32forth-cvs

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

Update of /cvsroot/win32forth/win32forth-stc/demos/benchmarks
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8410/win32forth-stc/demos/benchmarks

Modified Files:
	Testpde.f bench.f 
Log Message:
gah:added macro to utils removed timing routines (now in utils.f) from the benchmarks and added dependency. Added dependency to ConsoleMenu

Index: bench.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/demos/benchmarks/bench.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** bench.f	5 Nov 2006 23:34:07 -0000	1.2
--- bench.f	11 May 2007 10:45:15 -0000	1.3
***************
*** 1,96 ****
  
! \ IN-SYSTEM
! 
! create TIME-BUF
! here
!         0 w,    \ +0  year
!         0 w,    \ +2  month
!         0 w,    \ +4  day of week
!         0 w,    \ +6  day of month
!         0 w,    \ +8  hour
!         0 w,    \ +10 minute
!         0 w,    \ +12 second
!         0 w,    \ +14 milliseconds
! here swap - constant TIME-LEN
! 
! create date$ 32 allot
! create time$ 32 allot
!                       
! : get-local-time ( -- )                 \ get the local computer date and time
!         time-buf call GetLocalTime drop ;
! 
! : time&date     ( -- sec min hour day month year )
!                 get-local-time
!                 time-buf 12 + w@        \ seconds
!                 time-buf 10 + w@        \ minutes
!                 time-buf  8 + w@        \ hours
!                 time-buf  6 + w@        \ day of month
!                 time-buf  2 + w@        \ month of year
!                 time-buf      w@ ;      \ year
! 
! : .#"           ( n1 n2 -- a1 n3 )
!                 >r 0 <# r> 0 ?do # loop #> ;
! 
! : >date"        ( time_structure -- )
!                 >r 31 date$ null \ z" ddddd',' MMMM dd yyyy"
!                 r> null LOCALE_USER_DEFAULT
!                 call GetDateFormat date$ swap 1- ;
! 
! : .date         ( -- )
!                 get-local-time time-buf >date" type ;
! 
! : >month,day,year" ( time_structure -- )
!                 >r 31 date$  z" ddddd',' MMMM dd yyyy"
!                 r> null LOCALE_USER_DEFAULT
!                 call GetDateFormat date$ swap 1- ;
! 
! 
! : .month,day,year ( -- )
!                 get-local-time time-buf >month,day,year" type ;
! 
! : >time"        ( time_structure -- )
!                 >r 31 time$ null
!                 r> null LOCALE_USER_DEFAULT
!                 call GetTimeFormat time$ swap 1- ;
! 
! : .time         ( -- )
!                 get-local-time time-buf >time" type ;
! 
! : >am/pm"       ( time_structure -- )
!                 >r 31 time$ z" h':'mmtt"
!                 r> null LOCALE_USER_DEFAULT
!                 call GetTimeFormat time$ swap 1- ;
! 
! : .am/pm        ( -- )
!                 get-local-time time-buf >am/pm" type ;
! 
! : ms@           ( -- ms )
!                 get-local-time
!                 time-buf
!                 dup   8 + w@     60 *           \ hours
!                 over 10 + w@ +   60 *           \ minutes
!                 over 12 + w@ + 1000 *           \ seconds
!                 swap 14 + w@ + ;                \ milli-seconds
! 
! 0 value start-time
! 
! : time-reset    ( -- )
!                 ms@ to start-time ;
! 
! ' time-reset alias timer-reset
! 
! : .elapsed      ( -- )
!                 ." Elapsed time: "
!                 ms@ start-time -
!                 1000 /mod
!                   60 /mod
!                   60 /mod 2 .#" type ." :"
!                           2 .#" type ." :"
!                           2 .#" type ." ."
!                           3 .#" type ;
! 
! : elapse        ( -<commandline>- )
!                 time-reset interpret cr .elapsed ;
! 
  
  false constant specifics	\ true to use system dependent code
--- 1,4 ----
  
! Require utils.f                 \ Timing routines now in utils.f
  
  false constant specifics	\ true to use system dependent code
***************
*** 283,287 ****
  : Precedes  ( n n - f )    u< ;
  
! : Exchange  ( a1 a2 -- )   2DUP  @ SWAP @ ROT !  SWAP ! ;  
  
  : Both-Ends  ( f l pivot - f l )
--- 191,195 ----
  : Precedes  ( n n - f )    u< ;
  
! : Exchange  ( a1 a2 -- )   2DUP  @ SWAP @ ROT !  SWAP ! ;
  
  : Both-Ends  ( f l pivot - f l )
***************
*** 451,455 ****
    ABORT" File Access Error. " ;
  
! : read-char	\ file -- char 
          drop getnextchar 0= if -1 then
  ;
--- 359,363 ----
    ABORT" File Access Error. " ;
  
! : read-char	\ file -- char
          drop getnextchar 0= if -1 then
  ;
***************
*** 802,814 ****
  
  \ -- Control human fatigue factor
! 500000 VALUE LOOPS     
  
  \ -- Some types
! 1 CONSTANT Ident1       
! 2 CONSTANT Ident2       
! 3 CONSTANT Ident3       
! 4 CONSTANT Ident4       
! 5 CONSTANT Ident5       
! 0 CONSTANT NIL          
  
  CHAR A CONSTANT 'A'
--- 710,722 ----
  
  \ -- Control human fatigue factor
! 500000 VALUE LOOPS
  
  \ -- Some types
! 1 CONSTANT Ident1
! 2 CONSTANT Ident2
! 3 CONSTANT Ident3
! 4 CONSTANT Ident4
! 5 CONSTANT Ident5
! 0 CONSTANT NIL
  
  CHAR A CONSTANT 'A'
***************
*** 820,832 ****
  CHAR Z CONSTANT 'Z'
  
! CREATE  Array1Glob      50        CELLS ALLOT   
! CREATE  Array2Glob      50 DUP *  CELLS ALLOT   
  
  \ -- Some obvious macro's
! : []Array1Par    S" CELLS Array1Par + "        EVALUATE ; IMMEDIATE 
! : [][]Array2Par  S" 50 * + CELLS Array2Par + " EVALUATE ; IMMEDIATE 
! : ADDRESS ; IMMEDIATE 
  
! 0 VALUE /bytes  
  
  : RECORD        CREATE  0 TO /bytes  HERE 0 ,   \ ( -- sys )
--- 728,740 ----
  CHAR Z CONSTANT 'Z'
  
! CREATE  Array1Glob      50        CELLS ALLOT
! CREATE  Array2Glob      50 DUP *  CELLS ALLOT
  
  \ -- Some obvious macro's
! : []Array1Par    S" CELLS Array1Par + "        EVALUATE ; IMMEDIATE
! : [][]Array2Par  S" 50 * + CELLS Array2Par + " EVALUATE ; IMMEDIATE
! : ADDRESS ; IMMEDIATE
  
! 0 VALUE /bytes
  
  : RECORD        CREATE  0 TO /bytes  HERE 0 ,   \ ( -- sys )
***************
*** 836,849 ****
  
  : SIMPLE-TYPE   CREATE  ,                       \ ( fieldlength> -- )
!                 DOES>   @ 
                    CREATE IMMEDIATE
                          /bytes ,
                          /bytes + TO /bytes
                    DOES> @                       \ ( 'record -- 'offset )
!                         S" LITERAL + " EVALUATE ; 
  
!  1  CELLS SIMPLE-TYPE   RecordPtr       
   1  CELLS SIMPLE-TYPE   Enumeration             \ one of Ident1 .. Ident5
!  1  CELLS SIMPLE-TYPE   OneToFifty      
  31  CHARS SIMPLE-TYPE   String30                \ extra count byte
  
--- 744,757 ----
  
  : SIMPLE-TYPE   CREATE  ,                       \ ( fieldlength> -- )
!                 DOES>   @
                    CREATE IMMEDIATE
                          /bytes ,
                          /bytes + TO /bytes
                    DOES> @                       \ ( 'record -- 'offset )
!                         S" LITERAL + " EVALUATE ;
  
!  1  CELLS SIMPLE-TYPE   RecordPtr
   1  CELLS SIMPLE-TYPE   Enumeration             \ one of Ident1 .. Ident5
!  1  CELLS SIMPLE-TYPE   OneToFifty
  31  CHARS SIMPLE-TYPE   String30                \ extra count byte
  
***************
*** 854,868 ****
                  OneToFifty   IntComp            \ 3 CELLS
                  String30     StringComp         \ 4 CELLS
! END 
  
  \ -- Some global variables
! 0 VALUE IntGlob         
! 0 VALUE BoolGlob        
! 0 VALUE Char1Glob       
! 0 VALUE Char2Glob       
! 0 VALUE p^      
  
  NIL VALUE PtrGlb
! NIL VALUE PtrGlbNext    
  
  : Proc7         S" + 2 + " EVALUATE ; IMMEDIATE \ ( n1 n2 -- n3 )
--- 762,776 ----
                  OneToFifty   IntComp            \ 3 CELLS
                  String30     StringComp         \ 4 CELLS
! END
  
  \ -- Some global variables
! 0 VALUE IntGlob
! 0 VALUE BoolGlob
! 0 VALUE Char1Glob
! 0 VALUE Char2Glob
! 0 VALUE p^
  
  NIL VALUE PtrGlb
! NIL VALUE PtrGlbNext
  
  : Proc7         S" + 2 + " EVALUATE ; IMMEDIATE \ ( n1 n2 -- n3 )
***************
*** 872,878 ****
                       ELSE DROP 100 TO IntGlob
                       THEN
!                 10 IntGlob  Proc7   PtrGlb IntComp ! ; 
  
! : Func3         S" Ident3 = " EVALUATE ; IMMEDIATE 
  
  : Proc6 ( n1 n2 -- n )
--- 780,786 ----
                       ELSE DROP 100 TO IntGlob
                       THEN
!                 10 IntGlob  Proc7   PtrGlb IntComp ! ;
  
! : Func3         S" Ident3 = " EVALUATE ; IMMEDIATE
  
  : Proc6 ( n1 n2 -- n )
***************
*** 883,887 ****
                      Ident2 OF IntGlob
                                 100 > IF Ident1
!                                    ELSE Ident4 
                                     THEN         ENDOF
                      Ident3 OF Ident2            ENDOF
--- 791,795 ----
                      Ident2 OF IntGlob
                                 100 > IF Ident1
!                                    ELSE Ident4
                                     THEN         ENDOF
                      Ident3 OF Ident2            ENDOF
***************
*** 889,896 ****
                      Ident5 OF Ident3            ENDOF
                      ABORT" Proc6: argument out of range"
!                 ENDCASE ; 
  
  : Proc1 ( 'record -- )
!                 TO p^                           
                  PtrGlb  p^ PtrComp !
                  5       p^ IntComp !
--- 797,804 ----
                      Ident5 OF Ident3            ENDOF
                      ABORT" Proc6: argument out of range"
!                 ENDCASE ;
  
  : Proc1 ( 'record -- )
!                 TO p^
                  PtrGlb  p^ PtrComp !
                  5       p^ IntComp !
***************
*** 904,908 ****
                        p^ PtrComp @ IntComp DUP @  10  Proc7 SWAP !
                  ELSE  p^ PtrComp @ p^ !
!                 THEN ; 
  
  : Proc2 ( val -- val' )
--- 812,816 ----
                        p^ PtrComp @ IntComp DUP @  10  Proc7 SWAP !
                  ELSE  p^ PtrComp @ p^ !
!                 THEN ;
  
  : Proc2 ( val -- val' )
***************
*** 910,919 ****
                  BEGIN   Char1Glob 'A' =         \ This one never ends
                  WHILE   IntLoc 1- TO IntLoc     \ unless Char = 'A' ??
!                         DROP IntLoc IntGlob - 
                          TRUE
                  UNTIL   THEN ;
  
! : Proc4         S" 'B' TO Char2Glob "                    EVALUATE ; IMMEDIATE 
! : Proc5         S" 'A' TO Char1Glob  FALSE TO BoolGlob " EVALUATE ; IMMEDIATE 
  
  : Proc8 ( 'array1 'array2 n1 n2 -- )
--- 818,827 ----
                  BEGIN   Char1Glob 'A' =         \ This one never ends
                  WHILE   IntLoc 1- TO IntLoc     \ unless Char = 'A' ??
!                         DROP IntLoc IntGlob -
                          TRUE
                  UNTIL   THEN ;
  
! : Proc4         S" 'B' TO Char2Glob "                    EVALUATE ; IMMEDIATE
! : Proc5         S" 'A' TO Char1Glob  FALSE TO BoolGlob " EVALUATE ; IMMEDIATE
  
  : Proc8 ( 'array1 'array2 n1 n2 -- )
***************
*** 962,966 ****
                  0 0 0
  	        \ The following must be on ONE line or Win32Forth will crash.
!                 LOCALS| CharIndex CharLoc EnumLoc 
                          IntLoc3 IntLoc2 IntLoc1 String2Loc String1Loc |
                  RecordType TO PtrGlb            \ constructor, allocates !
--- 870,874 ----
                  0 0 0
  	        \ The following must be on ONE line or Win32Forth will crash.
!                 LOCALS| CharIndex CharLoc EnumLoc
                          IntLoc3 IntLoc2 IntLoc1 String2Loc String1Loc |
                  RecordType TO PtrGlb            \ constructor, allocates !
***************
*** 970,987 ****
                  Ident3      PtrGlb EnumComp !
                  40          PtrGlb IntComp  !
!                 C" DHRYSTONE PROGRAM, SOME STRING" 
                  DUP C@ 1+  PtrGlb StringComp  SWAP MOVE
!    LOOPS 0 DO   
!                 Proc5  
                  Proc4
                  2 TO IntLoc1  3 TO IntLoc2
!                 C" DHRYSTONE PROGRAM, 2'ND STRING" 
                  DUP C@ 1+ String2Loc SWAP MOVE
                  Ident2 TO EnumLoc
!                 String1Loc String2Loc  Func2 INVERT  TO BoolGlob  
  
!                 BEGIN  
                     IntLoc1 IntLoc2 <
!                 WHILE  
                     IntLoc1 5 * IntLoc2 - TO IntLoc3
                     IntLoc1 IntLoc2 Proc7 TO IntLoc3     \ The Forth way
--- 878,895 ----
                  Ident3      PtrGlb EnumComp !
                  40          PtrGlb IntComp  !
!                 C" DHRYSTONE PROGRAM, SOME STRING"
                  DUP C@ 1+  PtrGlb StringComp  SWAP MOVE
!    LOOPS 0 DO
!                 Proc5
                  Proc4
                  2 TO IntLoc1  3 TO IntLoc2
!                 C" DHRYSTONE PROGRAM, 2'ND STRING"
                  DUP C@ 1+ String2Loc SWAP MOVE
                  Ident2 TO EnumLoc
!                 String1Loc String2Loc  Func2 INVERT  TO BoolGlob
  
!                 BEGIN
                     IntLoc1 IntLoc2 <
!                 WHILE
                     IntLoc1 5 * IntLoc2 - TO IntLoc3
                     IntLoc1 IntLoc2 Proc7 TO IntLoc3     \ The Forth way
***************
*** 989,1004 ****
                  REPEAT
  
!                 ADDRESS Array1Glob ADDRESS Array2Glob IntLoc1 IntLoc2  
  		Proc8
                  PtrGlb Proc1
                  'A' TO CharIndex
  
!                 BEGIN  
                    CharIndex Char2Glob <=
!                 WHILE  
                    CharIndex 'C' Func1
                    EnumLoc = IF  Ident1 EnumLoc Proc6 TO EnumLoc
                            THEN
!                   CharIndex 1+ TO CharIndex     
                  REPEAT
  
--- 897,912 ----
                  REPEAT
  
!                 ADDRESS Array1Glob ADDRESS Array2Glob IntLoc1 IntLoc2
  		Proc8
                  PtrGlb Proc1
                  'A' TO CharIndex
  
!                 BEGIN
                    CharIndex Char2Glob <=
!                 WHILE
                    CharIndex 'C' Func1
                    EnumLoc = IF  Ident1 EnumLoc Proc6 TO EnumLoc
                            THEN
!                   CharIndex 1+ TO CharIndex
                  REPEAT
  
***************
*** 1007,1015 ****
                  IntLoc3 IntLoc2 - 7 * IntLoc1 - TO IntLoc2
                  IntLoc1 Proc2 TO IntLoc1                \ the Forth way
!          LOOP   
                  PtrGlb     FREE THROW
                  PtrGlbNext FREE THROW
                  String1Loc FREE THROW
!                 String2Loc FREE THROW ; 
  
  : $DHRY$        \ --
--- 915,923 ----
                  IntLoc3 IntLoc2 - 7 * IntLoc1 - TO IntLoc2
                  IntLoc1 Proc2 TO IntLoc1                \ the Forth way
!          LOOP
                  PtrGlb     FREE THROW
                  PtrGlbNext FREE THROW
                  String1Loc FREE THROW
!                 String2Loc FREE THROW ;
  
  : $DHRY$        \ --
***************
*** 1058,1062 ****
     .ann ." This system's primitives" .specifics cr
     .header
!    [$  
       $DO$
       $+$  $M+$
--- 966,970 ----
     .ann ." This system's primitives" .specifics cr
     .header
!    [$
       $DO$
       $+$  $M+$
***************
*** 1077,1081 ****
     .ann ." This system's application performance" .specifics CR
     .header
!    [$  
       $SIEVE$  $FIB$  $SORT$  $RAND$  $CODE77$ $DHRY$
  \   [ ANSSYSTEM ] [IF]  $DHRY$  [THEN]
--- 985,989 ----
     .ann ." This system's application performance" .specifics CR
     .header
!    [$
       $SIEVE$  $FIB$  $SORT$  $RAND$  $CODE77$ $DHRY$
  \   [ ANSSYSTEM ] [IF]  $DHRY$  [THEN]

Index: Testpde.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/demos/benchmarks/Testpde.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Testpde.f	1 Oct 2006 07:38:44 -0000	1.1
--- Testpde.f	11 May 2007 10:45:15 -0000	1.2
***************
*** 2,103 ****
  only forth also definitions decimal
  
! \ defined b/float nip 0= [if] 8 constant b/float [then]
! 
! \ needs stc/float
! 
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! \ Timing Routines                     \
! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
! 
! create TIME-BUF
! here
!         0 w,    \ +0  year
!         0 w,    \ +2  month
!         0 w,    \ +4  day of week
!         0 w,    \ +6  day of month
!         0 w,    \ +8  hour
!         0 w,    \ +10 minute
!         0 w,    \ +12 second
!         0 w,    \ +14 milliseconds
! here swap - constant TIME-LEN
! 
! create date$ 32 allot
! create time$ 32 allot
! 
! : get-local-time ( -- )                 \ get the local computer date and time
!         time-buf call GetLocalTime drop ;
! 
! : time&date     ( -- sec min hour day month year )
!                 get-local-time
!                 time-buf 12 + w@        \ seconds
!                 time-buf 10 + w@        \ minutes
!                 time-buf  8 + w@        \ hours
!                 time-buf  6 + w@        \ day of month
!                 time-buf  2 + w@        \ month of year
!                 time-buf      w@ ;      \ year
! 
! : .#"           ( n1 n2 -- a1 n3 )
!                 >r 0 <# r> 0 ?do # loop #> ;
! 
! : >date"        ( time_structure -- )
!                 >r 31 date$ null \ z" ddddd',' MMMM dd yyyy"
!                 r> null LOCALE_USER_DEFAULT
!                 call GetDateFormat date$ swap 1- ;
! 
! : .date         ( -- )
!                 get-local-time time-buf >date" type ;
! 
! : >month,day,year" ( time_structure -- )
!                 >r 31 date$  z" ddddd',' MMMM dd yyyy"
!                 r> null LOCALE_USER_DEFAULT
!                 call GetDateFormat date$ swap 1- ;
! 
! 
! : .month,day,year ( -- )
!                 get-local-time time-buf >month,day,year" type ;
! 
! : >time"        ( time_structure -- )
!                 >r 31 time$ null
!                 r> null LOCALE_USER_DEFAULT
!                 call GetTimeFormat time$ swap 1- ;
! 
! : .time         ( -- )
!                 get-local-time time-buf >time" type ;
! 
! : >am/pm"       ( time_structure -- )
!                 >r 31 time$ z" h':'mmtt"
!                 r> null LOCALE_USER_DEFAULT
!                 call GetTimeFormat time$ swap 1- ;
! 
! : .am/pm        ( -- )
!                 get-local-time time-buf >am/pm" type ;
! 
! : ms@           ( -- ms )
!                 get-local-time
!                 time-buf
!                 dup   8 + w@     60 *           \ hours
!                 over 10 + w@ +   60 *           \ minutes
!                 over 12 + w@ + 1000 *           \ seconds
!                 swap 14 + w@ + ;                \ milli-seconds
! 
! 0 value start-time
! 
! : time-reset    ( -- )
!                 ms@ to start-time ;
! 
! ' time-reset alias timer-reset
! 
! : .elapsed      ( -- )
!                 ." Elapsed time: "
!                 ms@ start-time -
!                 1000 /mod
!                   60 /mod
!                   60 /mod 2 .#" type ." :"
!                           2 .#" type ." :"
!                           2 .#" type ." ."
!                           3 .#" type ;
! 
! : elapse        ( -<commandline>- )
!                 time-reset interpret cr .elapsed ;
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 2,6 ----
  only forth also definitions decimal
  
! require utils.f
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 105,112 ****
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
- : ROLL          ( n1 n2 .. nk k -- n2 n3 .. nk n1 )
- \  Rotate k values on the stack, bringing the deepest to the top.
-                 DUP>R PICK SP@ DUP CELL+ R> CELLS CELL+ MOVE DROP ;
- 
  code k          ( -- n )
                  mov     -4 [ebp], eax
--- 8,11 ----