Paste number 348819: | my tape_01, in case it's useful |
Pasted by: | reepca |
When: | 4 years, 10 months ago |
Share: | Tweet this! | http://paste.lisp.org/+7H5F |
Channel: | None |
Paste contents: |
\ Everything I've made so far in the bootstrap forth. The 42 EMITs are just so \ I can see how far everything successfully compiles. That, and the irony of \ putting a loading screen on forth compilation. Not all of these are "canon" \ forth words, but most of them are or work similarly. I'm pretty sure /MOD \ works differently in ANS, but we can just overwrite it later. \ Wishlist: EXECUTE (given a code field address you would get with, for example, \ "' +", execute it), file access primitives, and a boatload of bug fixes (I'd \ love to split some of these definitions into separate lines...). So far the \ list of bugs I've noticed that aren't currently resolved: Honor the "hidden" \ flag when looking up words (that way I can redefine ; and get rid of all of \ these EMITs!), and parsing edge cases like "blank line entered" being handled \ properly (to see what's currently happening, enter a couple blank lines and \ use .S). \ Feel free to use anything in here that's useful to you, under the conditions \ of the GPLv3+ and stuff. \ Useful notes for people who want to try out forth stuff: \ 1. Case absolutely matters, and pretty much everything is BEING SHOUTED. \ 2. See above mentioned bugs \ 3. If you're in an emacs shell buffer, you'll want to run ./bin/vm-production \ instead of ./bin/vm. Worked better for me, anyway. \ 4. If you're new to forth, I'd recommend the gforth tutorials. \ Yes, I know it needs more comments. \ - Reepca : CELL 4 ; 42 EMIT : CELLS CELL * ; 42 EMIT : >FLAGS 2 CELLS + ; 42 EMIT : IMMEDIATE LATEST >FLAGS DUP @ 0x2 OR SWAP ! ; 42 EMIT : ALLOT HERE + DP! ; 42 EMIT \ Free the memory after using it to search : ' HERE WORD DROP FIND >CFA SWAP DP! ; 42 EMIT : [COMPILE] ' , ; IMMEDIATE 42 EMIT \ The literal code address of LIT. Don't think too hard about it. : LITERAL [ ' LIT DUP , , ] , , ; 42 EMIT : ['] ' LITERAL ; IMMEDIATE : IF [ ' 0BRANCH LITERAL ] , HERE 0 , ; IMMEDIATE 42 EMIT \ to-patch target -- : TARGET! OVER - SWAP ! ; 42 EMIT \ equivalent to "ENDIF". : THEN HERE TARGET! ; IMMEDIATE 42 EMIT : ELSE HERE 2 CELLS + TARGET! ['] BRANCH , HERE 0 , ; IMMEDIATE 42 EMIT : BEGIN HERE ; IMMEDIATE 42 EMIT : WHILE [COMPILE] IF ; IMMEDIATE 42 EMIT : REPEAT HERE 2 CELLS + TARGET! ['] BRANCH , HERE SWAP TARGET! CELL ALLOT ; IMMEDIATE 42 EMIT : AGAIN HERE SWAP TARGET! ; IMMEDIATE 42 EMIT : .BOOL IF 116 EMIT ELSE 102 EMIT THEN ; 42 EMIT : C, HERE C! 1 ALLOT ; 42 EMIT : TYPE OVER + SWAP BEGIN 2DUP > WHILE DUP C@ EMIT 1 + REPEAT 2DROP ; 42 EMIT : CR 10 EMIT ; 42 EMIT \ Currently this has to have something else on the same line or the parser \ will put a 0 on top of its output. : STR" HERE BEGIN KEY DUP 34 != WHILE C, REPEAT DROP HERE OVER - ; 42 EMIT : S" STATE IF ['] BRANCH , HERE 0 , STR" ROT HERE TARGET! SWAP LITERAL LITERAL ELSE STR" THEN ; IMMEDIATE 42 EMIT : ." [COMPILE] S" STATE IF ['] TYPE , ELSE TYPE THEN ; IMMEDIATE 42 EMIT : MOD % ; 42 EMIT : /MOD 2DUP MOD >R / R> ; 42 EMIT : NEXT-DIGIT 10 /MOD ; 42 EMIT \ Transient storage 'n stuff : PAD HERE 100 CELLS + ; 42 EMIT \ Assuming 2's complement : NEGATE NOT 1 + ; 42 EMIT : CSWAP! 2DUP C@ SWAP C@ ROT C! SWAP C! ; 42 EMIT \ addr n -- : REVERSE-STRING OVER + 1 - BEGIN 2DUP < WHILE 2DUP CSWAP! 1 - SWAP 1 + SWAP REPEAT 2DROP ; 42 EMIT : +C! OVER C! 1 + ; 42 EMIT \ num addr -- addr n (addr should have at least 10 free bytes). : NUM>STRING DUP >R OVER 0 < IF SWAP NEGATE SWAP 45 +C! THEN DUP >R SWAP BEGIN NEXT-DIGIT ROT SWAP 48 + +C! SWAP DUP WHILE REPEAT DROP R> 2DUP - REVERSE-STRING R> SWAP OVER - ; 42 EMIT : . PAD NUM>STRING TYPE ; 42 EMIT : STACK-BASE 0x00090000 ; 42 EMIT : .UNDERFLOW ." Warning: stack is underflowed by " STACK-BASE SWAP - CELL / . ." cells!" CR ; 42 EMIT : .HEIGHT STACK-BASE - CELL / ." <" . ." > " ; 42 EMIT : .S DSP@ DUP STACK-BASE < IF .UNDERFLOW ELSE DUP .HEIGHT STACK-BASE BEGIN 2DUP > WHILE DUP @ . 32 EMIT CELL + REPEAT 2DROP THEN ; 42 EMIT : CLEAR-STACK STACK-BASE DSP! ; 42 EMIT CLEAR-STACK
This paste has no annotations.