commit 9bbe18a8b4d74a7bbf0f5166cd0ede036b64ad25
parent 0a5b956077484cc08827e4914a1c042fb5996bd1
Author: prenev <an2qzavok@gmail.com>
Date: Sun, 10 Oct 2021 21:57:15 +0300
add files from original buzzard.2, remove initial declaration line from third and demo1.1st
Diffstat:
| A | demo1.1st | | | 10 | ++++++++++ |
| A | demo1.th | | | 4 | ++++ |
| A | demo2.th | | | 10 | ++++++++++ |
| A | demo3.th | | | 15 | +++++++++++++++ |
| A | demo4.th | | | 30 | ++++++++++++++++++++++++++++++ |
| A | demo5.th | | | 27 | +++++++++++++++++++++++++++ |
| A | demo6.th | | | 18 | ++++++++++++++++++ |
| A | help.th | | | 54 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | third | | | 365 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
9 files changed, 533 insertions(+), 0 deletions(-)
diff --git a/demo1.1st b/demo1.1st
@@ -0,0 +1,10 @@
+: show echo echo echo echo exit
+: all show show show show echo exit
+
+: doit immediate
+ 10 33 100 108 114 111 87
+ 32 111 108 108 101 72
+ all
+exit
+
+doit
diff --git a/demo1.th b/demo1.th
@@ -0,0 +1,4 @@
+: demo1 " Hello world!
+" ;
+
+demo1
diff --git a/demo2.th b/demo2.th
@@ -0,0 +1,10 @@
+: demo2
+
+ 10 0 ( iterate from 0 stopping before 10 )
+ do
+ i . ( print the loop counter )
+ loop
+ cr ( add a newline )
+;
+
+demo2
diff --git a/demo3.th b/demo3.th
@@ -0,0 +1,15 @@
+: printfour
+
+ dup ( save the number on top of the stack )
+ 4 = ( compare it to four )
+ if
+ " forth " ( output a string for it )
+ drop ( and delete the saved value )
+ else
+ .
+ endif
+;
+
+: demo3 10 0 do i printfour loop cr ;
+
+demo3
diff --git a/demo4.th b/demo4.th
@@ -0,0 +1,30 @@
+( compute factorial recursively )
+( take x as input, return x! and x as output )
+
+: fact-help
+
+ dup if
+ 1 - ( leave x-1 on top )
+ fact-help ( leave x-1, [x-1]! )
+ 1 + ( leave x, [x-1]!, x )
+ swap over swap ( leave [x-1]!, x, x )
+ * ( into x!, x )
+ swap ( into x, x! )
+ else
+ 1 swap
+ then
+;
+
+: fact
+
+ fact-help
+ drop
+
+;
+
+: demo4
+ " 4 factorial is: " 4 fact . cr
+ " 6 factorial is: " 6 fact . cr
+;
+
+demo4
diff --git a/demo5.th b/demo5.th
@@ -0,0 +1,27 @@
+( recursive factorial. given x on top, followed by )
+( an "accumulator" containing the product except for x! )
+
+: fact-help2
+
+ dup if
+ swap over swap
+ *
+ swap 1 -
+ fact-help2
+ then
+;
+
+: fact
+
+ 1 swap
+ fact-help2
+ drop
+;
+
+: demo5
+
+ " The factorial of 3 is: " 3 fact . cr
+ " The factorial of 5 is: " 5 fact . cr
+;
+
+demo5
diff --git a/demo6.th b/demo6.th
@@ -0,0 +1,18 @@
+: foobar
+ 2
+ [ 2 , ( '[' turns the compiler off, allowing us to execute code )
+ 1 1 1 + + , ( and we compile in-line a 2 and a three )
+ ( the '2' means 'push the number following this' )
+ ]
+ + . cr
+;
+
+foobar
+
+: 'foobar ' foobar ; ( ' can only be run inside the compiler )
+ ( ' leaves the address of the following word
+ on the stack )
+
+'foobar . cr
+
+'foobar dump
diff --git a/help.th b/help.th
@@ -0,0 +1,54 @@
+: help key ( flush the carriage return form the input buffer )
+
+" The following are the standard known words; words marked with (*) are
+immediate words, which cannot be used from command mode, but only in
+word definitions. Words marked by (**) declare new words, so are always
+followed by the new word.
+
+ ! @ fetch, store
+ + - * / mod standard arithmetic operations
+ = < > <= >= standard comparison operations
+
+ not boolean not of top of stack
+ logical turn top of stack into 0 or 1
+
+ dup over duplicate the top of stack or second of stack
+ swap drop reverse top two elements or drop topmost
+
+ inc dec increment/decrement the value at address from stack
+ add add a value from 2nd of stack into address from top
+
+ echo key output character from, or input to, top of stack
+ . # print out number on top of stack without/with cr
+ cr print a carriage return
+
+[more]" key
+" (**) var declare variable with initial value taken from stack
+(**) constant declare constant with initial value taken from stack
+(**) array declare an array with size taken from stack
+
+(*) if...else...then FORTH branching construct
+(*) do...loop FORTH looping construct
+ i j loop values (not variables)
+
+ print print the string pointed to on screen
+
+(*)(**) : declare a new THIRD word
+(*) <build does> declare a data types compile-time and run-time
+(*) ; terminate a word definition
+
+[more]" key
+" Advanced words:
+ here current location in dictionary
+ h pointer into dictionary
+ r pointer to return stack
+ fromr tor pop a value from or to the return stack
+
+ , write the top of stack to dictionary
+ ' store the address of the following word on the stack
+ allot leave space on the dictionary
+
+ :: compile a ':' header
+ [ switch into command mode
+ ] continue doing : definitions
+" ;
diff --git a/third b/third
@@ -0,0 +1,365 @@
+: debug immediate 1 5 ! exit
+
+: r 1 exit
+
+: ] r @ 1 - r ! _read ]
+
+: _main immediate r @ 7 ! ]
+_main
+
+
+: _x 3 @ exit
+: _y 4 @ exit
+: _x! 3 ! exit
+: _y! 4 ! exit
+
+
+: swap _x! _y! _x _y exit
+
+: + 0 swap - - exit
+
+: dup _x! _x _x exit
+
+: inc dup @ 1 + swap ! exit
+
+: h 0 exit
+
+: , h @ ! h inc exit
+
+
+: ' r @ @ dup 1 + r @ ! @ exit
+
+: ; immediate ' exit , exit
+
+
+: drop 0 * + ;
+
+: dec dup @ 1 - swap ! ;
+
+: tor r @ @ swap r @ ! r @ 1 + r ! r @ ! ;
+
+: fromr r @ @ r @ 1 - r ! r @ @ swap r @ ! ;
+
+: tail fromr fromr drop tor ;
+
+: minus 0 swap - ;
+
+: bnot 1 swap - ;
+
+: < - <0 ;
+
+: logical dup 0 < swap minus 0 < + ;
+
+: not logical bnot ;
+
+: = - not ;
+
+: branch r @ @ @ r @ @ + r @ ! ;
+
+: computebranch 1 - * 1 + ;
+
+: notbranch
+ not
+ r @ @ @
+ computebranch
+ r @ @ +
+ r @ !
+;
+
+: here h @ ;
+
+: if immediate ' notbranch , here 0 , ;
+
+: then immediate dup here swap - swap ! ;
+
+: ')' 0 ;
+
+: _fix key drop key swap 2 + ! ;
+
+: fix-')' immediate ' ')' _fix ;
+
+fix-')' )
+
+: find-) key ')' = not if tail find-) then ;
+
+: ( immediate find-) ;
+
+( we should be able to do FORTH-style comments now )
+
+( this works as follows: ( is an immediate word, so it gets
+ control during compilation. Then it simply reads in characters
+ until it sees a close parenthesis. once it does, it exits.
+ if not, it pops off the return stack--manual tail recursion. )
+
+( now that we've got comments, we can comment the rest of the code! )
+
+: else immediate
+ ' branch , ( compile a definite branch )
+ here ( push the backpatching address )
+ 0 , ( compile a dummy offset for branch )
+ swap ( bring old backpatch address to top )
+ dup here swap - ( calculate the offset from old address )
+ swap ! ( put the address on top and store it )
+;
+
+: over _x! _y! _y _x _y ;
+
+: add
+ _x! ( save the pointer in a temp variable )
+ _x @ ( get the value pointed to )
+ + ( add the incremement from on top of the stack )
+ _x ! ( and save it )
+;
+
+: allot h add ;
+
+: maybebranch
+ logical ( force the TOS to be 0 or 1 )
+ r @ @ @ ( load the branch offset )
+ computebranch ( calculate the condition offset [either TOS or 1])
+ r @ @ + ( add it to the return address )
+ r @ ! ( store it to our return address and return )
+;
+
+: mod _x! _y! ( get x then y off of stack )
+ _y
+ _y _x / _x * ( y - y / x * x )
+ -
+;
+
+: '\n' 0 ;
+: '"' 0 ;
+: '0' 0 ;
+: 'space' 0 ;
+
+: fix-'\n' immediate ' '\n' _fix ;
+: fix-'"' immediate ' '"' _fix ;
+: fix-'0' immediate ' '0' _fix ;
+: fix-'space' immediate ' 'space' _fix ;
+
+fix-'0' 0 fix-'space' fix-'"' "
+fix-'\n'
+
+
+: cr '\n' echo exit
+
+: printnum
+ dup
+ 10 mod '0' +
+ swap 10 / dup
+ if
+ printnum 0
+ then
+ drop echo
+;
+
+: .
+ dup 0 <
+ if
+ 45 echo minus
+ then
+ printnum
+ 'space' echo
+;
+
+
+: debugprint dup . cr ;
+
+( the following routine takes a pointer to a string, and prints it,
+ except for the trailing quote. returns a pointer to the next word
+ after the trailing quote )
+
+: _print
+ dup 1 +
+ swap @
+ dup '"' =
+ if
+ drop exit
+ then
+ echo
+ tail _print
+;
+
+: print _print ;
+
+ ( print the next thing from the instruction stream )
+: immprint
+ r @ @
+ print
+ r @ !
+;
+
+: find-"
+ key dup ,
+ '"' =
+ if
+ exit
+ then
+ tail find-"
+;
+
+: " immediate
+ key drop
+ ' immprint ,
+ find-"
+;
+
+: do immediate
+ ' swap , ( compile 'swap' to swap the limit and start )
+ ' tor , ( compile to push the limit onto the return stack )
+ ' tor , ( compile to push the start on the return stack )
+ here ( save this address so we can branch back to it )
+;
+
+: i r @ 1 - @ ;
+: j r @ 3 - @ ;
+
+: > swap < ;
+: <= 1 + < ;
+: >= swap <= ;
+
+: inci
+ r @ 1 - ( get the pointer to i )
+ inc ( add one to it )
+ r @ 1 - @ ( find the value again )
+ r @ 2 - @ ( find the limit value )
+ <
+ if
+ r @ @ @ r @ @ + r @ ! exit ( branch )
+ then
+ fromr 1 +
+ fromr drop
+ fromr drop
+ tor
+;
+
+: loop immediate ' inci , here - , ;
+
+: loopexit
+
+ fromr drop ( pop off our return address )
+ fromr drop ( pop off i )
+ fromr drop ( pop off the limit of i )
+; ( and return to the caller's caller routine )
+
+: isprime
+ dup 2 = if
+ exit
+ then
+ dup 2 / 2 ( loop from 2 to n/2 )
+ do
+ dup ( value we're checking if it's prime )
+ i mod ( mod it by divisor )
+ not if
+ drop 0 loopexit ( exit from routine from inside loop )
+ then
+ loop
+;
+
+: primes
+ " The primes from "
+ dup .
+ " to "
+ over .
+ " are:"
+ cr
+
+ do
+ i isprime
+ if
+ i . 'space' echo
+ then
+ loop
+ cr
+;
+
+: execute
+ 8 !
+ ' exit 9 !
+ 8 tor
+;
+
+: :: ; ( :: is going to be a word that does ':' at runtime )
+
+: fix-:: immediate 3 ' :: ! ;
+fix-::
+
+ ( Override old definition of ':' with a new one that invokes ] )
+: : immediate :: ] ;
+
+: command
+ here 5 ! ( store dict pointer in temp variable )
+ _read ( compile a word )
+ ( if we get control back: )
+ here 5 @
+ = if
+ tail command ( we didn't compile anything )
+ then
+ here 1 - h ! ( decrement the dictionary pointer )
+ here 5 @ ( get the original value )
+ = if
+ here @ ( get the word that was compiled )
+ execute ( and run it )
+ else
+ here @ ( else it was an integer constant, so push it )
+ here 1 - h ! ( and decrement the dictionary pointer again )
+ then
+ tail command
+;
+
+: make-immediate ( make a word just compiled immediate )
+ here 1 - ( back up a word in the dictionary )
+ dup dup ( save the pointer to here )
+ h ! ( store as the current dictionary pointer )
+ @ ( get the run-time code pointer )
+ swap ( get the dict pointer again )
+ 1 - ( point to the compile-time code pointer )
+ ! ( write run-time code pointer on compile-time pointer )
+;
+
+: <build immediate
+ make-immediate ( make the word compiled so far immediate )
+ ' :: , ( compile '::', so we read next word )
+ 2 , ( compile 'pushint' )
+ here 0 , ( write out a 0 but save address for does> )
+ ' , , ( compile a push that address onto dictionary )
+;
+
+: does> immediate
+ ' command , ( jump back into command mode at runtime )
+ here swap ! ( backpatch the build> to point to here )
+ 2 , ( compile run-code primitive so we look like a word )
+ ' fromr , ( compile fromr, which leaves var address on stack )
+;
+
+
+: _dump ( dump out the definition of a word, sort of )
+ dup " (" . " , "
+ dup @ ( save the pointer and get the contents )
+ dup ' exit
+ = if
+ " ;)" cr exit
+ then
+ . " ), "
+ 1 +
+ tail _dump
+;
+
+: dump _dump ;
+
+: # . cr ;
+
+: var <build , does> ;
+: constant <build , does> @ ;
+: array <build allot does> + ;
+
+: [ immediate command ;
+: _welcome " Welcome to THIRD.
+Ok.
+" ;
+
+: ; immediate ' exit , command exit
+
+[
+
+_welcome
