forth.src

\ -----------------------------------------------------------------------------------------------
\ This is the source code for the VM's boot loader.
\ This file is compiled by forth-compiler.exe and an image of the VM's initial state is created.
\ It then writes that image to a file specified by -i:<filename>. The default is forth.bin.
\ The image file is read by the VM (forth.exe) when it boots.
\
\ NB: don't inline anything with a 12 (0x0C) in it ... that is RET
\ -----------------------------------------------------------------------------------------------

\ Variables mess up the disassembler, put them first

.VARIABLE. >IN
.VARIABLE. #NEG
.VARIABLE. #LEN
.VARIABLE. INPUT-FP
.VARIABLE. T1			\ These are free to use, but since any word
.VARIABLE. T2			\ might use one or more of them, there is no
.VARIABLE. T3			\ guarantee that the value won't change across words.

.EndOfVariables. \ marks the end of the variables

: (CELL)    8 ; .INLINE.
: (HERE)   16 ; .INLINE.
: (LAST)   20 ; .INLINE.
: BASE     24 ; .INLINE.
: (VHERE)  28 ; .INLINE.
: STATE    32 ; .INLINE.
: (MEM_SZ) 36 ; .INLINE.

: @	  .FETCH  ; .INLINE.
: !	  .STORE  ; .INLINE.
: C!  .CSTORE ; .INLINE.
: +	  .ADD    ; .INLINE.
: 1+  .INC    ; .INLINE.

10000 (VHERE) !

: CELL (CELL) @ ; .INLINE.
: HERE (HERE) @ ; .INLINE.
: VHERE (VHERE) @ ; .INLINE.
: C, HERE ! HERE 1+ (HERE) ! ;
: ,  HERE ! HERE CELL + (HERE) ! ;

: [ 0 STATE ! ; .IMMEDIATE.
: ] 1 STATE ! ;
: LAST (LAST) @ ;

: C-LIT	   .C-LIT .C-LIT C,   ; .INLINE.
: LIT      .C-LIT .LIT C,   ;
: SWAP		   .SWAP   ; .INLINE.
: DROP		   .DROP   ; .INLINE.
: DUP		   .DUP    ; .INLINE.
: CTYPE .C-LIT .CTYPE C,   ;
: JMP   .C-LIT .JMP   C,   ;
: JMPZ  .C-LIT .JMPZ  C,   ;
: JMPNZ .C-LIT .JMPNZ C,   ;
: CALL		   11 C,   ;
: RET		   12 C,   ;
: OR		.OR ; .INLINE.
: C@		.CFETCH ; .INLINE.
: -			.SUB ; .INLINE.
: *			.MUL ; .INLINE.
: /			.DIV ; .INLINE.
: <			.LT ; .INLINE.
: =			[  22 C, ] ; .INLINE.
: >			[  23 C, ] ; .INLINE.
: DICTP		   24 C,   ; .INLINE.
: EMIT		[  25 C, ] ; .INLINE.
: OVER		[  26 C, ] ; .INLINE.
: COMPARE	[  27 C, ] ; .INLINE.
: FOPEN		[  28 C, ] ; .INLINE.
: FREAD		[  29 C, ] ; .INLINE.
: FREADLINE	[  30 C, ] ; .INLINE.
: FWRITE	[  31 C, ] ; .INLINE.
: FCLOSE	[  32 C, ] ; .INLINE.
: >R		[  33 C, ] ; .INLINE.
: R>		[  34 C, ] ; .INLINE.
: COM       [  35 C, ] ; .INLINE.
: AND		[  36 C, ] ; .INLINE.
: PICK		[  37 C, ] ; .INLINE.
: DEPTH		[  38 C, ] ; .INLINE.
: GETCH		[  39 C, ] ; .INLINE.
: COMPAREI	[  40 C, ] ; .INLINE.
: /MOD		[  41 C, ] ; .INLINE.	\ SLASHMOD ( n1 n2 -- r q )
: NOT		[  42 C, ] ; .INLINE.
: RFETCH	[  43 C, ] ; .INLINE.
: INC		[  44 C, ] ; .INLINE.
: RDEPTH	[  45 C, ] ; .INLINE.
: DEC		[  46 C, ] ; .INLINE.
: TIMER	[  47 C, ] ; .INLINE.
: LSHIFT    [  48 C, ] ; .INLINE.	\ SHIFTLEFT  ( n1 n2 -- n3 )
: RSHIFT    [  49 C, ] ; .INLINE.	\ SHIFTRIGHT ( n1 n2 -- n3 )
: +!        [  50 C, ] ; .INLINE.   \ ( n addr -- )
: OPEN-BLOCK [  51 C, ] ; .INLINE.   \ ( n -- fp int )
: GOTOXY    [  52 C, ] ; .INLINE.	\ ( x y -- )
: >SRC      [ 53 C, ] ; .INLINE.
: SRC?      [ 54 C, ] ; .INLINE.
: SRC+      [ 55 C, ] ; .INLINE.
: SRC+1     [ 56 C, ] ; .INLINE.
: >DST      [ 57 C, ] ; .INLINE.
: DST?      [ 58 C, ] ; .INLINE.
: DST+      [ 59 C, ] ; .INLINE.
: DST+1     [ 60 C, ] ; .INLINE.
: XOR       [ 61 C, ] ; .INLINE.
: NOP		[ 252 C, ] ; .INLINE.
: BREAK		[ 253 C, ] ; .INLINE.
: RESET		[ 254 C, ] ; .INLINE.
: BYE		[ 255 C, ] ; .INLINE.

