: \ KEY 10 = 0BRANCH [ -20 , ] ; IMMEDIATE \ Now we have line comments :) \ Conditionals : IF LIT 0BRANCH , HERE @ 0 , ; IMMEDIATE : THEN DUP HERE @ SWAP - SWAP ! ; IMMEDIATE : ELSE LIT BRANCH , HERE @ 0 , SWAP DUP HERE @ SWAP - SWAP ! ; IMMEDIATE \ Loops : BEGIN HERE @ ; IMMEDIATE : UNTIL LIT 0BRANCH , HERE @ - , ; IMMEDIATE : AGAIN LIT BRANCH , HERE @ - , ; IMMEDIATE \ Recursive calls : RECURSE LATEST @ >CFA , ; IMMEDIATE \ Block comments (with nesting) : ( BEGIN KEY DUP 40 = IF RECURSE THEN 41 = UNTIL ; IMMEDIATE ( ( Take that, C ) ) \ Printing utilities : CR 10 EMIT ; : SPACE 32 EMIT ; : CHAR KEY STATE @ 0<> IF LIT LIT , , \ Append LIT to definition if compiling THEN ; IMMEDIATE : EMIT-DIGIT DUP 10 < IF CHAR 0 ELSE 10 - CHAR A THEN + EMIT ; : . \ Handle negatives DUP 0< IF CHAR - EMIT NEGATE THEN \ Determine starting place value 1 BEGIN BASE @ * 2DUP / 0= UNTIL \ Print leading non-zero digits BEGIN BASE @ / 2DUP / EMIT-DIGIT TUCK MOD SWAP OVER 0= UNTIL \ Print any trailing zeros BASE @ / DUP 0<> IF BEGIN CHAR 0 EMIT BASE @ / DUP 0= UNTIL THEN 2DROP ; : TYPE ( addr len -- ) BEGIN DUP 0= IF 2DROP EXIT THEN SWAP DUP C@ EMIT 1+ SWAP 1- AGAIN ; : C, HERE @ C! 1 HERE +! ; : ." STATE @ IF LIT BRANCH , \ Compile BRANCH for jumping over string data HERE @ 0 , \ Compile placeholder offset and push offset cell address 0 BEGIN KEY DUP CHAR " = IF DROP HERE @ ALIGN HERE ! \ Pad to alignment SWAP DUP HERE @ SWAP - \ Compute offset OVER ! \ Update branch offset to skip data 4+ LIT LIT , , \ Append LIT LIT LIT , , \ Append LIT LIT TYPE , \ Append TYPE EXIT THEN C, 1+ \ Write byte and increment length AGAIN ELSE BEGIN KEY DUP CHAR " = IF DROP EXIT THEN EMIT AGAIN THEN ; IMMEDIATE \ Misc utilities : NIP SWAP DROP ; : HEX 16 BASE ! ; : DECIMAL 10 BASE ! ; : ' WORD FIND DUP 0<> IF >CFA ELSE DROP WNFHOOK EXECUTE THEN ; : [COMPILE] ' , ; IMMEDIATE \ Constants, variables and values : CONSTANT WORD CREATE DOCOL , LIT LIT , , LIT EXIT , ; : VARIABLE WORD CREATE DOVAR , 0 , ; : VALUE WORD CREATE DOVAL , , ; : TO ' 4+ STATE @ IF LIT LIT , , LIT ! , ELSE ! THEN ; IMMEDIATE \ Peripheral register addresses HEX 000 CONSTANT TXBUF 080 CONSTANT RXBUF 100 CONSTANT TXHEAD 104 CONSTANT TXTAIL 108 CONSTANT RXHEAD 10C CONSTANT RXTAIL 110 CONSTANT SYSREADY 114 CONSTANT SYSINTER DECIMAL \ A better word-not-found handler : ANY-RX? RXHEAD AC@ RXTAIL AC@ <> ; : WNF-HANDLER ." Unknown word: " WORDBUF SWAP TYPE CR STATE @ IF \ Remove incomplete definition and switch back to interpret mode LATEST @ HERE ! LATEST @ @ LATEST ! [COMPILE] [ THEN \ We only consume to the next newline if there is RX data available, \ because if the offending word was at the end of the line then the \ newline would have already been consumed by WORD. ANY-RX? IF BEGIN KEY 10 = UNTIL THEN QUIT ; ' WNF-HANDLER TO WNFHOOK \ Version number 0 CONSTANT VERSION-MAJOR 2 CONSTANT VERSION-MINOR 1 CONSTANT VERSION-PATCH : PRINT-VERSION CHAR v EMIT VERSION-MAJOR . CHAR . EMIT VERSION-MINOR . CHAR . EMIT VERSION-PATCH . ; \ Welcome banner : BANNER ." _ __ " CR ." _ __(_)__ ___ / / " CR ." | |/|/ / / _ \_ (_-./ _ \" CR ." |__,__/_/ .__(_)___/_//_/" CR ." /_/ " CR CR ." Wipforth " PRINT-VERSION CR ." Copyright (c) Camden Dixie O'Brien" CR CR ." Wipforth is freely available to use, modify and distribute for personal use" CR ." under the Komorebi license, version 2.0.0." CR CR ; \ Set SYSREADY high and wait until interactive 1 SYSREADY AC! SYSINTER WAIT DROP BANNER