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.
e95614755b
...
03bd9ee39b
@ -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
|
||||||
|
@ -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.
|
||||||
|
@ -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
4
emul/.gitignore
vendored
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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;
|
|
||||||
}
|
|
@ -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
|
|
Loading…
Reference in New Issue
Block a user