Commit 37b3cbb6 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Flash-enabled Gforth EC

parent bcb3848f

arch/r8c/prim.fs

+4 −4
Original line number Diff line number Diff line
@@ -147,10 +147,9 @@ end-macros 
\      # $06 , $E1 mov.b:g

     tos push.w:g

     w , tos mov.w:g   # 4 , tos add.w:q

     # -2 , rp add.w:q

     # -2 , rp add.w:q  2 [w] , r1 mov.w:g

     rp , w mov.w:g  ip , [w] mov.w:g

     2 [w] , r1 mov.w:g

     # 4 , r1 add.w:q  r1 , ip mov.w:g

     r1 , ip mov.w:g

     next,                                       \ execute does> part

  End-Code
@@ -611,12 +610,13 @@ end-code 
   : lcdpage  $01 lcdctrl! &15 ms ;

   : lcdcr    $C0 lcdctrl! ;

   : lcdinit ( -- )

       &20 ms  $20 >lcd

       &20 ms  $33 lcdctrl! 5 ms $20 >lcd

       &5 ms  $28 lcdctrl!

       &1 ms  $0C lcdctrl!

       &1 ms  lcdpage ;

   : ?flash  BEGIN  $1B7 c@ 1 and 1 =  UNTIL ;

   : flashc! ( c addr -- )  $40 over c! c! ?flash ;

   : flash! ( x addr -- )  2dup flashc! >r 8 rshift r> 1+ flashc! ;

   : flash-off ( addr -- )  $20 over c! $D0 swap c! ?flash ;

   : flash-enable ( -- )   $1b7 c! 3 $1b7 c! 0 $1b5 c! 2 $1b5 c! ;

   : r8cboot ( -- )  flash-enable lcdinit s" Gforth EC R8C" lcdtype boot ;

cross.fs

+3 −1
Original line number Diff line number Diff line
@@ -1184,6 +1184,7 @@ true DefaultValue gforthcross 
true DefaultValue interpreter

true DefaultValue ITC

false DefaultValue rom

false DefaultValue flash

true DefaultValue standardthreading



\ ANSForth environment  stuff
@@ -2639,7 +2640,8 @@ T has? peephole H [IF] 


>TARGET

