281 lines
4.1 KiB
Forth
281 lines
4.1 KiB
Forth
76 EMIT 111 EMIT 97 EMIT 100 EMIT 105 EMIT 110 EMIT 103 EMIT 32 EMIT
|
|
112 EMIT 114 EMIT 101 EMIT 108 EMIT 117 EMIT 100 EMIT 101 EMIT 32 EMIT
|
|
|
|
: \ KEY 10 = 0BRANCH [ -20 , ] ; IMMEDIATE \ Now we have line comments :)
|
|
|
|
\ We'll periodically sprinkle these in so that it's clear to the user
|
|
\ that things are happening.
|
|
46 EMIT
|
|
|
|
\ Conditionals
|
|
|
|
: IF
|
|
LIT 0BRANCH ,
|
|
HERE @ 0 ,
|
|
; IMMEDIATE
|
|
|
|
: THEN
|
|
DUP HERE @ SWAP -
|
|
SWAP !
|
|
; IMMEDIATE
|
|
|
|
: ELSE
|
|
LIT BRANCH ,
|
|
HERE @ 0 ,
|
|
SWAP
|
|
DUP HERE @ SWAP -
|
|
SWAP !
|
|
; IMMEDIATE
|
|
|
|
46 EMIT
|
|
|
|
\ Loops
|
|
|
|
: BEGIN HERE @ ; IMMEDIATE
|
|
|
|
: UNTIL
|
|
LIT 0BRANCH ,
|
|
HERE @ - ,
|
|
; IMMEDIATE
|
|
|
|
: AGAIN
|
|
LIT BRANCH ,
|
|
HERE @ - ,
|
|
; IMMEDIATE
|
|
|
|
46 EMIT
|
|
|
|
\ Recursive calls
|
|
|
|
: RECURSE LATEST @ >CFA , ; IMMEDIATE
|
|
|
|
\ Block comments (with nesting)
|
|
|
|
: (
|
|
BEGIN
|
|
KEY DUP
|
|
40 = IF RECURSE THEN
|
|
41 =
|
|
UNTIL
|
|
; IMMEDIATE
|
|
|
|
( ( Take that, C ) )
|
|
|
|
46 EMIT
|
|
|
|
\ Printing utilities
|
|
|
|
: CR 10 EMIT ;
|
|
: SPACE 32 EMIT ;
|
|
|
|
: CHAR
|
|
KEY
|
|
STATE @ 0<> IF
|
|
LIT LIT , , \ Append LIT <key> to definition if compiling
|
|
THEN
|
|
; IMMEDIATE
|
|
|
|
: EMIT-DIGIT
|
|
DUP 10 < IF CHAR 0 ELSE 10 - CHAR A THEN
|
|
+ EMIT
|
|
;
|
|
|
|
CHAR . 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 @ / 0= UNTIL
|
|
THEN
|
|
|
|
2DROP
|
|
;
|
|
|
|
CHAR . EMIT
|
|
|
|
: TYPE ( addr len -- )
|
|
BEGIN
|
|
DUP 0= IF 2DROP EXIT THEN
|
|
SWAP DUP C@ EMIT 1+
|
|
SWAP 1-
|
|
AGAIN
|
|
;
|
|
|
|
CHAR . EMIT
|
|
|
|
: 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 <addr>
|
|
LIT LIT , , \ Append LIT <len>
|
|
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
|
|
|
|
CHAR . EMIT
|
|
|
|
\ Misc utilities
|
|
|
|
: NIP SWAP DROP ;
|
|
|
|
: HEX 16 BASE ! ;
|
|
|
|
: DECIMAL 10 BASE ! ;
|
|
|
|
: '
|
|
WORD FIND DUP 0<> IF
|
|
>CFA
|
|
ELSE
|
|
DROP WNFHOOK EXECUTE
|
|
THEN
|
|
;
|
|
|
|
: [COMPILE] ' , ; IMMEDIATE
|
|
|
|
CHAR . EMIT
|
|
|
|
\ 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
|
|
|
|
CHAR . EMIT
|
|
|
|
\ Peripheral register addresses
|
|
|
|
HEX
|
|
|
|
00 CONSTANT TXBUF
|
|
20 CONSTANT RXBUF
|
|
40 CONSTANT TXHEAD
|
|
44 CONSTANT TXTAIL
|
|
48 CONSTANT RXHEAD
|
|
4C CONSTANT RXTAIL
|
|
50 CONSTANT SYSREADY
|
|
|
|
DECIMAL
|
|
|
|
46 EMIT
|
|
|
|
\ 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
|
|
|
|
CHAR . EMIT
|
|
|
|
\ Version number
|
|
|
|
0 CONSTANT VERSION-MAJOR
|
|
1 CONSTANT VERSION-MINOR
|
|
0 CONSTANT VERSION-PATCH
|
|
|
|
: PRINT-VERSION
|
|
CHAR v EMIT VERSION-MAJOR .
|
|
CHAR . EMIT VERSION-MINOR .
|
|
CHAR . EMIT VERSION-PATCH .
|
|
;
|
|
|
|
CHAR . EMIT
|
|
|
|
\ 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
|
|
;
|
|
|
|
." done" CR
|
|
BANNER
|
|
|
|
\ Set SYSREADY high to enable user input
|
|
1 SYSREADY AC!
|