aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/forth2012/core-ext
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-ext
parente0d6784e89dba33226c0edb815bb974486fa7c48 (diff)
Add AmForth
Diffstat (limited to 'amforth-6.5/common/lib/forth2012/core-ext')
-rw-r--r--amforth-6.5/common/lib/forth2012/core-ext/case-test.frt7
-rw-r--r--amforth-6.5/common/lib/forth2012/core-ext/case.frt35
-rw-r--r--amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/core-ext/defers.frt23
-rw-r--r--amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt15
-rw-r--r--amforth-6.5/common/lib/forth2012/core-ext/roll.frt7
6 files changed, 90 insertions, 0 deletions
diff --git a/amforth-6.5/common/lib/forth2012/core-ext/case-test.frt b/amforth-6.5/common/lib/forth2012/core-ext/case-test.frt
new file mode 100644
index 0000000..ad9b1f1
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/core-ext/case-test.frt
@@ -0,0 +1,7 @@
+ : foo ( selector -- )
+ case
+ 3 of ." three" endof
+ 5 9 range of ." between" endof
+ 1 of ." one" endof
+ endcase
+ ;
diff --git a/amforth-6.5/common/lib/forth2012/core-ext/case.frt b/amforth-6.5/common/lib/forth2012/core-ext/case.frt
new file mode 100644
index 0000000..02e73f1
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/core-ext/case.frt
@@ -0,0 +1,35 @@
+\ From: eaker@ukulele.crd.ge.com (Chuck Eaker)
+\ Subject: Re: Wanted .. CASE,OF,ENDOF,ENDCASE
+\ Message-ID: <1992Nov25.164255.23225@crd.ge.com>
+\ Date: 25 Nov 92 16:42:55 GMT
+
+: case 0 ; immediate
+: of ( #of -- orig #of+1 / x -- )
+ 1+ ( count OFs )
+ >r ( move off the stack in case the control-flow )
+ ( stack is the data stack. )
+ postpone over postpone = ( copy and test case value )
+ postpone if ( add orig to control flow stack )
+ postpone drop ( discards case value if = )
+ r> ; ( we can bring count back now )
+ immediate
+
+: endof ( orig1 #of -- orig2 #of )
+ >r ( move off the stack in case the control-flow )
+ ( stack is the data stack. )
+ postpone else
+ r> ; ( we can bring count back now )
+ immediate
+
+: endcase ( orig 1..orign #of -- )
+ postpone drop ( discard case value )
+ 0 ?do
+ postpone then
+ loop ;
+ immediate
+
+
+ \ from Message-ID: <ggo2up$67k$1@news-01.bur.connect.com.au>
+: range ( selector low high -- selector x )
+ 2>r dup dup 2r> within
+ 0= if invert then ;
diff --git a/amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt b/amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt
new file mode 100644
index 0000000..3845e6c
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt
@@ -0,0 +1,3 @@
+\ append the XT to the dictionary
+( xt -- )
+: compile, , ;
diff --git a/amforth-6.5/common/lib/forth2012/core-ext/defers.frt b/amforth-6.5/common/lib/forth2012/core-ext/defers.frt
new file mode 100644
index 0000000..25b9505
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/core-ext/defers.frt
@@ -0,0 +1,23 @@
+
+\ various defer definitions
+\ platform specific examples are available !
+
+\ place the XT in RAM, suitable for frequent changes
+\ but needs to be initialized at startup
+
+: Rdefer ( "name" -- )
+ (defer)
+ here ,
+ ['] Rdefer@ ,
+ ['] Rdefer! ,
+ 2 allot
+;
+
+\ use the user area to hold the XT. Similiar to
+\ Rdefer but task lokal in multitasking applications
+: Udefer ( u "name" -- )
+ (defer)
+ , \
+ ['] Udefer@ ,
+ ['] Udefer! ,
+;
diff --git a/amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt b/amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt
new file mode 100644
index 0000000..ec175a0
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt
@@ -0,0 +1,15 @@
+\ ******************************************
+\ some exceptions
+\ ******************************************
+
+: ?throw ( f exc -- )
+ swap if throw then drop
+;
+
+: ?comp ( -- )
+ state @ 0= -&14 ?throw
+;
+
+: ?pairs ( n1 n2 -- )
+ - -&22 ?throw
+;
diff --git a/amforth-6.5/common/lib/forth2012/core-ext/roll.frt b/amforth-6.5/common/lib/forth2012/core-ext/roll.frt
new file mode 100644
index 0000000..385c14a
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/core-ext/roll.frt
@@ -0,0 +1,7 @@
+
+: roll ( x0 x1 .. xn n -- x1 .. xn x0 ) \ core-ext
+ dup 0> 0= if
+ drop
+ else
+ swap >r 1- recurse r> swap
+ then ;