mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +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_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
|
||||
|
||||
( 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$
|
||||
H@ DUP DUP ACIA( ! ACIAR> !
|
||||
1 + ACIAW> ! ( write index starts one position later )
|
||||
@ -76,9 +29,9 @@ L3 FSET L2 FSET ( end )
|
||||
0b10010110 ACIA_CTL PC!
|
||||
|
||||
( setup interrupt )
|
||||
( 51 == INTJUMP )
|
||||
0xc3 0x51 RAM+ C! ( JP upcode )
|
||||
['] ~ACIA 0x52 RAM+ !
|
||||
( 4e == INTJUMP )
|
||||
0xc3 0x4e RAM+ C! ( JP upcode )
|
||||
['] ~ACIA 0x4f RAM+ !
|
||||
(im1)
|
||||
;
|
||||
|
||||
@ -86,14 +39,15 @@ L3 FSET L2 FSET ( end )
|
||||
( As long as R> == W>-1, it means that buffer is empty )
|
||||
BEGIN ACIAR> @ 1 + ACIAW> @ = NOT UNTIL
|
||||
|
||||
ACIAR> @ C@
|
||||
( inc then fetch )
|
||||
1 ACIAR> +!
|
||||
ACIAR> @ C@
|
||||
;
|
||||
|
||||
: EMIT
|
||||
( As long at CTL bit 1 is low, we are transmitting. wait )
|
||||
BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
|
||||
( 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
|
||||
OBJS = emul.o libz80/libz80.o
|
||||
SLATEST = ../tools/slatest
|
||||
STRIPFC = ../tools/stripfc
|
||||
|
||||
.PHONY: all
|
||||
all: $(TARGETS)
|
||||
|
||||
$(STRIPFC):
|
||||
$(SLATEST):
|
||||
$(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
|
||||
$(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
|
||||
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)
|
||||
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
|
||||
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
|
||||
|
||||
|
@ -80,7 +80,7 @@
|
||||
(parseb) IF EXIT THEN
|
||||
(parsed) IF EXIT THEN
|
||||
( nothing works )
|
||||
ABORT" unknown word! "
|
||||
LIT< (wnf) (find) DROP EXECUTE
|
||||
;
|
||||
|
||||
' (parse) (parse*) !
|
||||
|
@ -28,3 +28,8 @@
|
||||
|
||||
: (uflw) ABORT" stack underflow" ;
|
||||
: (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
|
||||
have (sysv), but here we need to allocate a big buffer, and
|
||||
@ -76,5 +76,5 @@
|
||||
( not EOL? good, inc and return )
|
||||
DUP IF 1 IN> +! EXIT THEN ( c )
|
||||
( EOL ? readline. we still return typed char though )
|
||||
(rdln) (<c) ( c )
|
||||
(rdln) ( c )
|
||||
;
|
||||
|
@ -5,8 +5,3 @@
|
||||
1 +
|
||||
AGAIN
|
||||
;
|
||||
|
||||
: BS 8 EMIT ;
|
||||
: LF 10 EMIT ;
|
||||
: CR 13 EMIT ;
|
||||
: SPC 32 EMIT ;
|
||||
|
@ -1,25 +1,33 @@
|
||||
TARGET = os.bin
|
||||
BASEDIR = ../..
|
||||
FDIR = $(BASEDIR)/emul/forth
|
||||
STAGE1 = $(FDIR)/stage1
|
||||
FORTH0 = $(FDIR)/forth0.bin
|
||||
FDIR = $(BASEDIR)/forth
|
||||
EDIR = $(BASEDIR)/emul/forth
|
||||
STAGE2 = $(EDIR)/stage2
|
||||
EMUL = $(BASEDIR)/emul/hw/rc2014/classic
|
||||
SRCS = core.fs str.fs parse.fs readln.fs fmt.fs
|
||||
PATHS = conf.fs \
|
||||
${SRCS:%=$(BASEDIR)/forth/%} \
|
||||
PATHS = pre.fs \
|
||||
$(FDIR)/core.fs \
|
||||
$(FDIR)/str.fs \
|
||||
$(FDIR)/parse.fs \
|
||||
$(BASEDIR)/drv/acia.fs \
|
||||
run.fs \
|
||||
$(FDIR)/stop.fs
|
||||
$(FDIR)/print.fs \
|
||||
$(FDIR)/readln.fs \
|
||||
$(FDIR)/fmt.fs \
|
||||
run.fs
|
||||
SLATEST = $(BASEDIR)/tools/slatest
|
||||
STRIPFC = $(BASEDIR)/tools/stripfc
|
||||
|
||||
.PHONY: all
|
||||
all: $(TARGET)
|
||||
$(TARGET): dict.bin $(FORTH0) $(SLATEST)
|
||||
cat $(FORTH0) dict.bin > $@
|
||||
$(TARGET): boot.bin z80c.bin $(SLATEST) $(PATHS)
|
||||
cat boot.bin z80c.bin > $@
|
||||
$(SLATEST) $@
|
||||
cat $(PATHS) | $(STRIPFC) >> $@
|
||||
|
||||
dict.bin: conf.fs
|
||||
cat $(PATHS) | $(STAGE1) > $@
|
||||
z80c.bin: boot.bin
|
||||
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):
|
||||
$(MAKE) -C $(BASEDIR)/tools
|
||||
|
@ -2,4 +2,5 @@
|
||||
0xf000 CONSTANT RS_ADDR
|
||||
0x80 CONSTANT ACIA_CTL
|
||||
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
|
||||
/pingpong
|
||||
/slatest
|
||||
/stripfc
|
||||
|
@ -5,8 +5,9 @@ FONTCOMPILE_TGT = fontcompile
|
||||
TTYSAFE_TGT = ttysafe
|
||||
PINGPONG_TGT = pingpong
|
||||
SLATEST_TGT = slatest
|
||||
STRIPFC_TGT = stripfc
|
||||
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
|
||||
|
||||
all: $(TARGETS)
|
||||
@ -22,6 +23,7 @@ $(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
|
||||
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
|
||||
$(PINGPONG_TGT): $(PINGPONG_TGT).c
|
||||
$(SLATEST_TGT): $(SLATEST_TGT).c
|
||||
$(STRIPFC_TGT): $(STRIPFC_TGT).c
|
||||
$(TARGETS): $(OBJS)
|
||||
$(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