begin-tests
t{ 3 4 pyth -> 5 }t
-t{ 65535 dup * sqrt -> 65535 }t
+t{ 255 dup * sqrt -> 255 }t
end-tests
: 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
( 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
Macro restore-#tokens
postpone #tokens
postpone !
-end-macro
\ No newline at end of file
+end-macro
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
key_done:
ld h,0
push hl
+ ;ld a,0x3d
+ ;call print_char
+ ;call print_hexw
jr next
;
rr h
rr l
push hl
- jp next1 ;jr next1
+ jr next1
;
code sp@ ( -- x )
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
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
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)
lit token h, \ 56 38
lit usleep h, \ 57 39 code
lit hp h, \ 58 40
+ lit dodoes h, \ 59 41
interpreter bye ;
\ pre
\
\ tokenize with
\
-\ gforth seedForth-tokinzer.fs seedForthDemo.seedsource
+\ gforth seedForth-tokenizer.fs seedForthDemo.seedsource
\
\ then pipe into seedForth:
\
\
\ tokenize with
\
-\ gforth seedForth-tokinzer.fs seedForthInteractive.seedsource
+\ gforth seedForth-tokenizer.fs seedForthInteractive.seedsource
\
\ then pipe into seedForth:
\
\ 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
;
: query ( -- )
- tib 80 accept #tib ! ;
+ tib max-line accept #tib ! ;
: 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