aboutsummaryrefslogtreecommitdiff
path: root/j1demo/firmware/main.fs
blob: 16e4cf55f965aa79098a59e669c52372b0ae01a5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
( Main for WGE firmware                      JCB 13:24 08/24/10)

\ warnings off
\ require tags.fs

include crossj1.fs
meta
    : TARGET? 1 ;
    : build-debug? 1 ;

include basewords.fs
target
include hwdefs.fs

0 [IF]
    h# 1f80 org
    \ the RAM Bootloader copies 2000-3f80 to 0-1f80, then branches to zero
    : bootloader
        h# 1f80 h# 0
        begin
            2dupxor
        while
            dup h# 2000 + @
            over !
            d# 2 +
        repeat

        begin dsp h# ff and while drop repeat
        d# 0 >r
    ;
[ELSE]
    h# 3f80 org
    \ the Flash Bootloader copies 0x190000 to 0-3f80, then branches to zero
    : bootloader
        h# c flash_a_hi !
        h# 0 begin
            dup h# 8000 + flash_a !
            d# 0 flash_oe_n !
            flash_d @
            d# 1 flash_oe_n !
            over dup + !
            d# 1 +
            dup h# 1fc0 =
        until

        begin dsp h# ff and while drop repeat
        d# 0 >r
    ;
[THEN]