Cond: DOES>

        T here 5 cells H + alit, compile (does>2) compile ;s

        T here H [ T has? peephole H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells

        H + alit, compile (does>2) compile ;s

        doeshandler, resolve-does>-part

        ;Cond

kernel/cbr.fs

+4 −3
Original line number Diff line number Diff line
@@ -20,8 +20,9 @@ 


: ?struc      ( flag -- )       abort" unstructured " ;

: sys?        ( sys -- )        dup 0= ?struc ;

: >mark       ( -- sys )        here  0 , ;

: >resolve    ( sys -- )        here swap ! ;

: >mark       ( -- sys )        here  cell allot ;

: >resolve    ( sys -- )        here swap

    [ has? flash [IF] ] flash! [ [ELSE] ] ! [  [THEN] ] ;

: <resolve    ( sys -- )        , ;



: BUT       sys? swap ;                      immediate restrict
@@ -31,7 +32,7 @@ 


: AHEAD     postpone branch >mark ;           immediate restrict

: IF        postpone ?branch >mark ;          immediate restrict

: THEN      sys? dup @ ?struc >resolve ;     immediate restrict

: THEN      sys? ( dup @ ?struc ) >resolve ;  immediate restrict

: ELSE      sys? postpone AHEAD swap postpone THEN ;

                                             immediate restrict

kernel/comp.fs

+34 −10
Original line number Diff line number Diff line
@@ -48,16 +48,17 @@ 


: c,    ( c -- ) \ core c-comma

    \G Reserve data space for one char and store @i{c} in the space.

    here 1 chars allot c! ;

    here 1 chars allot [ has? flash [IF] ] flashc! [ [ELSE] ] c! [ [THEN] ] ;



: ,     ( w -- ) \ core comma

    \G Reserve data space for one cell and store @i{w} in the space.

    here cell allot  ! ;

    here cell allot [ has? flash [IF] ] flash! [ [ELSE] ] ! [ [THEN] ] ;



: 2,	( w1 w2 -- ) \ gforth

    \G Reserve data space for two cells and store the double @i{w1

    \G w2} there, @i{w2} first (lower address).

    here 2 cells allot 2! ;

    here 2 cells allot  [ has? flash [IF] ] tuck flash! cell+ flash!

	[ [ELSE] ] 2! [ [THEN] ] ;



\ : aligned ( addr -- addr' ) \ core

\     [ cell 1- ] Literal + [ -1 cells ] Literal and ;
@@ -106,7 +107,11 @@ defer header ( -- ) \ gforth 
: string, ( c-addr u -- ) \ gforth

    \G puts down string as cstring

    dup [ has? rom [IF] ] $E0 [ [ELSE] ] alias-mask [ [THEN] ] or c,

    here swap chars dup allot move ;

[ has? flash [IF] ]

    bounds ?DO  I c@ c,  LOOP

[ [ELSE] ]

    here swap chars dup allot move

[ [THEN] ] ;



: longstring, ( c-addr u -- ) \ gforth

    \G puts down string as longcstring
@@ -116,7 +121,7 @@ defer header ( -- ) \ gforth 
    name-too-long?

    dup max-name-length @ max max-name-length !

    align here last !

[ has? ec [IF] ]

[ has? flash [IF] ]

    -1 A,

[ [ELSE] ]

    current @ 1 or A,	\ link field; before revealing, it contains the
@@ -226,7 +231,8 @@ Defer char@ ( addr u -- char addr' u' ) 
: cfa,     ( code-address -- )  \ gforth	cfa-comma

    here

    dup lastcfa !

    0 A, 0 ,  code-address! ;

    [ has? rom [IF] ] 2 cells allot [ [ELSE] ] 0 A, 0 , [ [THEN] ]

    code-address! ;



[IFUNDEF] compile,

defer compile, ( xt -- )	\ core-ext	compile-comma
@@ -377,11 +383,19 @@ has? peephole [IF] 


: S, ( addr u -- )

    \ allot string as counted string

    here over char+ allot  place align ;

[ has? flash [IF] ]

    dup c, bounds ?DO  I c@ c,  LOOP

[ [ELSE] ]

    here over char+ allot  place align

[ [THEN] ] ;



: mem, ( addr u -- )

    \ allot the memory block HERE (do alignment yourself)

    here over allot swap move ;

[ has? flash [IF] ]

    bounds ?DO  I c@ c,  LOOP

[ [ELSE] ]

    here over allot swap move

[ [THEN] ] ;



: ," ( "string"<"> -- )

    [char] " parse s, ;
@@ -497,11 +511,19 @@ doer? :dovalue [IF] 
: AConstant ( addr "name" -- ) \ gforth

    (Constant) A, ;



has? flash [IF]

: Value ( w "name" -- ) \ core-ext

    (Value) dpp @ >r here cell allot >r

    ram here >r , r> r> flash! r> dpp ! ;



' Value alias AValue

[ELSE]

: Value ( w "name" -- ) \ core-ext

    (Value) , ;



: AValue ( w "name" -- ) \ core-ext

    (Value) A, ;

[THEN]



: 2Constant ( w1 w2 "name" -- ) \ double two-constant

    Create ( w1 w2 "name" -- )
@@ -574,7 +596,8 @@ doer? :dodefer [IF] 
:noname

    ;-hook ?struc

    [ has? xconds [IF] ] exit-like [ [THEN] ]

    here 5 cells + postpone aliteral postpone (does>2) [compile] exit

    here [ has? peephole [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] cells +

    postpone aliteral postpone (does>2) [compile] exit

    [ has? peephole [IF] ] finish-code [ [THEN] ] dodoes,

    defstart :-hook ;

interpret/compile: DOES>  ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ core        does
@@ -655,7 +678,8 @@ has? ec [IF] 
    if \ the last word has a header

	dup ( name>link ) @ -1 =

	if \ it is still hidden

	    current @ dup >r @ over ! r> !

	    current @ dup >r @ over

	    [ has? flash [IF] ] flash! [ [ELSE] ] ! [  [THEN] ] r> !

	else

	    drop

	then

kernel/int.fs

+7 −2
Original line number Diff line number Diff line
@@ -537,13 +537,18 @@ has? standardthreading has? compiler and [IF] 
	drop 0

    endif ;



' ! alias code-address! ( c_addr xt -- ) \ gforth

has? flash [IF] ' flash! [ELSE] ' ! [THEN]

alias code-address! ( c_addr xt -- ) \ gforth

\G Create a code field with code address @i{c-addr} at @i{xt}.



: does-code! ( a_addr xt -- ) \ gforth

\G Create a code field at @i{xt} for a child of a @code{DOES>}-word;

\G @i{a-addr} is the start of the Forth code after @code{DOES>}.

    dodoes: over ! cell+ ! ;

    [ has? flash [IF] ]

    dodoes: over flash! cell+ flash!

    [ [ELSE] ]

    dodoes: over ! cell+ !

    [ [THEN] ] ;



' drop alias does-handler! ( a_addr -- ) \ gforth

\G Create a @code{DOES>}-handler at address @i{a-addr}. Normally,