bootstrap.f

create 0
' lit ,  1 1 - ,  ' exit ,

create 2
' lit ,  1 1 + ,  ' exit ,

create 3
' lit ,  2 1 + ,  ' exit ,

create 4
' lit ,  3 1 + ,  ' exit ,

create >flags
' exit ,

create >namelen
' lit ,  4 4 + ,  ' + ,  ' exit ,

create >name
' lit ,  4 4 + 1 + ,  ' + ,  ' exit ,

create aligned
' 3 ,  ' + ,  ' lit ,  3 invert ,  ' and ,  ' exit ,

create >cfa
' dup ,  ' >namelen ,  ' c@ ,  ' swap ,  ' >name ,  ' + ,  ' aligned ,  ' exit ,

create immediate?
' >flags ,  ' @ ,  ' 1 ,  ' and ,  ' exit ,

create (variable)
' r> ,  ' exit ,

create mode
' (variable) ,  ' 1 ,

create interpret
' word ,  ' find ,  ' dup ,  ' >cfa ,  ' swap ,
' immediate? ,  ' mode ,  ' @ ,  ' or ,  ' branch ,  here 0 ,
' , ,  ' exit ,
here swap !  ' execute ,  ' exit ,

create quit
here  ' interpret ,  ' jump ,  ,

quit

create immediate
' latest ,  ' @ ,  ' >flags ,  ' dup ,  ' @ ,  ' 1 ,  ' or ,  ' swap ,  ' ! , ' exit ,
immediate

create :        
' create ,  ' 0 , ' mode , ' ! , ' exit , 

create ;
' lit , ' exit ,  ' , ,
' 1 , ' mode , ' ! , ' exit ,
immediate

: not  0= ;
: =  - 0= ;
: <>  = not ;

: [  1 mode ! ; immediate
: ]  0 mode ! ; immediate

: [']  lit lit , ' , ; immediate

: literal  ['] lit , , ; immediate
: 2literal  ['] lit , ,  ['] lit , , ; immediate

: if  ['] 0= , ['] branch , here 0 , ; immediate
: else  ['] jump ,  here swap  0 ,  here swap ! ; immediate
: then  here swap ! ; immediate

: begin  here ; immediate
: again  ['] jump , , ; immediate
: until  ['] 0= , ['] branch , , ; immediate

: 2*  1 << ;
: 4*  2 << ;
: 8*  3 << ;

: 8  1 8* ;
: 256  1 8 << ;

: input?
  input @ input-end @ <> ;

: key
  input? if
    input @ dup c@ swap 1+ input !
  else
    getchar
  then ;

: (variable) r> ;

: char  ['] lit ,  key , ; immediate

: bl  char  ;
: nl  char 
;

: cr  nl putchar ;

: 2drop
  drop drop ;

: type
  begin
    over c@ putchar
    swap 1+ swap 1-
  dup 0= until
  2drop ;

: blank?
  dup bl = swap nl = or ;

create wordbuf
' (variable) ,  256 allot

: word
  wordbuf dup
  begin
    key
    dup blank? not if
      begin
        over c! 1+
        key 
      dup blank? until 
      drop  over -  exit
    then
    drop
  again ;

: interpret
  word find
  dup >cfa swap
  immediate? mode @ or if  execute  else  ,  then ;

: quit
  begin
    interpret
  again ;

: abort
  sp0 @ sp!
  rp0 @ rp!
  quit ;

: cmove1
  2dup swap c@ swap c!
  swap 1+ swap 1+ ;

: cmove
  begin
    dup 0= if 3drop exit then
    rot cmove1 -rot 1-
  again ;

: create
  word
  here
  0 ,
  latest @ ,  latest !
  dup c,
  here  over allot  swap cmove
  align
  docol , ;

: :
  create  0 mode ! ;

: '
  word find >cfa ;

: [']
  lit lit , ' , ; immediate

abort

: variable  , create  ['] (variable) ,  0 , ; immediate
: constant  create  ['] lit ,  ,  ['] exit , ; immediate