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. ; 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 ; All we need to do is to know how many bytes to copy. To do so, we
; skip compwords until EXIT is reached. ; skip compwords until EXIT is reached.
ex de, hl ; DE is our dest ld (HERE), hl ; where we write compwords.
ld l, (ix) ld l, (ix)
ld h, (ix+1) ld h, (ix+1)
.loop: .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 call HLPointsEXIT
ldi jr z, .loopend
ldi call compSkip
jr nz, .loop 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 ; HL has our new RS' TOS
ld (ix), l ld (ix), l
ld (ix+1), h ld (ix+1), h
ld (HERE), de ; update HERE ld (HERE), de ; update HERE
jp exit 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>" .db "DOES>"
.fill 3 .fill 3
.dw DEFINE .dw DEFINE
@ -334,43 +293,10 @@ DOES:
ld (HERE), iy ld (HERE), iy
jp exit 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 ) ; ( -- c )
.db "KEY" .db "KEY"
.fill 5 .fill 5
.dw LITERAL .dw DOES
KEY: KEY:
.dw nativeWord .dw nativeWord
call stdioGetC 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 call "atoms". Those atoms are most of the time word references, but they can
also be references to NUMBER and LIT. also be references to NUMBER and LIT.
*** Defining words *** *** Native Words ***
: x ... -- Define a new word : x ... -- Define a new word
; R:I -- Exit a colon definition ; R:I -- Exit a colon definition
ALLOT n -- Move HERE by n bytes . n -- Print n in its decimal form
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 ***
@ a -- n Set n to value at address a @ a -- n Set n to value at address a
! n a -- Store n in 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
* a b -- c a * b -> c * a b -- c a * b -> c
/ a b -- c a / b -> c / a b -- c a / b -> c
CREATE x -- Create cell named x. Doesn't allocate a PF.
*** I/O *** CURRENT -- n Set n to wordref of last added entry.
. n -- Print n in its decimal form DOES> -- See description at top of file
DUP a -- a a
ELSE -- Branch to THEN
EMIT c -- Spit char c to stdout 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 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 ld (HERE), hl
xor a ; set Z xor a ; set Z
ret 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 /shell/shell
/forth/forth /bshell/shell
/zasm/zasm /zasm/zasm
/zasm/avra /zasm/avra
/runbin/runbin /runbin/runbin
@ -7,4 +7,6 @@
/*/*.bin /*/*.bin
/cfsin/zasm /cfsin/zasm
/cfsin/ed /cfsin/ed
/cfsin/basic
/cfsin/forth
/cfsin/user.h /cfsin/user.h

View File

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