From 67d25d837ac55f28a366c0a3b262e439a6e75fc3 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 19 Aug 2017 12:15:28 +0200 Subject: Add AmForth --- .../common/lib/forth2012/core-ext/case-test.frt | 7 +++++ amforth-6.5/common/lib/forth2012/core-ext/case.frt | 35 ++++++++++++++++++++++ .../lib/forth2012/core-ext/compile-comma.frt | 3 ++ .../common/lib/forth2012/core-ext/defers.frt | 23 ++++++++++++++ .../common/lib/forth2012/core-ext/exceptions.frt | 15 ++++++++++ amforth-6.5/common/lib/forth2012/core-ext/roll.frt | 7 +++++ 6 files changed, 90 insertions(+) create mode 100644 amforth-6.5/common/lib/forth2012/core-ext/case-test.frt create mode 100644 amforth-6.5/common/lib/forth2012/core-ext/case.frt create mode 100644 amforth-6.5/common/lib/forth2012/core-ext/compile-comma.frt create mode 100644 amforth-6.5/common/lib/forth2012/core-ext/defers.frt create mode 100644 amforth-6.5/common/lib/forth2012/core-ext/exceptions.frt create mode 100644 amforth-6.5/common/lib/forth2012/core-ext/roll.frt (limited to 'amforth-6.5/common/lib/forth2012/core-ext') 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: +: 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 ; -- cgit v1.2.3