[retroforth] Re: Speed up of 'find' word
- From: "Helmar Wodtke" <helmwo@xxxxxx>
- To: retroforth@xxxxxxxxxxxxx
- Date: Tue, 25 Jan 2005 22:51:23 +0100
retroforth@xxxxxxxxxxxxx schrieb am 25.01.05 21:41:39:
Hi Ron,
> Use my timeit word or some variation. Gives cpu cycles to perform an action
> (smaller is better :-) :
cool word... I'm a little old-styled and do currently things like:
knoppix@ttyp1[helforth10pre9]$ time cat t t t t t t t t t t t t t t t | ./wtick
HelFORTH :: http://printly.de/HelFORTH/ :: Release 1.0
real 0m3.436s
user 0m1.030s
sys 0m2.330s
knoppix@ttyp1[helforth10pre9]$ time cat t t t t t t t t t t t t t t t | ./wphash
HelFORTH :: http://printly.de/HelFORTH/ :: Release 1.0
real 0m2.883s
user 0m0.530s
sys 0m2.320s
:)
It's both the same testing procedure. The second uses a tree to find inside
dictionary. Well, it's not really compareable, since the tree is implemented in
FORTH and the other is normal dictionary search implemented in asm :) See code
at end of mailing.
Currently I use a simple solution. The tree can not be extended. The only
problem I have now is that at the moment I initialize the tree I've also to
figure out, what words are not in my tree, so that I can respect this for a
later search.
Bis dann,
Helmar
helmwo@xxxxxx
---------------------------------------
context speedup~
enter speedup~
variable hp0 variable hp variable hpmax
: lookup here hp0 !
for 32 parse >num drop cells hp0 @ + , loop
here hpmax ! ;
: wordset for
32 parse tuck find' swap 1+ - ,
loop ;
: >hp dup hpmax @ u<if [
: >hp' @ dup hpmax @ u<if hp ! ;;
then else drop 0 then rdrop ;
: @sc 2dup 1+ u<if [
: fail drop hp @ >hp' ;; then [
: success >r over r> + c@ cells hp @ + >hp ;
: @bc negate over + success ;
doer inset'
: inset | addr cnt -- addr cnt p|0
inset' dup if
@ | dup . cr
| dup 1+ dup 1- c@ type cr
2dup c@ <>if drop 0 ;; then
>r 2dup r> 1+ swap for
2dup c@ swap c@ <>if
rdrop 2drop 0 ;;
then 1+ swap 1+ swap
loop nip
then ;
context wordset$
enter wordset$
309 lookup
309 0 17 68 95 121 180 149 154 193 309 482 309 309 309 309 309 309
309 309 309 309 309 309 309 309 309 309 309 309 309 309 309 309 310
309 309 309 309 311 309 309 312 313 314 315 316 317 309 309 325 326
331 332 333 334 335 336 318 319 327 328 309 329 320 330 9 12 337 340
342 345 356 358 309 309 338 339 424 7 425 6 346 359 309 344 309 415
309 309 309 321 309 322 309 309 309 309 309 405 309 309 347 353 309
372 351 367 361 38 84 354 373 406 323 355 38 349 350 352 343 341 4
368 357 363 324 374 1 362 20 10 39 377 364 375 378 416 399 24 379
376 385 387 394 386 400 395 402 410 426 411 348 130 46 389 403 390
391 365 388 360 404 396 397 366 2 466 369 467 370 85 371 398 412 4
309 30 28 380 421 35 381 382 383 419 428 413 384 427 437 414 309 392
393 33 55 4 429 401 420 438 430 51 2 407 408 409 431 456 30 70 27
417 418 453 433 469 422 423 80 434 0 97 440 441 454 309 458 432 119
442 435 436 127 90 439 460 309 443 120 444 445 459 470 462 471 457
123 461 145 309 476 42 309 463 477 465 479 480 309 309 472 309 68
464 468 473 309 309 474 309 475 309 309 309 309 309 446 447 448 309
309 309 478 309 309 309 449 450 451 309 309 309 452 114 455 309 149
309 309 309 309 309 309 309 309 309 481
174 wordset
! " ' * + , - . / : ; @ [ ] r ~ !r ", +! ,r ." 0; 1+ 1, 1- 2+ 2, 2-
3, ;; << >> >r @@ @r D' c! c, c@ cr d' e: if is of on or r> rr s" s,
sz (.) =if >if >rr ['] and bin bye dup for hex key kl~ max min mod
nip nop not off rr> sz+ tab xor /mod 2dup ;and ;ret <>if >num ?dup
base case doer drop else emit eval find fill here last like loop
make mode next over page swap sys~ then tuck type u<if undo vars
warm 2drop 2swap ;;ret allot begin cell+ cell- cells cmove endof
enter find' forth last' macro mfree octal parse rdrop root~ space
while width words ;enter =while >while banner create disasm later>
mallot negate repeat select spaces trash~ <>while branch! compile
context creates decimal editor~ endcase execute literal screen~
select: u<while ?execute consider constant literal, qsearch~
terminal variable ;consider ?literal, [compile] immediate interpret
sys-alloc scratch-pad
;enter
make inset'
dup cells hp0 @ + >hp
0 @sc
1 @sc
1 @bc
0 ;
variable stop last root~ @ stop !
: newfind'
stop @ dup @ >r off
2dup sys~ find0 ?dup 0 =if inset then
nip nip r> stop @ ! ;
;enter
: testproc
32 parse ?dup 0 =if bye then speedup~ newfind' drop
testproc ;
testproc
-- Binary/unsupported file stripped by Ecartis --
-- Type: application/x-pkcs7-signature
-- File: smime.p7s
-- Desc: S/MIME Cryptographic Signature
Other related posts:
