mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 14:20:56 +11:00
Compare commits
7 Commits
2af959a13d
...
edb2771488
Author | SHA1 | Date | |
---|---|---|---|
|
edb2771488 | ||
|
7b42bbde27 | ||
|
d1f4dc0ca3 | ||
|
32b420b19c | ||
|
5be9b9cd3e | ||
|
435b4f452c | ||
|
ba384bfa0f |
62
drv/acia.fs
62
drv/acia.fs
@ -9,59 +9,12 @@ CONFIGURATION
|
|||||||
|
|
||||||
ACIA_CTL: IO port for the ACIA's control registers
|
ACIA_CTL: IO port for the ACIA's control registers
|
||||||
ACIA_IO: IO port for the ACIA's data registers
|
ACIA_IO: IO port for the ACIA's data registers
|
||||||
|
ACIA_MEM: Address in memory that can be used variables shared
|
||||||
|
with ACIA's native words. 8 bytes used.
|
||||||
)
|
)
|
||||||
|
|
||||||
0x20 CONSTANT ACIABUFSZ
|
0x20 CONSTANT ACIABUFSZ
|
||||||
|
|
||||||
( Points to ACIA buf )
|
|
||||||
(sysv) ACIA(
|
|
||||||
( Points to ACIA buf end )
|
|
||||||
(sysv) ACIA)
|
|
||||||
( Read buf pointer. Pre-inc )
|
|
||||||
(sysv) ACIAR>
|
|
||||||
( Write buf pointer. Post-inc )
|
|
||||||
(sysv) ACIAW>
|
|
||||||
( This means that if W> == R>, buffer is full.
|
|
||||||
If R>+1 == W>, buffer is empty. )
|
|
||||||
|
|
||||||
(entry) ~ACIA
|
|
||||||
AF PUSHqq,
|
|
||||||
HL PUSHqq,
|
|
||||||
DE PUSHqq,
|
|
||||||
|
|
||||||
( Read our character from ACIA into our BUFIDX )
|
|
||||||
ACIA_CTL INAn,
|
|
||||||
0x01 ANDn, ( is ACIA rcv buf full? )
|
|
||||||
JRZ, L2 FWR ( end, no, wrong interrupt cause. )
|
|
||||||
|
|
||||||
ACIAW> @ LDHL(nn),
|
|
||||||
( is it == to ACIAR>? )
|
|
||||||
DE ACIAR> @ LDdd(nn),
|
|
||||||
( carry cleared from ANDn above )
|
|
||||||
DE SBCHLss,
|
|
||||||
JRZ, L3 FWR ( end, buffer full )
|
|
||||||
|
|
||||||
( buffer not full, let's write )
|
|
||||||
ACIA_IO INAn,
|
|
||||||
(HL) A LDrr,
|
|
||||||
|
|
||||||
( advance W> )
|
|
||||||
HL INCss,
|
|
||||||
DE ACIAR) @ LDdd(nn),
|
|
||||||
DE SUBHLss,
|
|
||||||
JRNZ, L4 FWR ( skip )
|
|
||||||
( end of buffer reached )
|
|
||||||
ACIA( @ LDHL(nn),
|
|
||||||
L4 FSET ( skip )
|
|
||||||
ACIAW> @ LD(nn)HL,
|
|
||||||
L3 FSET L2 FSET ( end )
|
|
||||||
|
|
||||||
DE POPqq,
|
|
||||||
HL POPqq,
|
|
||||||
AF POPqq,
|
|
||||||
EI,
|
|
||||||
RETI,
|
|
||||||
|
|
||||||
: ACIA$
|
: ACIA$
|
||||||
H@ DUP DUP ACIA( ! ACIAR> !
|
H@ DUP DUP ACIA( ! ACIAR> !
|
||||||
1 + ACIAW> ! ( write index starts one position later )
|
1 + ACIAW> ! ( write index starts one position later )
|
||||||
@ -76,9 +29,9 @@ L3 FSET L2 FSET ( end )
|
|||||||
0b10010110 ACIA_CTL PC!
|
0b10010110 ACIA_CTL PC!
|
||||||
|
|
||||||
( setup interrupt )
|
( setup interrupt )
|
||||||
( 51 == INTJUMP )
|
( 4e == INTJUMP )
|
||||||
0xc3 0x51 RAM+ C! ( JP upcode )
|
0xc3 0x4e RAM+ C! ( JP upcode )
|
||||||
['] ~ACIA 0x52 RAM+ !
|
['] ~ACIA 0x4f RAM+ !
|
||||||
(im1)
|
(im1)
|
||||||
;
|
;
|
||||||
|
|
||||||
@ -86,14 +39,15 @@ L3 FSET L2 FSET ( end )
|
|||||||
( As long as R> == W>-1, it means that buffer is empty )
|
( As long as R> == W>-1, it means that buffer is empty )
|
||||||
BEGIN ACIAR> @ 1 + ACIAW> @ = NOT UNTIL
|
BEGIN ACIAR> @ 1 + ACIAW> @ = NOT UNTIL
|
||||||
|
|
||||||
ACIAR> @ C@
|
( inc then fetch )
|
||||||
1 ACIAR> +!
|
1 ACIAR> +!
|
||||||
|
ACIAR> @ C@
|
||||||
;
|
;
|
||||||
|
|
||||||
: EMIT
|
: EMIT
|
||||||
( As long at CTL bit 1 is low, we are transmitting. wait )
|
( As long at CTL bit 1 is low, we are transmitting. wait )
|
||||||
BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
|
BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
|
||||||
( The way is clear, go! )
|
( The way is clear, go! )
|
||||||
ACIA_IO SWAP PC!
|
ACIA_IO PC!
|
||||||
;
|
;
|
||||||
|
|
||||||
|
55
drv/acia.z80
Normal file
55
drv/acia.z80
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
( Save ACIA conf )
|
||||||
|
ACIA_CTL
|
||||||
|
: ACIA_CTL [ LITN ] ;
|
||||||
|
ACIA_IO
|
||||||
|
: ACIA_IO [ LITN ] ;
|
||||||
|
( Points to ACIA buf )
|
||||||
|
: ACIA( [ ACIA_MEM 4 + LITN ] ;
|
||||||
|
( Points to ACIA buf end )
|
||||||
|
: ACIA) [ ACIA_MEM 6 + LITN ] ;
|
||||||
|
( Read buf pointer. Pre-inc )
|
||||||
|
: ACIAR> [ ACIA_MEM LITN ] ;
|
||||||
|
( Write buf pointer. Post-inc )
|
||||||
|
: ACIAW> [ ACIA_MEM 2 + LITN ] ;
|
||||||
|
( This means that if W> == R>, buffer is full.
|
||||||
|
If R>+1 == W>, buffer is empty. )
|
||||||
|
|
||||||
|
(entry) ~ACIA
|
||||||
|
AF PUSHqq,
|
||||||
|
HL PUSHqq,
|
||||||
|
DE PUSHqq,
|
||||||
|
|
||||||
|
( Read our character from ACIA into our BUFIDX )
|
||||||
|
ACIA_CTL INAn,
|
||||||
|
0x01 ANDn, ( is ACIA rcv buf full? )
|
||||||
|
JRZ, L2 FWR ( end, no, wrong interrupt cause. )
|
||||||
|
|
||||||
|
ACIAW> LDHL(nn),
|
||||||
|
( is it == to ACIAR>? )
|
||||||
|
DE ACIAR> LDdd(nn),
|
||||||
|
( carry cleared from ANDn above )
|
||||||
|
DE SBCHLss,
|
||||||
|
JRZ, L3 FWR ( end, buffer full )
|
||||||
|
|
||||||
|
DE ADDHLss, ( restore ACIAW> )
|
||||||
|
( buffer not full, let's write )
|
||||||
|
ACIA_IO INAn,
|
||||||
|
(HL) A LDrr,
|
||||||
|
|
||||||
|
( advance W> )
|
||||||
|
HL INCss,
|
||||||
|
ACIAW> LD(nn)HL,
|
||||||
|
DE ACIA) @ LDdd(nn),
|
||||||
|
DE SUBHLss,
|
||||||
|
JRNZ, L4 FWR ( skip )
|
||||||
|
( end of buffer reached )
|
||||||
|
ACIA( @ LDHL(nn),
|
||||||
|
ACIAW> LD(nn)HL,
|
||||||
|
L4 FSET ( skip )
|
||||||
|
L3 FSET L2 FSET ( end )
|
||||||
|
|
||||||
|
DE POPqq,
|
||||||
|
HL POPqq,
|
||||||
|
AF POPqq,
|
||||||
|
EI,
|
||||||
|
RETI,
|
@ -4,10 +4,12 @@ FORTHSRCS = core.fs print.fs str.fs parse.fs readln.fs fmt.fs z80a.fs
|
|||||||
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
|
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
|
||||||
OBJS = emul.o libz80/libz80.o
|
OBJS = emul.o libz80/libz80.o
|
||||||
SLATEST = ../tools/slatest
|
SLATEST = ../tools/slatest
|
||||||
|
STRIPFC = ../tools/stripfc
|
||||||
|
|
||||||
.PHONY: all
|
.PHONY: all
|
||||||
all: $(TARGETS)
|
all: $(TARGETS)
|
||||||
|
|
||||||
|
$(STRIPFC):
|
||||||
$(SLATEST):
|
$(SLATEST):
|
||||||
$(MAKE) -C ../tools
|
$(MAKE) -C ../tools
|
||||||
|
|
||||||
@ -27,8 +29,10 @@ forth/stage1: forth/stage.c $(OBJS) forth/forth0-bin.h
|
|||||||
forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h
|
forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h
|
||||||
$(CC) -DDEBUG forth/stage.c $(OBJS) -o $@
|
$(CC) -DDEBUG forth/stage.c $(OBJS) -o $@
|
||||||
|
|
||||||
|
# We don't really need to use stripfc, but we do it anyway to test that we
|
||||||
|
# don't mistakenly break our code with that tool. It's easier to debug here.
|
||||||
forth/core.bin: $(FORTHSRC_PATHS) forth/stage1
|
forth/core.bin: $(FORTHSRC_PATHS) forth/stage1
|
||||||
cat $(FORTHSRC_PATHS) ./forth/stop.fs | ./forth/stage1 | tee $@ > /dev/null
|
cat $(FORTHSRC_PATHS) ./forth/stop.fs | $(STRIPFC) | ./forth/stage1 | tee $@ > /dev/null
|
||||||
|
|
||||||
forth/forth1.bin: forth/core.bin $(SLATEST)
|
forth/forth1.bin: forth/core.bin $(SLATEST)
|
||||||
cat forth/boot.bin forth/z80c.bin forth/core.bin > $@
|
cat forth/boot.bin forth/z80c.bin forth/core.bin > $@
|
||||||
|
@ -115,7 +115,12 @@ those slots...) in boot binaries are made to jump to this address. If you use
|
|||||||
one of those slots for an interrupt, write a jump to the appropriate offset in
|
one of those slots for an interrupt, write a jump to the appropriate offset in
|
||||||
that RAM location.
|
that RAM location.
|
||||||
|
|
||||||
SYSTEM SCRATCHPAD is reserved for temporary system storage.
|
SYSTEM SCRATCHPAD is reserved for temporary system storage or can be reserved
|
||||||
|
by low-level drivers. These are the current usages of this space throughout the
|
||||||
|
project:
|
||||||
|
|
||||||
|
* 0x51-0x53: (c<) pointer during in-memory initialization (see below)
|
||||||
|
* 0x53-0x5b: ACIA buffer pointers in RC2014 recipes.
|
||||||
|
|
||||||
*** Initialization sequence
|
*** Initialization sequence
|
||||||
|
|
||||||
|
@ -80,7 +80,7 @@
|
|||||||
(parseb) IF EXIT THEN
|
(parseb) IF EXIT THEN
|
||||||
(parsed) IF EXIT THEN
|
(parsed) IF EXIT THEN
|
||||||
( nothing works )
|
( nothing works )
|
||||||
ABORT" unknown word! "
|
LIT< (wnf) (find) DROP EXECUTE
|
||||||
;
|
;
|
||||||
|
|
||||||
' (parse) (parse*) !
|
' (parse) (parse*) !
|
||||||
|
@ -28,3 +28,8 @@
|
|||||||
|
|
||||||
: (uflw) ABORT" stack underflow" ;
|
: (uflw) ABORT" stack underflow" ;
|
||||||
: (wnf) ABORT" word not found" ;
|
: (wnf) ABORT" word not found" ;
|
||||||
|
|
||||||
|
: BS 8 EMIT ;
|
||||||
|
: LF 10 EMIT ;
|
||||||
|
: CR 13 EMIT ;
|
||||||
|
: SPC 32 EMIT ;
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
( requires core, parse )
|
( requires core, parse, print )
|
||||||
|
|
||||||
( Managing variables in a core module is tricky. Sure, we
|
( Managing variables in a core module is tricky. Sure, we
|
||||||
have (sysv), but here we need to allocate a big buffer, and
|
have (sysv), but here we need to allocate a big buffer, and
|
||||||
@ -76,5 +76,5 @@
|
|||||||
( not EOL? good, inc and return )
|
( not EOL? good, inc and return )
|
||||||
DUP IF 1 IN> +! EXIT THEN ( c )
|
DUP IF 1 IN> +! EXIT THEN ( c )
|
||||||
( EOL ? readline. we still return typed char though )
|
( EOL ? readline. we still return typed char though )
|
||||||
(rdln) (<c) ( c )
|
(rdln) ( c )
|
||||||
;
|
;
|
||||||
|
@ -5,8 +5,3 @@
|
|||||||
1 +
|
1 +
|
||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
: BS 8 EMIT ;
|
|
||||||
: LF 10 EMIT ;
|
|
||||||
: CR 13 EMIT ;
|
|
||||||
: SPC 32 EMIT ;
|
|
||||||
|
@ -1,25 +1,33 @@
|
|||||||
TARGET = os.bin
|
TARGET = os.bin
|
||||||
BASEDIR = ../..
|
BASEDIR = ../..
|
||||||
FDIR = $(BASEDIR)/emul/forth
|
FDIR = $(BASEDIR)/forth
|
||||||
STAGE1 = $(FDIR)/stage1
|
EDIR = $(BASEDIR)/emul/forth
|
||||||
FORTH0 = $(FDIR)/forth0.bin
|
STAGE2 = $(EDIR)/stage2
|
||||||
EMUL = $(BASEDIR)/emul/hw/rc2014/classic
|
EMUL = $(BASEDIR)/emul/hw/rc2014/classic
|
||||||
SRCS = core.fs str.fs parse.fs readln.fs fmt.fs
|
PATHS = pre.fs \
|
||||||
PATHS = conf.fs \
|
$(FDIR)/core.fs \
|
||||||
${SRCS:%=$(BASEDIR)/forth/%} \
|
$(FDIR)/str.fs \
|
||||||
|
$(FDIR)/parse.fs \
|
||||||
$(BASEDIR)/drv/acia.fs \
|
$(BASEDIR)/drv/acia.fs \
|
||||||
run.fs \
|
$(FDIR)/print.fs \
|
||||||
$(FDIR)/stop.fs
|
$(FDIR)/readln.fs \
|
||||||
|
$(FDIR)/fmt.fs \
|
||||||
|
run.fs
|
||||||
SLATEST = $(BASEDIR)/tools/slatest
|
SLATEST = $(BASEDIR)/tools/slatest
|
||||||
|
STRIPFC = $(BASEDIR)/tools/stripfc
|
||||||
|
|
||||||
.PHONY: all
|
.PHONY: all
|
||||||
all: $(TARGET)
|
all: $(TARGET)
|
||||||
$(TARGET): dict.bin $(FORTH0) $(SLATEST)
|
$(TARGET): boot.bin z80c.bin $(SLATEST) $(PATHS)
|
||||||
cat $(FORTH0) dict.bin > $@
|
cat boot.bin z80c.bin > $@
|
||||||
$(SLATEST) $@
|
$(SLATEST) $@
|
||||||
|
cat $(PATHS) | $(STRIPFC) >> $@
|
||||||
|
|
||||||
dict.bin: conf.fs
|
z80c.bin: boot.bin
|
||||||
cat $(PATHS) | $(STAGE1) > $@
|
cat conf.fs $(FDIR)/z80c.fs $(BASEDIR)/drv/acia.z80 $(FDIR)/icore.fs | $(STAGE2) | tee $@ > /dev/null
|
||||||
|
|
||||||
|
boot.bin: conf.fs
|
||||||
|
cat conf.fs $(FDIR)/boot.fs | $(STAGE2) | tee $@ > /dev/null
|
||||||
|
|
||||||
$(SLATEST):
|
$(SLATEST):
|
||||||
$(MAKE) -C $(BASEDIR)/tools
|
$(MAKE) -C $(BASEDIR)/tools
|
||||||
|
@ -2,4 +2,5 @@
|
|||||||
0xf000 CONSTANT RS_ADDR
|
0xf000 CONSTANT RS_ADDR
|
||||||
0x80 CONSTANT ACIA_CTL
|
0x80 CONSTANT ACIA_CTL
|
||||||
0x81 CONSTANT ACIA_IO
|
0x81 CONSTANT ACIA_IO
|
||||||
|
RAMSTART 0x53 + CONSTANT ACIA_MEM
|
||||||
|
|
||||||
|
1
recipes/rc2014/pre.fs
Normal file
1
recipes/rc2014/pre.fs
Normal file
@ -0,0 +1 @@
|
|||||||
|
96 RAM+ HERE !
|
@ -1 +1,9 @@
|
|||||||
: INIT 5 5 PC! BYE ACIA$ INTERPRET ;
|
: INIT
|
||||||
|
ACIA$
|
||||||
|
(c<$)
|
||||||
|
." Collapse OS" LF
|
||||||
|
( 0c == CINPTR )
|
||||||
|
['] (c<) 0x0c RAM+ !
|
||||||
|
;
|
||||||
|
INIT
|
||||||
|
|
||||||
|
1
tools/.gitignore
vendored
1
tools/.gitignore
vendored
@ -5,3 +5,4 @@
|
|||||||
/ttysafe
|
/ttysafe
|
||||||
/pingpong
|
/pingpong
|
||||||
/slatest
|
/slatest
|
||||||
|
/stripfc
|
||||||
|
@ -5,8 +5,9 @@ FONTCOMPILE_TGT = fontcompile
|
|||||||
TTYSAFE_TGT = ttysafe
|
TTYSAFE_TGT = ttysafe
|
||||||
PINGPONG_TGT = pingpong
|
PINGPONG_TGT = pingpong
|
||||||
SLATEST_TGT = slatest
|
SLATEST_TGT = slatest
|
||||||
|
STRIPFC_TGT = stripfc
|
||||||
TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
|
TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
|
||||||
$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT)
|
$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT) $(STRIPFC_TGT)
|
||||||
OBJS = common.o
|
OBJS = common.o
|
||||||
|
|
||||||
all: $(TARGETS)
|
all: $(TARGETS)
|
||||||
@ -22,6 +23,7 @@ $(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
|
|||||||
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
|
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
|
||||||
$(PINGPONG_TGT): $(PINGPONG_TGT).c
|
$(PINGPONG_TGT): $(PINGPONG_TGT).c
|
||||||
$(SLATEST_TGT): $(SLATEST_TGT).c
|
$(SLATEST_TGT): $(SLATEST_TGT).c
|
||||||
|
$(STRIPFC_TGT): $(STRIPFC_TGT).c
|
||||||
$(TARGETS): $(OBJS)
|
$(TARGETS): $(OBJS)
|
||||||
$(CC) $(CFLAGS) $@.c $(OBJS) -o $@
|
$(CC) $(CFLAGS) $@.c $(OBJS) -o $@
|
||||||
|
|
||||||
|
55
tools/stripfc.c
Normal file
55
tools/stripfc.c
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
|
||||||
|
/* read stdin and strip Forth-style comments before spitting in stdout. This
|
||||||
|
also deduplicate spaces and newlines.
|
||||||
|
|
||||||
|
THIS PARSING IS IMPERFECT. Only a Forth interpreter can reliably detect
|
||||||
|
comments. For example, a naive parser misinterprets the "(" word definition as
|
||||||
|
a comment.
|
||||||
|
|
||||||
|
We work around this by considering as a comment opener only "(" chars preceeded
|
||||||
|
by more than once space or by a newline. Hackish, but works.
|
||||||
|
*/
|
||||||
|
|
||||||
|
int main()
|
||||||
|
{
|
||||||
|
int spccnt = 0;
|
||||||
|
int incomment = 0;
|
||||||
|
int c;
|
||||||
|
c = getchar();
|
||||||
|
while ( c != EOF ) {
|
||||||
|
if (c == '\n') {
|
||||||
|
// We still spit newlines whenever we see them, Forth interpreter
|
||||||
|
// doesn't like when they're not there...
|
||||||
|
putchar(c);
|
||||||
|
spccnt += 2;
|
||||||
|
} else if (c == ' ') {
|
||||||
|
spccnt++;
|
||||||
|
} else {
|
||||||
|
if (incomment) {
|
||||||
|
if ((c == ')') && spccnt) {
|
||||||
|
incomment = 0;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if ((c == '(') && (spccnt > 1)) {
|
||||||
|
putchar(' ');
|
||||||
|
spccnt = 0;
|
||||||
|
int next = getchar();
|
||||||
|
if (next <= ' ') {
|
||||||
|
incomment = 1;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
putchar(c);
|
||||||
|
c = next;
|
||||||
|
}
|
||||||
|
if (spccnt) {
|
||||||
|
putchar(' ');
|
||||||
|
}
|
||||||
|
putchar(c);
|
||||||
|
}
|
||||||
|
spccnt = 0;
|
||||||
|
}
|
||||||
|
c = getchar();
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user