From a76977af62010a392c16010c367185e61e856ffe Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Wed, 30 Oct 2019 20:04:56 +0100 Subject: mv to docs --- buzzard/third | 367 ---------------------------------------------------------- 1 file changed, 367 deletions(-) delete mode 100644 buzzard/third (limited to 'buzzard/third') diff --git a/buzzard/third b/buzzard/third deleted file mode 100644 index b5d3802..0000000 --- a/buzzard/third +++ /dev/null @@ -1,367 +0,0 @@ -: 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 ) -; - -: ) - ' , , ( 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 ; -: constant @ ; -: array + ; - -: [ immediate command ; -: _welcome " Welcome to THIRD. -Ok. -" ; - -: ; immediate ' exit , command exit - -[ - -_welcome -- cgit v1.2.3