Forums before death by AOL, social media and spammers... "We can't have nice things"
|    comp.lang.forth    |    Forth programmers eat a lot of Bratwurst    |    117,927 messages    |
[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]
|    Message 117,861 of 117,927    |
|    Hans Bezemer to All    |
|    I'm not close, but it's fun!    |
|    30 Jan 26 16:57:26    |
      From: the.beez.speaks@gmail.com              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              --- SoupGate-Win32 v1.05        * Origin: you cannot sedate... all the things you hate (1:229/2)    |
[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]
(c) 1994, bbs@darkrealms.ca