aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/forth2012/tools
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
committerDimitri Sokolyuk <demon@dim13.org>2017-08-19 12:15:28 +0200
commit67d25d837ac55f28a366c0a3b262e439a6e75fc3 (patch)
treedf7715c7724c5935ab87c807f3b8b4ef529315e3 /amforth-6.5/common/lib/forth2012/tools
parente0d6784e89dba33226c0edb815bb974486fa7c48 (diff)
Add AmForth
Diffstat (limited to 'amforth-6.5/common/lib/forth2012/tools')
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/bracket-conditional.frt20
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/defined.frt10
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/dot-s.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/dump.frt50
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/dumper.frt57
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/name2compile.frt9
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/name2interpret.frt4
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/question.frt4
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/see.frt56
-rw-r--r--amforth-6.5/common/lib/forth2012/tools/synonym.frt12
10 files changed, 225 insertions, 0 deletions
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 -- )
+: <dump postpone trimm postpone 0 postpone ?do postpone dup
+ postpone .addr 8 postpone literal ; immediate
+
+( n -- )
+: dump> postpone +loop postpone drop ; immediate
+
+( addr len -- )
+: idump <dump .icells 8 dump> ;
+: edump <dump .ecells 10 dump> ;
+: dump <dump .rcells 10 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 ( "<spaces>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 <newname> <oldname>
+
+\
+\ 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