aboutsummaryrefslogtreecommitdiff
path: root/docs/buzzard/third
diff options
context:
space:
mode:
Diffstat (limited to 'docs/buzzard/third')
-rw-r--r--docs/buzzard/third367
1 files changed, 367 insertions, 0 deletions
diff --git a/docs/buzzard/third b/docs/buzzard/third
new file mode 100644
index 0000000..b5d3802
--- /dev/null
+++ b/docs/buzzard/third
@@ -0,0 +1,367 @@
+: immediate _read @ ! - * / <0 exit echo key _pick
+
+: 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