From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- amforth-6.5/common/lib/forth2012/core/2over.frt | 8 ++++++++ amforth-6.5/common/lib/forth2012/core/2swap.frt | 3 +++ amforth-6.5/common/lib/forth2012/core/action-of.frt | 14 ++++++++++++++ amforth-6.5/common/lib/forth2012/core/blank.frt | 4 ++++ amforth-6.5/common/lib/forth2012/core/buffer.frt | 6 ++++++ amforth-6.5/common/lib/forth2012/core/char-plus.frt | 3 +++ amforth-6.5/common/lib/forth2012/core/chars.frt | 3 +++ amforth-6.5/common/lib/forth2012/core/count.frt | 3 +++ amforth-6.5/common/lib/forth2012/core/dot-paren.frt | 5 +++++ amforth-6.5/common/lib/forth2012/core/erase.frt | 6 ++++++ amforth-6.5/common/lib/forth2012/core/find.frt | 21 +++++++++++++++++++++ amforth-6.5/common/lib/forth2012/core/is.frt | 12 ++++++++++++ amforth-6.5/common/lib/forth2012/core/move.frt | 5 +++++ amforth-6.5/common/lib/forth2012/core/source-id.frt | 5 +++++ .../common/lib/forth2012/core/star-slash.frt | 4 ++++ amforth-6.5/common/lib/forth2012/core/values.frt | 16 ++++++++++++++++ 16 files changed, 118 insertions(+) create mode 100644 amforth-6.5/common/lib/forth2012/core/2over.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/2swap.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/action-of.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/blank.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/buffer.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/char-plus.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/chars.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/count.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/dot-paren.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/erase.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/find.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/is.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/move.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/source-id.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/star-slash.frt create mode 100644 amforth-6.5/common/lib/forth2012/core/values.frt (limited to 'amforth-6.5/common/lib/forth2012/core') diff --git a/amforth-6.5/common/lib/forth2012/core/2over.frt b/amforth-6.5/common/lib/forth2012/core/2over.frt new file mode 100644 index 0000000..cf614ca --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/2over.frt @@ -0,0 +1,8 @@ +\ 2over ( w1 w2 w3 w4 -- w1 w2 w3 w4 w1 w2 ) core two_over +: 2over + >r >r + over over + r> + rot rot + r> + rot rot ; diff --git a/amforth-6.5/common/lib/forth2012/core/2swap.frt b/amforth-6.5/common/lib/forth2012/core/2swap.frt new file mode 100644 index 0000000..773228e --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/2swap.frt @@ -0,0 +1,3 @@ +\ 2swap ( w1 w2 w3 w4 -- w3 w4 w1 w2 ) core two_swap +: 2swap + rot >r rot r> ; diff --git a/amforth-6.5/common/lib/forth2012/core/action-of.frt b/amforth-6.5/common/lib/forth2012/core/action-of.frt new file mode 100644 index 0000000..894b399 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/action-of.frt @@ -0,0 +1,14 @@ +\ ******************************************* +\ action-of depends on defer@ +\ ******************************************* + +\ #requires postpone.frt + +: action-of + state @ + if + postpone ['] postpone defer@ + else + ' defer@ + then +; immediate diff --git a/amforth-6.5/common/lib/forth2012/core/blank.frt b/amforth-6.5/common/lib/forth2012/core/blank.frt new file mode 100644 index 0000000..a99ae5f --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/blank.frt @@ -0,0 +1,4 @@ +\ fill with blanks +: blank ( addr n -- ) + bl fill +; diff --git a/amforth-6.5/common/lib/forth2012/core/buffer.frt b/amforth-6.5/common/lib/forth2012/core/buffer.frt new file mode 100644 index 0000000..10db671 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/buffer.frt @@ -0,0 +1,6 @@ +\ allocate a buffer and give it a name in the dictionary +\ see http://www.forth200x.org/buffer.html + +: buffer: ( n "name" ) + \ variable already allocates 1 cell + variable 1 cells - allot ; diff --git a/amforth-6.5/common/lib/forth2012/core/char-plus.frt b/amforth-6.5/common/lib/forth2012/core/char-plus.frt new file mode 100644 index 0000000..c71230e --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/char-plus.frt @@ -0,0 +1,3 @@ +\ a character has 1 bytes +: char+ 1+ ; + diff --git a/amforth-6.5/common/lib/forth2012/core/chars.frt b/amforth-6.5/common/lib/forth2012/core/chars.frt new file mode 100644 index 0000000..254b3dc --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/chars.frt @@ -0,0 +1,3 @@ +\ a character has 1 byte, multiply by 1 is easy +: chars ; immediate \ does nothing at all + diff --git a/amforth-6.5/common/lib/forth2012/core/count.frt b/amforth-6.5/common/lib/forth2012/core/count.frt new file mode 100644 index 0000000..339da65 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/count.frt @@ -0,0 +1,3 @@ + +\ ( addr -- addr+1 len ) +: count dup 1+ swap c@ ; diff --git a/amforth-6.5/common/lib/forth2012/core/dot-paren.frt b/amforth-6.5/common/lib/forth2012/core/dot-paren.frt new file mode 100644 index 0000000..6266725 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/dot-paren.frt @@ -0,0 +1,5 @@ + +: .( \ (s -- ) + [char] ) parse type +; immediate + diff --git a/amforth-6.5/common/lib/forth2012/core/erase.frt b/amforth-6.5/common/lib/forth2012/core/erase.frt new file mode 100644 index 0000000..eb23f3b --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/erase.frt @@ -0,0 +1,6 @@ +\ fill a memory area with zeros + +: erase ( addr n -- ) + 0 fill +; + diff --git a/amforth-6.5/common/lib/forth2012/core/find.frt b/amforth-6.5/common/lib/forth2012/core/find.frt new file mode 100644 index 0000000..a289cc8 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/find.frt @@ -0,0 +1,21 @@ +\ #require count.frt + +: find ( addr -- addr 0 | xt -1 | xt 1 ) + dup count find-xt dup + if rot drop then +; + +\ \ find-xt is using the order stack +\ \ with map-stack as iterator. +\ : (find-xt) ( addr len wid -- addr len 0 | xt +/-1 -1 ) +\ >r 2dup r> search-wordlist +\ dup if +\ >r nip nip r> -1 +\ then +\ ; +\ +\ : find-xt +\ ['] (find-xt) 'ORDER map-stack +\ 0= if 2drop 0 then +\ ; + diff --git a/amforth-6.5/common/lib/forth2012/core/is.frt b/amforth-6.5/common/lib/forth2012/core/is.frt new file mode 100644 index 0000000..9ac18ea --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/is.frt @@ -0,0 +1,12 @@ + +\ ******************************************* +\ IS depends on defer! +\ ******************************************* + +: is + state @ if + postpone ['] postpone defer! + else + ' defer! + then +; immediate diff --git a/amforth-6.5/common/lib/forth2012/core/move.frt b/amforth-6.5/common/lib/forth2012/core/move.frt new file mode 100644 index 0000000..795a8ef --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/move.frt @@ -0,0 +1,5 @@ +\ respect overlapping memory regions a choose +\ the proper cmove +: move + >r 2dup u< if r> cmove> else r> cmove then +; diff --git a/amforth-6.5/common/lib/forth2012/core/source-id.frt b/amforth-6.5/common/lib/forth2012/core/source-id.frt new file mode 100644 index 0000000..aeea963 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/source-id.frt @@ -0,0 +1,5 @@ + +\ source-id is currently not used +: source-id ( -- f ) + 0 \ always user input device +; diff --git a/amforth-6.5/common/lib/forth2012/core/star-slash.frt b/amforth-6.5/common/lib/forth2012/core/star-slash.frt new file mode 100644 index 0000000..4a47ed9 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/star-slash.frt @@ -0,0 +1,4 @@ + +\ #require star-slash-mod.frt + +: */ */mod nip ; diff --git a/amforth-6.5/common/lib/forth2012/core/values.frt b/amforth-6.5/common/lib/forth2012/core/values.frt new file mode 100644 index 0000000..08bf0a1 --- /dev/null +++ b/amforth-6.5/common/lib/forth2012/core/values.frt @@ -0,0 +1,16 @@ + +: Uvalue ( n offs -- ) + (value) + dup , + ['] Udefer@ , + ['] Udefer! , + up@ + ! +; + +: Rvalue ( n -- ) + (value) + here , + ['] Rdefer@ , + ['] Rdefer! , + here ! 2 allot +; -- cgit v1.2.3