Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
738 lines (689 sloc) 9.16 KB
include(ga144.hdr)
define(READ_FOREVER, `')
include(708out.hdr)
---------------------------- 704 ----------------------------
@p b!
EAST
: main
\@b
@p a!
read-byte
@p push
18
@+ !b unext
jump main
: read-byte
- push
call 705.out0
call 705.out0
call 705.out0
call 705.out0
call 705.out0
call 705.out0
pop @p push \ return addr
EAST
@p push
17 \ loop counter
jump 705.oloop \ call 705.24o
dup drop
call 705.setup
@p - !
0
call 705.in8
!
jump 705.again
---------------------------- 705 ----------------------------
\ See block 1428 for ROM definitions
\ For usage notes:
\ https://mschuldt.github.io/www.colorforth.com/flash.htm
\ http://ww1.microchip.com/downloads/en/DeviceDoc/25024C.pdf
\ EVB001 note: check jumpers J20 and J26
include(romSPI.hdr)
@p a!
EAST
@p b!
io
@p @p
0x2b
0x2a
: again
@p call cmd
eval(`0x03 << 10') \ read
@p a! @
SOUTH
-if read-word
jump WEST
: setup
over over over
over over over @p
EAST
a! ;
: read-word
call 24o
call setup
call in8
pop !
dup !
@p and push
63
: readloop
call in18
! next readloop
jump again
: cmd \ n-
@p !b @p
0x2f
0x2b
!b @p
7
push jump oloop
: 24o
@p push
23
: oloop
-if tx0
2* @p !b @p
0x3a
0x3b
!b next oloop
drop ;
: tx0
push dup !b
over !b pop
2* next oloop
drop ;
: in8
dup dup or @p
7
push jump inloop
: in18
@p push dup
17
: inloop
push !b !b
pop @b
-if got0
drop - 2*
- next inloop
;
: got0
drop 2*
next inloop
;
: out0
dup !b over
!b ;
---------------------------- 506 ----------------------------
\ attr: render color 0 .3 .3
@p b!
NORTH
: main
jump NORTH
: addr \ ( -- o )
\ fetch byte address 0-383
\ set A to bank
\ o to offset 0-63
dup 2/
2/ 2/ 2/
2/ 2/ call tab
WEST \ 3 bank nodes
SOUTH
EAST
: tab
pop + a!
@ a! @p
63
and ;
: @
@b call addr
@p ! !
@p a! @ !p
@ !b ;
: !
@b call addr
@p ! ! @p
@p a! . .
@p ! . .
! @b ! ;
: c@
@b dup dup
call addr
@p ! !
@p a! @ !p
2/ 2* or \ low bit of addr
2* 2* 2* \ 0 or 8
push @ next hibyte
: lo8
@p and !b ;
255
: hibyte
2/ unext jump lo8
: c!
@b dup
call addr
@p ! !
@p a! . .
! @b ! ;
: erase
@b push @b
: loop
dup call addr
@p ! ! @p
@p a! dup
or !
! @p . +
1
next loop
;
\ The three banks for the RAM
---------------------------- 505 ----------------------------
\ attr: render color .3 .3 0
: cold
jump EAST
50502
50504
---------------------------- 507 ----------------------------
\ attr: render color .3 .3 0
: cold
jump WEST
50702
50704
---------------------------- 406 ----------------------------
\ attr: render color .3 .3 0
: cold
jump NORTH
40602
40604
---------------------------- 706 ----------------------------
@p a! @p
WEST
SOUTH
b!
: again
@ -if read-code
@
@p !b
@p \call 606.-!
!b
@p !b
call 606.DORETURN
jump again
: read-code
@
dup @p push
9
2* unext
-if noreturn
@p !b
call 606.DORETURN
: noreturn
drop
@p and push
63
@ !b unext
jump again
---------------------------- 605 ----------------------------
\ R stk
@p b!
NORTH \ to F
@p a!
RSTACKTOP
: main
jump EAST \ port exe from X
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
: RSTACKTOP
: RETURN
@+ !b ;
: RPUSH
@p a +
-1
a! ! ;
---------------------------- 606 ----------------------------
\ D stk and execute
@p b!
WEST \ R stk
@p a!
STACKTOP
@p
0x947
: again
@p call GO
0
jump NORTH \ port exe from D
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
.
: STACKTOP
: TO_R
@p !b !b ;
@p call 605.RPUSH
: DORETURN
@p !b ;
call 605.RETURN
: IFELSE \ a b f : if (f) a else b
if TWOD
drop
: TWOD
drop
: GO
@p !b !b ;
@p !b
: LIT
over
: -!
@p a +
-1
a! ! ;
: 18shr
@p push
8
2/ 2/ unext ;
: swap
over push over
or or pop
jump NORTH \ why?
---------------------------- 610 ----------------------------
@p a!
373
@p b!
469
: __start
jump main
; . . .
jump wait
: main
@ dup push .
ex . . .
call main
: wait
@p b! !b .
277
@ !b @ .
!b @b ! @p
469
b! ; . .
---------------------------- 609 ----------------------------
@p a!
469
@p b!
373
: __start
jump main
; . . .
jump wait
: main
@ dup push .
ex . . .
jump main
: wait
!b @ !b .
@ !b @b .
! ; . .
---------------------------- 608 ----------------------------
@p a!
373
@p b!
469
: __start
jump run
jump emit
jump wait
: run
@ dup push .
ex . . .
jump run
: emit
@p b! @ .
277
!b @p b! ;
469
: wait
!b @ !b .
@ !b @b .
! ; . .
---------------------------- 607 ----------------------------
@p a!
469
@p b!
373
: __start
jump main
@ !b ; .
jump wait
: main
@ dup !b .
push ex . .
jump main
: wait
@ !b @ .
!b @b ! ;
\---------------------------- 708 ----------------------------
\: __start
\: emit1
\ @p and @p .
\ 1
\ 3
\ or !b @p .
\ 904
\ push . . .
\ unext ; . .
\: emit8
\ @p call emit1
\ 0
\ @p push . .
\ 7
\: _12
\ dup call emit1
\ 2/ next _12
\ @p jump emit1
\ 1
\: emit18
\ @p call emit8
\ 0
\ drop call emit8
\ call emit8
\ jump emit8
\: main
\ @p b! @p .
\ 349
\ 277
\ a! . . .
\: loop
\ @ call emit18
\ jump loop
\
---------------------------- 611 ----------------------------
@p a!
469
@p b!
373
: __start
jump main
; . . .
jump wait
: main
@ dup !b .
push ex . .
call main
: wait
@p a! . .
277
: loop
@ -if _8
- @p a! .
469
! ; . .
: _8
!b @b ! .
jump loop
---------------------------- 709 ----------------------------
@p a!
325
@p b!
349
: __start
: main
@p push . .
3
: _2
@p @p next _2
: _40
341
170
@p push push .
341
push push push .
push push push .
push @p @p @p
0
2
2
@p @p @p @p
2
: _30
2
2048
170
: cycle
over or dup .
!b dup ! .
over or dup .
!b dup ! .
push push 2* .
-if _23
drop 2* . .
-if _25
drop 2* . .
-if _27
drop . . .
@p . . .
call _30
@p a! ! @p
373
325
a! pop pop .
drop push 2* .
2* -if _37
drop . . .
@p . . .
call _40
@p a! ! @p
373
325
a! !b @p .
2
: _37
@p . . .
2
: _27
@p . . .
2
: _25
@p . . .
2
: _23
pop pop . .
jump cycle
---------------------------- 710 ----------------------------
@p a!
469
@p b!
349
: __start
jump main
; . . .
jump wait
: 1s
call @waiting-time
if 8 \ 8hz
. @p . +
-1
dup call !waiting-time
if _8
; . . .
: _8
call @waiting-fragment
@p b! !b @p
277
349
b! . . .
: 8hz
@b @p and .
8192
if _17
@p b! @b dup
277
push ex . .
@p b! . .
349
: _17
; . . .
: wait
@b @p . +
1
call !waiting-fragment
@b jump !waiting-time
: !waiting-fragment
@p drop !p ;
: @waiting-fragment
@p ; . .
0
: !waiting-time
@p drop !p ;
: @waiting-time
@p ; . .
0
: main
@p push ex .
373
; . . .
---------------------------- 715 ----------------------------
@p a!
325
@p b!
349
: __start
jump main
: -osc
push . . .
: _10
@p !b dup .
196608
2/ dup push .
unext @p !b .
131072
over @p and .
1
+ push . .
unext next _10
dup or !b dup
@p push . .
30000
: _16
drop @b - .
-if _15
next _16
; . . .
: _15
dup or pop .
drop ; . .
: main
@p @p push .
12895
2000
: _29
dup @p . .
5000
call -osc
if prep
drop @p . +
1
next _29
jump main
: prep
@p @p @p @p
0
131072
2048
198656
@p @p @p @p
0
131072
2048
198656
: run
!b !b @ .
drop jump run