Fix interactive dodoes, fix multiply, fix tests

diff --git a/preForth/hi.forth b/preForth/hi.forth
index 4cd1091..591d07d 100644 (file)
--- a/preForth/hi.forth
+++ b/preForth/hi.forth
@@ -306,7 +306,7 @@ end-tests
 begin-tests
 
 t{ 3 4 pyth -> 5 }t
-t{ 65535 dup * sqrt -> 65535 }t
+t{ 255 dup * sqrt -> 255 }t
 
 end-tests
 
@@ -588,7 +588,7 @@ only Forth also definitions
 : th.prime ( u -- )
     1 BEGIN over WHILE 1+ dup prime? IF swap 1- swap THEN REPEAT nip ; 
 
-cr cr cr .( The ) 10001 dup . .( st prime is ) th.prime . 
+cr cr cr .( The ) 1001 dup . .( st prime is ) th.prime . 
 
 
 \ cooperative multi tasker

diff --git a/preForth/seedForth-tokenizer.fs b/preForth/seedForth-tokenizer.fs
index 3cbd559..71cb61a 100644 (file)
--- a/preForth/seedForth-tokenizer.fs
+++ b/preForth/seedForth-tokenizer.fs
@@ -76,7 +76,7 @@ Variable #tokens  0 #tokens !
 ( 44 $2C ) Token and       Token or            Token sp@        Token sp!           
 ( 48 $30 ) Token rp@       Token rp!           Token $lit       Token num
 ( 52 $34 ) Token um*       Token um/mod        Token unused     Token key?          
-( 56 $38 ) Token token     Token usleep        Token hp
+( 56 $38 ) Token token     Token usleep        Token hp         Token dodoes
 
 \ generate token sequences for numbers
 
@@ -277,4 +277,4 @@ end-macro
 Macro restore-#tokens
    postpone #tokens
    postpone !
-end-macro
\ No newline at end of file
+end-macro

diff --git a/preForth/seedForth-z80.pre b/preForth/seedForth-z80.pre
index 191b946..777cb3d 100644 (file)
--- a/preForth/seedForth-z80.pre
+++ b/preForth/seedForth-z80.pre
@@ -89,11 +89,17 @@ code emit ( c -- )
 pre
 
 key_loop:
+ ;ld a,0x2e
+ ;call print_char
        ld      a,SYSTEM_YIELD
        out     (SYSTEM_PORT),a
+ ;jr silly
 ;
 
 code key ( -- c )
+ ;ld a,0x4b
+ ;call print_char
+;silly:
        in      a,(SYSTEM_PORT)
 
        ; test SYSTEM_STDIN_EOF bit
@@ -110,6 +116,9 @@ code key ( -- c )
 key_done:
        ld      h,0
        push    hl
+ ;ld a,0x3d
+ ;call print_char
+ ;call print_hexw
        jr      next
 ;
 
@@ -332,7 +341,7 @@ code depth ( -- n )
        rr      h
        rr      l
        push    hl
-       jp next1 ;jr    next1
+       jr      next1
 ;
 
 code sp@ ( -- x )
@@ -363,21 +372,43 @@ code um* ( u1 u2 -- ud )
 
        pop     de ; pop u2
        pop     bc ; pop u1
-
-       ld      hl,0
+ ;ld l,c
+ ;ld h,b
+ ;call print_hexw
+ ;ld a,0x2a
+ ;call print_char
+ ;ld l,e
+ ;ld h,d
+ ;call print_hexw
+
+       sub     a ; clears cf
+       ld      l,a
+       ld      h,a
        ld      a,b
        ld      b,16
        or      a
 umul_loop:
-       rr      h
-       rr      l
        rra
        rr      c
        jr      nc,umul_skip
        add     hl,de ; can't overflow, leaves cf = 0
 umul_skip:
+       rr      h
+       rr      l
        djnz    umul_loop
+       rra
+       rr      c
        ld      b,a
