Commit 37b3cbb6 authored by pazsan's avatar pazsan

Flash-enabled Gforth EC

parent bcb3848f
......@@ -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 ;
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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,
......
......@@ -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
......
......@@ -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 !
......
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