: INLINE    LAST 2 CELL * + DUP C@ 2 OR SWAP C! ;
: IMMEDIATE LAST 2 CELL * + DUP C@ 1 OR SWAP C! ;
: CELLS CELL * ; INLINE

: FLAG_IMMEDIATE 1 ; INLINE
: FLAG_INLINE    2 ; INLINE

: HEX     16 BASE ! ;
: DECIMAL 10 BASE ! ;
: OCTAL    8 BASE ! ;
: BINARY   2 BASE ! ;

: ON  1 SWAP ! ;
: OFF 0 SWAP ! ;

: ?COMPILING STATE @ ;

: IF   ?COMPILING .IF JMPZ HERE 0 ,                   .THEN ; IMMEDIATE
: ELSE ?COMPILING .IF JMP  HERE 0 , SWAP HERE  SWAP ! .THEN ; IMMEDIATE
: THEN ?COMPILING .IF                    HERE  SWAP ! .THEN ; IMMEDIATE

: BEGIN ?COMPILING IF HERE    THEN ;    IMMEDIATE 
: AGAIN ?COMPILING IF JMP   , THEN ;    IMMEDIATE
: WHILE ?COMPILING IF JMPNZ , THEN ;    IMMEDIATE
: UNTIL ?COMPILING IF JMPZ  , THEN ;    IMMEDIATE
: LEAVE ?COMPILING IF RET     THEN ;    IMMEDIATE

: MEM_SZ (MEM_SZ) @ ;

: R@ RFETCH ; INLINE
: RDROP R> DROP   ; INLINE

: ?DUP DUP IF DUP THEN ;
: 2DUP  OVER OVER ; INLINE
: 2DROP DROP DROP ; INLINE
: TUCK  SWAP OVER ; INLINE
: NIP   SWAP DROP ; INLINE
: ROT   >R SWAP R> SWAP ; INLINE
: -ROT  SWAP >R SWAP R> ; INLINE
: /   /MOD NIP  ;   INLINE    \ ( n1 n2 -- q )
: MOD /MOD DROP ;   INLINE    \ ( n1 n2 -- r )

: 1+ INC ; INLINE
: 1- DEC ; INLINE

: 2* 2 * ; INLINE 
: 2/ 2 / ; INLINE

: += OVER @      + SWAP ! ;  INLINE  \ ( addr n -- )
: -= OVER @ SWAP - SWAP ! ;  INLINE  \ ( addr n -- )

: -!  SWAP -=  ;   \ ( n addr -- )

: ++   1 SWAP +! ;  INLINE  \ ( addr -- )
: --  -1 SWAP +! ;  INLINE  \ ( addr -- )

: C++ DUP C@ 1+ SWAP C! ;  INLINE  \ ( addr -- )
: C-- DUP C@ 1- SWAP C! ;  INLINE  \ ( addr -- )

: 0= NOT  ; INLINE
: <> = 0= ; INLINE
: <= > 0= ; INLINE
: >= < 0= ; INLINE

: TRUE -1 ; INLINE
: FALSE 0 ; INLINE

: COUNT DUP 1+ SWAP C@ ;		\ ( addr1 --  addr2 num )

: TYPE
    BEGIN
        DUP 0= IF
            2DROP LEAVE
        THEN
        SWAP DUP C@ EMIT 1+ 
        SWAP 1-
    AGAIN ;

: CT COUNT TYPE ;

: \ 0 >IN @ C! ; IMMEDIATE

: ( 
    BEGIN 
        >IN @ C@ 
        DUP 0= IF 
            S" missing closing ')'" CT RESET
        THEN
        >IN ++
        ')' = 
    UNTIL ; IMMEDIATE

: SPACE #32 EMIT ; INLINE
: BL SPACE       ; INLINE
: CRLF #13 EMIT #10 EMIT ; INLINE
: CR CRLF ; INLINE

: BETWEEN											\ ( num min max -- int )
    2 PICK < IF 
        2DROP FALSE LEAVE 
    THEN
    < 0= ;

: skipWS               								\ ( addr1 -- addr2 )
    BEGIN
        DUP C@ DUP
        IF
            #32 > 
            IF LEAVE ELSE 1+ THEN
        ELSE
            DROP LEAVE
        THEN
    AGAIN
;

: to-upper  \ ( c1 -- c2 )
     DUP 'a' < IF LEAVE THEN
     DUP 'z' > IF LEAVE THEN
     $20 - ;

: to-lower  \ ( c1 -- c2 )
     DUP 'A' < IF LEAVE THEN
     DUP 'Z' > IF LEAVE THEN
     $20 + ;

: char-find \ ( ch str -- pos|-1 )
     SWAP T2 ! 0 >R COUNT
    BEGIN
          DUP 0= IF 2DROP RDROP -1 LEAVE THEN
        OVER C@ T2 @ = IF 2DROP R> LEAVE THEN
          R> 1+ >R
        1- SWAP 1+ SWAP
    AGAIN ;

: getOneWord										\ ( addr1 -- word-addr addr2 )
    \ NB: this word assumes that 
    \ leading WS has already been skipped.
    DUP >R >R
    BEGIN
        R@ C@ #32 > IF
            R> 1+ >R
        ELSE
            \ If not at the end of the line, stick a 
            \ ZERO here and go to the next char.
            R@ C@ 
            IF
                0 R@ C! R> 1+ >R
            THEN
            R> R> SWAP LEAVE
        THEN
    AGAIN
;

: DICT>NEXT ;
: DICT>XT     CELL + ;
: DICT>FLAGS  2 CELLS + ;
: DICT>NAME   DICT>FLAGS 1+ ;

: NEXT>DICT ;
: XT>DICT     CELL - ;
: FLAGS>DICT  2 CELLS - ;
: NAME>DICT   1- 2 CELLS - ;

: DICT.GetXT DICT>XT @ ;
: DICT.GetFLAGS DICT>FLAGS C@ ;

: DICTP>NAME 1+ @ DICT>NAME ;

: XT.GetDICTP 						\ ( XT -- dictp )
    DUP C@ [ C-LIT DICTP ] = 
    IF
        1+ @
    ELSE
        RESET
    THEN
;

: FLAGS.ISIMMEDIATE? FLAG_IMMEDIATE AND ;
: FLAGS.ISINLINE?    FLAG_INLINE    AND ;

: DICT.GetIMMEDIATE DICT.GetFLAGS FLAGS.ISIMMEDIATE? ;
: DICT.GetINLINE    DICT.GetFLAGS FLAGS.ISINLINE? ;

: findInDict						\ ( addr -- XT IMM int )
    LAST >R
    BEGIN
        R@ DUP
        IF
            \ addr is a null-termnated string with no count byte
            DICT>NAME 1+ OVER COMPAREI
            IF
                DROP R@ DICT.GetXT R> DICT.GetFLAGS 1
                LEAVE
            THEN
        ELSE
            2DROP R> 0 0 LEAVE
        THEN
        R> @ >R
    AGAIN
;

: is-num-char?				\ ( base ch -- val int )
     to-upper
     SWAP >R
     S" 0123456789ABCDEF"
     char-find DUP 0 < IF 0 RDROP LEAVE THEN     
     R> 1- OVER < IF 0 ELSE 1 THEN ;

: NEGATE 0 SWAP - ;
: ABS DUP 0 < IF NEGATE THEN ;

: parse-char 			\ ( addr -- num int )
    DUP 1+  C@ ''' <> IF 0   LEAVE   THEN
    DUP 2 + C@        IF 0 ELSE C@ 1 THEN ;

: isNumber?				\ ( addr -- num int )
    \ 'c' means it's a character literal
    DUP C@ ''' = IF 1+ parse-char LEAVE THEN

    BASE @ T3 !
    \ $xxx means it could be a HEX number
    DUP C@ '$' = IF 1+ $10 T3 ! THEN
    DUP C@ '#' = IF 1+ #10 T3 ! THEN
    DUP C@ '%' = IF 1+ %10 T3 ! THEN

    \ find out if it is negative (BASE 10 only)
    #NEG OFF 
    T3 @ 10 = IF DUP C@ '-' = DUP #NEG ! IF 1+ THEN THEN

    \ accumulate the result on the return stack
    0 >R
    BEGIN
        DUP C@
        DUP 0 = \ end of word?
        IF 
            2DROP R> 
            #NEG @ IF NEGATE THEN
            1 LEAVE
        THEN

        T3 @ SWAP is-num-char?
        \ isNumChar?
        IF
            R> T3 @ * + >R
            1+
        ELSE
            DROP R> 0 LEAVE
        THEN
    AGAIN ;

: <# #NEG OFF #LEN OFF DUP 0 < IF NEGATE #NEG ON THEN 0 SWAP ;  \ ( u1 -- 0 u2 )
: # BASE @ /MOD SWAP '0' + DUP '9' > IF 7 + THEN #LEN ++ SWAP ; \  ( u1 -- c u2 )
: #S BEGIN # DUP 0= UNTIL ;                  \  ( u1 -- u2 )
: #> ;
: #P- DROP #NEG @ IF '-' EMIT THEN ;
: #P #P- BEGIN EMIT DUP 0= UNTIL DROP ;      \ ( 0 ... n 0 -- )

: (.) <# #S #> #P ;
: . (.) SPACE ;
: .2 <# # # #> #P ;
: .3 <# # # # #> #P ;
: .4 <# # # # # #> #P ;

HEX 
: HEX.      BASE @ SWAP HEX (.) BASE ! ; 
: HEX.2     BASE @ SWAP HEX .2 BASE ! ; 
: HEX.4     BASE @ SWAP HEX .4 BASE ! ; 
: DECIMAL.  BASE @ SWAP DECIMAL (.) BASE ! ;
: DECIMAL.3 BASE @ SWAP DECIMAL .3  BASE ! ;
: BINARY.   BASE @ SWAP BINARY  (.) BASE ! ;
DECIMAL

: MIN 2DUP > IF SWAP THEN DROP ; 
: MAX 2DUP < IF SWAP THEN DROP ; 

: .S 
    BL DEPTH 0 < 
    IF S" Stack underflow!" COUNT TYPE RESET THEN
    DEPTH 0 =
    IF '(' EMIT 237 EMIT ')' EMIT LEAVE THEN
    '(' EMIT SPACE
    DEPTH 1- >R
    BEGIN 
        R@ PICK . R@ 
        IF
            R> 1- >R
        ELSE
            RDROP ')' EMIT LEAVE
        THEN
    AGAIN
;


: .(MEM_SZ) S" Memory: " CT MEM_SZ DUP HEX. S"  (" CT (.) S" )" CT ;
: .(HERE)   S" HERE: "   CT HERE   DUP HEX. S"  (" CT (.) S" )" CT ;
: .(VHERE)  S" VHERE: "  CT VHERE  DUP HEX. S"  (" CT (.) S" )" CT ;
: .(LAST)   S" LAST: "   CT LAST   DUP HEX. S"  (" CT (.) S" )" CT ;

: .WORD-SHORT DUP DICT>NAME CT BL @ ;
: WORDS LAST BEGIN DUP @ 0= IF DROP CRLF LEAVE THEN .WORD-SHORT AGAIN ;

: .WORD-LONG  
        DUP HEX. ':' EMIT BL
        DUP DICT>NAME CT BL
        DUP DICT.GetXT 40 EMIT HEX.4 41 EMIT \ DEBUG
        DUP DICT>FLAGS C@ \ DEBUG
        DUP S" , Flags: " CT HEX.2 \ DEBUG
        DUP FLAGS.ISINLINE? IF S"  (INLINE)" CT THEN \ DEBUG
        FLAGS.ISIMMEDIATE? IF S"  (IMMEDIATE)" CT THEN \ DEBUG
        CRLF @ ;

: WORDSV .(LAST) CRLF LAST BEGIN DUP @ 0= IF DROP CRLF LEAVE THEN .WORD-LONG  AGAIN ;

: NUM-WORDS 0 >R LAST BEGIN DUP @ 0= IF DROP R> CRLF LEAVE THEN R> 1+ >R @ AGAIN ;

\ Prints the last <x> words
: .lastx CR LAST SWAP
    BEGIN
            SWAP .WORD-LONG SWAP
            1- 
            DUP 
    WHILE
    DROP DROP ;

: EXECUTE RDROP >R ;		\ ( addr -- )

: find.ret			\ ( addr1 -- addr2 )
    BEGIN
        DUP C@ 
        [ C-LIT RET ] =
        IF
            LEAVE
        THEN
        1+
    AGAIN
;

: (inline)		\ ( from to -- )
    2DUP < IF SWAP THEN
    BEGIN
        DUP C@ C,
        1+ 2DUP >
    WHILE
    2DROP
;

: DOES>
    R> DUP find.ret
    DUP >R
    1+
    (inline)
;

: Copy.INLINE		\ ( XT -- )
    \ Skip over the DICTP
    DUP C@ [ C-LIT DICTP ] =
    IF 
        1+ CELL +
    THEN

    DUP find.ret
    (inline)
;

: strlen 0 SWAP 
    BEGIN
        TUCK C@ DUP
        IF
            DROP 1+ SWAP 1+ 1
        THEN
    WHILE
    NIP
;

: cstr,			\ ( start -- )
    DUP C@ 
    OVER + 1+ 1+
    (inline)
;

: [COMPILE]		\ ( XT flags -- )
    FLAGS.ISINLINE? 
    IF
        Copy.INLINE
    ELSE
        CALL ,
    THEN
;

: executeWord		\ ( addr -- )
    >R R@ findInDict \ ( addr -- XT FLAGS found )
    IF
        RDROP
        ?COMPILING
        IF
            DUP FLAGS.ISIMMEDIATE? \ Immediate?
            IF
                DROP EXECUTE
            ELSE
                [COMPILE]
            THEN
        ELSE
            DROP EXECUTE
        THEN
    ELSE             \ word not found
        2DROP        \ discard IMM and XT place holders
        R@ isNumber? \ ( addr -- num int )
        IF
            ?COMPILING
            IF
                DUP 0 255 BETWEEN
                IF
                    C-LIT C,
                ELSE
                    LIT   ,
                THEN
            THEN
        ELSE
            DROP
            S" ??" CT RESET     \ TODO: error
        THEN
        RDROP
    THEN
;

: executeInput 
    BEGIN 
        >IN @ skipWS >IN ! 
        >IN @ C@  \ <EOL>?
        IF
            >IN @ getOneWord 
            >IN ! executeWord
        ELSE
            LEAVE
        THEN
    AGAIN
;

: Pad LAST 200 - 
    DUP HERE < IF
        S" Out of Memory!" RESET
    THEN
; 

: getLine			\ ( -- addr )
    0 Pad DUP 1+ >IN ! C!

    BEGIN
        0 >IN @ C!     \ Null term
        GETCH 

        DUP #13 = IF 
            DROP Pad BL LEAVE 
        THEN

        DUP #9 = IF     \ Tab?
            DROP 32    \ Change it into a BL
        THEN

        DUP #3 = IF
            BYE
        THEN
        
        DUP #8 = IF       \ Backspace?
            Pad C@ 0 > IF 
                Pad C--
                >IN --
                DUP EMIT BL EMIT
            ELSE
                DROP
            THEN
        ELSE
            DUP #32 127 BETWEEN IF
                DUP EMIT
                >IN @ C! 
                >IN ++
                Pad C++
            ELSE
                DROP
            THEN
        THEN
    AGAIN
;

: strcpy2c			\ ( from to -- ) from is NOT counted, to is to get count byte
    DUP >R					\ from to
    0 OVER C!				\ from to (init count)
    1+ SWAP					\ to+1 from
    BEGIN
        DUP C@ DUP			\ to from ch ch
        IF					\ to from ch
            2 PICK C!		\ to from
            SWAP 1+ SWAP 1+
            R@ C++
        ELSE				\ to from ch
            ROT C! DROP
            RDROP
            LEAVE
        THEN
    AGAIN
;

: Define-Word		\ ( addr -- )
    LAST OVER strlen 2 CELLS 3 + + - 
    DUP >R >R					\ Save new LAST
    LAST R@  !  R> CELL + >R	\ NEXT
    HERE R@  !  R> CELL + >R	\ XT
    0    R@ C!  R> 1+ >R		\ IMM
    R> strcpy2c					\ LEN + NAME
    R> (LAST) !
;

: CREATE-NAME		\ ( -- )
    >IN @ skipWS >IN ! 
    >IN @ C@ 
    IF
        >IN @ getOneWord >IN ! 
        DUP C@
        IF
            Define-Word
            DICTP
            LAST ,
        ELSE
            RESET
        THEN
    THEN
;

: : CREATE-NAME STATE ON ;
: :NONAME HERE STATE ON ;

: ;
    RET
    STATE OFF
; IMMEDIATE

: ForgetLast 				\ Forgets the last word
    LAST CELL + @ (HERE) ! 
    LAST @ (LAST) ! ;

: close-input INPUT-FP @ FCLOSE 0 INPUT-FP ! ;

: resetState 
    ?COMPILING IF ForgetLast THEN 
    DECIMAL STATE OFF
    close-input ;

: ALLOT HERE + (HERE) ! ;

: ? @ . ;		\ ( addr -- )
: C? C@ . ;		\ ( addr -- )

: FREE LAST HERE - ;
: .FREE FREE (.) S"  bytes free." CT ;

\ ------------------------------------------------------------------------------------
: file-getLine		\ ( fp -- addr num-read )
    Pad SWAP 200 SWAP
    FREADLINE \ ( addr sz fp -- num-read )
    Pad SWAP
    \ Pad CT CR \ DEBUG
    ;

: load-sub 		\ (  -- ) 
    \ S" [loading]" CT .S
    BEGIN
        INPUT-FP @ file-getLine
        IF
            1+ >IN !
            \ >IN @ C@ .
            executeInput
        ELSE
            DROP
            close-input
            LEAVE
        THEN
    AGAIN ;

: load-file \ ( filename -- ) 
    close-input
    0 0 FOPEN
    0= IF
        S" Cannot open file." CT 
        DROP LEAVE
    THEN
    INPUT-FP !
    load-sub ;

: LOAD  		\ ( block# -- ) 
    INPUT-FP @ >R \ close-input 
    OPEN-BLOCK
    IF
        INPUT-FP ! load-sub
        close-input R> INPUT-FP !
    ELSE
        S" Cannot open block file." CT 
        DROP
        R> INPUT-FP !
    THEN ;

\ ( n1 n2 -- )
: THRU SWAP
    BEGIN
        2DUP < IF 2DROP LEAVE THEN
        DUP -ROT
        >R >R LOAD R> R> 1+
    AGAIN ;

\ ******************************************************************************************
: STR.EMPTY 0 OVER C! ; INLINE          \ ( addr -- addr )
: STR.LEN DUP C@      ; INLINE          \ ( addr -- addr len )
: STR.END DUP C@ + 1+ ; INLINE          \ ( addr -- addr2 )
: STR.NULLTERM 0 OVER STR.END 1+ C! ;   \ ( addr -- addr )
: STR.CATC OVER STR.END C! DUP C++      \ ( addr ch -- addr )
    STR.NULLTERM ;


\ ******************************************************************************************
\ String literals
: cq             \ ( --addr )
    VHERE STR.EMPTY
    BEGIN
        >IN @ C@ >IN ++            \ ( addr--addr ch )
        DUP 0= IF
            S" missing closing quote" CT RESET
        THEN
        DUP '"' = IF DROP          \ ( addr ch--addr )
            ?COMPILING IF
                LIT ,              \ ( -- )
                VHERE C@ 2 + VHERE + (VHERE) !
            THEN
            LEAVE 
        THEN
        STR.CATC                   \ ( addr ch--addr )
    AGAIN ;

: " cq ; IMMEDIATE
: ." cq ?COMPILING IF .C-LIT .CTYPE C, ELSE CT THEN ; IMMEDIATE

: sys-info
    .(MEM_SZ) 44 EMIT BL
    .(HERE)   44 EMIT BL 
    .(VHERE)  44 EMIT BL 
    .(LAST)   44 EMIT BL
    .FREE CR ;

: VARIABLE  CREATE-NAME HERE 2 + CELL + LIT , RET 0 , ;

: bench-loop BEGIN 1- DUP WHILE DROP ;
: bench TIMER >SRC bench-loop TIMER SRC? - . ;
: mil 1000 DUP * * ;
: xx S" running bench: " CT 5 mil bench ;

: mainLoop 
    resetState 
    BEGIN 
        ?COMPILING 0= IF S"  OK" CT .S THEN
        CRLF getLine 1+ >IN ! 
        executeInput BL 
    AGAIN ;

: main STATE @ 99 = IF STATE OFF S" Hello." CT THEN mainLoop ;

xx CR \ main
\ 1 LOAD

\ --------------------------------------------------------------------------------
sys-info

\ This is so that forth-dis behaves as it should
99 STATE !