1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 18:28:05 +11:00

Compare commits

..

No commits in common. "d0545d555f78418c552f3596026d96325e1e30f9" and "4c7dfe0dfe8b1f4e5aadd1c715b90c3a01a5642d" have entirely different histories.

18 changed files with 54 additions and 198 deletions

View File

@ -38,31 +38,25 @@ $ - Initialize
~ - Container for native code. Usually not an executable word. ~ - Container for native code. Usually not an executable word.
? - Is it ...? (example: IMMED?) ? - Is it ...? (example: IMMED?)
*** Entry management *** *** Defining words ***
(find) a -- a f Read at a and find it in dict. If found, f=1 and (find) a -- a f Read at a and find it in dict. If found, f=1 and
a = wordref. If not found, f=0 and a = string addr. a = wordref. If not found, f=0 and a = string addr.
: x ... -- Define a new word
; R:I -- Exit a colon definition
, n -- Write n in HERE and advance it.
' x -- a Push addr of word x to a. If not found, aborts ' x -- a Push addr of word x to a. If not found, aborts
['] x -- *I* Like "'", but spits the addr as a number ['] x -- *I* Like "'", but spits the addr as a number
literal. If not found, aborts. literal. If not found, aborts.
, n -- Write n in HERE and advance it. ( -- *I* Comment. Ignore rest of line until ")" is read.
ALLOT n -- Move HERE by n bytes ALLOT n -- Move HERE by n bytes
C, b -- Write byte b in HERE and advance it. C, b -- Write byte b in HERE and advance it.
DELW a -- Delete wordref at a. If it shadows another
definition, that definition is unshadowed.
FORGET x -- Rewind the dictionary (both CURRENT and HERE) up to
x's previous entry.
PREV a -- a Return a wordref's previous entry.
WHLEN a -- n Get word header length from wordref. That is, name
length + 3. a is a wordref
*** Defining words ***
: x ... -- Define a new word
; R:I -- Exit a colon definition
CREATE x -- Create cell named x. Doesn't allocate a PF. CREATE x -- Create cell named x. Doesn't allocate a PF.
[COMPILE] x -- Compile word x and write it to HERE. IMMEDIATE [COMPILE] x -- Compile word x and write it to HERE. IMMEDIATE
words are *not* executed. words are *not* executed.
COMPILE x -- Meta compiles. Kind of blows the mind. See below. COMPILE x -- Meta compiles. Kind of blows the mind. See below.
CONSTANT x n -- Creates cell x that when called pushes its value CONSTANT x n -- Creates cell x that when called pushes its value
DELW a -- Delete wordref at a. If it shadows another
definition, that definition is unshadowed.
DOES> -- See description in usage.txt DOES> -- See description in usage.txt
IMMED? a -- f Checks whether wordref at a is immediate. IMMED? a -- f Checks whether wordref at a is immediate.
IMMEDIATE -- Flag the latest defined word as immediate. IMMEDIATE -- Flag the latest defined word as immediate.
@ -78,7 +72,6 @@ input stream is executed immediately. In this context, branching doesn't work.
(br) -- Branches by the number specified in the 2 following (br) -- Branches by the number specified in the 2 following
bytes. Can be negative. bytes. Can be negative.
(?br) f -- Branch if f is false. (?br) f -- Branch if f is false.
( -- *I* Comment. Ignore rest of line until ")" is read.
[ -- Begin interetative mode. In a definition, words [ -- Begin interetative mode. In a definition, words
between here and "]" will be executed instead of between here and "]" will be executed instead of
compiled. compiled.

View File

@ -29,7 +29,7 @@ $(BIN2C):
forth/forth0.bin: $(SLATEST) forth/forth0.bin: $(SLATEST)
cp forth/z80c.bin $@ cp forth/z80c.bin $@
$(SLATEST) $@ $(SLATEST) $@
cat forth/pre.fs forth/emul.fs >> $@ cat forth/emul.fs >> $@
forth/forth0-bin.h: forth/forth0.bin $(BIN2C) forth/forth0-bin.h: forth/forth0.bin $(BIN2C)
$(BIN2C) KERNEL < forth/forth0.bin | tee $@ > /dev/null $(BIN2C) KERNEL < forth/forth0.bin | tee $@ > /dev/null
@ -43,14 +43,14 @@ forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h
# We don't really need to use stripfc, but we do it anyway to test that we # 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. # 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 | $(STRIPFC) | ./forth/stage1 > $@ 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/z80c.bin forth/core.bin > $@ cat forth/z80c.bin forth/core.bin > $@
$(SLATEST) $@ $(SLATEST) $@
forth/forth1-bin.h: forth/forth1.bin $(BIN2C) forth/forth1-bin.h: forth/forth1.bin $(BIN2C)
$(BIN2C) KERNEL < forth/forth1.bin > $@ $(BIN2C) KERNEL < forth/forth1.bin | tee $@ > /dev/null
forth/stage2: forth/stage.c $(OBJS) forth/forth1-bin.h forth/stage2: forth/stage.c $(OBJS) forth/forth1-bin.h
$(CC) -DSTAGE2 forth/stage.c $(OBJS) -o $@ $(CC) -DSTAGE2 forth/stage.c $(OBJS) -o $@

View File

@ -1,2 +0,0 @@
CURRENT @ HERE !

View File

@ -1 +1 @@
: INIT CURRENT @ HERE ! RDLN$ Z80A$ INTERPRET ; : INIT RDLN$ Z80A$ INTERPRET ;

Binary file not shown.

View File

@ -118,14 +118,12 @@ PC ORG @ 1 + ! ( main )
SP 0xfffa LDddnn, SP 0xfffa LDddnn,
RAMSTART SP LD(nn)dd, ( RAM+00 == INITIAL_SP ) RAMSTART SP LD(nn)dd, ( RAM+00 == INITIAL_SP )
IX RS_ADDR LDddnn, IX RS_ADDR LDddnn,
( HERE begins at RAMEND )
HL RAMSTART 0x80 + LDddnn,
RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
( LATEST is a label to the latest entry of the dict. It is ( LATEST is a label to the latest entry of the dict. It is
written at offset 0x08 by the process or person building written at offset 0x08 by the process or person building
Forth. ) Forth. )
0x08 LDHL(nn), 0x08 LDHL(nn),
RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT ) RAMSTART 0x02 + LD(nn)HL, ( RAM+02 == CURRENT )
RAMSTART 0x04 + LD(nn)HL, ( RAM+04 == HERE )
EXDEHL, EXDEHL,
HL L1 @ LDddnn, HL L1 @ LDddnn,
0x03 CALLnn, ( 03 == find ) 0x03 CALLnn, ( 03 == find )

View File

@ -117,22 +117,3 @@
: DELW : DELW
1 - 0 SWAP C! 1 - 0 SWAP C!
; ;
: PREV
3 - DUP @ ( a o )
- ( a-o )
;
: WHLEN
1 - C@ ( name len field )
127 AND ( 0x7f. remove IMMEDIATE flag )
3 + ( fixed header len )
;
: FORGET
' DUP ( w w )
( HERE must be at the end of prev's word, that is, at the
beginning of w. )
DUP WHLEN - HERE ! ( w )
PREV CURRENT !
;

View File

@ -39,6 +39,15 @@
1 + 1 +
; ;
( Get word header length from wordref. That is, name length
+ 3. a is a wordref )
( a -- n )
: WHLEN
1 - C@ ( name len field )
0x7f AND ( remove IMMEDIATE flag )
3 + ( fixed header len )
;
( Get word addr, starting at name's address ) ( Get word addr, starting at name's address )
: '< ' DUP WHLEN - ; : '< ' DUP WHLEN - ;
@ -112,6 +121,13 @@
( TODO implement RLCELL ) ( TODO implement RLCELL )
( Get word's prev offset )
( a -- a )
: PREV
3 - DUP @ ( a o )
- ( a-o )
;
( Copy dict from target wordref, including header, up to HERE. ( Copy dict from target wordref, including header, up to HERE.
We're going to compact the space between that word and its We're going to compact the space between that word and its
prev word. To do this, we're copying this whole memory area prev word. To do this, we're copying this whole memory area

View File

@ -170,11 +170,8 @@ advanced to the address following the null.
*** Initialization sequence *** Initialization sequence
On boot, we jump to the "main" routine in boot.fs which does very few things. On boot, we jump to the "main" routine in boot.fs which does very few things.
It sets up the SP register, CURRENT and HERE to LATEST (saved in stable ABI),
1. Set SP to 0x10000-6 then look for the BOOT word and calls it.
2. Sets HERE to RAMEND (RAMSTART+0x80).
3. Sets CURRENT to value of LATEST field in stable ABI.
4. Look for the word "BOOT" and calls it.
In a normal system, BOOT is in icore and does a few things: In a normal system, BOOT is in icore and does a few things:
@ -195,9 +192,9 @@ as such until you set a new (c<).
Note that there is no EMIT in a bare system. You have to take care of supplying Note that there is no EMIT in a bare system. You have to take care of supplying
one before your load core.fs and its higher levels. one before your load core.fs and its higher levels.
In the "/emul" binaries, "HERE" is readjusted to "CURRENT @" so that we don't Also note that this initialization code is fighting for space with HERE: New
have to relocate compiled dicts. Note that in this context, the initialization entries to the dict will overwrite that code! Also, because we're barebone, we
code is fighting for space with HERE: New entries to the dict will overwrite can't have comments. This leads to peculiar code in this area. If you see weird
that code! Also, because we're barebone, we can't have comments. This can lead whitespace usage, it's probably because not using those whitespace would result
to peculiar code in this area where we try to "waste" space in initialization in dict entry creation overwriting the code before it has the chance to be
code. interpreted.

View File

@ -1,4 +1,4 @@
TARGET = stage1.bin TARGET = os.bin
BASEDIR = ../.. BASEDIR = ../..
FDIR = $(BASEDIR)/forth FDIR = $(BASEDIR)/forth
EDIR = $(BASEDIR)/emul/forth EDIR = $(BASEDIR)/emul/forth
@ -13,7 +13,7 @@ BOOTSRCS = conf.fs \
$(FDIR)/icore.fs \ $(FDIR)/icore.fs \
$(EDIR)/xstop.fs $(EDIR)/xstop.fs
PATHS = \ PATHS = pre.fs \
$(FDIR)/core.fs \ $(FDIR)/core.fs \
$(FDIR)/cmp.fs \ $(FDIR)/cmp.fs \
$(FDIR)/str.fs \ $(FDIR)/str.fs \

View File

@ -202,9 +202,9 @@ using our hex editor.
Now are we ready yet? ALMOST! There's one last thing we need to do: add runtime Now are we ready yet? ALMOST! There's one last thing we need to do: add runtime
source. In our case, because we have a compiled dict, the only source we need source. In our case, because we have a compiled dict, the only source we need
to include is `run.fs`: to include is `pre.fs` and `run.fs`:
cat stage2.bin run.fs > stage2r.bin cat stage2.bin pre.fs run.fs > stage2r.bin
That's it! our binary is ready to run! That's it! our binary is ready to run!
@ -212,8 +212,7 @@ That's it! our binary is ready to run!
And there you have it, a stage2 binary that you've assembled yourself. Now, And there you have it, a stage2 binary that you've assembled yourself. Now,
here's for your homework: use the same technique to add the contents of here's for your homework: use the same technique to add the contents of
`readln.fs` and `adev.fs` to stage2 so that you have a full-featured `readln.fs` to stage2 so that you have a full-featured interpreter.
interpreter.
Name it `stage3.bin` (the version without any source code appended and no Name it `stage3.bin` (the version without any source code appended and no
`INIT` word defined), you'll need this binary for sub-recipes written for the `INIT` word defined), you'll need this binary for sub-recipes written for the
@ -222,10 +221,9 @@ RC2014.
Here's a little cheatsheet, but seriously, you should figure most of it Here's a little cheatsheet, but seriously, you should figure most of it
yourself. Tough love they call it. yourself. Tough love they call it.
* `cat stage2.bin ../../forth/readln.fs ../../forth/adev.fs run.fs > stage2r.bin` * `cat stage2.bin pre.fs ../../forth/readln.fs run.fs > stage2r.bin`
* Don't forget `RDLN$` and `ADEV$`. * Don't forget `(c<$)`.
* `RLDICT` is like `RLCORE` but with a chosen target. * `RLDICT` is like `RLCORE` but with a chosen target.
* `stripfc` can help you deal with size constraints.
[rc2014]: https://rc2014.co.uk [rc2014]: https://rc2014.co.uk
[romwrite]: https://github.com/hsoft/romwrite [romwrite]: https://github.com/hsoft/romwrite

1
recipes/rc2014/pre.fs Normal file
View File

@ -0,0 +1 @@
128 RAM+ HERE !

1
tools/.gitignore vendored
View File

@ -7,4 +7,3 @@
/slatest /slatest
/stripfc /stripfc
/bin2c /bin2c
/exec

View File

@ -7,10 +7,9 @@ PINGPONG_TGT = pingpong
SLATEST_TGT = slatest SLATEST_TGT = slatest
STRIPFC_TGT = stripfc STRIPFC_TGT = stripfc
BIN2C_TGT = bin2c BIN2C_TGT = bin2c
EXEC_TGT = exec
TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \ TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT) $(STRIPFC_TGT) \ $(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT) $(STRIPFC_TGT) \
$(BIN2C_TGT) $(EXEC_TGT) $(BIN2C_TGT)
OBJS = common.o OBJS = common.o
all: $(TARGETS) all: $(TARGETS)
@ -28,7 +27,6 @@ $(PINGPONG_TGT): $(PINGPONG_TGT).c
$(SLATEST_TGT): $(SLATEST_TGT).c $(SLATEST_TGT): $(SLATEST_TGT).c
$(STRIPFC_TGT): $(STRIPFC_TGT).c $(STRIPFC_TGT): $(STRIPFC_TGT).c
$(BIN2C_TGT): $(BIN2C_TGT).c $(BIN2C_TGT): $(BIN2C_TGT).c
$(EXEC_TGT): $(EXEC_TGT).c
$(TARGETS): $(OBJS) $(TARGETS): $(OBJS)
$(CC) $(CFLAGS) $@.c $(OBJS) -o $@ $(CC) $(CFLAGS) $@.c $(OBJS) -o $@

View File

@ -1,18 +1,5 @@
#include <stdlib.h> #include <stdlib.h>
#include <unistd.h> #include <unistd.h>
#include <termios.h>
#include <errno.h>
#include <stdio.h>
#include <string.h>
void mread(int fd, char *s, int count)
{
while (count) {
while (read(fd, s, 1) == 0);
s++;
count--;
}
}
void sendcmd(int fd, char *cmd) void sendcmd(int fd, char *cmd)
{ {
@ -25,8 +12,8 @@ void sendcmd(int fd, char *cmd)
// it breathe, it can choke. // it breathe, it can choke.
usleep(1000); usleep(1000);
} }
write(fd, "\r", 1); write(fd, "\n", 1);
mread(fd, junk, 2); // sends back \r\n read(fd, &junk, 2); // sends back \r\n
usleep(1000); usleep(1000);
} }
@ -35,66 +22,5 @@ void sendcmdp(int fd, char *cmd)
{ {
char junk[2]; char junk[2];
sendcmd(fd, cmd); sendcmd(fd, cmd);
mread(fd, junk, 2); read(fd, &junk, 2);
} }
// from https://stackoverflow.com/a/6947758
// discussion from https://stackoverflow.com/a/26006680 is interesting,
// but we don't want POSIX compliance.
int set_interface_attribs(int fd, int speed, int parity)
{
struct termios tty;
if (tcgetattr (fd, &tty) != 0) {
fprintf(stderr, "error %d from tcgetattr", errno);
return -1;
}
if (speed) {
cfsetospeed (&tty, speed);
cfsetispeed (&tty, speed);
}
tty.c_cflag = (tty.c_cflag & ~CSIZE) | CS8; // 8-bit chars
// disable IGNBRK for mismatched speed tests; otherwise receive break
// as \000 chars
tty.c_iflag &= ~IGNBRK; // disable break processing
tty.c_lflag = 0; // no signaling chars, no echo,
// no canonical processing
tty.c_oflag = 0; // no remapping, no delays
tty.c_cc[VMIN] = 0; // read doesn't block
tty.c_cc[VTIME] = 5; // 0.5 seconds read timeout
tty.c_iflag &= ~(IXON | IXOFF | IXANY); // shut off xon/xoff ctrl
tty.c_cflag |= (CLOCAL | CREAD);// ignore modem controls,
// enable reading
tty.c_cflag &= ~(PARENB | PARODD); // shut off parity
tty.c_cflag |= parity;
tty.c_cflag &= ~CSTOPB;
tty.c_cflag &= ~CRTSCTS;
if (tcsetattr (fd, TCSANOW, &tty) != 0) {
fprintf(stderr, "error %d from tcsetattr", errno);
return -1;
}
return 0;
}
void set_blocking(int fd, int should_block)
{
struct termios tty;
memset(&tty, 0, sizeof tty);
if (tcgetattr (fd, &tty) != 0) {
fprintf(stderr, "error %d from tggetattr", errno);
return;
}
tty.c_cc[VMIN] = should_block ? 1 : 0;
tty.c_cc[VTIME] = 1; // 0.1 seconds read timeout
if (tcsetattr (fd, TCSANOW, &tty) != 0) {
fprintf(stderr, "error %d setting term attributes", errno);
}
}

View File

@ -1,6 +1,3 @@
void sendcmd(int fd, char *cmd); void sendcmd(int fd, char *cmd);
void sendcmdp(int fd, char *cmd); void sendcmdp(int fd, char *cmd);
void mread(int fd, char *s, int count);
int set_interface_attribs(int fd, int speed, int parity);
void set_blocking(int fd, int should_block);

View File

@ -1,38 +0,0 @@
#include <stdlib.h>
#include <stdio.h>
#include <fcntl.h>
#include <unistd.h>
#include "common.h"
/* Execute code from stdin on the target machine.
*/
int main(int argc, char **argv)
{
if (argc != 2) {
fprintf(stderr, "Usage: ./exec device\n");
return 1;
}
int fd = open(argv[1], O_RDWR|O_NOCTTY|O_SYNC);
if (fd < 0) {
fprintf(stderr, "Could not open %s\n", argv[1]);
return 1;
}
set_interface_attribs(fd, 0, 0);
set_blocking(fd, 0);
int c = getchar();
while (c != EOF) {
if (c == '\n') c = '\r';
write(fd, &c, 1);
while (read(fd, &c, 1) == 1) {
putchar(c);
fflush(stdout);
}
c = getchar();
}
printf("Done!\n");
return 0;
}

View File

@ -5,7 +5,7 @@
#include "common.h" #include "common.h"
/* Push specified file to specified device running Forth and verify /* Push specified file to specified device running the BASIC shell and verify
* that the sent contents is correct. * that the sent contents is correct.
*/ */
@ -35,17 +35,11 @@ int main(int argc, char **argv)
return 1; return 1;
} }
rewind(fp); rewind(fp);
int fd = open(argv[1], O_RDWR|O_NOCTTY|O_SYNC); int fd = open(argv[1], O_RDWR|O_NOCTTY);
if (fd < 0) {
fprintf(stderr, "Could not open %s\n", argv[1]);
return 1;
}
set_interface_attribs(fd, 0, 0);
set_blocking(fd, 1);
char s[0x40]; char s[0x40];
sprintf(s, sprintf(s, "m=0x%04x", memptr);
": _ 0x%04x 0x%04x DO KEY DUP .x I A! LOOP ; _", sendcmdp(fd, s);
memptr+bytecount, memptr); sprintf(s, "while m<0x%04x getc:puth a:poke m a:m=m+1", memptr+bytecount);
sendcmd(fd, s); sendcmd(fd, s);
int returncode = 0; int returncode = 0;
@ -55,7 +49,7 @@ int main(int argc, char **argv)
unsigned char c = s[0]; unsigned char c = s[0];
write(fd, &c, 1); write(fd, &c, 1);
usleep(1000); // let it breathe usleep(1000); // let it breathe
mread(fd, s, 2); // read hex pair read(fd, s, 2); // read hex pair
s[2] = 0; // null terminate s[2] = 0; // null terminate
unsigned char c2 = strtol(s, NULL, 16); unsigned char c2 = strtol(s, NULL, 16);
if (c != c2) { if (c != c2) {
@ -66,8 +60,6 @@ int main(int argc, char **argv)
returncode = 1; returncode = 1;
} }
} }
mread(fd, s, 2); // "> " prompt
sendcmdp(fd, "FORGET _");
printf("Done!\n"); printf("Done!\n");
fclose(fp); fclose(fp);
return returncode; return returncode;