nasmjf

1 ( -*- text -*- 2 FORTH repeated DUP DROP * 1000 using ordinary indirect threaded code 3 and the assembler primitives. 4 $Id: perf_dupdrop.f,v 1.3 2007-10-12 01:46:26 rich Exp $ ) 5 6 1024 32 * MORECORE 7 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. ) 13 2 PICK <> IF 14 ." MSBs not equal, please repeat the test" CR 15 ELSE 16 NIP 17 SWAP - U. CR 18 THEN 19 ; 20 21 : 4DROP DROP DROP DROP DROP ; 22 23 : PERFORM-TEST ( xt -- ) 24 ( Get everything in the cache. ) 25 DUP EXECUTE 4DROP 26 DUP EXECUTE 4DROP 27 DUP EXECUTE 4DROP 28 DUP EXECUTE 4DROP 29 DUP EXECUTE 4DROP 30 DUP EXECUTE 4DROP 31 0 0 0 0 PRINT-TIME 32 ( Run the test 10 times. ) 33 DUP EXECUTE PRINT-TIME 34 DUP EXECUTE PRINT-TIME 35 DUP EXECUTE PRINT-TIME 36 DUP EXECUTE PRINT-TIME 37 DUP EXECUTE PRINT-TIME 38 DUP EXECUTE PRINT-TIME 39 DUP EXECUTE PRINT-TIME 40 DUP EXECUTE PRINT-TIME 41 DUP EXECUTE PRINT-TIME 42 DUP EXECUTE PRINT-TIME 43 DROP 44 ; 45 46 ( ---------------------------------------------------------------------- ) 47 ( Make a word which builds the repeated DUP DROP sequence. ) 48 : MAKE-DUPDROP ( n -- ) 49 BEGIN ?DUP WHILE ' DUP , ' DROP , 1- REPEAT 50 ; 51 52 ( Now the actual test routine. ) 53 : TEST ( -- startlsb startmsb endlsb endmsb ) 54 RDTSC ( Start time ) 55 [ 1000 MAKE-DUPDROP ] ( 1000 * DUP DROP ) 56 RDTSC ( End time ) 57 ; 58 59 : RUN ['] TEST PERFORM-TEST ; 60 RUN 61 62 ( ---------------------------------------------------------------------- ) 63 ( Try the inlined alternative. ) 64 65 ( Inline the assembler primitive (cfa) n times. ) 66 : *(INLINE) ( cfa n -- ) 67 BEGIN ?DUP WHILE OVER (INLINE) 1- REPEAT DROP 68 ; 69 70 : DUPDROP INLINE DUP INLINE DROP ;CODE 71 72 : TEST 73 INLINE RDTSC 74 [ S" DUPDROP" FIND >CFA 1000 *(INLINE) ] 75 INLINE RDTSC 76 ;CODE 77 78 : RUN ['] TEST PERFORM-TEST ; 79 RUN