aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/examples
diff options
context:
space:
mode:
Diffstat (limited to 'amforth-6.5/examples')
-rw-r--r--amforth-6.5/examples/ascii.frt13
-rw-r--r--amforth-6.5/examples/co.frt36
-rw-r--r--amforth-6.5/examples/date-time.frt29
-rw-r--r--amforth-6.5/examples/easter.frt112
-rw-r--r--amforth-6.5/examples/fib.frt12
-rw-r--r--amforth-6.5/examples/forward-declarations-test.frt12
-rw-r--r--amforth-6.5/examples/forward-declarations.frt23
-rw-r--r--amforth-6.5/examples/fsm.frt67
-rw-r--r--amforth-6.5/examples/i2c-compass.frt55
-rw-r--r--amforth-6.5/examples/life.frt178
-rw-r--r--amforth-6.5/examples/literacy.frt49
-rw-r--r--amforth-6.5/examples/local.frt64
-rw-r--r--amforth-6.5/examples/many.frt13
-rw-r--r--amforth-6.5/examples/parsed-to.frt22
-rw-r--r--amforth-6.5/examples/queens.frt54
-rw-r--r--amforth-6.5/examples/readme.txt37
-rw-r--r--amforth-6.5/examples/rec-char.frt12
-rw-r--r--amforth-6.5/examples/rec-double-paren.frt73
-rw-r--r--amforth-6.5/examples/rec-name.frt18
-rw-r--r--amforth-6.5/examples/run-hayes.frt26
-rw-r--r--amforth-6.5/examples/scope.frt21
-rw-r--r--amforth-6.5/examples/sierpinsi.frt26
-rw-r--r--amforth-6.5/examples/sieve.frt58
-rw-r--r--amforth-6.5/examples/stack.frt76
-rw-r--r--amforth-6.5/examples/string-rec.frt28
-rw-r--r--amforth-6.5/examples/time-rec.frt59
-rw-r--r--amforth-6.5/examples/value-variations.frt65
27 files changed, 0 insertions, 1238 deletions
diff --git a/amforth-6.5/examples/ascii.frt b/amforth-6.5/examples/ascii.frt
deleted file mode 100644
index ab09ad6..0000000
--- a/amforth-6.5/examples/ascii.frt
+++ /dev/null
@@ -1,13 +0,0 @@
-\ print a ascii table
-: .ascii
-base @
-$7f $20 do
- i emit
- decimal ." , dec: " i .
- hex ." , hex: " i .
- 8 base ! ." , oct: " i .
- 2 base ! ." , bin: " i .
- cr
-loop
-base !
-;
diff --git a/amforth-6.5/examples/co.frt b/amforth-6.5/examples/co.frt
deleted file mode 100644
index 0351ff9..0000000
--- a/amforth-6.5/examples/co.frt
+++ /dev/null
@@ -1,36 +0,0 @@
-\ coroutines
-
-: co r> r> swap >r >r ;
-
-: tokyo
- ." Here Tokyo over" cr co
- ." What gives? over" cr co
- ." Yes, more? over" cr co
- ." over and out" cr
-;
-
-: amsterdam
- tokyo
- ." here Amsterdam over" cr co
- ." has it arrived over" cr co
- ." no. over and out" cr
-;
-
-\ amsterdam
-
-\ generate a list of numbers, one by one
-: producer ( n -- n' n' ) begin 1+ dup co again ;
-: consumer
- \ setup producer
- 0 producer \ returns with a new number
- \ now starts a ping-pong via co calls
- \ every call to co *here* will give a new number
- \ which has to be consumed.
- begin dup . 10 < while co repeat
- \ stop producer and clean up data
- r> drop drop
-;
-\ output:
-\ > consumer
-\ 0 1 2 3 4 5 6 7 8 9 10 ok
-\ >
diff --git a/amforth-6.5/examples/date-time.frt b/amforth-6.5/examples/date-time.frt
deleted file mode 100644
index 13e5d25..0000000
--- a/amforth-6.5/examples/date-time.frt
+++ /dev/null
@@ -1,29 +0,0 @@
-
-\ create task space
-$20 $20 0 task: t:date&time
-
-variable seconds
-\ runs every second
-: job-date&time
- 1 seconds +!
- \ more code for minute/hour/day...
- 0 \ flag for an endless loop
-;
-
-\ set up the task
-: setup-date&time
- t:date&time task-init \ create TCB in RAM
- 0 seconds ! \ more code for minutes etc
- t:date&time tcb>tid activate
- \ code from here is executed as task, later on
- ['] job-date&time every-second
-;
-
-\ setup and start the task "date/time"
-: turnkey-date&time
- onlytask \ set up multitasker
- 6 timer0.init timer0.start \ 16 MHz quartz
- \ insert task into task list
- setup-date&time t:date&time tcb>tid alsotask
- multi \ start multitasking
-;
diff --git a/amforth-6.5/examples/easter.frt b/amforth-6.5/examples/easter.frt
deleted file mode 100644
index f742d31..0000000
--- a/amforth-6.5/examples/easter.frt
+++ /dev/null
@@ -1,112 +0,0 @@
-
-\ Date of Easter According to Knuth
-\ Donald E. Knuth, _The Art of Computer Programming_, 1.3.2 Exercise
-\ 14-15.
-\ [Commentary by Knuth, Forth by Wil Baden. This is not well-suited
-\ for Forth, but there's no advantage in purifying it.]
-\ The following algorithm, due to the Neapolitan astronomer Aloysius
-\ Lilius and the German Jesuit mathematician Christopher Clavius in
-\ the late 16th century, is used by most Western churches to
-\ determine the date of Easter Sunday for any year after 1582.
-
-\ Counters.
-
-\ Y
-\ Year.
-\ G
-\ Golden number.
-\ C
-\ Century.
-\ X
-\ Century leap year adjustment.
-\ Z
-\ Moon's orbit adjustment.
-\ D
-\ Sunday date.
-\ E
-\ Epact.
-\ N
-\ Day of month.
-
-variable easter.y \ Year
-variable easter.g \ Golden number
-variable easter.c \ Century
-variable easter.x \ Century leap year adjustment
-variable easter.z \ Moon's orbit adjustment
-variable easter.d \ Sunday date
-variable easter.e \ Epact
-variable easter.n \ Day of month
-
-\ EASTER ( yyyyy -- dd mm yyyyy )
-\ Compute date of Easter for year _yyyyy_.
-
-: easter ( yyyyy -- dd mm yyyyy )
- easter.y ! ( )
- \ E1. Golden number.
- \ _G_ is the so-called "golden number" of the year in the
- \ 19-year Metonic cycle.
-
- easter.y @ 19 mod 1+ easter.g !
-
- \ E2. Century.
- \ When _Y_ is not a multiple of 100, _C_ is the century number;
- \ for example, 1984 is in the twentieth century.
-
- easter.y @ 100 / 1+ easter.c !
-
- \ E3. Corrections.
- \ Here _X_ is the number of years, such as 1900, in which leap
- \ year was dropped in order to keep in step with the sun; _Z_ is
- \ a special correction designed to synchronize Easter with the
- \ moon's orbit.
-
- easter.c @ 3 4 */ 12 - easter.x !
- easter.c @ 8 * 5 + 25 / 5 - easter.z !
-
- \ E4. Find Sunday.
- \ March ((-_D_) mod 7) actually will be a Sunday.
-
- easter.y @ 5 4 */ easter.x @ - 10 - easter.d !
-
- \ E5. Epact.
- \ This number _E_ is the _epact_, which specifies when a full
- \ moon occurs.
-
- easter.g @ 11 * 20 + easter.z @ + easter.x @ - 30 mod
- dup 0< if 30 + then
- easter.e !
- easter.e @ 25 = dup if drop easter.g @ 11 > then
- dup 0= if drop easter.e @ 24 = then
- if 1 easter.e +! then
-
- \ E6. Find full moon.
- \ Easter is supposedly the first Sunday following the first full
- \ moon that occurs on or after March 21. Actually perturbations
- \ in the moon's orbit do not make this strictly true, but we are
- \ concerned here with the "calendar moon" rather than the actual
- \ moon. The _N_th of March is a calendar full moon.
-
- 44 easter.e @ - easter.n !
- easter.n @ 21 < if 30 easter.n +! then
-
- \ E7. Advance to Sunday.
-
- easter.n @ 7 +
- easter.d @ easter.n @ + 7 mod -
- easter.n !
-
- \ E8. Get month.
-
- easter.n @ 31 > if
- easter.n @ 31 - 4 easter.y @
- else
- easter.n @ 3 easter.y @
- then ;
-
-\ .EASTER ( yyyyy -- )
-\ Display date of Easter for year _yyyyy_.
-
-: .easter ( yyyyy -- )
- easter . 4 = if ." April" else ." March" then 3 .R ;
-
-\\ ************************* End of Easter *************************
diff --git a/amforth-6.5/examples/fib.frt b/amforth-6.5/examples/fib.frt
deleted file mode 100644
index 3eaab4a..0000000
--- a/amforth-6.5/examples/fib.frt
+++ /dev/null
@@ -1,12 +0,0 @@
-( fibonacci number )
-: fib
- dup 2 > if
- dup 1- recurse swap 1- 1- recurse + exit
- then
- drop 1
-;
-
-: fib-iter 0 1 rot 0 ?do over + swap loop drop ;
-
-: dfib-iter >r 0 s>d 1 s>d r> 0 ?do 2over d+ 2swap loop 2drop .s ;
-
diff --git a/amforth-6.5/examples/forward-declarations-test.frt b/amforth-6.5/examples/forward-declarations-test.frt
deleted file mode 100644
index b44ce94..0000000
--- a/amforth-6.5/examples/forward-declarations-test.frt
+++ /dev/null
@@ -1,12 +0,0 @@
-forward: foo
-
-: bar foo ;
-: baz foo ;
-
-bar \ should cause an error: foo not bound, or (simpler) silently crash
-
-: foo ." I'm foo the first" ;
-bar \ should execute the does> part of forward: for foo
-: foo ." I'm the second foo" ;
-baz \ uses the new definition of foo!
-
diff --git a/amforth-6.5/examples/forward-declarations.frt b/amforth-6.5/examples/forward-declarations.frt
deleted file mode 100644
index 274edf4..0000000
--- a/amforth-6.5/examples/forward-declarations.frt
+++ /dev/null
@@ -1,23 +0,0 @@
-: forward:
- dp
- create
- ,
- \ save more information?
- does>
- \ get the current name and
- \ lookup the dictionary. get the
- \ XT and replace the dictionary entry in the
- \ *caller* with it. After that execute it too
- \ next code is executed only once if successful
- dup 1- swap @i here iplace here count ( copy to temporary ram)
- find-name if \ unless some wordlist voodoo is in place...
- swap over = abort" found only forward declaration."
- dup r@ 1- !i execute
- else
- \ can only happen if search wordlist has changed
- true abort" unresolved forward declaration"
- then
-;
-
-
-
diff --git a/amforth-6.5/examples/fsm.frt b/amforth-6.5/examples/fsm.frt
deleted file mode 100644
index 94af976..0000000
--- a/amforth-6.5/examples/fsm.frt
+++ /dev/null
@@ -1,67 +0,0 @@
-\ FSM routines, from a paper presented by J . Noble-----
-\ ---------------------------------------------------------
-\ you can find the paper at http://www.forth.org/literature/noble.html
-\ The fsm: word has been modified to correctly increment addresses by
-\ word, instead of byte. and to also use the i@ dictionary fetch word.
-\ Ver 1.1 fsm: now implements "The best FSM so far" (see paper). State
-\ is now a heap variable with it's address in the dictionary of the fsm.
-\ Written by Bernard Mentink
-
-marker _fsm_
-
-hex
-
-\ dummy nop word for readability
-: wide ;
-
-\ perform word that executes vector
-: perform
- @i execute ;
-
-\ Get 2 cells from dictionary space
-: 2@i
- dup 1+ @i swap @i ;
-
-\ comment if you have this word.
-: tuck swap over ;
-
-\ Allocate a RAM variable on the data space, init with x, and return RAM address
-: >ram ( x -- addr ) here 1 cells allot tuck ! ;
-
-
-\ This word creates FSM transition tables
-: fsm: ( width -- )
- create 0 >ram , , ] \ ram addr of state stored in dict,also width.
- does> ( col# adr -- )
- dup dup >r 2@i @ * 2* + ( -- col#+width*state )
- swap 2* 1+ 1+ + ( -- offset-to-action)
- dup >r ( -- offset-to-action)
- perform ( ? )
- r> 1+ ( -- offset-to-update)
- perform ( -- state')
- r> @i ! ; \ update state
-
-
-\ ......... some test code ..............
-\ un-comment the code lines to test state changes dependant on input supplied
-\ e.g 2 test_fsm, 0 test_fsm etc
-\ If you want the address of the state variable associated with your state
-\ machine, create the following word : mystate ['] test_fsm 1+ i@ ;
-
-\ : one ." one " ;
-\ : two ." two " ;
-\ : three ." three " ;
-\ : four ." four " ;
-\ : nop ." nop " ;
-
-\ 0 constant >0
-\ 1 constant >1
-\ 2 constant >2
-
-\ a test state-machine table
-\ 4 wide fsm: test_fsm
-\ input: | 0 | 1 | 2 | 3 |
-\ state: ---------------------------------------------
-\ ( 0 ) nop >0 one >1 one >1 two >2
-\ ( 1 ) four >1 one >1 nop >1 two >2
-\ ( 2 ) nop >2 two >2 nop >2 nop >2 ;
diff --git a/amforth-6.5/examples/i2c-compass.frt b/amforth-6.5/examples/i2c-compass.frt
deleted file mode 100644
index 651af14..0000000
--- a/amforth-6.5/examples/i2c-compass.frt
+++ /dev/null
@@ -1,55 +0,0 @@
-\
-\ compass module mmc2120 (memsic)
-\ hwid is always $30
-\ provides:
-\
-\ i2c.compass.get ( -- status X Y)
-\ X and Y are around 2000 (raw data)
-\ status is 0 if no error occured
-
-\ further calculation?
-
-$30 constant i2c.compass
-
-\ internal commands
-: i2c.compass.setcoil
- i2c.compass i2c.begin
- 0 i2c.tx
- %00000010 i2c.tx \ set coil
- i2c.end
-;
-: i2c.compass.resetcoil
- i2c.compass i2c.begin
- 0 i2c.tx
- %00000100 i2c.tx \ reset coil
- i2c.end
-;
-
-: i2c.compass.measure
- i2c.compass i2c.begin
- 0 i2c.tx
- %00000001 i2c.tx \ start measurement
- i2c.end
-;
-
-: i2c.compass.fetchdata ( -- status x y )
- i2c.compass i2c.begin
- 0 i2c.tx
- i2c.start \ rep-start
- i2c.compass i2c.rd i2c.tx
- 4 0 do i2c.rx loop i2c.rxn
- i2c.end
- ( -- status msb-x lsb-x msb-y lsb-y)
- swap >< or $fff and >r \ Y
- swap >< or $fff and r> \ X
-;
-
-\ get the raw data from the module
-\ the numbers for X/Y are usually around 2000.
-\ status is 0 if everything is ok
-: i2c.compass.get ( -- status x y )
- i2c.compass.resetcoil 1ms
- i2c.compass.setcoil 5 ms
- i2c.compass.measure 5 ms
- i2c.compass.fetchdata
-;
diff --git a/amforth-6.5/examples/life.frt b/amforth-6.5/examples/life.frt
deleted file mode 100644
index a8543c1..0000000
--- a/amforth-6.5/examples/life.frt
+++ /dev/null
@@ -1,178 +0,0 @@
-\ Conway's Game of Life, or Occam's Razor Dulled
-
-\ The original ANS Forth version by Leo Wong (see bottom)
-\ has been modified slightly to allow it to run under
-\ kForth. Also, delays have been changed from 1000 ms to
-\ 100 ms for faster update --- K. Myneni, 12-26-2001
-\
-marker Genesis
-
-\ needs portpone.frt, marker.frt, 2x.frt, ans.frt
-\ and finally vt100.frt already loaded
-
-decimal
-
-\ ANS Forth this life is remains and
-1 chars constant /char
-: c+! ( char c-addr -- ) dup >r c@ + r> c! ;
-
-\ the universal pattern; optimum is 25x80, but that
-\ requires memory. The 10x20 screen works on an Atmega16
-
-&10 constant How-Deep
-&20 constant How-Wide
-
-\ nothing beyound this line should be changed
-
-How-Wide How-Deep * 1- \ 1- prevents scrolling on my screen
- constant Homes
-
-\ world wrap
-: World
- variable ( -- ) Homes chars allot
- does> ( u -- c-addr ) @i swap Homes + Homes mod chars + ;
-
-World old
-World new
-
-\ biostatistics
-
-\ begin hexadecimal numbering
-hex \ hex xy : x holds life , y holds neighbors count
-
-10 constant Alive \ 0y = not alive
-
-\ Conway's rules:
-\ a life depends on the number of its next-door neighbors
-
-\ it dies if it has fewer than 2 neighbors
-: Lonely ( char -- flag ) 12 < ;
-
-\ it dies if it has more than 3 neighbors
-: Crowded ( char -- flag ) 13 > ;
-
-: -Sustaining ( char -- flag )
- dup Lonely swap Crowded or ;
-
-\ it is born if it has exactly 3 neighbors
-: Quickening ( char -- flag )
- 03 = ;
-
-\ back to decimal
-decimal
-
-\ compass points
-: N ( i -- j ) How-Wide - ;
-: S ( i -- j ) How-Wide + ;
-: E ( i -- j ) 1+ ;
-: W ( i -- j ) 1- ;
-
-\ census
-: Home+! ( -1|1 i -- ) >r Alive * r> new c+! ;
-
-: Neighbors+! ( -1|0|1 i -- )
- 2dup N W new c+! 2dup N new c+! 2dup N E new c+!
- 2dup W new c+! ( i ) 2dup E new c+!
- 2dup S W new c+! 2dup S new c+! S E new c+! ;
-
-: Bureau-of-Vital-Statistics ( -1|1 i -- )
- 2dup Home+! Neighbors+! ;
-
-\ mortal coils
-char ? constant Soul
- bl constant Body
-
-\ at home
-: Home ( char i -- ) How-Wide /mod at-xy emit ;
-
-\ changes, changes
-: Is-Born ( i -- )
- Soul over Home
- 1 swap Bureau-of-Vital-Statistics ;
-: Dies ( i -- )
- Body over Home
- -1 swap Bureau-of-Vital-Statistics ;
-
-\ the one and the many
-: One ( c-addr -- i )
- 0 old - /char / ;
-: Everything ( -- )
- 0 old Homes
- begin dup
- while over c@ dup Alive and
- if -Sustaining if over One Dies then
- else Quickening if over One Is-Born then then
- 1 /string
- repeat 2drop
- How-Wide 1- How-Deep 1- at-xy ;
-
-\ in the beginning
-: Void ( -- )
- 0 old Homes blank ;
-
-\ spirit
-: Voice ( -- c-addr u )
- page
- ." Say: " 0 new dup Homes accept ;
-
-\ subtlety
-: Serpent ( -- )
- 0 2 at-xy ." Press a key for knowledge." key drop
- 0 2 at-xy ." Press space to re-start, Esc to escape life." ;
-
-\ the primal state
-: Innocence ( -- )
- Homes 0
- do i new c@ Alive / i Neighbors+! loop ;
-
-\ children become parents
-: Passes ( -- ) 0 new 0 old Homes cmove ;
-
-\ a garden
-: Paradise ( c-addr u -- )
- >r How-Deep How-Wide * How-Deep 2 mod 0= How-Wide and -
- r@ - 2/ old
- r> cmove
- 0 old Homes 0
- do count bl <>
- dup if Soul i Home then
- Alive and i new c!
- loop drop
- Serpent
- Innocence Passes ;
-
-: Creation ( -- ) Void Voice Paradise ;
-
-\ the human element
-
-( 1000) 100 constant Ideas
-: Dreams ( -- ) Ideas ms ;
-
-( 1000) 100 constant Images
-: Meditation ( -- ) Images ms ;
-
-\ free will
-: Action ( -- char )
- key? dup
- if drop key
- dup bl = if Creation then
- then ;
-
-\ environmental dependence
-27 constant Escape
-
-\ history
-: Goes-On ( -- )
- begin Everything Passes
- Dreams Action Meditation
- Escape = until ;
-
-\ a vision
-: Life ( -- ) Creation Goes-On ;
-
-
-\ run the word Life and enjoy
-
-\ Copyright 1995 Leo Wong
-\ hello@albany.net
-\ http://www.albany.net/~hello/
diff --git a/amforth-6.5/examples/literacy.frt b/amforth-6.5/examples/literacy.frt
deleted file mode 100644
index b9b0bd9..0000000
--- a/amforth-6.5/examples/literacy.frt
+++ /dev/null
@@ -1,49 +0,0 @@
-\ from Newsgroups: comp.lang.forth
-\ Date: Sun, 28 Dec 2014 14:12:44 -0800 (PST)
-\ Message-ID: <fdfa0f77-57f9-4ea6-b5bc-32d5651aabef@googlegroups.com>
-\ Subject: String literacy
-\ From: Julian Fondren <julian....@gmail.com>
-\ Adapted to most recent recognizer RFD
-
-
-\ Also, notice how I intend code by two spaces? That makes it very
-\ clear what's code and what's me talking about code, without the
-\ reader having to keep switching between two files, say. It also
-\ allows me to tie documentation and source together in such a way
-\ that one will seldom be supplied without the other. You could
-\ even organize your code into 'blocks', with corresponding 'shadow
-\ blocks' ... well, once again, let's just do it:
-
-\ This is the entire contents of literate.fs:
-
- ' noop ' noop ' noop recognizer: r:noop
- : literacy-recognizer ( c-addr u -- r:noop | r:fail )
- 2drop source s" " string-prefix? if r:fail else 0 parse 2drop r:noop then ;
-
- \ place it at the top of the recognizer stack
- forth-recognizers get-recognizers
- 1+ ' literacy-recognizer swap
- forth-recognizers set-recognizers
-
-And the entire rest of my post will be the contents of a file
-named hello.fs, which makes use of it:
-
---- hello.fs begins next line ---
- require literate.fs
-
-Having required literate.fs, the rest of this file is commentary unless
-intended by two spaces.
-
-For example, Forth will pass over the following:
-
-: hello ( -- ) cr ." Hello!" ;
-
-But will compile and execute these indented statements:
-
- : goodbye ( -- )
- cr ." Good bye." ;
-
- goodbye bye bye bye
-
-(This behavior is also seen interactively.)
-
diff --git a/amforth-6.5/examples/local.frt b/amforth-6.5/examples/local.frt
deleted file mode 100644
index 71564a2..0000000
--- a/amforth-6.5/examples/local.frt
+++ /dev/null
@@ -1,64 +0,0 @@
-\ trivial local
-
-\ there is exactly one local called X
-\ it is not initialized upon entry
-\ it works like a local should do:
-\ get the content by calling X, assign
-\ a new value with TO
-
-\ separate local stack
-\ max. call depth 10
-
-\ "2" means "1 cells", if portability is a concern
-
-#10 cells constant l-size
-\ the local stack pointer and the stack itself
-l-size cell+ buffer: lsp
-
-\ initialize l-stackpointer, call it
-\ in e.g. turnkey prior to use!
-: l-init lsp l-size + lsp ! ;
-
-\ general stack access, unsued
-: l@ lsp @ @ ;
-: l! lsp @ ! ;
-: l-free 2 lsp +! ;
-: l-alloc -2 lsp +! ;
-: >l l! l-alloc ;
-: l> l-free l@ ;
-
-: local@ negate lsp @ + @ ;
-: local! negate lsp @ + ! ;
-
-\ define a local by its offset
-\ relative to the local stack pointer
-: local ( offset "name" -- )
- (value) ,
- ['] local@ ,
- ['] local! ,
-;
-
-\ should be smarter, it should
-\ check whether X is used at all
-\ and allocate the local stack
-\ only if needed.
-: : : l-alloc ;
-: ; l-free postpone ; ; immediate
-
-\ globally define a label for the first
-\ local variable. The X is a global name
-\ but has local content. If using more,
-\ add a l-alloc/l-free pair in the : and ;
-\ definitions above.
-
-0 local X
-
-\ test cases
-\ l-init
-\ : test1 to X X . ;
-\ 1 test1
-\ -> 1
-\ : test2 1 test1 to X X . ;
-\ 2 test2
-\ -> 1 2
-\ \ No newline at end of file
diff --git a/amforth-6.5/examples/many.frt b/amforth-6.5/examples/many.frt
deleted file mode 100644
index c5bfc49..0000000
--- a/amforth-6.5/examples/many.frt
+++ /dev/null
@@ -1,13 +0,0 @@
-\ Rick VanNorman, clf 15. Apr 1997
-
-: many key? if key drop exit then 0 >in ! ;
-
-\ use it like
-\ > 0
-\ > dup . 1+ many
-\ 0 1 2 3 4 5 6 .....
-\
-\ this repeats the current input line until a key
-\ is hit. The repeat can, of course, cause a total
-\ desaster
-\ \ No newline at end of file
diff --git a/amforth-6.5/examples/parsed-to.frt b/amforth-6.5/examples/parsed-to.frt
deleted file mode 100644
index 8c06769..0000000
--- a/amforth-6.5/examples/parsed-to.frt
+++ /dev/null
@@ -1,22 +0,0 @@
-
-\ prepend -> to a value name and act like TO
-\ 42 to answer
-\ is the same as
- \ 42 ->answer
-\ The -> should be made a synonymous to TO
-\
-\ actions
-:noname defer! ;
-:noname postpone literal postpone defer! ;
-:noname postpone 2literal ;
-recognizer: r:parsed-to
-
-: rec-parsed-to ( addr len -- addr r:parsed-to | r:fail )
- over @ $3e2d = ( -> ) 0= if 2drop r:fail exit then
- \ something left?
- 2 /string dup 0= if 2drop r:fail exit then
- \ search for the name
- find-name 0= if r:fail exit then
- ( -- xt )
- r:parsed-to
-;
diff --git a/amforth-6.5/examples/queens.frt b/amforth-6.5/examples/queens.frt
deleted file mode 100644
index e20b05d..0000000
--- a/amforth-6.5/examples/queens.frt
+++ /dev/null
@@ -1,54 +0,0 @@
-\ Copyright (c) 2007 the authors listed at the following URL, and/or
-\ the authors of referenced articles or incorporated external code:
-\ http://en.literateprograms.org/Eight_queens_puzzle_(Forth)?action=history&offset=20070512025943
-\
-\ Permission is hereby granted, free of charge, to any person obtaining
-\ a copy of this software and associated documentation files (the
-\ "Software"), to deal in the Software without restriction, including
-\ without limitation the rights to use, copy, modify, merge, publish,
-\ distribute, sublicense, and/or sell copies of the Software, and to
-\ permit persons to whom the Software is furnished to do so, subject to
-\ the following conditions:
-\
-\ The above copyright notice and this permission notice shall be
-\ included in all copies or substantial portions of the Software.
-\
-\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-\ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-\ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-\ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-\ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-\
-\ Retrieved from: http://en.literateprograms.org/Eight_queens_puzzle_(Forth)?oldid=10015
-marker queen
-
- : bits ( bits -- mask ) 1 swap lshift 1- ;
- : lowBit ( mask -- bit ) dup negate and ;
- : lowBit- ( mask -- mask ) dup 1- and ;
- : third ( a b c -- a b c a ) 2 pick ;
-
- variable solutions
- variable nodes
- : poss ( a b c -- a b c a&b&c ) dup 2over and and ;
-
- : next3 ( dl dr f Qfilebit -- dl dr f dl' dr' f' )
- invert >r
- third r@ and 2* 1+
- third r@ and 2/
- third r> and ;
-
- : try ( dl dr f -- ) \ bitmasks for unused diagonals and files
- dup if 1 nodes +! poss
- begin ?dup while
- dup >r lowBit next3 recurse r> lowBit-
- repeat
- else ( .sol) 1 solutions +! then
- drop drop drop ;
-
- : queens ( n -- ) >r
- 0 solutions ! 0 nodes !
- -1 dup r@ bits try
- r> . ." queens: " solutions @ u. ." solutions, " nodes @ u. ." nodes" ;
-
diff --git a/amforth-6.5/examples/readme.txt b/amforth-6.5/examples/readme.txt
deleted file mode 100644
index 940d913..0000000
--- a/amforth-6.5/examples/readme.txt
+++ /dev/null
@@ -1,37 +0,0 @@
-This folder contains some example codes not
-related to any application.
-
-easter.frt: calculates the date of easter. almost unmodfied version
- of Will Baden's code
-
-fib.frt: simple benchmark. calculate a fibonacci number using
- different algorithm.
-
-sieve.frt: not-so simple benchmark modelled after the sieve code
- of Marcel Hendrix. Uses single bits to store the is-prim flag.
-
-run-hayes.frt: demonstrate the use of the amforth-upload.py utility
- and the special #include syntax. The test itself is a slightly
- modified HAYES test suite
-
-queens.frt: solves the queens problem for various size, maybe useful
- as a benchmark.
-
-ascii.frt: prints an ascii table on screen
-
-life.frt: Conveys game of life. Its very memory intensive, the example
- code works on an Atmega16, but a bigger one would allow larger
- worlds.
-
-string-rec.frt: converts a " delimited string into a printable,
- compilable and postponable text object. It replaces the s" command.
-
-sierpinski.frt: simple fractal generator. Illustrates the use of
- the amforth-shell to include library files.
-
-co.frt: co routines aka subroutines for nonpreemtive multitasking.
- Examples on how to use them are included.
-
-many.frt: Repeat the input line until a key is hit. Use it with care
- since it can cause a lot of trouble. Since the input line is re-parsed
- every time, it is much slower than a compiled word.
diff --git a/amforth-6.5/examples/rec-char.frt b/amforth-6.5/examples/rec-char.frt
deleted file mode 100644
index 1e7b1ac..0000000
--- a/amforth-6.5/examples/rec-char.frt
+++ /dev/null
@@ -1,12 +0,0 @@
-\ check for the 'c' syntax for single
-\ characters.
-: rec:char ( addr len -- n r:num | r:fail )
- 3 = if \ a three character string
- dup c@ [char] ' = if \ starts with a '
- dup 2 + c@ [char] ' = if \ and ends with a '
- 1+ c@ r:num exit
- then
- then
- then
- drop r:fail
-;
diff --git a/amforth-6.5/examples/rec-double-paren.frt b/amforth-6.5/examples/rec-double-paren.frt
deleted file mode 100644
index 254fa9e..0000000
--- a/amforth-6.5/examples/rec-double-paren.frt
+++ /dev/null
@@ -1,73 +0,0 @@
-\
-\ Purpose: temporarly switch off all actions until
-\ a delimiting word is found and executed.
-\ Useful to comment larger text parts.
-\
-\ (( switches to a limited command set and
-\ makes all words no-operations. Only words
-\ in a special wordlist are allowed for
-\ execution. )) is one of them and switches
-\ back to normal operation.
-\
-\ The recognizer switch survives REFILL's so
-\ multi line comments work too. This is an
-\ example for replacing the whole system
-\ recognizer stack with another one.
-\
-\ Author: Matthias Trute
-\ Date: Oct 14, 2016
-\ License: Public Domain
-\
-
-\ keep the previously active forth-recognizer stack
-variable old-f-rs
-wordlist constant comment-actions
-
-get-current
-comment-actions set-current
-
-\ only words in this wordlist are executed inside comments
-\ at least the )) is needed.
-
-\ switch back to the saved recognizer stack
-: ))
- old-f-rs @ to forth-recognizer
-; immediate
-
-\ that's all for the comment actions
-set-current
-
-\ every word found is fine. Even the ones that are not found
-\ in the dictionary
-' noop dup dup recognizer: r:skip
-: rec:skip ( addr len -- r:skip ) 2drop r:skip ;
-
-\ search only in the comment-actions wordlist
-: rec:comment-actions ( addr len -- xt +/-1 r:word | r:fail )
- comment-actions search-wordlist ( xt +/-1 | 0 )
- ?dup if r:word else r:fail then
-;
-
-\ a simple two-element recognizer stack
-2 recognizer constant rs:comment
-' rec:skip ' rec:comment-actions 2 rs:comment set-recognizers
-
-\ save the current recognizer stack and
-\ switch over to the limited one
-: (( ( -- )
- forth-recognizer old-f-rs !
- rs:comment to forth-recognizer
-; immediate
-
-\ ------------- Test Cases ----------------
-\
-\ : rec:comment rs:comment do-recognizer ;
-\ T{ S" DUP" rec:comment -> r:skip }T
-\ T{ S" 1234" rec:comment -> r:skip }T
-
-\ the XT of )) is not important
-\ T{ S" ))" rec:comment rot drop -> 1 r:word }T
-\
-\ ------------------------------------------
-\ with nesting the [IF] [ELSE] [THEN] can be
-\ implemented likewise.
diff --git a/amforth-6.5/examples/rec-name.frt b/amforth-6.5/examples/rec-name.frt
deleted file mode 100644
index 3957133..0000000
--- a/amforth-6.5/examples/rec-name.frt
+++ /dev/null
@@ -1,18 +0,0 @@
-
-\ #require recognizer.frt
-\ #require find-name.frt
-
-\ from forth 2012
-:noname name>interpret execute ;
-:noname name>compile execute ;
-:noname postpone literal ;
-recognizer: r:name
-
-\ the parsing word
-: rec:name ( addr len -- nt r:name | r:fail)
- find-name ?dup
- if r:name else r:fail then
-;
-
-\ replace rec:word with rec:name
-\ everthing else should work as before
diff --git a/amforth-6.5/examples/run-hayes.frt b/amforth-6.5/examples/run-hayes.frt
deleted file mode 100644
index 3549977..0000000
--- a/amforth-6.5/examples/run-hayes.frt
+++ /dev/null
@@ -1,26 +0,0 @@
-\
-\ process this file with amforth-upload.py and
-\ the proper setting of $AMFORTH_LIB (basedir of
-\ you amforth file tree)
-\ WIN (untested, DOS Box)
-\ cd c:\amforth-x.y
-\ set AMFORTH_LIB=c:\amforth-x.y
-\ python tools\amforth-upload.py -t com1: examples\run-hayes.frt
-\ UNIX / MAC (Terminal)
-\ cd $HOME/amforth-x.y
-\ export AMFORTH_LIB=$HOME/amforth-x.y
-\ tools/amforth-upload.py -t /dev/ttyUSB0 examples/run-hayes.frt
-\ enjoy!
-\
-\ it is meant to be run on a newly flashed
-\ controller, e.g. all the dict_* are included
-\
-
-\ include all sources
-#include ans94/core.frt
-#include ans94/tester/tester-amforth.frt
-#include ans94/double.frt
-#include ans94/core-ext/marker.frt
-\ and finally run all the tests
-
-#include ans94/tester/core.fr
diff --git a/amforth-6.5/examples/scope.frt b/amforth-6.5/examples/scope.frt
deleted file mode 100644
index d6a5d31..0000000
--- a/amforth-6.5/examples/scope.frt
+++ /dev/null
@@ -1,21 +0,0 @@
-\ The following example shows how to create a library of words under a special
-\ wordlist (can_lib). This example also shows how to chain scope calls safely.
-
-wordlist constant can_lib
-
-get-order 1+ can_lib swap set-order \ can_lib would be searched first
-
-: can_scope ( addr len -- addr' len' wid )
- 2dup
- 4 > if \ name length check
- s" can_" tuck icompare if \ name prefix check
- 4 /string \ drop prefix from created word
- can_lib exit
- then
- else
- drop
- then
- [ ' wlscope defer@ ] literal execute
-;
-
-' can_scope is wlscope
diff --git a/amforth-6.5/examples/sierpinsi.frt b/amforth-6.5/examples/sierpinsi.frt
deleted file mode 100644
index 19fe920..0000000
--- a/amforth-6.5/examples/sierpinsi.frt
+++ /dev/null
@@ -1,26 +0,0 @@
-\ Sierpinski fractal
-\ richard.w@gmail.com, clf 13.2.2015
-
-\ additional words from the forth lib
-\ #require buffer.frt
-\ #require blank.frt
-\ #require chars.frt
-
-64 constant size
-char * constant '*'
-size buffer: line[]
-
-line[] size blank '*' size 2/ chars line[] + c! ( init )
-
-: .line[] ( -- ) line[] size type cr ;
-: =*? ( addr -- f ) c@ '*' = ;
-: >char ( f f -- ch ) xor [ '*' bl - ] literal and bl + ;
-: init-flags ( -- f-1 f0 ) 0 line[] =*? ;
-: sierp-line ( -- ) init-flags line[] size bounds do
- i 1 chars + =*? rot over >char i c!
- loop 2drop ;
-: sierpinski ( -- ) size 2/ 0 do .line[] sierp-line loop ;
-
-\
-\ sierpinski prints the fractal on the terminal
-\ \ No newline at end of file
diff --git a/amforth-6.5/examples/sieve.frt b/amforth-6.5/examples/sieve.frt
deleted file mode 100644
index 13c45f2..0000000
--- a/amforth-6.5/examples/sieve.frt
+++ /dev/null
@@ -1,58 +0,0 @@
-\ sieve benchmark, modified version of
-\ marcel hendrix' sources. Uses single bits
-\ insted of whole bytes to store the is-prime
-\ marker cuts memory footprint to 1/8th.
-
-\ runtime: ATMega644 @ 16MHz 2,3 seconds per DO-PRIME
-
-marker _sieve_
-
-decimal
-
-1000 constant #times
-8192 constant size \ needs 1KB
-
-variable flags size 8 / allot
-
-\ highly un-optimized words
-: bit-addr ( addr bit -- eff-addr )
- \ every byte has 8 bits. addr = addr + (bit >> 3)
- 3 rshift ( -- addr off)
- + ( -- eff-addr)
-;
-
-: bit? ( addr bit -- f )
- swap over bit-addr swap ( -- eff-addr bit )
- 7 and 1 swap lshift ( -- eff-addr bitmask)
- swap c@ and ( -- f)
-;
-
-: bit-reset ( addr bit -- )
- swap over bit-addr swap ( -- eff-addr bit )
- 7 and 1 swap lshift ( -- eff-addr bitmask)
- invert over c@ and swap c!
-;
-
-: 2drop drop drop ;
-
-: DO-PRIME flags [ size 8 / ] literal -1 fill
- 0 size 0 do
- flags i
- bit? if
- i 2* 3 +
- dup i +
- begin
- dup
- size u<
- while
- flags over bit-reset
- over +
- repeat
- 2drop 1+
- then
- loop ;
-
-: primes cr #times u. ." iterations."
- 0 #times 0 do drop DO-PRIME loop
- cr . ." primes found, " ;
-
diff --git a/amforth-6.5/examples/stack.frt b/amforth-6.5/examples/stack.frt
deleted file mode 100644
index b640cfb..0000000
--- a/amforth-6.5/examples/stack.frt
+++ /dev/null
@@ -1,76 +0,0 @@
-\
-\ separate stacks for cell sized data
-\
-\ Date: Nov 13, 2016
-\ Author: Matthias Trute
-
-\ allocate a stack region with at most
-\ size elements
-: stack ( size -- stack-id )
- 1+ ( size ) cells here swap allot
- 0 over ! \ empty stack
-;
-
-\ replace the stack content with data from
-\ the data stack.
-: set-stack ( rec-n .. rec-1 n recstack-id -- )
- over 0< if -4 throw then \ stack underflow
- 2dup ! cell+ swap cells bounds
- ?do i ! 1 cells +loop
-;
-
-\ read the whole stack to the data stack
-: get-stack ( recstack-id -- rec-n .. rec-1 n )
- dup @ >r r@ cells + r@ begin
- ?dup
- while
- 1- over ( -- a n a )
- @ ( -- a n r_i)
- rot 1 cells -
- rot ( -- r_i a n )
- repeat
- drop r>
-;
-
-\ execute XT for earch element of the stack
-\ leave the loop if the XT returns TRUE
-: map-stack ( i*x XT stack-id -- j*y f )
- dup cell+ swap @ cells bounds ?do
- ( -- i*x XT )
- i @ swap dup >r execute
- ?dup if r> drop unloop exit then
- r> 1 cells +loop
- drop 0
-;
-
-\ add an item as new top of the stack
-: >stack ( x stack-id -- )
- 2dup 2>r nip get-stack 2r> rot 1+ swap set-stack
-;
-
-\ destructivly get Top Of Stack
-: stack> ( stack-id -- x )
- dup >r get-stack 1- r> rot >r set-stack r>
-;
-
-\ actual stack depth
-: depth-stack ( stack-id -- n )
- @
-;
-
-\ copy a stack item
-: pick-stack ( n stack-id -- n' )
- 2dup depth-stack 0 swap within 0= if -9 throw then
- cell+ swap cells + @
-;
-
-\ add an item at the bottom of a stack
-: >back ( x stack-id -- )
- dup >r get-stack 1+ r> set-stack
-;
-
-\ destructivly get Bottom Of Stack
-: back> ( stack-id -- x )
- dup >r get-stack 1- r> set-stack
-;
-
diff --git a/amforth-6.5/examples/string-rec.frt b/amforth-6.5/examples/string-rec.frt
deleted file mode 100644
index b1bd930..0000000
--- a/amforth-6.5/examples/string-rec.frt
+++ /dev/null
@@ -1,28 +0,0 @@
-
-\ use " as string delimiters. Everything
-\ between two " is a string. It replaces
-\ the forth command s" completly
-\ instead of s" foo" use "foo". The space
-\ after s" is no longer needed, instead it
-\ a part of the string. s" foo" and " foo"
-\ differ with the leading space in the latter
-
-\ strings live as long as the SOURCE is
-\ unchanged! Compilation is done to the
-\ flash if called in compile state.
-\ postponing a compiled string is not yet
-\ supported.
-
-\ #require recognizer.frt
-
-' noop
-:noname postpone sliteral ;
-:noname -48 throw ; recognizer: r:string
-
-: rec:string ( addr len -- addr' len' r:string | r:fail )
- over c@ [char] " <> if 2drop r:fail exit then
- negate 1+ >in +! drop \ reset parse area to SOURCE
- [char] " parse \ get trailing delimiter
- -1 /string
- r:string
-;
diff --git a/amforth-6.5/examples/time-rec.frt b/amforth-6.5/examples/time-rec.frt
deleted file mode 100644
index 9fa77e8..0000000
--- a/amforth-6.5/examples/time-rec.frt
+++ /dev/null
@@ -1,59 +0,0 @@
-
-\ recognize a time information in the format
-\ hh:mm:ss (two : between numbers)
-\ returns either r:fail (if unsuccessful) or
-\ a double number representing the seconds of the
-\ time stamp
-
-\ append it to the recognizer stack with
-\ ' rec:h:m:s get-recognizers 1+ set-recognizers
-\ and than enter 02:00:00 to get 7200. (double
-\ cell number) which is the number of seconds
-\ 2 hours have.
-
-#require m-star-slash.frt
-
-\ some factors.
-\ is the character a ':' ?
-: ':'? ( addr len -- addr+1 len-1 f )
- over >r 1 /string r> c@ [char] : = ;
-
-\ extract a number from the current string
-: get-number ( addr len -- d addr' len' )
- 0. 2swap >number
-;
-
-\ (hours*60+minutes)*60+seconds, factor during calculation
-: a+60b 2swap 60 1 m*/ d+ ;
-
-: rec:h:m:s ( c-addr u -- d r:dnum | r:fail )
- get-number ( -- hh. addr len )
- ':'? 0= if 2drop 2drop r:fail exit then
-
- get-number ( -- hh. mm. addr+1 len-1 )
- \ add hours to minutes
- 2>r a+60b 2r>
- ':'? 0= if 2drop 2drop r:fail exit then
-
- get-number \ -- (hh*60+mm). ss. addr len
- \ len must now be 0 or its not a time stamp
- if drop 2drop 2drop r:fail exit then drop
- \ add minutes to seconds and finish
- a+60b r:dnum
-;
-
-\ wishlist:
-\ validate the values for minutes and seconds (between 0 and 59)
-\ factor the code
-\ add milliseconds?
-
-\ test cases (xy=XT of r:dnum, ab=XT of r:fail)
-\ tests are made outside of the interpreter, thus the
-\ need for explicit strings.
-
-\ > s" 01:00:00" rec:h:m:s . d.
-\ xy 3600
-\ > s" 01:00:0a" rec:h:m:s .
-\ ab
-\ > s" 72:00:09" rec:h:m:s . d.
-\ xy 259200
diff --git a/amforth-6.5/examples/value-variations.frt b/amforth-6.5/examples/value-variations.frt
deleted file mode 100644
index df7ec91..0000000
--- a/amforth-6.5/examples/value-variations.frt
+++ /dev/null
@@ -1,65 +0,0 @@
-\ This file contains variations of the
-\ standard VALUE. in amforth values are
-\ stored in EEPROM and occupy 1 cell (2bytes).
-\ Calling the name of a value returns this
-\ information on the stack. With the command
-\ TO this data can be changed. Implementation
-\ allows to extend this schema to any data
-\ in any memory.
-
-\ First example is a 1byte value in RAM:
-
-\ two helper words,
-: c@v @i c@ ;
-: c!v @i c! ;
-
-: cvalue ( n "name" -- )
- (value) \ create a new wordlist entry
- here , \ the address for the methods
- postpone c@v \ method for the read operation
- postpone c!v \ method for the write (TO) operation
- here 1 allot ! \ allocate the memory and initialize it
- ;
-
-\ $dead cvalue answer will store only the lower byte
-\ of the number ($ad). The upper byte is either ignored
-\ (TO) or set to 0
-
-
-\ a buffered value is a value that tolerates heavy write access
-\ by using a RAM cell as a cache.
-
-\ you need to define a trigger, that flushes the cache
-\ warm-cache initializes the cache with the stored data
-\ (to be called in turnkey and similiar actions)
-
-\ it is a matter of style whether a sequence should be
-\ ' vvv method
-\ or
-\ method vvv
-\ is used. The implementation below goes the first way
-\ since parsing words are considered suboptimal by the
-\ gurus (they are state smart and less flexible)
-
-\ 2 is a magic number
-: @cache 2 + @i @ ;
-: !cache 2 + @i ! ;
-
-: flush-cache 1+ dup 2 + @i @ swap @i !e ;
-: warm-cache 1+ dup @i @e swap 2 + @i ! ;
-
-: cache-value
- (value)
- dup ehere dup , dup cell+ to ehere !e
- postpone @cache
- postpone !cache
- here 2 ( 1 cell ) allot dup , ! \ 3 address units, remember?
-;
-
-\ \ test case
-\ ehere dup . \ keep the eeprom address
-\ 42 cache-value c-dp
-\ 17 to c-dp
-\ c-dp . dup @e . \ prints 17 and 42
-\ ' c-dp flush-cache
-\ c-dp . dup @e . \ prints 17 and 17