Flash-enabled Gforth EC

arch/r8c/prim.fs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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,

kernel/nio.fs

@@ -24,7 +24,8 @@ require ./io.fs
     \G @var{c-addr} is the address of a transient region that can be
     \G used as temporary data storage. At least 84 characters of space
     \G is available.
-    here word-pno-size + aligned ;
+    [ has? flash [IF] ] normal-dp @ [ [ELSE] ] here [ [THEN] ]
+    word-pno-size + aligned ;
 
 \ hold <# #> sign # #s                                 25jan92py
 

kernel/vars.fs

@@ -202,6 +202,12 @@ AUser dpp		normal-dp dpp !
 AUser LastCFA
 AUser Last
 
+has? flash [IF]
+    AUser flash-dp
+    : rom  flash-dp dpp ! ;
+    : ram  normal-dp dpp ! ;
+[THEN]
+
 User max-name-length \ maximum length of all names defined yet
 32 max-name-length !