4 org
module[ everything"
include nuc.fs

include version.fs

\ 33333333 / 115200 = 289, half cycle is 144

: pause144
    d# 0 d# 45
    begin
        1-
        2dup=
    until
    2drop
;

: serout ( u -- )
    h# 300 or   \ 1 stop bits
    2*          \ 0 start bit
    \ Start bit
    begin
        dup RS232_TXD ! 2/
        pause144
        pause144
        dup 0=
    until
    drop
    pause144 pause144
    pause144 pause144
;

: frac ( ud u -- d1 u1 ) \ d1+u1 is ud
    >r 2dup d# 1 r@ m*/ 2swap 2over r> d# 1 m*/ d- drop ;
: .2  s>d <# # # #> type ;
: build.
    decimal
    builddate drop
    [ -8 3600 * ] literal s>d d+
    d# 1 d# 60 m*/mod >r
    d# 1 d# 60 m*/mod >r
    d# 1 d# 24 m*/mod >r
    2drop
    r> .2 [char] : emit
    r> .2 [char] : emit
    r> .2 ;

: net-my-mac h# 1234 h# 5677 h# 7777 ;

include doc.fs
include time.fs
include eth-ax88796.fs
include packet.fs
include ip0.fs
include defines_tcpip.fs
include defines_tcpip2.fs
include arp.fs
include ip.fs
include udp.fs
include dhcp.fs

code in end-code
: on ( a -- ) d# 1 swap ! ;
code out end-code
: off ( a -- ) d# 0 swap ! ;

: flash-reset
    flash_rst_n   off
    flash_rst_n   on
;

: flash-cold
    flash_ddir    on
    flash_ce_n    off
    flash_oe_n    on
    flash_we_n    on
    flash_byte_n  on
    flash_rdy     on
    flash-reset
;

: flash-w ( u a -- )
    flash_a !
    flash_d !
    flash_ddir off
    flash_we_n off
    flash_we_n on
    flash_ddir on
;

: flash-r ( a -- u )
    flash_a !
    flash_oe_n off
    flash_d @
    flash_oe_n on
;

: flash-unlock ( -- )
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
;

: flash! ( u da. -- )
    flash-unlock
    h# a0 h# 555 flash-w
    flash_a 2+ !    ( u a )
    2dup            ( u a u a)
    flash-w         ( u a )
    begin
        2dup flash-r xor
        h# 80 and 0=
    until
    2drop
    flash-reset
;

: flash@ ( da. -- u )
    flash_a 2+ !    ( u a )
    flash-r
;

: flash-chiperase
    flash-unlock
    h# 80 h# 555 flash-w
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
    h# 10 h# 555 flash-w
;

: flash-sectorerase ( da -- ) \ erase one sector
    flash-unlock
    h# 80 h# 555 flash-w
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
    flash_a 2+ ! h# 30 swap flash-w
;

: flash-erased ( a -- f )
    flash@ h# 80 and 0<> ;

: flash-dump ( da u -- )
    0do
        2dup flash@ hex4 space
        d1+
    loop cr
    2drop
;

: flashc@
    over d# 15 lshift flash_d !
    d2/ flash@
;

: flash-bytes
    s" BYTES: " type
    flash_byte_n  off
    h# 0.
    d# 1024 0do
        i d# 15 and 0= if
            cr
            2dup hex8 space space
        then
        2dup flashc@ hex2 space
        d1+
    loop cr
    2drop
    flash_byte_n  on
;

0 [IF]
: flash-demo
    flash-unlock
    h# 90 h# 555 flash-w
    h# 00 flash-r hex4 cr
    flash-reset

    false if
        flash-unlock
        h# a0 h# 555 flash-w
        h# 0947 h# 5 flash-w
        sleep1
        flash-reset
    then

    \ h# dead d# 11. flash!

    h# 100 0do
        i flash-r hex4 space
    loop cr
    cr cr
    d# 0. h# 80 flash-dump
    cr cr

    flash-bytes

    exit
    flash-unlock
    h# 80 h# 555 flash-w
    h# aa h# 555 flash-w
    h# 55 h# 2aa flash-w
    h# 10 h# 555 flash-w
    s" waiting for erase" type cr
    begin
        h# 0 flash-r dup hex4 cr
        h# 80 and
    until

    h# 100 0do
        i flash-r hex4 space
    loop cr
;
[THEN]

include sprite.fs

variable cursory \ ptr to start of line in video memory
variable cursorx \ offset to char

64 constant width
50 constant wrapcolumn

: vga-at-xy ( u1 u2 )
    cursory !
    cursorx !
;

: home  d# 0 vga_scroll ! d# 0 d# 0 vga-at-xy ;

: vga-line ( -- a ) \ address of current line
    cursory @ vga_scroll @ + d# 31 and d# 6 lshift 
    h# 8000 or
;

: vga-erase ( a u -- )
    bounds begin
        2dupxor
    while
        h# 00 over ! 1+
    repeat 2drop
;

: vga-page
    home vga-line d# 2048 vga-erase
    hide
;

: down1
    cursory @ d# 31 <> if
        d# 1 cursory +!
    else
        false if
            d# 1 vga_scroll +!
            vga-line width vga-erase
        else
            home
        then
    then
;

: vga-emit ( c -- )
    dup d# 13 = if
        drop d# 0 cursorx !
    else
        dup d# 10 = if
            drop down1
        else
            d# -32 +
            vga-line cursorx @ + !
            d# 1 cursorx +!
            cursorx @ wrapcolumn = if
                d# 0 cursorx !
                down1
            then
        then
    then
;

: flash>ram ( d. a -- ) \ copy 2K from flash d to a
    >r d2/ r>
    d# 1024 0do
        >r
        2dup flash@
        r> ( d. u a )
        over swab over !
        1+
        tuck !
        1+
        >r d1+ r>
    loop
    drop 2drop
;

: vga-cold
    h# f800 h# f000 do
        d# 0 i !
    loop

    vga-page

    \ pic: Copy 2048 bytes from 180000 to 8000
    \ chr: Copy 2048 bytes from 180800 to f000
    h# 180000. h# 8000 flash>ram
    h# 180800. h# f000 flash>ram

    \ ['] vga-emit 'emit !
;

create glyph 8 allot
: wide1 ( c -- )
    swab
    d# 8 0do
        dup 0<
        if d# 127 else sp then
        \ if [char] * else [char] . then
        vga-emit
        2*
    loop drop
;

: vga-bigemit ( c -- )
    dup d# 13 = if
        drop d# 0 cursorx !
    else
        dup d# 10 = if
            drop d# 8 0do down1 loop
        else
            sp - d# 8 * s>d
            h# 00180800. d+ d2/
            d# 4 0do
                2dup flash@ swab
                i cells glyph + !
                d1+
            loop 2drop

            d# 7 0do
                i glyph + c@ wide1
                d# -8 cursorx +! down1
            loop
            d# 7 glyph + c@ wide1

            d# -7 cursory +!
        then
    then
;

( Demo utilities                             JCB 10:56 12/05/10)

: statusline ( a u -- ) \ display string on the status line
    d# 0 d# 31 2dup vga-at-xy
    d# 50 spaces
    vga-at-xy type
;

( Game stuff                                 JCB 15:20 11/15/10)

variable seed
: random  ( -- u )
    seed @ d# 23947 * d# 57711 xor dup seed ! ;   


\ Each line is 20.8 us, so 1000 instructions

include sincos.fs

( Stars                                      JCB 15:23 11/15/10)

2variable vision
variable frame
128 constant nstars
create stars 1024 allot

: star 2* cells stars + ;
: 15.*  m* d2* nip ;

\ >>> math.cos(math.pi / 180) * 32767
\ 32762.009427189474
\ >>> math.sin(math.pi / 180) * 32767
\ 571.8630017304688

[ pi 128e0 f/ fcos 32767e0 f* f>d drop ] constant COSa
[ pi 128e0 f/ fsin 32767e0 f* f>d drop ] constant SINa

: rotate ( i -- ) \ rotate star i
    star dup 2@ ( x y )
    over SINa 15.* over COSa 15.* + >r
    swap COSa 15.* swap SINa 15.* - r>
    rot 2!
;

: rotateall
    d# 256 0do i rotate loop ;

: scatterR
    nstars 0do
        random d# 0 i star 2!
        rotateall
        rotateall
        rotateall
        rotateall
    loop
;

: scatterSpiral
    nstars 0do
        i d# 3 and 1+ d# 8000 *
        d# 0 i star 2!
        rotateall
        rotateall
        rotateall
        rotateall
    loop
;

: scatter
    nstars 0do
        \ d# 0 random
        d# 0 i sin
        i star 2!
        i random d# 255 and 0do
            dup rotate
        loop drop
    loop
;

: /128  dup 0< h# fe00 and swap d# 7 rshift or ;
: tx    /128 [ 400 ] literal + ;
: ty    /128 [ 256 ] literal + ;

: plot ( i s ) \ plot star i in sprite s
    >r
    dup star @ tx swap d# 2 lshift
    r> sprite!
;

( Display list                               JCB 16:10 11/15/10)

create dl 1026 allot

: erasedl
    dl d# 1024 bounds begin
        d# -1 over !
        cell+ 2dup=
    until 2drop
;

: makedl
    erasedl

    nstars 0do
        i d# 2 lshift
        cells dl +
        \ cell occupied, use one below
        \ dup @ 0< invert if cell+ then
        i swap !
    loop
;

variable lastsp
: stars-chasebeam
    hide
    d# 0 lastsp !
    d# 512 0do
        begin vga-line@ i = until
        i cells dl + @ dup 0< if
            drop
        else
            lastsp @ 1+ d# 7 and dup lastsp ! plot
        then
        i nstars < if i rotate then
    loop
;



: loadcolors
    d# 8 0do
        dup @
        i cells vga_spritec + !
        cell+
    loop
    drop
;
create cpastels
h# 423 ,
h# 243 ,
h# 234 ,
h# 444 ,
h# 324 ,
h# 432 ,
h# 342 ,
h# 244 ,
: pastels cpastels loadcolors ;

create crainbow
h# 400 ,
h# 440 ,
h# 040 ,
h# 044 ,
h# 004 ,
h# 404 ,
h# 444 ,
h# 444 ,
: rainbow crainbow loadcolors ;

variable prev_sw3_n

: next? ( -- f ) \ has user requested next screen
    sw3_n @ prev_sw3_n fall?
;

: loadsprites ( da -- )
    2/
    d# 16384 0do
        2dup i s>d d+ flash@
        i vga_spritea !  vga_spriteport !
    loop
    2drop
;

: stars-main
    vga-page
    d# 16384 0do
        h# 204000. 2/ i s>d d+ flash@
        i vga_spritea !  vga_spriteport !
    loop

    vga_addsprites on
    rainbow

    time@ xor seed !
    seed off
    scatter

    d# 7000000. vision setalarm
    d# 0 frame !
    begin
        makedl
        stars-chasebeam
        \ d# 256 0do i i plot loop
        \ rotateall
        frame @ 1+ frame !
        next?
    until
    frame @ . s"  frames" type cr
;

: buttons ( -- u ) \ pb4 pb3 pb2
    pb_a_dir on
    pb_a @ d# 7 xor
    pb_a_dir off
;

include loader.fs
include dns.fs

: preip-handler
    begin
        mac-fullness
    while
        OFFSET_ETH_TYPE packet@ h# 800 = if
            dhcp-wait-offer
        then
        mac-consume
    repeat
;

: haveip-handler
    \ time@ begin ether_irq @ until time@ 2swap d- d. cr
    \ begin ether_irq @ until
    begin
        mac-fullness
    while
        arp-handler
        OFFSET_ETH_TYPE packet@ h# 800 =
        if
            d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
            if
                icmp-handler
            then
            loader-handler
        then
        depth if .s cr then
        mac-consume
    repeat
;

include invaders.fs

: uptime
    time@
    d# 1 d# 1000 m*/
    d# 1 d# 1000 m*/
;

( IP address formatting                      JCB 14:50 10/26/10)

: #ip1  h# ff and s>d #s 2drop ;
: #.    [char] . hold ;
: #ip2  dup #ip1 #. d# 8 rshift #ip1 ;
: #ip   ( ip -- c-addr u) dup #ip2 #. over #ip2 ;

variable prev_sw2_n
: sw2?  sw2_n @ prev_sw2_n fall? ;

include ps2kb.fs

: istab?
    key? dup if key TAB = and then
;
        
: welcome-main
    vga-cold
    home
    s" F1 to set up network, TAB for next demo" statusline

    rainbow
    h# 200000. loadsprites
    'emit @ >r
    d# 6 d# 26 vga-at-xy s" Softcore Forth CPU" type

    d# 32 d# 6 vga-at-xy  s" version " type version type
    d# 32 d# 8 vga-at-xy  s" built   " type build.

    kb-cold
    home
    begin
        kbfifo-proc
        d# 32 d# 10 vga-at-xy net-my-ip <# #ip #> type space space
        d# 32 d# 12 vga-at-xy s" uptime  " type uptime d.
        haveip-handler

        d# 8 0do
            frame @ i d# 32 * + invert >r
            d# 100 r@ sin* d# 600 +
            d# 100 r> cos* d# 334 +
            i sprite!
        loop

        waitblank
        d# 1 frame +!
        next?
        istab? or
    until
    r> 'emit !
;

include clock.fs

: frob
    flash_ce_n    on
    flash_ddir off
    d# 32 0do
        d# 1 i d# 7 and lshift
        flash_d !
        d# 30000. sleepus
    loop
    flash_ddir on
;

: main
    decimal
    ['] serout 'emit !
    \ sleep1

    frob

    d# 60 0do cr loop
    s" Welcome! Built " type build. cr 
    snap

    flash-cold
    \ flash-demo
    \ flash-bytes
    vga-cold
    ['] vga-emit 'emit !
    s" Waiting for Ethernet NIC" statusline
    mac-cold
    nicwork
    h# decafbad. dhcp-xid!
    d# 3000000. dhcp-alarm setalarm
    false if
        ip-addr dz
        begin
            net-my-ip d0=
        while
            dhcp-alarm isalarm if
                dhcp-discover
                s" DISCOVER" type cr
                d# 3000000. dhcp-alarm setalarm
            then
            preip-handler
        repeat
    else
        ip# 192.168.0.99 ip-addr 2!
        ip# 255.255.255.0 ip-subnetmask 2!
        ip# 192.168.0.1 ip-router 2!
        \ ip# 192.168.2.201 ip-addr 2!
        \ ip# 255.255.255.0 ip-subnetmask 2!
        \ ip# 192.168.2.1 ip-router 2!
    then
    dhcp-status
    arp-reset

    begin
        welcome-main        sleep.1
        clock-main          sleep.1
        stars-main          sleep.1
        invaders-main       sleep.1
        s" looping" type cr
    again

    begin
        haveip-handler
    again
;


]module

0 org

code 0jump
    \ h# 3e00 ubranch
    main ubranch
    main ubranch
end-code

meta

hex

: create-output-file w/o create-file throw to outfile ;

\ .mem is a memory dump formatted for use with the Xilinx
\ data2mem tool.
s" j1.mem" create-output-file
:noname
    s" @ 20000" type cr
    4000 0 do i t@ s>d <# # # # # #> type cr 2 +loop
; execute

\ .bin is a big-endian binary memory dump
s" j1.bin" create-output-file
:noname 4000 0 do i t@ dup 8 rshift emit emit 2 +loop ; execute

\ .lst file is a human-readable disassembly 
s" j1.lst" create-output-file
d# 0
h# 2000 disassemble-block