1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 18:30:56 +11:00

Compare commits

..

No commits in common. "e95614755b583b77d26300d32475d2e385c09b94" and "03bd9ee39b088d17df53530a8b8fb93e1aa97d22" have entirely different histories.

7 changed files with 49 additions and 265 deletions

View File

@ -243,75 +243,34 @@ DEFINE:
; been compiled by INTERPRET*. All those bytes will be copied as-is.
; 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), hl ; where we write compwords.
ld l, (ix)
ld h, (ix+1)
.loop:
call HLPointsNUMBER
jr nz, .notNUMBER
; is number
ld bc, 4
ldir
jr .loop
.notNUMBER:
call HLPointsLIT
jr nz, .notLIT
; is lit
ldi
ldi
inc hl \ inc hl
call strcpyM
inc hl ; byte after word termination
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 (HERE), 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 HLPointsEXIT
ldi
ldi
jr nz, .loop
jr z, .loopend
call compSkip
jr .loop
.loopend:
; At this point, HL points to EXIT compword. We'll copy it too.
; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2
ld e, (ix)
ld d, (ix+1)
inc hl \ inc hl ; our +2
or a ; clear carry
sbc hl, de
ld b, h
ld c, l
; BC has proper count
ex de, hl ; HL is our source (old RS' TOS)
ld de, (HERE) ; and DE is our dest
ldir ; go!
; 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
ld l, (ix)
ld h, (ix+1)
ld de, (HERE)
; continue!
jr .loop
.db "DOES>"
.fill 3
.dw DEFINE
@ -334,43 +293,10 @@ DOES:
ld (HERE), iy
jp exit
.db "IMMEDIA"
.db 0
.dw DOES
IMMEDIATE:
.dw nativeWord
ld hl, (CURRENT)
dec hl
dec hl
dec hl
inc (hl)
jp exit
; ( n -- )
.db "LITERAL"
.db 1 ; IMMEDIATE
.dw IMMEDIATE
LITERAL:
.dw nativeWord
ld hl, (HERE)
ld de, NUMBER
ld (hl), e
inc hl
ld (hl), d
inc hl
pop de ; number from stack
ld (hl), e
inc hl
ld (hl), d
inc hl
ld (HERE), hl
jp exit
; ( -- c )
.db "KEY"
.fill 5
.dw LITERAL
.dw DOES
KEY:
.dw nativeWord
call stdioGetC

View File

@ -25,49 +25,39 @@ Atom: A word of the type compiledWord contains, in its PF, a list of what we
call "atoms". Those atoms are most of the time word references, but they can
also be references to NUMBER and LIT.
*** Defining words ***
*** Native Words ***
: x ... -- Define a new word
; R:I -- Exit a colon definition
ALLOT n -- Move HERE by n bytes
CREATE x -- Create cell named x. Doesn't allocate a PF.
CONSTANT x n -- Creates cell x that when called pushes its value
DOES> -- See description at top of file
IMMEDIATE -- Flag the latest defined word as immediate.
LITERAL n -- Inserts number from TOS as a literal
VARIABLE c -- Creates cell x with 2 bytes allocation.
*** Flow ***
ELSE -- Branch to THEN
EXECUTE a -- Execute wordref at addr a
IF n -- Branch to ELSE or THEN if n is zero
INTERPRET -- Get a line from stdin, compile it in tmp memory,
then execute the compiled contents.
QUIT R:drop -- Return to interpreter promp immediately
THEN -- Does nothing. Serves as a branching merker for IF
and ELSE.
*** Stack ***
DUP a -- a a
OVER a b -- a b a
SWAP a b -- b a
*** Memory ***
. n -- Print n in its decimal form
@ a -- n Set n to value at address a
! n a -- Store n in address a
? a -- Print value of addr a
+! n a -- Increase value of addr a by n
CURRENT -- n Set n to wordref of last added entry.
HERE -- a Push HERE's address
*** Arithmetic ***
+ a b -- c a + b -> c
- a b -- c a - b -> c
* a b -- c a * b -> c
/ a b -- c a / b -> c
*** I/O ***
. n -- Print n in its decimal form
CREATE x -- Create cell named x. Doesn't allocate a PF.
CURRENT -- n Set n to wordref of last added entry.
DOES> -- See description at top of file
DUP a -- a a
ELSE -- Branch to THEN
EMIT c -- Spit char c to stdout
EXECUTE a -- Execute wordref at addr a
HERE -- a Push HERE's address
IF n -- Branch to ELSE or THEN if n is zero
QUIT R:drop -- Return to interpreter promp immediately
KEY -- c Get char c from stdin
INTERPRET -- Get a line from stdin, compile it in tmp memory,
then execute the compiled contents.
OVER a b -- a b a
SWAP a b -- b a
THEN -- Does nothing. Serves as a branching merker for IF
and ELSE.
*** Core-but-Forth Words ***
? a -- Print value of addr a
+! n a -- Increase value of addr a by n
ALLOT n -- Move HERE by n bytes
CONSTANT x n -- Creates cell x that when called pushes its value
VARIABLE c -- Creates cell x with 2 bytes allocation.

View File

@ -274,20 +274,3 @@ entryhead:
ld (HERE), hl
xor a ; set Z
ret
; Sets Z if wordref at (HL) is of the IMMEDIATE type
HLPointsIMMED:
push hl
call intoHL
dec hl
dec hl
dec hl
; We need an invert flag. We want to Z to be set when flag is non-zero.
ld a, 1
and (hl)
dec a ; if A was 1, Z is set. Otherwise, Z is unset
inc hl
inc hl
inc hl
pop hl
ret

4
emul/.gitignore vendored
View File

@ -1,5 +1,5 @@
/shell/shell
/forth/forth
/bshell/shell
/zasm/zasm
/zasm/avra
/runbin/runbin
@ -7,4 +7,6 @@
/*/*.bin
/cfsin/zasm
/cfsin/ed
/cfsin/basic
/cfsin/forth
/cfsin/user.h

View File

@ -1,10 +1,10 @@
CFSPACK_OBJ = ../tools/cfspack/libcfs.o
TARGETS = shell/shell zasm/zasm runbin/runbin forth/forth
TARGETS = shell/shell zasm/zasm runbin/runbin
KERNEL = ../kernel
APPS = ../apps
ZASMBIN = zasm/zasm
AVRABIN = zasm/avra
SHELLAPPS = zasm ed
SHELLAPPS = zasm ed forth
SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
OBJS = emul.o libz80/libz80.o
@ -24,15 +24,6 @@ shell/shell-bin.h: shell/shell.bin
shell/shell: shell/shell.c $(SHELLOBJS) shell/shell-bin.h
$(CC) shell/shell.c $(SHELLOBJS) -o $@
forth/forth.bin: forth/glue.asm $(ZASMBIN)
$(ZASMBIN) $(KERNEL) $(APPS) < forth/glue.asm | tee $@ > /dev/null
forth/forth-bin.h: forth/forth.bin
./bin2c.sh KERNEL < forth/forth.bin | tee $@ > /dev/null
forth/forth: forth/forth.c $(OBJS) forth/forth-bin.h
$(CC) forth/forth.c $(OBJS) -o $@
zasm/kernel-bin.h: zasm/kernel.bin
./bin2c.sh KERNEL < zasm/kernel.bin | tee $@ > /dev/null

View File

@ -1,68 +0,0 @@
#include <stdint.h>
#include <stdio.h>
#include <unistd.h>
#include <termios.h>
#include "../emul.h"
#include "forth-bin.h"
// in sync with glue.asm
#define RAMSTART 0x2000
#define STDIO_PORT 0x00
static int running;
static uint8_t iord_stdio()
{
int c = getchar();
if (c == EOF) {
running = 0;
}
return (uint8_t)c;
}
static void iowr_stdio(uint8_t val)
{
if (val == 0x04) { // CTRL+D
running = 0;
} else {
putchar(val);
}
}
int main(int argc, char *argv[])
{
bool tty = isatty(fileno(stdin));
struct termios termInfo;
if (tty) {
// Turn echo off: the shell takes care of its own echoing.
if (tcgetattr(0, &termInfo) == -1) {
printf("Can't setup terminal.\n");
return 1;
}
termInfo.c_lflag &= ~ECHO;
termInfo.c_lflag &= ~ICANON;
tcsetattr(0, TCSAFLUSH, &termInfo);
}
Machine *m = emul_init();
m->ramstart = RAMSTART;
m->iord[STDIO_PORT] = iord_stdio;
m->iowr[STDIO_PORT] = iowr_stdio;
// initialize memory
for (int i=0; i<sizeof(KERNEL); i++) {
m->mem[i] = KERNEL[i];
}
// Run!
running = 1;
while (running && emul_step());
if (tty) {
printf("Done!\n");
termInfo.c_lflag |= ECHO;
termInfo.c_lflag |= ICANON;
tcsetattr(0, TCSAFLUSH, &termInfo);
emul_printdebug();
}
return 0;
}

View File

@ -1,40 +0,0 @@
.inc "ascii.h"
.equ RAMSTART 0x2000
.equ STDIO_PORT 0x00
jp init
.inc "core.asm"
.inc "str.asm"
.equ STDIO_RAMSTART RAMSTART
.equ STDIO_GETC emulGetC
.equ STDIO_PUTC emulPutC
.inc "stdio.asm"
.inc "lib/util.asm"
.inc "lib/parse.asm"
.inc "lib/ari.asm"
.inc "lib/fmt.asm"
.equ FORTH_RAMSTART STDIO_RAMEND
.inc "forth/main.asm"
.inc "forth/util.asm"
.inc "forth/stack.asm"
.inc "forth/dict.asm"
init:
di
; setup stack
ld sp, 0xffff
call forthMain
halt
emulGetC:
; Blocks until a char is returned
in a, (STDIO_PORT)
cp a ; ensure Z
ret
emulPutC:
out (STDIO_PORT), a
ret