main.fs 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799
  1. ( Main for WGE firmware JCB 13:24 08/24/10)
  2. \ warnings off
  3. \ require tags.fs
  4. include crossj1.fs
  5. meta
  6. : TARGET? 1 ;
  7. : build-debug? 1 ;
  8. include basewords.fs
  9. target
  10. include hwdefs.fs
  11. 0 [IF]
  12. h# 1f80 org
  13. \ the RAM Bootloader copies 2000-3f80 to 0-1f80, then branches to zero
  14. : bootloader
  15. h# 1f80 h# 0
  16. begin
  17. 2dupxor
  18. while
  19. dup h# 2000 + @
  20. over !
  21. d# 2 +
  22. repeat
  23. begin dsp h# ff and while drop repeat
  24. d# 0 >r
  25. ;
  26. [ELSE]
  27. h# 3f80 org
  28. \ the Flash Bootloader copies 0x190000 to 0-3f80, then branches to zero
  29. : bootloader
  30. h# c flash_a_hi !
  31. h# 0 begin
  32. dup h# 8000 + flash_a !
  33. d# 0 flash_oe_n !
  34. flash_d @
  35. d# 1 flash_oe_n !
  36. over dup + !
  37. d# 1 +
  38. dup h# 1fc0 =
  39. until
  40. begin dsp h# ff and while drop repeat
  41. d# 0 >r
  42. ;
  43. [THEN]
  44. 4 org
  45. module[ everything"
  46. include nuc.fs
  47. include version.fs
  48. \ 33333333 / 115200 = 289, half cycle is 144
  49. : pause144
  50. d# 0 d# 45
  51. begin
  52. 1-
  53. 2dup=
  54. until
  55. 2drop
  56. ;
  57. : serout ( u -- )
  58. h# 300 or \ 1 stop bits
  59. 2* \ 0 start bit
  60. \ Start bit
  61. begin
  62. dup RS232_TXD ! 2/
  63. pause144
  64. pause144
  65. dup 0=
  66. until
  67. drop
  68. pause144 pause144
  69. pause144 pause144
  70. ;
  71. : frac ( ud u -- d1 u1 ) \ d1+u1 is ud
  72. >r 2dup d# 1 r@ m*/ 2swap 2over r> d# 1 m*/ d- drop ;
  73. : .2 s>d <# # # #> type ;
  74. : build.
  75. decimal
  76. builddate drop
  77. [ -8 3600 * ] literal s>d d+
  78. d# 1 d# 60 m*/mod >r
  79. d# 1 d# 60 m*/mod >r
  80. d# 1 d# 24 m*/mod >r
  81. 2drop
  82. r> .2 [char] : emit
  83. r> .2 [char] : emit
  84. r> .2 ;
  85. : net-my-mac h# 1234 h# 5677 h# 7777 ;
  86. include doc.fs
  87. include time.fs
  88. include eth-ax88796.fs
  89. include packet.fs
  90. include ip0.fs
  91. include defines_tcpip.fs
  92. include defines_tcpip2.fs
  93. include arp.fs
  94. include ip.fs
  95. include udp.fs
  96. include dhcp.fs
  97. code in end-code
  98. : on ( a -- ) d# 1 swap ! ;
  99. code out end-code
  100. : off ( a -- ) d# 0 swap ! ;
  101. : flash-reset
  102. flash_rst_n off
  103. flash_rst_n on
  104. ;
  105. : flash-cold
  106. flash_ddir on
  107. flash_ce_n off
  108. flash_oe_n on
  109. flash_we_n on
  110. flash_byte_n on
  111. flash_rdy on
  112. flash-reset
  113. ;
  114. : flash-w ( u a -- )
  115. flash_a !
  116. flash_d !
  117. flash_ddir off
  118. flash_we_n off
  119. flash_we_n on
  120. flash_ddir on
  121. ;
  122. : flash-r ( a -- u )
  123. flash_a !
  124. flash_oe_n off
  125. flash_d @
  126. flash_oe_n on
  127. ;
  128. : flash-unlock ( -- )
  129. h# aa h# 555 flash-w
  130. h# 55 h# 2aa flash-w
  131. ;
  132. : flash! ( u da. -- )
  133. flash-unlock
  134. h# a0 h# 555 flash-w
  135. flash_a 2+ ! ( u a )
  136. 2dup ( u a u a)
  137. flash-w ( u a )
  138. begin
  139. 2dup flash-r xor
  140. h# 80 and 0=
  141. until
  142. 2drop
  143. flash-reset
  144. ;
  145. : flash@ ( da. -- u )
  146. flash_a 2+ ! ( u a )
  147. flash-r
  148. ;
  149. : flash-chiperase
  150. flash-unlock
  151. h# 80 h# 555 flash-w
  152. h# aa h# 555 flash-w
  153. h# 55 h# 2aa flash-w
  154. h# 10 h# 555 flash-w
  155. ;
  156. : flash-sectorerase ( da -- ) \ erase one sector
  157. flash-unlock
  158. h# 80 h# 555 flash-w
  159. h# aa h# 555 flash-w
  160. h# 55 h# 2aa flash-w
  161. flash_a 2+ ! h# 30 swap flash-w
  162. ;
  163. : flash-erased ( a -- f )
  164. flash@ h# 80 and 0<> ;
  165. : flash-dump ( da u -- )
  166. 0do
  167. 2dup flash@ hex4 space
  168. d1+
  169. loop cr
  170. 2drop
  171. ;
  172. : flashc@
  173. over d# 15 lshift flash_d !
  174. d2/ flash@
  175. ;
  176. : flash-bytes
  177. s" BYTES: " type
  178. flash_byte_n off
  179. h# 0.
  180. d# 1024 0do
  181. i d# 15 and 0= if
  182. cr
  183. 2dup hex8 space space
  184. then
  185. 2dup flashc@ hex2 space
  186. d1+
  187. loop cr
  188. 2drop
  189. flash_byte_n on
  190. ;
  191. 0 [IF]
  192. : flash-demo
  193. flash-unlock
  194. h# 90 h# 555 flash-w
  195. h# 00 flash-r hex4 cr
  196. flash-reset
  197. false if
  198. flash-unlock
  199. h# a0 h# 555 flash-w
  200. h# 0947 h# 5 flash-w
  201. sleep1
  202. flash-reset
  203. then
  204. \ h# dead d# 11. flash!
  205. h# 100 0do
  206. i flash-r hex4 space
  207. loop cr
  208. cr cr
  209. d# 0. h# 80 flash-dump
  210. cr cr
  211. flash-bytes
  212. exit
  213. flash-unlock
  214. h# 80 h# 555 flash-w
  215. h# aa h# 555 flash-w
  216. h# 55 h# 2aa flash-w
  217. h# 10 h# 555 flash-w
  218. s" waiting for erase" type cr
  219. begin
  220. h# 0 flash-r dup hex4 cr
  221. h# 80 and
  222. until
  223. h# 100 0do
  224. i flash-r hex4 space
  225. loop cr
  226. ;
  227. [THEN]
  228. include sprite.fs
  229. variable cursory \ ptr to start of line in video memory
  230. variable cursorx \ offset to char
  231. 64 constant width
  232. 50 constant wrapcolumn
  233. : vga-at-xy ( u1 u2 )
  234. cursory !
  235. cursorx !
  236. ;
  237. : home d# 0 vga_scroll ! d# 0 d# 0 vga-at-xy ;
  238. : vga-line ( -- a ) \ address of current line
  239. cursory @ vga_scroll @ + d# 31 and d# 6 lshift
  240. h# 8000 or
  241. ;
  242. : vga-erase ( a u -- )
  243. bounds begin
  244. 2dupxor
  245. while
  246. h# 00 over ! 1+
  247. repeat 2drop
  248. ;
  249. : vga-page
  250. home vga-line d# 2048 vga-erase
  251. hide
  252. ;
  253. : down1
  254. cursory @ d# 31 <> if
  255. d# 1 cursory +!
  256. else
  257. false if
  258. d# 1 vga_scroll +!
  259. vga-line width vga-erase
  260. else
  261. home
  262. then
  263. then
  264. ;
  265. : vga-emit ( c -- )
  266. dup d# 13 = if
  267. drop d# 0 cursorx !
  268. else
  269. dup d# 10 = if
  270. drop down1
  271. else
  272. d# -32 +
  273. vga-line cursorx @ + !
  274. d# 1 cursorx +!
  275. cursorx @ wrapcolumn = if
  276. d# 0 cursorx !
  277. down1
  278. then
  279. then
  280. then
  281. ;
  282. : flash>ram ( d. a -- ) \ copy 2K from flash d to a
  283. >r d2/ r>
  284. d# 1024 0do
  285. >r
  286. 2dup flash@
  287. r> ( d. u a )
  288. over swab over !
  289. 1+
  290. tuck !
  291. 1+
  292. >r d1+ r>
  293. loop
  294. drop 2drop
  295. ;
  296. : vga-cold
  297. h# f800 h# f000 do
  298. d# 0 i !
  299. loop
  300. vga-page
  301. \ pic: Copy 2048 bytes from 180000 to 8000
  302. \ chr: Copy 2048 bytes from 180800 to f000
  303. h# 180000. h# 8000 flash>ram
  304. h# 180800. h# f000 flash>ram
  305. \ ['] vga-emit 'emit !
  306. ;
  307. create glyph 8 allot
  308. : wide1 ( c -- )
  309. swab
  310. d# 8 0do
  311. dup 0<
  312. if d# 127 else sp then
  313. \ if [char] * else [char] . then
  314. vga-emit
  315. 2*
  316. loop drop
  317. ;
  318. : vga-bigemit ( c -- )
  319. dup d# 13 = if
  320. drop d# 0 cursorx !
  321. else
  322. dup d# 10 = if
  323. drop d# 8 0do down1 loop
  324. else
  325. sp - d# 8 * s>d
  326. h# 00180800. d+ d2/
  327. d# 4 0do
  328. 2dup flash@ swab
  329. i cells glyph + !
  330. d1+
  331. loop 2drop
  332. d# 7 0do
  333. i glyph + c@ wide1
  334. d# -8 cursorx +! down1
  335. loop
  336. d# 7 glyph + c@ wide1
  337. d# -7 cursory +!
  338. then
  339. then
  340. ;
  341. ( Demo utilities JCB 10:56 12/05/10)
  342. : statusline ( a u -- ) \ display string on the status line
  343. d# 0 d# 31 2dup vga-at-xy
  344. d# 50 spaces
  345. vga-at-xy type
  346. ;
  347. ( Game stuff JCB 15:20 11/15/10)
  348. variable seed
  349. : random ( -- u )
  350. seed @ d# 23947 * d# 57711 xor dup seed ! ;
  351. \ Each line is 20.8 us, so 1000 instructions
  352. include sincos.fs
  353. ( Stars JCB 15:23 11/15/10)
  354. 2variable vision
  355. variable frame
  356. 128 constant nstars
  357. create stars 1024 allot
  358. : star 2* cells stars + ;
  359. : 15.* m* d2* nip ;
  360. \ >>> math.cos(math.pi / 180) * 32767
  361. \ 32762.009427189474
  362. \ >>> math.sin(math.pi / 180) * 32767
  363. \ 571.8630017304688
  364. [ pi 128e0 f/ fcos 32767e0 f* f>d drop ] constant COSa
  365. [ pi 128e0 f/ fsin 32767e0 f* f>d drop ] constant SINa
  366. : rotate ( i -- ) \ rotate star i
  367. star dup 2@ ( x y )
  368. over SINa 15.* over COSa 15.* + >r
  369. swap COSa 15.* swap SINa 15.* - r>
  370. rot 2!
  371. ;
  372. : rotateall
  373. d# 256 0do i rotate loop ;
  374. : scatterR
  375. nstars 0do
  376. random d# 0 i star 2!
  377. rotateall
  378. rotateall
  379. rotateall
  380. rotateall
  381. loop
  382. ;
  383. : scatterSpiral
  384. nstars 0do
  385. i d# 3 and 1+ d# 8000 *
  386. d# 0 i star 2!
  387. rotateall
  388. rotateall
  389. rotateall
  390. rotateall
  391. loop
  392. ;
  393. : scatter
  394. nstars 0do
  395. \ d# 0 random
  396. d# 0 i sin
  397. i star 2!
  398. i random d# 255 and 0do
  399. dup rotate
  400. loop drop
  401. loop
  402. ;
  403. : /128 dup 0< h# fe00 and swap d# 7 rshift or ;
  404. : tx /128 [ 400 ] literal + ;
  405. : ty /128 [ 256 ] literal + ;
  406. : plot ( i s ) \ plot star i in sprite s
  407. >r
  408. dup star @ tx swap d# 2 lshift
  409. r> sprite!
  410. ;
  411. ( Display list JCB 16:10 11/15/10)
  412. create dl 1026 allot
  413. : erasedl
  414. dl d# 1024 bounds begin
  415. d# -1 over !
  416. cell+ 2dup=
  417. until 2drop
  418. ;
  419. : makedl
  420. erasedl
  421. nstars 0do
  422. i d# 2 lshift
  423. cells dl +
  424. \ cell occupied, use one below
  425. \ dup @ 0< invert if cell+ then
  426. i swap !
  427. loop
  428. ;
  429. variable lastsp
  430. : stars-chasebeam
  431. hide
  432. d# 0 lastsp !
  433. d# 512 0do
  434. begin vga-line@ i = until
  435. i cells dl + @ dup 0< if
  436. drop
  437. else
  438. lastsp @ 1+ d# 7 and dup lastsp ! plot
  439. then
  440. i nstars < if i rotate then
  441. loop
  442. ;
  443. : loadcolors
  444. d# 8 0do
  445. dup @
  446. i cells vga_spritec + !
  447. cell+
  448. loop
  449. drop
  450. ;
  451. create cpastels
  452. h# 423 ,
  453. h# 243 ,
  454. h# 234 ,
  455. h# 444 ,
  456. h# 324 ,
  457. h# 432 ,
  458. h# 342 ,
  459. h# 244 ,
  460. : pastels cpastels loadcolors ;
  461. create crainbow
  462. h# 400 ,
  463. h# 440 ,
  464. h# 040 ,
  465. h# 044 ,
  466. h# 004 ,
  467. h# 404 ,
  468. h# 444 ,
  469. h# 444 ,
  470. : rainbow crainbow loadcolors ;
  471. variable prev_sw3_n
  472. : next? ( -- f ) \ has user requested next screen
  473. sw3_n @ prev_sw3_n fall?
  474. ;
  475. : loadsprites ( da -- )
  476. 2/
  477. d# 16384 0do
  478. 2dup i s>d d+ flash@
  479. i vga_spritea ! vga_spriteport !
  480. loop
  481. 2drop
  482. ;
  483. : stars-main
  484. vga-page
  485. d# 16384 0do
  486. h# 204000. 2/ i s>d d+ flash@
  487. i vga_spritea ! vga_spriteport !
  488. loop
  489. vga_addsprites on
  490. rainbow
  491. time@ xor seed !
  492. seed off
  493. scatter
  494. d# 7000000. vision setalarm
  495. d# 0 frame !
  496. begin
  497. makedl
  498. stars-chasebeam
  499. \ d# 256 0do i i plot loop
  500. \ rotateall
  501. frame @ 1+ frame !
  502. next?
  503. until
  504. frame @ . s" frames" type cr
  505. ;
  506. : buttons ( -- u ) \ pb4 pb3 pb2
  507. pb_a_dir on
  508. pb_a @ d# 7 xor
  509. pb_a_dir off
  510. ;
  511. include loader.fs
  512. include dns.fs
  513. : preip-handler
  514. begin
  515. mac-fullness
  516. while
  517. OFFSET_ETH_TYPE packet@ h# 800 = if
  518. dhcp-wait-offer
  519. then
  520. mac-consume
  521. repeat
  522. ;
  523. : haveip-handler
  524. \ time@ begin ether_irq @ until time@ 2swap d- d. cr
  525. \ begin ether_irq @ until
  526. begin
  527. mac-fullness
  528. while
  529. arp-handler
  530. OFFSET_ETH_TYPE packet@ h# 800 =
  531. if
  532. d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
  533. if
  534. icmp-handler
  535. then
  536. loader-handler
  537. then
  538. depth if .s cr then
  539. mac-consume
  540. repeat
  541. ;
  542. include invaders.fs
  543. : uptime
  544. time@
  545. d# 1 d# 1000 m*/
  546. d# 1 d# 1000 m*/
  547. ;
  548. ( IP address formatting JCB 14:50 10/26/10)
  549. : #ip1 h# ff and s>d #s 2drop ;
  550. : #. [char] . hold ;
  551. : #ip2 dup #ip1 #. d# 8 rshift #ip1 ;
  552. : #ip ( ip -- c-addr u) dup #ip2 #. over #ip2 ;
  553. variable prev_sw2_n
  554. : sw2? sw2_n @ prev_sw2_n fall? ;
  555. include ps2kb.fs
  556. : istab?
  557. key? dup if key TAB = and then
  558. ;
  559. : welcome-main
  560. vga-cold
  561. home
  562. s" F1 to set up network, TAB for next demo" statusline
  563. rainbow
  564. h# 200000. loadsprites
  565. 'emit @ >r
  566. d# 6 d# 26 vga-at-xy s" Softcore Forth CPU" type
  567. d# 32 d# 6 vga-at-xy s" version " type version type
  568. d# 32 d# 8 vga-at-xy s" built " type build.
  569. kb-cold
  570. home
  571. begin
  572. kbfifo-proc
  573. d# 32 d# 10 vga-at-xy net-my-ip <# #ip #> type space space
  574. d# 32 d# 12 vga-at-xy s" uptime " type uptime d.
  575. haveip-handler
  576. d# 8 0do
  577. frame @ i d# 32 * + invert >r
  578. d# 100 r@ sin* d# 600 +
  579. d# 100 r> cos* d# 334 +
  580. i sprite!
  581. loop
  582. waitblank
  583. d# 1 frame +!
  584. next?
  585. istab? or
  586. until
  587. r> 'emit !
  588. ;
  589. include clock.fs
  590. : frob
  591. flash_ce_n on
  592. flash_ddir off
  593. d# 32 0do
  594. d# 1 i d# 7 and lshift
  595. flash_d !
  596. d# 30000. sleepus
  597. loop
  598. flash_ddir on
  599. ;
  600. : main
  601. decimal
  602. ['] serout 'emit !
  603. \ sleep1
  604. frob
  605. d# 60 0do cr loop
  606. s" Welcome! Built " type build. cr
  607. snap
  608. flash-cold
  609. \ flash-demo
  610. \ flash-bytes
  611. vga-cold
  612. ['] vga-emit 'emit !
  613. s" Waiting for Ethernet NIC" statusline
  614. mac-cold
  615. nicwork
  616. h# decafbad. dhcp-xid!
  617. d# 3000000. dhcp-alarm setalarm
  618. false if
  619. ip-addr dz
  620. begin
  621. net-my-ip d0=
  622. while
  623. dhcp-alarm isalarm if
  624. dhcp-discover
  625. s" DISCOVER" type cr
  626. d# 3000000. dhcp-alarm setalarm
  627. then
  628. preip-handler
  629. repeat
  630. else
  631. ip# 192.168.0.99 ip-addr 2!
  632. ip# 255.255.255.0 ip-subnetmask 2!
  633. ip# 192.168.0.1 ip-router 2!
  634. \ ip# 192.168.2.201 ip-addr 2!
  635. \ ip# 255.255.255.0 ip-subnetmask 2!
  636. \ ip# 192.168.2.1 ip-router 2!
  637. then
  638. dhcp-status
  639. arp-reset
  640. begin
  641. welcome-main sleep.1
  642. clock-main sleep.1
  643. stars-main sleep.1
  644. invaders-main sleep.1
  645. s" looping" type cr
  646. again
  647. begin
  648. haveip-handler
  649. again
  650. ;
  651. ]module
  652. 0 org
  653. code 0jump
  654. \ h# 3e00 ubranch
  655. main ubranch
  656. main ubranch
  657. end-code
  658. meta
  659. hex
  660. : create-output-file w/o create-file throw to outfile ;
  661. \ .mem is a memory dump formatted for use with the Xilinx
  662. \ data2mem tool.
  663. s" j1.mem" create-output-file
  664. :noname
  665. s" @ 20000" type cr
  666. 4000 0 do i t@ s>d <# # # # # #> type cr 2 +loop
  667. ; execute
  668. \ .bin is a big-endian binary memory dump
  669. s" j1.bin" create-output-file
  670. :noname 4000 0 do i t@ dup 8 rshift emit emit 2 +loop ; execute
  671. \ .lst file is a human-readable disassembly
  672. s" j1.lst" create-output-file
  673. d# 0
  674. h# 2000 disassemble-block