alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix

Browse Source
This commit is contained in:
Brad Nelson
2020-12-29 20:42:19 -08:00
parent d28204531c
commit ad84e77109
1 changed files with 4 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
forth.c
View File

@ -1,5 +1,6 @@
#include <stdio.h> #include <inttypes.h>
#include <stdint.h> #include <stdint.h>
#include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
@ -46,7 +47,7 @@ typedef int64_t dcell_t;
X("R>", OP_FROMR, DUP; tos = *rp--) \ X("R>", OP_FROMR, DUP; tos = *rp--) \
X("R@", OP_RAT, DUP; tos = *rp) \ X("R@", OP_RAT, DUP; tos = *rp) \
X("CELL", OP_CELL, DUP; tos = sizeof(cell_t)) \ X("CELL", OP_CELL, DUP; tos = sizeof(cell_t)) \
X(".", OP_DOT, printf("%d ", (int) tos); DROP) \ X(".", OP_DOT, printf("%"PRIiPTR" ", tos); DROP) \
X("TYPE", OP_TYPE, fwrite((void *) *sp, 1, tos, stdout); DROP; DROP) \ X("TYPE", OP_TYPE, fwrite((void *) *sp, 1, tos, stdout); DROP; DROP) \
X("KEY", OP_KEY, DUP; tos = fgetc(stdin)) \ X("KEY", OP_KEY, DUP; tos = fgetc(stdin)) \
X("SYSEXIT", OP_SYSEXIT, DUP; exit(tos)) \ X("SYSEXIT", OP_SYSEXIT, DUP; exit(tos)) \
@ -193,7 +194,7 @@ static const char boot[] =
" : exit= ( xt -- ) ['] exit = ; " " : exit= ( xt -- ) ['] exit = ; "
" : see-loop >body begin see-one dup @ exit= until ; " " : see-loop >body begin see-one dup @ exit= until ; "
" : see cr ['] : see. ' dup see. see-loop drop ['] ; see. cr ; " " : see cr ['] : see. ' dup see. see-loop drop ['] ; see. cr ; "
" : words last @ begin dup >name type space >link dup 0= until drop cr ; " " : words last @ begin dup see. >link dup 0= until drop cr ; "
// ( Printing ) // ( Printing )
" : $. r@ dup cell+ swap @ type r> dup @ aligned + cell+ >r ; " " : $. r@ dup cell+ swap @ type r> dup @ aligned + cell+ >r ; "