From Newsgroup: comp.lang.forth

Although I'm not even *remotely* close to executing a non-trivial Factor program, this thing runs virtually unmodified (https://rosettacode.org/wiki/Ethiopian_multiplication#Factor):

include lib/factor.4th
include 4pp/lib/factor.4pp

: odd? ( n -- ? ) 1 bitand 1 number= ;
: double ( n -- 2*n ) 2 * ;
: halve ( n -- n/2 ) 2 /i ;

: ethiopian-mult ( a b -- a*b )
[ 0 ] 2dip
[ dup 0 > ] [
[ odd? [ + ] [ drop ] if ] 2keep
[ double ] [ halve ] bi*
] while 2drop ;

34 17 ethiopian-mult .

Decompile (of the interesting bits):

358| branch 363 odd?
359| literal 1
360| and 0
361| literal 1
362| = 0
363| exit 0
364| branch 366 double
365| *literal 2
366| exit 0
367| branch 369 halve
368| /literal 2
369| exit 0
370| branch 416 ethiopian-mult
371| literal 372
372| branch 374
373| literal 0
374| exit 0
375| call 151 2dip
376| literal 377
377| branch 381
378| dup 0
379| literal 0
380| > 0
381| exit 0
382| literal 383
383| branch 403
384| literal 385
385| branch 395
386| call 358 odd?
387| literal 388
388| branch 390
389| + 0
390| exit 0
391| literal 392
392| branch 394
393| drop 0
394| exit 0
395| branch 78 if?
396| call 197 2keep
397| literal 398
398| branch 399
399| branch 364 double
400| literal 401
401| branch 402
402| branch 367 halve
403| branch 265 bi*
404| >r 0
405| >r 0
406| r@ 0
407| execute 0
408| 0branch 411
409| r'@ 0
410| execute 0
411| branch 405
412| rdrop 0
413| rdrop 0
414| drop 0
415| drop 0
416| exit 0
417| literal 34
418| literal 17
419| call 370 ethiopian-mult
420| . 0
421| cr 0

An finally, the output:

$ pp4th -x ethimul.4pp
578
$

Hans Bezemer
--- Synchronet 3.21b-Linux NewsLink 1.2