You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
88 lines
2.1 KiB
Forth
88 lines
2.1 KiB
Forth
: cell+ cell + ;
|
|
: cells cell * ;
|
|
: char+ 1 + ;
|
|
: chars ;
|
|
|
|
: state [ _d 7 cells + ] literal ;
|
|
\ : [ 0 state ! ; immediate
|
|
\ : ] -1 state ! ;
|
|
|
|
: sp _d ;
|
|
: rp [ _d cell+ ] literal ;
|
|
: dp [ _d 3 cells + ] literal ;
|
|
|
|
: sp@ sp @ ;
|
|
: rp@ rp @ cell+ ;
|
|
: ip [ _d cell+ cell+ ] literal ;
|
|
: here dp @ ;
|
|
: unused [ _d 8 cells + ] literal @ here - ;
|
|
: base [ _d 9 cells + ] literal ;
|
|
: latest [ _d 4 cells + ] literal @ ;
|
|
|
|
\ : dup sp@ @ ;
|
|
\ : drop sp@ cell+ sp ! ;
|
|
: pick cells cell+ sp@ + @ ;
|
|
: >r rp@ cell - rp !
|
|
rp@ cell+ @ rp@ !
|
|
rp@ cell+ ! ;
|
|
: r> rp@ @
|
|
rp@ cell+ rp !
|
|
rp@ @ swap rp@ ! ;
|
|
\ : rot >r swap r> swap ;
|
|
: -rot rot rot ;
|
|
: over 1 pick ;
|
|
|
|
: 2drop drop drop ;
|
|
: 2dup over over ;
|
|
: 2over 3 pick 3 pick ;
|
|
: 2swap rot >r rot r> ;
|
|
|
|
: +! dup >r swap r> @ + swap ! ;
|
|
: allot dp +! ;
|
|
: , here ! cell allot ;
|
|
: c, here c! 1 allot ;
|
|
: ['] ' [ ' literal , ] ; immediate
|
|
|
|
: if ['] _jmp0 , here 0 , ; immediate
|
|
: then here swap ! ; immediate
|
|
: else ['] _jmp , here 0 , swap here swap ! ; immediate
|
|
|
|
: 2r> ['] r> , ['] r> , ['] swap , ; immediate
|
|
: 2>r ['] swap , ['] >r , ['] >r , ; immediate
|
|
: r@ ['] r> , ['] dup , ['] >r , ; immediate
|
|
|
|
: 2! swap over ! cell+ ! ;
|
|
: 2@ dup cell+ @ swap @ ;
|
|
|
|
: 0= 0 = ;
|
|
: 0< 0 < ;
|
|
: <= 2dup < >r = r> or ;
|
|
: > swap < ;
|
|
: <> = 0= ;
|
|
|
|
: 1+ 1 + ;
|
|
: 1- 1 - ;
|
|
|
|
: invert -1 xor ;
|
|
: negate -1 * ;
|
|
: 2* 2 * ;
|
|
: _msb [ 1 cell 8 * 1- lshift ] literal ;
|
|
: 2/ dup 1 rshift swap 0< if _msb or then ;
|
|
|
|
: ?dup dup if dup then ;
|
|
: abs dup 0< if negate then ;
|
|
: min 2dup <= if drop else swap drop then ;
|
|
: max 2dup <= if swap drop else drop then ;
|
|
|
|
: aligned cell 1- + cell 1- invert and ;
|
|
: align here dup aligned swap - allot ;
|
|
|
|
: cr 10 emit ;
|
|
: bl 32 ;
|
|
: space bl emit ;
|
|
\ : spaces begin dup 0 > while space 1- repeat drop ;
|
|
|
|
: decimal 10 base ! ;
|
|
: hex 16 base ! ;
|
|
|