From d80736ab6e8e3cad2f1a30c6eaba2d6883dbe967 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 26 Aug 2017 20:31:40 +0200 Subject: Remove AmForth --- amforth-6.5/examples/ascii.frt | 13 -- amforth-6.5/examples/co.frt | 36 ----- amforth-6.5/examples/date-time.frt | 29 ---- amforth-6.5/examples/easter.frt | 112 ------------- amforth-6.5/examples/fib.frt | 12 -- amforth-6.5/examples/forward-declarations-test.frt | 12 -- amforth-6.5/examples/forward-declarations.frt | 23 --- amforth-6.5/examples/fsm.frt | 67 -------- amforth-6.5/examples/i2c-compass.frt | 55 ------- amforth-6.5/examples/life.frt | 178 --------------------- amforth-6.5/examples/literacy.frt | 49 ------ amforth-6.5/examples/local.frt | 64 -------- amforth-6.5/examples/many.frt | 13 -- amforth-6.5/examples/parsed-to.frt | 22 --- amforth-6.5/examples/queens.frt | 54 ------- amforth-6.5/examples/readme.txt | 37 ----- amforth-6.5/examples/rec-char.frt | 12 -- amforth-6.5/examples/rec-double-paren.frt | 73 --------- amforth-6.5/examples/rec-name.frt | 18 --- amforth-6.5/examples/run-hayes.frt | 26 --- amforth-6.5/examples/scope.frt | 21 --- amforth-6.5/examples/sierpinsi.frt | 26 --- amforth-6.5/examples/sieve.frt | 58 ------- amforth-6.5/examples/stack.frt | 76 --------- amforth-6.5/examples/string-rec.frt | 28 ---- amforth-6.5/examples/time-rec.frt | 59 ------- amforth-6.5/examples/value-variations.frt | 65 -------- 27 files changed, 1238 deletions(-) delete mode 100644 amforth-6.5/examples/ascii.frt delete mode 100644 amforth-6.5/examples/co.frt delete mode 100644 amforth-6.5/examples/date-time.frt delete mode 100644 amforth-6.5/examples/easter.frt delete mode 100644 amforth-6.5/examples/fib.frt delete mode 100644 amforth-6.5/examples/forward-declarations-test.frt delete mode 100644 amforth-6.5/examples/forward-declarations.frt delete mode 100644 amforth-6.5/examples/fsm.frt delete mode 100644 amforth-6.5/examples/i2c-compass.frt delete mode 100644 amforth-6.5/examples/life.frt delete mode 100644 amforth-6.5/examples/literacy.frt delete mode 100644 amforth-6.5/examples/local.frt delete mode 100644 amforth-6.5/examples/many.frt delete mode 100644 amforth-6.5/examples/parsed-to.frt delete mode 100644 amforth-6.5/examples/queens.frt delete mode 100644 amforth-6.5/examples/readme.txt delete mode 100644 amforth-6.5/examples/rec-char.frt delete mode 100644 amforth-6.5/examples/rec-double-paren.frt delete mode 100644 amforth-6.5/examples/rec-name.frt delete mode 100644 amforth-6.5/examples/run-hayes.frt delete mode 100644 amforth-6.5/examples/scope.frt delete mode 100644 amforth-6.5/examples/sierpinsi.frt delete mode 100644 amforth-6.5/examples/sieve.frt delete mode 100644 amforth-6.5/examples/stack.frt delete mode 100644 amforth-6.5/examples/string-rec.frt delete mode 100644 amforth-6.5/examples/time-rec.frt delete mode 100644 amforth-6.5/examples/value-variations.frt (limited to 'amforth-6.5/examples') 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: -\ Subject: String literacy -\ From: Julian Fondren -\ 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 -- cgit v1.2.3