+ ;ld a,0x3d
+ ;call print_char
+ ;push hl
+ ;call print_hexw
+ ;ld l,c
+ ;ld h,b
+ ;call print_hexw
+ ;pop hl
+ ;ld a,0xa
+ ;call print_char
 
        push    bc ; push ud lo
        push    hl ; push ud hi
@@ -392,17 +423,17 @@ code um/mod ( ud u1 -- u2 u3 )
        pop     bc ; pop u1
        pop     hl ; pop ud hi
        pop     de ; pop ud lo
- push hl
- call print_hexw
- ld l,e
- ld h,d
- call print_hexw
- ld a,0x2f
- call print_char
- ld l,c
- ld h,b
- call print_hexw
- pop hl
+; push hl
+; call print_hexw
+; ld l,e
+; ld h,d
+; call print_hexw
+; ld a,0x2f
+; call print_char
+; ld l,c
+; ld h,b
+; call print_hexw
+; pop hl
 
        ld      a,16
        or      a
@@ -429,18 +460,18 @@ udiv_cont:
        jr      nz,udiv_loop
        ex      de,hl
        adc     hl,hl ; record final quotient bit
- ld a,0x3d
- call print_char
- push hl
- call print_hexw
- ld a,0x72
- call print_char
- ld l,e
- ld h,d
- call print_hexw
- pop hl
- ld a,0xa
- call print_char
+; ld a,0x3d
+; call print_char
+; push hl
+; call print_hexw
+; ld a,0x72
+; call print_char
+; ld l,e
+; ld h,d
+; call print_hexw
+; pop hl
+; ld a,0xa
+; call print_char
 
        push    de ; push u2 (remainder)
        push    hl ; push u1 (quotient)
@@ -652,6 +683,7 @@ print_char:
    lit token       h, \ 56  38
    lit usleep      h, \ 57  39  code
    lit hp          h, \ 58  40
+   lit dodoes      h, \ 59  41
    interpreter bye ;
 
 \ pre

diff --git a/preForth/seedForthDemo.seedsource b/preForth/seedForthDemo.seedsource
index 4e2ddad..027080a 100644 (file)
--- a/preForth/seedForthDemo.seedsource
+++ b/preForth/seedForthDemo.seedsource
@@ -2,7 +2,7 @@
 \
 \ tokenize with
 \
-\ gforth seedForth-tokinzer.fs seedForthDemo.seedsource
+\ gforth seedForth-tokenizer.fs seedForthDemo.seedsource
 \
 \ then pipe into seedForth:
 \

diff --git a/preForth/seedForthInteractive.seedsource b/preForth/seedForthInteractive.seedsource
index fe7204f..21c5a79 100644 (file)
--- a/preForth/seedForthInteractive.seedsource
+++ b/preForth/seedForthInteractive.seedsource
@@ -2,7 +2,7 @@
 \
 \ tokenize with
 \
-\ gforth seedForth-tokinzer.fs seedForthInteractive.seedsource
+\ gforth seedForth-tokenizer.fs seedForthInteractive.seedsource
 \
 \ then pipe into seedForth:
 \
@@ -489,7 +489,8 @@ init
 
 \ for the input stream a struct could be defined that generally handles terminal input, evaluate, file input and others.
 
-Create tib 80 allot
+256 Constant max-line
+Create tib max-line allot
 
 Create 'source here 0 , tib ,  \ ' source is normally  ^tib #tib is set to c-addr u for evaluate
 Constant #tib
@@ -514,7 +515,7 @@ Variable input-echo -1 input-echo !
 ;
 
 : query ( -- )
-    tib 80 accept #tib ! ;
+    tib max-line accept #tib ! ;
 
 
 
@@ -856,9 +857,11 @@ Variable heads -1 heads !
 : last-xt ( -- xt )
      last @ _xt @ ;
 
+\ for z80 dtc implementation, insert "call _dodoes" after each "does>" token
 : (Does>) ( -- )
      [ ' last-xt ] Literal compile,
-     [ ' does> ] Literal compile, ; 
+     [ ' does> ] Literal compile,
+     205 c, [ ' dodoes ] Literal compile, ; 
 
 ' (Does>) has-header Does> immediate
 ' last has-header last