Commit 37b3cbb6 authored by pazsan's avatar pazsan

Flash-enabled Gforth EC

parent bcb3848f
...@@ -147,10 +147,9 @@ end-macros ...@@ -147,10 +147,9 @@ end-macros
\ # $06 , $E1 mov.b:g \ # $06 , $E1 mov.b:g
tos push.w:g tos push.w:g
w , tos mov.w:g # 4 , tos add.w:q 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 rp , w mov.w:g ip , [w] mov.w:g
2 [w] , r1 mov.w:g r1 , ip mov.w:g
# 4 , r1 add.w:q r1 , ip mov.w:g
next, \ execute does> part next, \ execute does> part
End-Code End-Code
...@@ -611,12 +610,13 @@ end-code ...@@ -611,12 +610,13 @@ end-code
: lcdpage $01 lcdctrl! &15 ms ; : lcdpage $01 lcdctrl! &15 ms ;
: lcdcr $C0 lcdctrl! ; : lcdcr $C0 lcdctrl! ;
: lcdinit ( -- ) : lcdinit ( -- )
&20 ms $20 >lcd &20 ms $33 lcdctrl! 5 ms $20 >lcd
&5 ms $28 lcdctrl! &5 ms $28 lcdctrl!
&1 ms $0C lcdctrl! &1 ms $0C lcdctrl!
&1 ms lcdpage ; &1 ms lcdpage ;
: ?flash BEGIN $1B7 c@ 1 and 1 = UNTIL ; : ?flash BEGIN $1B7 c@ 1 and 1 = UNTIL ;
: flashc! ( c addr -- ) $40 over c! c! ?flash ; : 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-off ( addr -- ) $20 over c! $D0 swap c! ?flash ;
: flash-enable ( -- ) $1b7 c! 3 $1b7 c! 0 $1b5 c! 2 $1b5 c! ; : flash-enable ( -- ) $1b7 c! 3 $1b7 c! 0 $1b5 c! 2 $1b5 c! ;
: r8cboot ( -- ) flash-enable lcdinit s" Gforth EC R8C" lcdtype boot ; : r8cboot ( -- ) flash-enable lcdinit s" Gforth EC R8C" lcdtype boot ;
......
...@@ -1184,6 +1184,7 @@ true DefaultValue gforthcross ...@@ -1184,6 +1184,7 @@ true DefaultValue gforthcross
true DefaultValue interpreter true DefaultValue interpreter
true DefaultValue ITC true DefaultValue ITC
false DefaultValue rom false DefaultValue rom
false DefaultValue flash
true DefaultValue standardthreading true DefaultValue standardthreading
\ ANSForth environment stuff \ ANSForth environment stuff
...@@ -2639,7 +2640,8 @@ T has? peephole H [IF] ...@@ -2639,7 +2640,8 @@ T has? peephole H [IF]
>TARGET >TARGET
Cond: DOES> 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 doeshandler, resolve-does>-part
;Cond ;Cond
......
...@@ -20,8 +20,9 @@ ...@@ -20,8 +20,9 @@
: ?struc ( flag -- ) abort" unstructured " ; : ?struc ( flag -- ) abort" unstructured " ;
: sys? ( sys -- ) dup 0= ?struc ; : sys? ( sys -- ) dup 0= ?struc ;
: >mark ( -- sys ) here 0 , ; : >mark ( -- sys ) here cell allot ;
: >resolve ( sys -- ) here swap ! ; : >resolve ( sys -- ) here swap
[ has? flash [IF] ] flash! [ [ELSE] ] ! [ [THEN] ] ;
: <resolve ( sys -- ) , ; : <resolve ( sys -- ) , ;
: BUT sys? swap ; immediate restrict : BUT sys? swap ; immediate restrict
...@@ -31,7 +32,7 @@ ...@@ -31,7 +32,7 @@
: AHEAD postpone branch >mark ; immediate restrict : AHEAD postpone branch >mark ; immediate restrict
: IF 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 ; : ELSE sys? postpone AHEAD swap postpone THEN ;
immediate restrict immediate restrict
......
...@@ -48,16 +48,17 @@ ...@@ -48,16 +48,17 @@
: c, ( c -- ) \ core c-comma : c, ( c -- ) \ core c-comma
\G Reserve data space for one char and store @i{c} in the space. \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 : , ( w -- ) \ core comma
\G Reserve data space for one cell and store @i{w} in the space. \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 : 2, ( w1 w2 -- ) \ gforth
\G Reserve data space for two cells and store the double @i{w1 \G Reserve data space for two cells and store the double @i{w1
\G w2} there, @i{w2} first (lower address). \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 \ : aligned ( addr -- addr' ) \ core
\ [ cell 1- ] Literal + [ -1 cells ] Literal and ; \ [ cell 1- ] Literal + [ -1 cells ] Literal and ;
...@@ -106,7 +107,11 @@ defer header ( -- ) \ gforth ...@@ -106,7 +107,11 @@ defer header ( -- ) \ gforth
: string, ( c-addr u -- ) \ gforth : string, ( c-addr u -- ) \ gforth
\G puts down string as cstring \G puts down string as cstring
dup [ has? rom [IF] ] $E0 [ [ELSE] ] alias-mask [ [THEN] ] or c, 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 : longstring, ( c-addr u -- ) \ gforth
\G puts down string as longcstring \G puts down string as longcstring
...@@ -116,7 +121,7 @@ defer header ( -- ) \ gforth ...@@ -116,7 +121,7 @@ defer header ( -- ) \ gforth
name-too-long? name-too-long?
dup max-name-length @ max max-name-length ! dup max-name-length @ max max-name-length !
align here last ! align here last !
[ has? ec [IF] ] [ has? flash [IF] ]
-1 A, -1 A,
[ [ELSE] ] [ [ELSE] ]
current @ 1 or A, \ link field; before revealing, it contains the current @ 1 or A, \ link field; before revealing, it contains the
...@@ -226,7 +231,8 @@ Defer char@ ( addr u -- char addr' u' ) ...@@ -226,7 +231,8 @@ Defer char@ ( addr u -- char addr' u' )
: cfa, ( code-address -- ) \ gforth cfa-comma : cfa, ( code-address -- ) \ gforth cfa-comma
here here
dup lastcfa ! dup lastcfa !
0 A, 0 , code-address! ; [ has? rom [IF] ] 2 cells allot [ [ELSE] ] 0 A, 0 , [ [THEN] ]
code-address! ;
[IFUNDEF] compile, [IFUNDEF] compile,
defer compile, ( xt -- ) \ core-ext compile-comma defer compile, ( xt -- ) \ core-ext compile-comma
...@@ -377,11 +383,19 @@ has? peephole [IF] ...@@ -377,11 +383,19 @@ has? peephole [IF]
: S, ( addr u -- ) : S, ( addr u -- )
\ allot string as counted string \ 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 -- ) : mem, ( addr u -- )
\ allot the memory block HERE (do alignment yourself) \ 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"<"> -- ) : ," ( "string"<"> -- )
[char] " parse s, ; [char] " parse s, ;
...@@ -497,11 +511,19 @@ doer? :dovalue [IF] ...@@ -497,11 +511,19 @@ doer? :dovalue [IF]
: AConstant ( addr "name" -- ) \ gforth : AConstant ( addr "name" -- ) \ gforth
(Constant) A, ; (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 ( w "name" -- ) \ core-ext
(Value) , ; (Value) , ;
: AValue ( w "name" -- ) \ core-ext : AValue ( w "name" -- ) \ core-ext
(Value) A, ; (Value) A, ;
[THEN]
: 2Constant ( w1 w2 "name" -- ) \ double two-constant : 2Constant ( w1 w2 "name" -- ) \ double two-constant
Create ( w1 w2 "name" -- ) Create ( w1 w2 "name" -- )
...@@ -574,7 +596,8 @@ doer? :dodefer [IF] ...@@ -574,7 +596,8 @@ doer? :dodefer [IF]
:noname :noname
;-hook ?struc ;-hook ?struc
[ has? xconds [IF] ] exit-like [ [THEN] ] [ 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, [ has? peephole [IF] ] finish-code [ [THEN] ] dodoes,
defstart :-hook ; defstart :-hook ;
interpret/compile: DOES> ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ core does interpret/compile: DOES> ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ core does
...@@ -655,7 +678,8 @@ has? ec [IF] ...@@ -655,7 +678,8 @@ has? ec [IF]
if \ the last word has a header if \ the last word has a header
dup ( name>link ) @ -1 = dup ( name>link ) @ -1 =
if \ it is still hidden if \ it is still hidden
current @ dup >r @ over ! r> ! current @ dup >r @ over
[ has? flash [IF] ] flash! [ [ELSE] ] ! [ [THEN] ] r> !
else else
drop drop
then then
......
...@@ -537,13 +537,18 @@ has? standardthreading has? compiler and [IF] ...@@ -537,13 +537,18 @@ has? standardthreading has? compiler and [IF]
drop 0 drop 0
endif ; 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}. \G Create a code field with code address @i{c-addr} at @i{xt}.
: does-code! ( a_addr xt -- ) \ gforth : does-code! ( a_addr xt -- ) \ gforth
\G Create a code field at @i{xt} for a child of a @code{DOES>}-word; \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>}. \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 ' drop alias does-handler! ( a_addr -- ) \ gforth
\G Create a @code{DOES>}-handler at address @i{a-addr}. Normally, \G Create a @code{DOES>}-handler at address @i{a-addr}. Normally,
......
...@@ -24,7 +24,8 @@ require ./io.fs ...@@ -24,7 +24,8 @@ require ./io.fs
\G @var{c-addr} is the address of a transient region that can be \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 used as temporary data storage. At least 84 characters of space
\G is available. \G is available.
here word-pno-size + aligned ; [ has? flash [IF] ] normal-dp @ [ [ELSE] ] here [ [THEN] ]
word-pno-size + aligned ;
\ hold <# #> sign # #s 25jan92py \ hold <# #> sign # #s 25jan92py
......
...@@ -202,6 +202,12 @@ AUser dpp normal-dp dpp ! ...@@ -202,6 +202,12 @@ AUser dpp normal-dp dpp !
AUser LastCFA AUser LastCFA
AUser Last 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 User max-name-length \ maximum length of all names defined yet
32 max-name-length ! 32 max-name-length !
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment