diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index a5478a3..785a200 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ diff --git a/forth/forth.asm b/forth/forth.asm index fa708fb..65c51b0 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -66,6 +66,8 @@ .equ CINPTR @+2 ; Pointer to (emit) word .equ EMITPTR @+2 +; Pointer to (print) word +.equ PRINTPTR @+2 .equ WORDBUF @+2 ; Sys Vars are variables with their value living in the system RAM segment. We ; need this mechanisms for core Forth source needing variables. Because core @@ -151,6 +153,10 @@ forthMain: ld hl, .emitName call find ld (EMITPTR), de + ; Set up PRINTPTR + ld hl, .printName + call find + ld (PRINTPTR), de ; Set up CINPTR ; do we have a (c<) impl? ld hl, .cinName @@ -174,6 +180,8 @@ forthMain: .db "(c<)", 0 .emitName: .db "(emit)", 0 +.printName: + .db "(print)", 0 .keyName: .db "KEY", 0 @@ -195,7 +203,7 @@ INTERPRET: .dw DROP .dw EXECUTE -.fill 31 +.fill 13 ; *** Collapse OS lib copy *** ; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to @@ -681,8 +689,11 @@ abortUnderflow: .word: .dw compiledWord .dw LIT - .db "stack underflow", 0 - .dw PRINT + .db "stack underfl", 0 + .dw NUMBER + .dw PRINTPTR + .dw FETCH + .dw EXECUTE .dw ABORT .db "BYE" @@ -692,6 +703,9 @@ BYE: .dw nativeWord halt +; STABLE ABI +; Offset: 02aa +.out $ ; ( c -- ) .db "EMIT" .dw $-BYE @@ -705,43 +719,10 @@ EMIT: .dw EXIT - .db "(print)" - .dw $-EMIT - .db 7 -PRINT: - .dw compiledWord ; a - ; BBR mark - .dw DUP ; a a - .dw .getc ; a c - .dw DUP ; a c f - .dw CSKIP ; a c - ; zero, end of string - .dw FBR - .db 12 - .dw EMIT ; a - .dw NUMBER ; a 1 - .dw 1 - .dw PLUS ; a+1 - .dw BBR - .db 21 - ; FBR mark - .dw DROP - .dw DROP - .dw EXIT - -; Yes, very much like C@, but it has already been Forth-ified... -.getc: - .dw nativeWord - pop hl - call chkPS - ld l, (hl) - ld h, 0 - push hl - jp next - +.fill 49 .db "C," - .dw $-PRINT + .dw $-EMIT .db 2 CWR: .dw nativeWord diff --git a/forth/icore.fs b/forth/icore.fs index e042293..713babf 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -61,6 +61,18 @@ (parsed) SKIP? ABORT ; +( a -- ) +: (print) + BEGIN + DUP ( a a ) + _c C@ ( a c ) + ( exit if null ) + DUP NOT IF DROP DROP EXIT THEN + EMIT ( a ) + 1 + ( a+1 ) + AGAIN +; + ( ; has to be defined last because it can't be executed now ) : X ( can't have its real name now ) ['] EXIT ,