mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 08:20:57 +11:00
Compare commits
No commits in common. "80d730318a6358dadba84406af2945f6d92fd4b1" and "33d37d4ce958f7865a7496fcee32e92749e45a21" have entirely different histories.
80d730318a
...
33d37d4ce9
1
blk/044
1
blk/044
@ -2,3 +2,4 @@ INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||
then execute the compiled contents.
|
||||
LEAVE -- In a DO..LOOP, exit at the next LOOP call.
|
||||
QUIT -- Return to interpreter prompt immediately
|
||||
EXIT! -- Exit current INTERPRET loop.
|
||||
|
4
blk/062
4
blk/062
@ -1,7 +1,5 @@
|
||||
WORD -- a Read one word from buffered input and push its
|
||||
addr. Always null terminated. If ASCII EOT is
|
||||
encountered, a will point to it (it is cons-
|
||||
idered a word).
|
||||
addr.
|
||||
There are also ascii const emitters:
|
||||
BS CR LF SPC CRLF
|
||||
NL is an indirect word (see B80) that aliases to CRLF by
|
||||
|
10
blk/405
10
blk/405
@ -1,7 +1,9 @@
|
||||
: WS? 33 < ;
|
||||
: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
|
||||
|
||||
: TOWORD
|
||||
0 ( dummy ) BEGIN
|
||||
DROP C< DUP WS? NOT OVER EOT? OR
|
||||
UNTIL ;
|
||||
BEGIN
|
||||
C< DUP WS? NOT IF EXIT THEN DROP
|
||||
AGAIN
|
||||
;
|
||||
|
||||
|
||||
|
15
blk/406
15
blk/406
@ -1,13 +1,16 @@
|
||||
( Read word from C<, copy to WORDBUF, null-terminate, and
|
||||
return WORDBUF. )
|
||||
: WORD
|
||||
0x0e RAM+ TOWORD ( a c )
|
||||
DUP EOT? IF OVER ! EXIT THEN
|
||||
0x0e RAM+ ( 0e == WORDBUF )
|
||||
TOWORD ( a c )
|
||||
BEGIN
|
||||
( We take advantage of the fact that char MSB is
|
||||
always zero to pre-write our null-termination )
|
||||
OVER ! 1+ C< ( a c )
|
||||
OVER ! 1+ ( a+1 )
|
||||
C< ( a c )
|
||||
OVER 0x2d ( 2e-1 for NULL ) RAM+ = OVER WS? OR
|
||||
UNTIL ( a c )
|
||||
SWAP DROP 0x0e RAM+ ( ws a )
|
||||
SWAP EOT? IF 4 OVER ! THEN ;
|
||||
UNTIL
|
||||
( a this point, PS is: a WS )
|
||||
( null-termination is already written )
|
||||
2DROP
|
||||
0x0e RAM+ ;
|
||||
|
11
blk/409
11
blk/409
@ -1,7 +1,16 @@
|
||||
: INTERPRET
|
||||
BEGIN
|
||||
WORD DUP C@ EOT? IF DROP EXIT THEN
|
||||
WORD
|
||||
(find)
|
||||
NOT IF (parse) ELSE EXECUTE THEN
|
||||
C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN
|
||||
AGAIN ;
|
||||
|
||||
( Drop RSP until I-2 == INTERPRET. )
|
||||
: EXIT!
|
||||
['] INTERPRET ( I )
|
||||
BEGIN ( I )
|
||||
DUP ( I I )
|
||||
R> DROP I 2- @ ( I I a )
|
||||
= UNTIL
|
||||
DROP ;
|
||||
|
3
blk/411
3
blk/411
@ -9,5 +9,6 @@
|
||||
['] (boot<) 0x0c RAM+ !
|
||||
( boot< always has a char waiting. 06 == C<?* )
|
||||
1 0x06 RAM+ !
|
||||
INTERPRET BYE ;
|
||||
INTERPRET
|
||||
;
|
||||
|
||||
|
4
blk/429
4
blk/429
@ -1,8 +1,8 @@
|
||||
( Read one line in input buffer and make IN> point to it )
|
||||
: (rdln)
|
||||
( EOT or less triggers line flush )
|
||||
(infl) BEGIN (rdlnc) 5 < UNTIL
|
||||
(infl) BEGIN (rdlnc) NOT UNTIL
|
||||
LF IN( IN> ! ;
|
||||
|
||||
( And finally, implement C<* )
|
||||
: RDLN<
|
||||
IN> @ C@
|
||||
|
11
blk/432
11
blk/432
@ -1,3 +1,14 @@
|
||||
: _
|
||||
(boot<)
|
||||
DUP 4 = IF
|
||||
( We drop our char, but also "a" from WORD: it won't
|
||||
have the opportunity to balance PSP because we're
|
||||
EXIT!ing. )
|
||||
2DROP
|
||||
( We're finished interpreting )
|
||||
EXIT!
|
||||
THEN
|
||||
;
|
||||
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
|
||||
is to check whether we're restoring to "_", the word above.
|
||||
if yes, then we're in a nested load. Also, the 1 in 0x06 is
|
||||
|
2
blk/433
2
blk/433
@ -5,7 +5,7 @@
|
||||
0x2e RAM+ @ >R ( boot ptr )
|
||||
BLK@
|
||||
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
|
||||
['] (boot<) 0x08 RAM+ !
|
||||
['] _ 0x08 RAM+ !
|
||||
1 0x06 RAM+ ! ( 06 == C<? )
|
||||
INTERPRET
|
||||
R> 0x2e RAM+ ! R> 0x06 RAM+ !
|
||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
13
emul/forth.c
13
emul/forth.c
@ -17,6 +17,7 @@
|
||||
#define BLK_PORT 0x03
|
||||
#define BLKDATA_PORT 0x04
|
||||
|
||||
static int running;
|
||||
static FILE *fp;
|
||||
static FILE *blkfp;
|
||||
static int retcode = 0;
|
||||
@ -26,14 +27,18 @@ static uint8_t iord_stdio()
|
||||
{
|
||||
int c = getc(fp);
|
||||
if (c == EOF) {
|
||||
c = 4; // ASCII EOT
|
||||
running = 0;
|
||||
}
|
||||
return (uint8_t)c;
|
||||
}
|
||||
|
||||
static void iowr_stdio(uint8_t val)
|
||||
{
|
||||
putchar(val);
|
||||
if (val == 0x04) { // CTRL+D
|
||||
running = 0;
|
||||
} else {
|
||||
putchar(val);
|
||||
}
|
||||
}
|
||||
|
||||
static void iowr_ret(uint8_t val)
|
||||
@ -118,7 +123,9 @@ int main(int argc, char *argv[])
|
||||
}
|
||||
|
||||
// Run!
|
||||
while (emul_step());
|
||||
running = 1;
|
||||
|
||||
while (running && emul_step());
|
||||
|
||||
if (tty) {
|
||||
printf("\nDone!\n");
|
||||
|
Loading…
Reference in New Issue
Block a user