wipforth/prelude.f

: \ 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 <key> 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 <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

\ 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
2 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
  ." Welcome to 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