2 FORTH repeated DUP DROP * 1000 using ordinary indirect threaded code
3 and the assembler primitives.
4 $Id: perf_dupdrop.f,v 1.2 2007-10-11 07:45:35 rich Exp $ )
8 ( Print the time passed. )
9 : PRINT-TIME ( lsb msb lsb msb -- lsb lsb )
10 ( The test is very short so likely the MSBs will be the same. This
11 makes calculating the time easier (because we can only do 32 bit
12 subtraction). So check MSBs are equal. )
14 ." MSBs not equal, please repeat the test" CR
21 : PERFORM-TEST ( xt -- )
22 ( Get everything in the cache. )
23 DUP EXECUTE DUP EXECUTE DUP EXECUTE DUP EXECUTE DUP EXECUTE DUP EXECUTE
25 ( Run the test 10 times. )
26 DUP EXECUTE PRINT-TIME
27 DUP EXECUTE PRINT-TIME
28 DUP EXECUTE PRINT-TIME
29 DUP EXECUTE PRINT-TIME
30 DUP EXECUTE PRINT-TIME
31 DUP EXECUTE PRINT-TIME
32 DUP EXECUTE PRINT-TIME
33 DUP EXECUTE PRINT-TIME
34 DUP EXECUTE PRINT-TIME
35 DUP EXECUTE PRINT-TIME
39 ( ---------------------------------------------------------------------- )
40 ( Make a word which builds the repeated DUP DROP sequence. )
41 : MAKE-DUPDROP ( n -- )
42 BEGIN ?DUP WHILE ' DUP , ' DROP , 1- REPEAT
45 ( Now the actual test routine. )
46 : TEST ( -- startlsb startmsb endlsb endmsb )
48 [ 1000 MAKE-DUPDROP ] ( 1000 * DUP DROP )
52 : RUN ['] TEST PERFORM-TEST ;
55 ( ---------------------------------------------------------------------- )
56 ( Try the inlined alternative. )
58 ( Inline the assembler primitive (cfa) n times. )
59 : *(INLINE) ( cfa n -- )
60 BEGIN ?DUP WHILE OVER (INLINE) 1- REPEAT DROP
63 : DUPDROP INLINE DUP INLINE DROP ;CODE
67 [ S" DUPDROP" FIND >CFA 1000 *(INLINE) ]
71 : RUN ['] TEST PERFORM-TEST ;