1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 10:30:55 +11:00

Compare commits

...

4 Commits

Author SHA1 Message Date
Virgil Dupras
d0545d555f upload: use A! instead of C!
It makes the tool much more versatile. I'll have adev being included
in all recipes, so it can be assumed.
2020-04-13 12:00:56 -04:00
Virgil Dupras
d08a9711c5 boot: make HERE point to RAMEND instead of CURRENT
The former was only used in the peculiar context of "/emul". The
regular case is actually HERE pointing to RAMEND on boot.
2020-04-13 11:43:15 -04:00
Virgil Dupras
509972b08c tools: add exec and convert ./upload to Forth 2020-04-13 10:25:27 -04:00
Virgil Dupras
1e0b40a876 Add word "FORGET" 2020-04-13 08:09:36 -04:00
18 changed files with 198 additions and 54 deletions

View File

@ -38,25 +38,31 @@ $ - 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?)
*** Defining words *** *** Entry management ***
(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.
( -- *I* Comment. Ignore rest of line until ")" is read. , n -- Write n in HERE and advance it.
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.
@ -72,6 +78,7 @@ 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/emul.fs >> $@ cat forth/pre.fs 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 | tee $@ > /dev/null cat $(FORTHSRC_PATHS) ./forth/stop.fs | $(STRIPFC) | ./forth/stage1 > $@
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 | tee $@ > /dev/null $(BIN2C) KERNEL < forth/forth1.bin > $@
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 $@

2
emul/forth/pre.fs Normal file
View File

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

View File

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

Binary file not shown.

View File

@ -118,12 +118,14 @@ 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,3 +117,22 @@
: 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,15 +39,6 @@
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 - ;
@ -121,13 +112,6 @@
( 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,8 +170,11 @@ 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),
then look for the BOOT word and calls it. 1. Set SP to 0x10000-6
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:
@ -192,9 +195,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.
Also note that this initialization code is fighting for space with HERE: New In the "/emul" binaries, "HERE" is readjusted to "CURRENT @" so that we don't
entries to the dict will overwrite that code! Also, because we're barebone, we have to relocate compiled dicts. Note that in this context, the initialization
can't have comments. This leads to peculiar code in this area. If you see weird code is fighting for space with HERE: New entries to the dict will overwrite
whitespace usage, it's probably because not using those whitespace would result that code! Also, because we're barebone, we can't have comments. This can lead
in dict entry creation overwriting the code before it has the chance to be to peculiar code in this area where we try to "waste" space in initialization
interpreted. code.

View File

@ -1,4 +1,4 @@
TARGET = os.bin TARGET = stage1.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 = pre.fs \ PATHS = \
$(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 `pre.fs` and `run.fs`: to include is `run.fs`:
cat stage2.bin pre.fs run.fs > stage2r.bin cat stage2.bin run.fs > stage2r.bin
That's it! our binary is ready to run! That's it! our binary is ready to run!
@ -212,7 +212,8 @@ 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` to stage2 so that you have a full-featured interpreter. `readln.fs` and `adev.fs` to stage2 so that you have a full-featured
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
@ -221,9 +222,10 @@ 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 pre.fs ../../forth/readln.fs run.fs > stage2r.bin` * `cat stage2.bin ../../forth/readln.fs ../../forth/adev.fs run.fs > stage2r.bin`
* Don't forget `(c<$)`. * Don't forget `RDLN$` and `ADEV$`.
* `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

View File

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

1
tools/.gitignore vendored
View File

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

View File

@ -7,9 +7,10 @@ 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) $(BIN2C_TGT) $(EXEC_TGT)
OBJS = common.o OBJS = common.o
all: $(TARGETS) all: $(TARGETS)
@ -27,6 +28,7 @@ $(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,5 +1,18 @@
#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)
{ {
@ -12,8 +25,8 @@ void sendcmd(int fd, char *cmd)
// it breathe, it can choke. // it breathe, it can choke.
usleep(1000); usleep(1000);
} }
write(fd, "\n", 1); write(fd, "\r", 1);
read(fd, &junk, 2); // sends back \r\n mread(fd, junk, 2); // sends back \r\n
usleep(1000); usleep(1000);
} }
@ -22,5 +35,66 @@ void sendcmdp(int fd, char *cmd)
{ {
char junk[2]; char junk[2];
sendcmd(fd, cmd); sendcmd(fd, cmd);
read(fd, &junk, 2); mread(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,3 +1,6 @@
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);

38
tools/exec.c Normal file
View File

@ -0,0 +1,38 @@
#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 the BASIC shell and verify /* Push specified file to specified device running Forth and verify
* that the sent contents is correct. * that the sent contents is correct.
*/ */
@ -35,11 +35,17 @@ int main(int argc, char **argv)
return 1; return 1;
} }
rewind(fp); rewind(fp);
int fd = open(argv[1], O_RDWR|O_NOCTTY); 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, 1);
char s[0x40]; char s[0x40];
sprintf(s, "m=0x%04x", memptr); sprintf(s,
sendcmdp(fd, s); ": _ 0x%04x 0x%04x DO KEY DUP .x I A! LOOP ; _",
sprintf(s, "while m<0x%04x getc:puth a:poke m a:m=m+1", memptr+bytecount); memptr+bytecount, memptr);
sendcmd(fd, s); sendcmd(fd, s);
int returncode = 0; int returncode = 0;
@ -49,7 +55,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
read(fd, s, 2); // read hex pair mread(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) {
@ -60,6 +66,8 @@ 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;