Constant paxforth::PRELUDE[][src]

pub const PRELUDE: &str = "variable  temp \\ first variable\n\n: swap   >r temp! r> temp@ ;\n: over   >r temp! temp@ r> temp@ ;\n: rot    >r swap r> swap ;\n: dup    temp! temp@ temp@ ;\n: 2drop   + drop ;\n: 2dup   over over ;\n\n\\ note: must preserve return address!\n: r@   r> r> temp! temp@ >r temp@ swap >r ;\n: r!   r> r> drop swap >r >r ;\n\n: invert   -1 nand ;\n: negate   invert 1 + ;\n: -        negate + ;\n\n: 1+   1 + ;\n: 1-   -1 + ;\n: +!   dup >r @ + r> ! ;\n: 0=   if 0 else -1 then ;\n: 0<>  if -1 else 0 then ;\n: =    - 0= ;\n: <>   = 0= ;\n: ==   - 0= ;\n\n: or   invert swap invert nand ;\n: xor   2dup nand 1+ dup + + + ;\n: and   nand invert ;\n\n\\ pop off the return address, then limit, then index.\n\\ add one to index and push limit and index back to stack; then compare\n\\ increased index with limit. return true if equal\n: loopimpl r> r> r> 1+ 2dup >r >r = swap >r ;\n\\ same thing but accepts input argument saying countdown value\n: -loopimpl r> swap r> swap r> swap - 2dup >r >r = swap >r ;\n\n\\ note: must preserve return address!\n: i r> r> r> temp! temp@ >r >r >r temp@ ;\n: j r> r> r> r> r> temp! temp@ >r >r >r >r >r temp@ ;\n\n: cells dup + ;\n: cell+ 1 cells + ;\n\n: * >r 0 r> 0 do over + loop swap drop ;\n: 2* 2 * ;\n\n: 0<   $8000 nand invert if -1 else 0 then ;\n: % ( value divisor -- modulus ) begin 2dup - dup 0< if + -1 else rot drop swap 0 then until swap drop ;\n\n: type ( c-addr u -- )\n    0 do\n        dup i + c@ emit\n    loop\n    drop\n    ;\n\n: cr $0D emit $0A emit ;\n\n: 0>=   $8000 nand invert if 0 else -1 then ;\n: 0<= ( n -- f ) dup 0= swap 0< or ;\n: -rot ( w1 w2 w3 -- w3 w1 w2 ) swap >r swap r> ;\n: tuck ( w1 w2 -- w2 w1 w2 ) swap over ;\n: throw 0 = if else abort then ;\n\n: ?dup ( w -- 0 | w w ) dup 0= if else dup then ;\n: 2over ( w1 w2 w3 w4 -- w1 w2 w3 w4 w1 w2 )\n    rot >r rot dup r> swap >r >r -rot r@ -rot r> r> swap ;\n: 2swap ( w1 w2 w3 w4 -- w3 w4 w1 w2 )\n    rot >r rot r> ;\n\n\\ TODO involve \"cells\"\n: 2@ ( a-addr -- w1 w2 ) dup 1+ @ swap @ ;\n: 2! ( w1 w2 a-addr -- ) dup temp! ! temp@ 1+ ! ;\n\n: nip    >r temp! r> ;\n: <   2dup xor 0< if drop 0< else - 0< then ;\n: u<   2dup xor 0< if nip 0< else - 0< then ;\n: >   swap < ;\n: u>   swap u> ;\n: >=   2dup > >r = r> or ;\n\n: within ( u1 u2 u3 -- flag ) over - >r - r> u< ;\n\n: throw 0 = if else abort then ;\n\n: true -1 ;\n: false 0 ;\n\n: roll ( x .. n -- .. x )\n    dup\n    begin dup 0 <> while 1- rot >r repeat \\ top of alt is counter\n    drop\n    begin dup 0 <> while 1- r> -rot repeat \\ top of alt is counter\n    drop\n    ;\n\n: pick ( x .. n -- x .. x )\n    dup\n    begin dup 0 <> while 1- rot >r repeat \\ top of alt is counter\n    drop\n    over\n    swap\n    begin dup 0 <> while 1- r> -rot repeat \\ top of alt is counter\n    drop\n    ;\n\n\\ hardcoded *roll and *pick variants that are optimizable w/o inline\n\n: 3roll\n    >r >r\n    swap r> swap r> swap\n    ;\n\n: 4roll\n    >r >r >r\n    swap r> swap r> swap r> swap\n    ;\n\n: compare ( c-addr1 u1 c-addr2 u2 -- n )\n    begin\n        rot\n        2dup\n        or 0= if\n            drop 0 1\n        else                            ( c-addr1 c-addr2)\n            dup 0= if\n                drop -1 1\n            else\n                over 0= if\n                    drop 1 1\n                else                    ( c-addr1 c-addr2 u2 u1 )\n                    >r >r               ( c-addr1 c-addr2 )\n                    2dup c@ swap c@       ( c-addr1 c-addr2 c2 c1 )\n                    -                   ( c-addr1 c-addr2 [c2 - c1] )\n                    dup 0< if\n                        \\ less than 1\n                        drop\n                        r> r>\n                        drop 1 1\n                    else if\n                            \\ more than 1\n                            r> r>\n                            drop -1 1\n                        else\n                            \\ loop\n                            1+ swap 1+ swap\n                            r> 1- r> 1-\n                            rot rot\n                            0           ( continue )\n                        then\n                    then\n                then\n            then\n        then\n    until\n    swap drop\n    swap drop\n    swap drop\n    ;\n";