diff options
Diffstat (limited to 'forth')
| -rw-r--r-- | forth/core-ext.fth | 2 | ||||
| -rw-r--r-- | forth/core.fth | 65 | ||||
| -rw-r--r-- | forth/msp430.fth | 101 |
3 files changed, 125 insertions, 43 deletions
diff --git a/forth/core-ext.fth b/forth/core-ext.fth index 8bc83be..f9178e8 100644 --- a/forth/core-ext.fth +++ b/forth/core-ext.fth @@ -67,7 +67,7 @@ drop - spaces u. ; ( WORD uses HERE and must be at least 33 characters. ) -: pad here 50 chars + align ; +: pad here [ 50 chars ] literal + align ; : parse here dup >r swap begin key? if key else dup then 2dup <> while diff --git a/forth/core.fth b/forth/core.fth index 8ec5b71..d198583 100644 --- a/forth/core.fth +++ b/forth/core.fth @@ -6,6 +6,8 @@ : cell+ 2 + ; : cells 2 * ; +: char+ 1 + ; +: chars ; : . 0 sys ; : emit 2 sys ; @@ -13,39 +15,41 @@ : 1+ 1 + ; : 1- 1 - ; +: over 1 pick ; +: rot >r swap r> swap ; +: -rot rot rot ; + : ' _' drop ; : ! 1 _! ; : @ 1 _@ ; : +! dup >r swap r> @ + swap ! ; -: base 0 ; -: here 1 cells @ ; -: allot 1 cells +! ; - -: c! 0 _! ; -: c@ 0 _@ ; -: c, here c! 1 allot ; -: char+ 1+ ; -: chars ; - : _latest 2 cells ; : imm _latest @ dup @ 1 5 << | swap ! ; : immediate imm ; -: state 3 cells ; -: _compxt 4 cells ; -: _source 5 cells ; -: _sourceu 6 cells ; -: >in 7 cells ; -: _begin 8 cells 80 chars + ; -: , here ! 1 cells allot ; +: [ 0 3 cells ! ; imm +: ] 1 3 cells ! ; -: [ 0 state ! ; imm -: ] 1 state ! ; +: , 1 cells dup >r @ ! r> dup +! ; : literal [ ' _lit dup , , ] , , ; imm : ['] ' [ ' literal , ] ; imm +: base 0 ; +: here [ 1 cells ] literal @ ; +: allot [ 1 cells ] literal +! ; +: state [ 3 cells ] literal ; +: _compxt [ 4 cells ] literal ; +: _source [ 5 cells ] literal ; +: _sourceu [ 6 cells ] literal ; +: >in [ 7 cells ] literal ; +: _begin [ 8 cells 80 chars + ] literal ; + +: c! 0 _! ; +: c@ 0 _@ ; +: c, here c! 1 allot ; + : if ['] _jmp0 , here 0 , ; imm : then here swap ! ; imm : else ['] _jmp , here 0 , swap here swap ! ; imm @@ -54,10 +58,6 @@ 1 = swap ['] _lit , , if ['] execute , else ['] , , then ; imm -: over 1 pick ; -: rot >r swap r> swap ; -: -rot rot rot ; - : 2drop drop drop ; : 2dup over over ; : 2over 3 pick 3 pick ; @@ -99,7 +99,8 @@ : j postpone 2r> ['] r> , postpone r@ ['] swap , ['] >r , ['] -rot , postpone 2>r ; imm -: aligned dup 1 cells 1- swap over & if 1 cells swap - + else drop then ; +: aligned dup [ 1 cells 1- ] literal swap over & if [ 1 cells ] literal + swap - + else drop then ; : align here dup aligned swap - allot ; : and & ; @@ -110,7 +111,7 @@ : invert -1 ^ ; : mod % ; : 2* 2 * ; -: _msb 1 1 cells 8 * 1- << ; +: _msb [ 1 1 cells 8 * 1- << ] literal ; : 2/ dup 1 >> swap 0< if _msb or then ; : /mod 2dup % -rot / ; @@ -145,12 +146,14 @@ 2dup <> while rot repeat 2drop here - here c! here ; : count dup char+ swap c@ ; -: char bl word char+ c@ ; +: char 0 here char+ c! bl word char+ c@ ; : [char] char postpone literal ; imm : ( begin [char] ) key <> while repeat ; imm -: type begin dup 0 > while swap dup c@ emit char+ swap 1- repeat 2drop ; +: _type >r begin dup 0 > while + swap dup c@ r@ execute char+ swap 1- repeat 2drop r> drop ; +: type [ ' emit ] literal _type ; : s" state @ if ['] _jmp , here 0 , then [char] " word count state @ 0= if exit then @@ -161,17 +164,17 @@ : :noname here dup _compxt ! 0 , here swap ] ; -: create : here 4 cells + postpone literal postpone ; 0 , ; +: create : here [ 4 cells ] literal + postpone literal postpone ; 0 , ; : >body cell+ @ ; -: _does> >r _latest @ dup @ 31 & + cell+ aligned 2 cells + +: _does> >r _latest @ dup @ 31 & + cell+ aligned [ 2 cells ] literal + ['] _jmp over ! cell+ r> cell+ swap ! ; : does> state @ if ['] _lit , here 2 cells + , ['] _does> , ['] exit , else here dup _does> dup _compxt ! 0 , ] then ; imm -: variable create 1 cells allot ; +: variable create [ 1 cells ] literal allot ; : constant create , does> @ ; : quit begin _rdepth 1 > while r> drop repeat postpone [ ; @@ -197,7 +200,7 @@ : accept over >r begin dup 0 > while key dup 32 < if 2drop 0 else dup emit rot 2dup c! char+ swap drop swap 1- then - repeat drop r> - 1 chars / ; + repeat drop r> - [ 1 chars ] literal / ; : evaluate _source @ >r _sourceu @ >r >in @ >r 0 >in ! _sourceu ! _source ! _ev diff --git a/forth/msp430.fth b/forth/msp430.fth index 1b3ab40..9c5fd30 100644 --- a/forth/msp430.fth +++ b/forth/msp430.fth @@ -1,18 +1,97 @@ -: vector! 10 sys ; -: reg! 11 sys ; -: reg@ 12 sys ; -: 2reg! 13 sys ; -: 2reg@ 14 sys ; -: sr+ 15 sys ; -: sr- 16 sys ; +: vector! 10 sys ; +: byte! 11 sys ; +: byte@ 12 sys ; +: reg! 13 sys ; +: reg@ 14 sys ; +: sr+ 15 sys ; +: sr- 16 sys ; +: lpm-exit 17 sys ; : reg [ ' reg@ ' reg! ] literal literal ; -: 2reg [ ' 2reg@ ' 2reg! ] literal literal ; +: byte [ ' byte@ ' byte! ] literal literal ; -: set ( b r reg/wreg -- ) +: set ( b r reg/byte -- ) >r over r> execute >r rot r> | -rot execute ; -: clear ( b r reg/wreg -- ) +: clear ( b r reg/byte -- ) >r over r> execute >r rot invert r> & -rot execute ; -: toggle ( b r reg/wreg -- ) +: toggle ( b r reg/byte -- ) >r over r> execute >r rot r> ^ -rot execute ; +create _outs p1out , p2out , p3out , p4out , p5out , p6out , +create _ins p1in , p2in , p3in , p4in , p5in , p6in , +create _dirs p1dir , p2dir , p3dir , p4dir , p5dir , p6dir , + +1 constant output +0 constant input + +: pin-mode ( output? pin port -- ) + rot >r cells _dirs + @ byte r> if set else clear then ; + +: pin-set ( high? pin port -- ) + rot >r cells _outs + @ byte r> if set else clear then ; + +: pin-get ( pin port -- high? ) + cells _ins + @ byte@ swap and 0 > ; + +: analog-init + adcon adcsht_2 or adcctl0 reg set + adcshp adcctl1 reg set + adcres adcctl2 reg clear + adcres_2 adcctl2 reg set + adcie0 adcie reg set ; + +: rtc-init + rtcps__10 rtcctl reg! ; + +: ms ( u -- ) + rtcmod reg! + rtcss_3 rtcsr or rtcctl reg set + begin rtciv reg@ 0<> until + rtc-init ; + +: D0 bit5 1 ; +: D1 bit6 1 ; +: D2 bit1 2 ; +: D3 bit4 1 ; +: D4 bit7 2 ; +: D5 bit0 3 ; +: D6 bit1 3 ; +: D7 bit7 3 ; +: D8 bit6 3 ; +: D9 bit5 3 ; +: D10 bit4 4 ; +: D11 bit2 2 ; +: D12 bit6 2 ; +: D13 bit5 2 ; + +: A0 bit0 0 ; +: A1 bit1 0 ; +: A2 bit5 0 ; +: A3 bit6 0 ; +: A4 bit2 0 ; +: A5 bit3 0 ; +: AREF bit4 0 ; + +: pin-analog + drop + dup p1sel0 reg set + p1sel1 reg set ; + +: analog-get + drop 0 begin + swap 2/ dup 0<> while + swap 1+ repeat + drop adcmctl0 reg! + adcenc adcsc or adcctl0 reg set + adcmem0 reg@ ; + +: LED1R bit1 5 ; +: LED1G bit0 5 ; +: LED1B bit2 5 ; + +: LED2R bit6 4 ; +: LED2G bit5 4 ; +: LED2B bit7 4 ; + +: SW2 bit3 1 ; +: SW3 bit4 2 ; |