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

works

Browse Source
This commit is contained in:
Brad Nelson
2020-12-29 21:27:39 -08:00
parent ad84e77109
commit d092a86678
1 changed files with 10 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
forth.c
View File

@ -19,7 +19,7 @@ typedef int64_t dcell_t;
#define DUP *++sp = tos #define DUP *++sp = tos
#define DROP tos = *sp-- #define DROP tos = *sp--
#define NEXT w = *ip++; goto **(void **) w #define NEXT w = *ip++; goto **(void **) w
#define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) & ~(sizeof(cell_t) - 1)) #define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t))
#define FIND(name) find(name, sizeof(name) - 1) #define FIND(name) find(name, sizeof(name) - 1)
#define OPCODE_LIST \ #define OPCODE_LIST \
@ -185,12 +185,12 @@ static const char boot[] =
" ' throw 'throw ! " " ' throw 'throw ! "
// Examine Dictionary // Examine Dictionary
" : >link ( xt -- a ) 2 cells - @ ; "
" : >name ( xt -- a n ) 3 cells - dup @ swap over aligned - swap ; " " : >name ( xt -- a n ) 3 cells - dup @ swap over aligned - swap ; "
" : >link ( xt -- a ) 2 cells - @ ; "
" : >body ( xt -- a ) cell+ ; " " : >body ( xt -- a ) cell+ ; "
" : see. ( xt -- ) >name type space ; " " : see. ( xt -- ) >name type space ; "
" : see-one ( xt -- xt+1 ) " " : see-one ( xt -- xt+1 ) "
" dup @ dup ['] dolit: = if drop cell+ dup @ . else see. then cell+ ; " " dup @ dup ['] DOLIT = if drop cell+ dup @ . else see. then cell+ ; "
" : 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 ; "