forth
: dup [ $fc4689 3, $fc768d 3, ] ;
: 1+ [ $40 1, ] ;          : 1- [ $48 1, ] ;
: swap [ $0687 2, ] ;      : drop [ $ad 1, ] ;
: nip [ $04c683 3, ] ;     : false [ $f9 1, ] ;
: true [ $f8 1, ] ;        : 2drop [ $adad 2, ] ;
: and [ $0623 2, ] nip ;   : or [ $060b 2, ] nip ;
: xor [ $0633 2, ] nip ;   : not -1 xor ;
: @ [ $008b 2, ] ;         : ! [ $adc289 3, $ad0289 3, ] ;
: w@ @ $ffff and ;         : w! [ $adc289 3, $ad028966 , ] ;
: c@ @ $ff and ;           : c! [ $adc289 3, $ad0288 3, ] ;

: + [ $0603 2, ] nip ;     : * [ $26f7 2, ] nip ;
: - [ $ad0629 3, ] ;       : negate -1 * ;
: /mod [ $c389 2, $99ad 2, $fbf7 2, ] dup [ $d089 2, ] swap ;
: / /mod nip ;             : mod /mod drop ;
 
: wsparse 32 parse ;       : lnparse 10 parse ;
: ' wsparse find ;
: >> [ $c189 2, $d3ad 2, $e8 1, ] ;
: << [ $c189 2, $d3ad 2, $e0 1, ] ;
: here h0 @ ;

: reclass last @ 8 + ! ;
: reclass: class @ ' drop which @ 8 + ! ;

macro
: x:  ' compile ;          : ['] ' x: literal ;
: c: x: ['] ['] compile compile ;

: as ' x: literal c: reclass ;

: >r $ad50 2, ;            : r> c: dup $58 1, ;
: r@ x: r> $50 1, ;        : rdrop $5b 1, ;
 
: repeat here ;            : again compile x: ;; ;
: next x: r> $48 1, $8f0f 2, here - 4 - , $ad 1, ;
: for here x: >r ;
 
: (if) $063b 2, $adad 2, 1, here 0 1, ;
: <>if $74 x: (if) ;       : =if  $75 x: (if) ;
: <if  $7e x: (if) ;       : >if  $7d x: (if) ;
: ?if  $72 1, here 0 1, ;  : if   0 x: literal x: <>if ;
: then dup here swap - 1- swap c! $90 1, ;
: ;then x: ;; x: then ;

: prior last @ >r last @ @ last ! wsparse find compile r> last ! ;
: vector $90909090 , $90 1, ;
: class> here 14 + x: literal c: reclass x: ;; ;

forth
: cells 4 * ;
: cell+ 4 + ;              : cell- 4 - ;
: word+ 2 + ;              : word- 2 - ;
 
: rot >r swap r> swap ;    : -rot swap >r swap r> ;
: over >r dup r> swap ;    : tuck dup -rot ;
: 2dup over over ;
 
: later r> r> swap >r >r ;
: 0; dup 0 =if rdrop drop then ;
: execute >r ;

: create: wsparse entry ;
: literal, x: literal ;

: create create: as .data ;
: variable 0 : variable: create , ;
: constant create last @ cell+ ! ;

: +! dup @ rot + swap ! ;
: -! dup @ rot - swap ! ;
: allot h0 +! ;
 
forth
: :: here ] ;              : alias create: last @ cell+ ! ;
 
: is here swap ' h0 ! compile x: ;; h0 ! ;
: devector $90909090 ' $90 over c! 1+ ! ;
 
create list 5 cells allot
: loc: 1 list +! list @ cells list + last @ swap ! ;
: ;loc list @ cells list + @ last ! 1 list -! ;
 
: fill swap for swap 2dup c! 1+ swap next 2drop ;
: move for swap 2dup c@ swap c! 1+ swap 1+ next 2drop ;
: place dup >r swap move r> ;
: pad here 1024 + ;
: >pad dup 0; >r pad place r> ;

: " '" parse >pad ;

loc:
  : .string dup r> + dup >r over - swap ;
 :: dup literal, dup >r here 5 + place drop c: .string r> allot ;
;loc alias $,

macro  : s" " $, ;         : { '} parse $, c: eval ;
self   : ." state @ if " $, c: type ;then " type ;

forth
: space vector 32 emit ;
: cr vector 10 emit ;
: . vector dup 0 <if '- emit negate then : u. vector # space ;
 
: hex 16 base ! ;          : decimal 10 base ! ;
: binary 2 base ! ;        : octal 8 base ! ;

: ui vector ;
: exit { devector ui } ;
reset
