( -*- forth -*- )
( BADNOP dev env for PICmicro 18fxx2 )

( note on macros = words compiling code
compiler macros end with '_'
target macros end with ',' )

( note on addressing:
compiler !,@ use real processs addresses.
target p!, p@ use virtual addresses )

( ********** COMPILER EXTENSION  ************ )

( words )
: not -1 xor ;
: neg not 1 + ;
: create word & dovar @ _ here ;  ( create dict entry and compile dovar's code field )
: x @ .x ;

( macros )
: for_     & >r _ here ;
: next_    & loop _ _ & rdrop _ ;
: variable create 0 _ ;                   ( initialized variable )
: symbol   create here accept readword ;  ( read next word and store as symbol )
: table    for 0 _ next ;                 ( initialized table )
: 0jump_   _ here 0 _ ;                   ( compile jump instruction, load address and reserve space )
: if_      & jz 0jump_ ;
: then_    here swap ! ;                  ( backpatch jump address )
: else_    & jmp 0jump_ swap then_ ;


( target )
: , there dup >r t! r> 2 + !there ;   ( x -- ) ( compile )
: lit, , ;       ( x -- ) ( compile literal )
: call, , ;      ( x -- ) ( compile word invocation )
: enter, ;       ( -- )   ( called after docolon )

( stack: bottom contains top pointer 
stacks grow upward in memory
popping an empty stack returns 0
pushing a full stack resets the stack, then pushes )

: stack-default-size 16 ;       ( default stack size )
: stack				( create a stack )
    create 			( create tos pointer )
    _                           ( make TOS point to itself: empty stack )
    stack-default-size table ; 	( create stack buffer )

: stack-reset dup ! ;		( make TOS point to itself )
: stack-elements
    dup @ swap - 1 cell / ;     ( get nb of elements on stack )

: stack-empty?
    stack-elements 0 = ;

: stack-full?
    stack-elements stack-default-size = ;

: stack-top                     ( get value from top of stack )
    dup stack-empty? if drop 0 ;; then
    @ @ ;


: stack-push
    dup stack-full? if dup stack-reset then 
    dup >r			( save address of stack pointer )
    @ 1 cell +                  ( deref and pre-inc )
    dup r> !	                ( store new value of stack pointer )
    ! ;                         ( store value on new TOS )

: stack-pop
    dup stack-empty? if drop 0 ;; then
    dup >r                      ( save address of stack pointer )
    @ dup >r                    ( get TOS ptr + save value )
    @                           ( get value on TOS )
    r> 1 cell - r> ! ;          ( post-dec stack pointer and store it )
	
: stack-drop stack-pop drop ;



( file io )

: savehex    output-file .hex   output-close ;
: savebin    output-file .bin   output-close ;
: saveforth  output-file .forth output-close ;

( coroutines )

( a coroutine carries within its body its rsp )

0 variable frame-free !
: frame-allot frame-free @ swap over + frame-free ! ;


(


16 variable task ! ) ( the next task's rsp )

(
: swaptask_ & rsp@ _ & task _ & @ _ & rsp! _ & task _ & ! _ ;

: yield rsp@ task @ rsp! task ! ;
: start rsp@ task @ rsp! task ! execute ;


: X
    loop
    50 for
    1 + yield
    2 + yield
    3 + yield
    next
;

: test 10 for 123 . next ;

)