From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- .../lib/forth2012/tools/bracket-conditional.frt | 20 ++++++++ amforth-6.5/common/lib/forth2012/tools/defined.frt | 10 ++++ amforth-6.5/common/lib/forth2012/tools/dot-s.frt | 3 ++ amforth-6.5/common/lib/forth2012/tools/dump.frt | 50 +++++++++++++++++++ amforth-6.5/common/lib/forth2012/tools/dumper.frt | 57 ++++++++++++++++++++++ .../common/lib/forth2012/tools/name2compile.frt | 9 ++++ .../common/lib/forth2012/tools/name2interpret.frt | 4 ++ .../common/lib/forth2012/tools/question.frt | 4 ++ amforth-6.5/common/lib/forth2012/tools/see.frt | 56 +++++++++++++++++++++ amforth-6.5/common/lib/forth2012/tools/synonym.frt | 12 +++++ 10 files changed, 225 insertions(+) create mode 100644 amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/defined.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/dot-s.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/dump.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/dumper.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/name2compile.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/name2interpret.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/question.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/see.frt create mode 100644 amforth-6.5/common/lib/forth2012/tools/synonym.frt (limited to 'amforth-6.5/common/lib/forth2012/tools') diff --git a/amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt b/amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt new file mode 100644 index 0000000..5df8c28 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt @@ -0,0 +1,20 @@ + +: [else] \ ( -- ) + begin + begin + parse-name + dup + while + 2dup s" [else]" icompare + ?dup 0= + if exit then + repeat 2drop + refill 0= + until +; immediate + +: [if] \ ( flag -- ) + 0= if postpone [else] then +; immediate + +: [then] ; immediate diff --git a/amforth-6.5/common/lib/forth2012/tools/defined.frt b/amforth-6.5/common/lib/forth2012/tools/defined.frt new file mode 100644 index 0000000..cef7e78 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/defined.frt @@ -0,0 +1,10 @@ + +\ http://www.forth200x.org/defined.html +\ adapted to non-counted strings + +: [defined] parse-name find-name dup if swap drop then ; immediate +: [undefined] postpone [defined] 0= ; immediate + +\ ... and without postpone (Enoch, Feb-2013) +\ : [defined] parse-name find-name if drop -1 else 0 then ; immediate +\ : [undefined] parse-name find-name if drop 0 else -1 then ; immediate diff --git a/amforth-6.5/common/lib/forth2012/tools/dot-s.frt b/amforth-6.5/common/lib/forth2012/tools/dot-s.frt new file mode 100644 index 0000000..1c86dd8 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/dot-s.frt @@ -0,0 +1,3 @@ + +\ a .s with the TOS printed *last* +: .s depth 0 ?do depth i - 1- pick . loop ; \ No newline at end of file diff --git a/amforth-6.5/common/lib/forth2012/tools/dump.frt b/amforth-6.5/common/lib/forth2012/tools/dump.frt new file mode 100644 index 0000000..fba47d7 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/dump.frt @@ -0,0 +1,50 @@ + +\ dump memories +\ usage is +\ addr len [ei]dump +\ output looks like (for word oriented memories) +\ (ATmega32)> 0 10 edump +\ 0000 - FFFF D9FF 17D9 2117 0121 5201 0052 DE00 .......!!..RR... +\ 0008 - 0CDE 6F0C 3B6F 193B 0019 3200 0B32 140B ...oo;;....22... + +\ RAM dump is byte oriented: +\ 00B0 BD 3E 55 33 5B E6 C4 9B 4A 63 72 20 63 72 20 24 .>U3[...Jcr.cr.$ +\ 00C0 62 30 20 32 30 20 64 75 6D 70 20 63 72 20 63 72 b0.20.dump.cr.cr + +hex + +: ?ascii ( char -- printable-char ) + dup 20 < if drop 2e + else dup 7e > + if drop 2e then + then ; + +: .2hex s>d <# # # #> type ; +: .4hex s>d <# # # # # #> type ; + +: dump ( addr count -- ) + cr 0 + do dup .4hex space + 10 0 do dup i + c@ .2hex space loop 2 spaces + 10 0 do dup i + c@ ?ascii emit loop + 10 + cr + 10 +loop drop ; + +: split ( n - c c ) dup $ff and swap $ff00 and $100 / $ff and swap ; + +: idump ( addr count -- ) + cr 0 + do dup .4hex space [char] - emit space + 8 0 do dup i + @i .4hex space loop 2 spaces + 8 0 do dup i + @i split ?ascii emit ?ascii emit loop + 8 + cr + 8 +loop drop ; + +: edump ( addr count -- ) + cr 0 + do dup .4hex space [char] - emit space + 08 0 do dup i cells + @e .4hex space loop 2 spaces + 08 0 do dup i cells + @e split ?ascii emit ?ascii emit loop + 10 + cr + 10 +loop drop ; + diff --git a/amforth-6.5/common/lib/forth2012/tools/dumper.frt b/amforth-6.5/common/lib/forth2012/tools/dumper.frt new file mode 100644 index 0000000..fdb1c09 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/dumper.frt @@ -0,0 +1,57 @@ +\ dump cells from addr upward for len. mk03.10.2008 + +\ We want xdump ( addr len -- ) doing output like this: +\ xxx0 cccc cccc cccc cccc cccc cccc cccc cccc +\ xxx8 cccc cccc cccc cccc cccc cccc cccc cccc +\ ... + +\ That is, we alway print 8 cells. And want to see them in segments of 8 cells, +\ all starting at xxx0 or xxx8 addresses. +\ So we have to trimm addr and len first: +\ Clear lower 3 bits of addr, then set lower 3 bits of len +\ The rest shoud be obvious. + +hex + +\ helper word +\ print a number in a field with 0 filled +: u.r ( u w -- ) + >r 0 \ see u. + <# + r> 0 ?do # loop + #> + type +; + +( item -- ) +: .item 4 u.r space ; + +( addr -- ) +: i? @i .item ; +: e? @e .item ; +: ? @ .item ; + +( addr n -- addr+n ) +: .icells 0 do dup i? 1+ loop ; \ flash +: .ecells 0 do dup e? cell+ loop ; \ eeprom +: .rcells 0 do dup ? cell+ loop ; \ ram + +( addr -- ) +: .addr cr .item space ; + +( addr1 len1 -- addr2 len2 ) +: trimm swap fff8 and swap 7 or ; + +( adr len -- ) +: postpone +loop postpone drop ; immediate + +( addr len -- ) +: idump ; +: edump ; +: dump ; + +\ finis tested ok on amforth-2.9 05.10.2008 mk diff --git a/amforth-6.5/common/lib/forth2012/tools/name2compile.frt b/amforth-6.5/common/lib/forth2012/tools/name2compile.frt new file mode 100644 index 0000000..fa50d2b --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/name2compile.frt @@ -0,0 +1,9 @@ + +: name>compile ( nt -- xt1 xt2) + dup nfa>cfa swap name>flags immediate? 1 = if + ['] execute + else + ['] , + then +; + diff --git a/amforth-6.5/common/lib/forth2012/tools/name2interpret.frt b/amforth-6.5/common/lib/forth2012/tools/name2interpret.frt new file mode 100644 index 0000000..417980a --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/name2interpret.frt @@ -0,0 +1,4 @@ + +: name>interpret ( nt -- xt ) + nfa>cfa +; diff --git a/amforth-6.5/common/lib/forth2012/tools/question.frt b/amforth-6.5/common/lib/forth2012/tools/question.frt new file mode 100644 index 0000000..bd96e6c --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/question.frt @@ -0,0 +1,4 @@ + +\ displays the value of the given address with current base +: ? ( addr -- ) + @ . ; diff --git a/amforth-6.5/common/lib/forth2012/tools/see.frt b/amforth-6.5/common/lib/forth2012/tools/see.frt new file mode 100644 index 0000000..5b5fda5 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/see.frt @@ -0,0 +1,56 @@ +hex +\ decompiler + +\ marker --see-- + +: .name ( nfa -- ) \ Namensfeld ausgeben + icount $ff and dup 15 < if itype else drop drop ." :noname" then ; + +' exit constant exitxt \ Adresse des xt zu "exit" speichern +' cr @i constant docolxt \ Adresse des Forth-DOCOLON VM Interpreter +' cr 1+ @i constant litxt \ Adresse des xt zu "(lit)" speichern +' bl @i constant dovarxt \ Adresse des xt zu "VARIABLE" +' base @i constant douser \ Adresse des xt zu "USER" +' emit @i constant dodefer \ +' s" 9 + @i constant doslit \ Adresse des xt zu "(slit)" speichern +' if 2 + @i constant do0branch \ Adresse des xt zu "0branch" speichern +' else 2 + @i constant dobranch \ Adresse des xt zu "branch" speichern +' loop 2 + @i constant doloop \ Adresse des xt zu "(loop)" speichern +' +loop 2 + @i constant do+loop \ Adresse des xt zu "(+loop)" speichern +' do 2 + @i constant dodo \ Adresse des xt zu "(do)" speichern +' ?do 2 + @i constant doqdo \ Adresse des xt zu "(?do)" speichern + +: see ( "name" -- ) \ decompiler + parse-name find-name if + dup @i over - 1 = if dup >name .name space ." is a primitive" then + dup @i dovarxt = if ." variable " 1+ dup @i . then + dup @i douser = if ." user " 1+ dup @i . then + dup @i dodefer = if ." defer " then + dup @i docolxt = if + [char] : emit space dup >name .name + begin + cr [char] [ emit space dup u. [char] ] emit space 2 spaces + 1+ dup @i dup 4 .r space ( get next xt ) + dup litxt = if drop 1+ dup @i . 0 then + dup exitxt = if drop [char] ; emit 1 then + dup doslit = if + drop [char] . emit [char] " emit space 1+ dup .name [char] " emit + dup @i $FF and 2/ 2 + + 0 + then + dup do0branch = if drop ." 0branch -> " 1+ dup @i 1- u. 0 then + dup dobranch = if drop ." branch -> " 1+ dup @i 1- u. 0 then + dup dodo = if drop ." do -> " 1+ dup @i 1- u. 0 then + dup doqdo = if drop ." ?do -> " 1+ dup @i 1- u. 0 then + dup doloop = if drop ." loop -> " 1+ dup @i 1- u. 0 then + dup do+loop = if drop ." +loop -> " 1+ dup @i 1- u. 0 then + dup 1 > if dup >name .name then + 1 = + until then + drop + else + ." not found" + then +; + +\ Beispiel: +\ ' see see diff --git a/amforth-6.5/common/lib/forth2012/tools/synonym.frt b/amforth-6.5/common/lib/forth2012/tools/synonym.frt new file mode 100644 index 0000000..bb51c61 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/tools/synonym.frt @@ -0,0 +1,12 @@ +\ SYNONYM + +\ +\ does not check for reference to itself +\ +: synonym + create immediate ' , + does> + @i state @ if , else execute then +; + +\ : synonym : bl word find >r compile, postpone ; r> 0> IF immedate THEN ; \ No newline at end of file -- cgit v1.2.3