aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/forth2012/core
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/core
parente0d6784e89dba33226c0edb815bb974486fa7c48 (diff)
Add AmForth
Diffstat (limited to 'amforth-6.5/common/lib/forth2012/core')
-rw-r--r--amforth-6.5/common/lib/forth2012/core/2over.frt8
-rw-r--r--amforth-6.5/common/lib/forth2012/core/2swap.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/core/action-of.frt14
-rw-r--r--amforth-6.5/common/lib/forth2012/core/blank.frt4
-rw-r--r--amforth-6.5/common/lib/forth2012/core/buffer.frt6
-rw-r--r--amforth-6.5/common/lib/forth2012/core/char-plus.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/core/chars.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/core/count.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/core/dot-paren.frt5
-rw-r--r--amforth-6.5/common/lib/forth2012/core/erase.frt6
-rw-r--r--amforth-6.5/common/lib/forth2012/core/find.frt21
-rw-r--r--amforth-6.5/common/lib/forth2012/core/is.frt12
-rw-r--r--amforth-6.5/common/lib/forth2012/core/move.frt5
-rw-r--r--amforth-6.5/common/lib/forth2012/core/source-id.frt5
-rw-r--r--amforth-6.5/common/lib/forth2012/core/star-slash.frt4
-rw-r--r--amforth-6.5/common/lib/forth2012/core/values.frt16
16 files changed, 118 insertions, 0 deletions
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 "<spaces>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
+;