diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index 20992d0..f379112 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -242,71 +242,35 @@ DEFINE: ; All we need to do is to know how many bytes to copy. To do so, we ; skip compwords until EXIT is reached. ex de, hl ; DE is our dest + ld (HERE), de ; update HERE ld l, (ix) ld h, (ix+1) .loop: - call HLPointsNUMBER - jr nz, .notNUMBER - ; is number - ld bc, 4 - ldir + call HLPointsEXIT + jr z, .loopend + call compSkip jr .loop -.notNUMBER: - call HLPointsLIT - jr nz, .notLIT - ; is lit - ldi - ldi - call strcpyM - jr .loop -.notLIT: - ; it's a word - call HLPointsIMMED - jr nz, .notIMMED - ; Immediate word, we'll have to call it. - ; Before we make our call, let's save our current HL/DE position - ld (CMPDST), de - ld e, (hl) - inc hl - ld d, (hl) - inc hl ; point to next word - push de \ pop iy ; prepare for executeCodeLink - ld (ix), l - ld (ix+1), h - ; Push return address - ld hl, .retList - call pushRS - ; Ready! - jp executeCodeLink -.notIMMED: - ; a good old regular word. We have 2 bytes to copy. But before we do, - ; let's check whether it's an EXIT. LDI doesn't affect Z, so we can - ; make our jump later. - call HLPointsEXITQUIT - ldi - ldi - jr nz, .loop - ; HL has our new RS' TOS - ld (ix), l - ld (ix+1), h - ld (HERE), de ; update HERE - jp exit - -; This label is pushed to RS when an IMMED word is called. When that word calls -; exit, this is where it returns. When we return, RS will need to be popped so -; that we stay on the proper RS level. -.retList: - .dw .retWord -.retWord: - .dw .retEntry -.retEntry: - call popRS ; unwind stack - ; recall old HL / DE values +.loopend: + ; skip EXIT + inc hl \ inc hl + ; We have out end offset. Let's get our offset + ld e, (ix) + ld d, (ix+1) + or a ; clear carry + sbc hl, de + ; HL is our copy count. + ld b, h + ld c, l ld l, (ix) ld h, (ix+1) - ld de, (CMPDST) - ; continue! - jr .loop + ld de, (HERE) ; recall dest + ; copy! + ldir + ld (ix), l + ld (ix+1), h + ld (HERE), de + jp exit + .db "DOES>" .fill 3 diff --git a/apps/forth/main.asm b/apps/forth/main.asm index 42669d9..a793218 100644 --- a/apps/forth/main.asm +++ b/apps/forth/main.asm @@ -123,7 +123,9 @@ forthInterpret: .retRef: .dw $+2 - .dw forthInterpret + .dw $+2 + call popRS + jr forthInterpret msgOk: .db " ok", 0 diff --git a/apps/forth/util.asm b/apps/forth/util.asm index b0720d8..d504539 100644 --- a/apps/forth/util.asm +++ b/apps/forth/util.asm @@ -69,14 +69,28 @@ HLPointsLIT: pop de ret -HLPointsEXITQUIT: +HLPointsBRANCH: + push de + ld de, BRANCH + call HLPointsDE + jr z, .end + ld de, CBRANCH + call HLPointsDE +.end: + pop de + ret + +HLPointsEXIT: push de ld de, EXIT call HLPointsDE - jr z, .end + pop de + ret + +HLPointsQUIT: + push de ld de, QUIT call HLPointsDE -.end: pop de ret @@ -85,7 +99,9 @@ HLPointsEXITQUIT: ; to after null-termination. compSkip: call HLPointsNUMBER - jr z, .isNum + jr z, .isNumOrBranch + call HLPointsBRANCH + jr z, .isNumOrBranch call HLPointsLIT jr nz, .isWord ; We have a literal @@ -93,7 +109,7 @@ compSkip: call strskip inc hl ; byte after word termination ret -.isNum: +.isNumOrBranch: ; skip by 4 inc hl \ inc hl ; continue to isWord @@ -160,7 +176,11 @@ readLIT: ; it's a word. call HLPointsNUMBER jr z, .notWord - call HLPointsEXITQUIT + call HLPointsBRANCH + jr z, .notWord + call HLPointsEXIT + jr z, .notWord + call HLPointsQUIT jr z, .notWord ; Not a number, then it's a word. Copy word to pad and point to it. push hl ; --> lvl 1. we need it to set DE later