diff --git a/apps/forth/core.fth b/apps/forth/core.fth index 1e2be46..6aab627 100644 --- a/apps/forth/core.fth +++ b/apps/forth/core.fth @@ -1,17 +1,26 @@ : H HERE @ ; : -^ SWAP - ; -: ? @ . ; : +! SWAP OVER @ + SWAP ! ; : ALLOT HERE +! ; -: VARIABLE CREATE 2 ALLOT ; -: CONSTANT CREATE H ! DOES> @ ; : , H ! 2 ALLOT ; : C, H C! 1 ALLOT ; -: IF ['] (fbr?) , H 0 C, ; IMMEDIATE +: IF ['] (fbr?) , H 1 ALLOT ; IMMEDIATE : THEN DUP H -^ SWAP C! ; IMMEDIATE -: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE +: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE +: RECURSE R> R> 2 - >R >R EXIT ; +: ( LIT@ ) WORD SCMP IF RECURSE THEN ; IMMEDIATE +( Hello, hello, krkrkrkr... do you hear me? ) +( Ah, voice at last! Some lines above need comments ) +( IF: write (fbr?) addr, push HERE, create cell ) +( THEN: Subtract TOS from H to get offset to write to cell ) +( in that same TOS's addr ) +( ELSE: write (fbr) addr, allot, then same as THEN ) +( RECURSE: RS TOS is for RECURSE itself, then we have to dig ) +( one more level to get to RECURSE's parent's caller. ) : NOT IF 0 ELSE 1 THEN ; +: ? @ . ; +: VARIABLE CREATE 2 ALLOT ; +: CONSTANT CREATE H ! DOES> @ ; : = CMP NOT ; : < CMP 0 1 - = ; : > CMP 1 = ; -: RECURSE R> R> 2 - >R >R EXIT ; diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt index 68a4a53..230e455 100644 --- a/apps/forth/dictionary.txt +++ b/apps/forth/dictionary.txt @@ -36,7 +36,9 @@ directly, but as part of another word. ; R:I -- Exit a colon definition , n -- Write n in HERE and advance it. ' x -- a Push addr of word x to a. -['] x -- *I* Like "'", but spits the addr as a number literal. +['] x -- *I* Like "'", but spits the addr as a number + literal. +( -- *I* Comment. Ignore rest of line until ")" is read. ALLOT n -- Move HERE by n bytes C, b -- Write byte b in HERE and advance it. CREATE x -- Create cell named x. Doesn't allocate a PF. diff --git a/apps/forth/main.asm b/apps/forth/main.asm index b0e3bc8..ac24513 100644 --- a/apps/forth/main.asm +++ b/apps/forth/main.asm @@ -155,16 +155,25 @@ forthInterpret: ld (HERE), de jr forthInterpret .immed: - push hl ; --> For EXECUTE - ld hl, .retRef - ld (IP), hl - jp EXECUTE+2 + ; For this IMMEDIATE word to be compatible with regular execution model, + ; it needs to be compiled as an atom list. We need a temporary space for + ; this, let's use (OLDHERE) while it isn't used. + ex de, hl ; atom to write in DE + ld hl, (OLDHERE) + call DEinHL + ; Now, let's write the .retRef + ld de, .retRef + call DEinHL + ld iy, (OLDHERE) + jr .execIY .execute: ld de, QUIT call .writeDE ; Compilation done, let's restore (HERE) and execute! ld hl, (OLDHERE) ld (HERE), hl + ld iy, COMPBUF +.execIY: ; before we execute, let's play with our RS a bit: compiledWord is ; going to push (IP) on the RS, but we don't expect our compiled words ; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and @@ -172,21 +181,16 @@ forthInterpret: ld hl, ABORTREF ld (IP), hl ld ix, RS_ADDR-2 - ld iy, COMPBUF jp compiledWord .writeDE: push hl ld hl, (HERE) - ld (hl), e - inc hl - ld (hl), d - inc hl + call DEinHL ld (HERE), hl pop hl ret .retRef: - .dw $+2 .dw forthInterpret msgOk: