Move ALLOT and HERE to high level.

This commit is contained in:
Brad Nelson
2020-12-30 13:05:14 -08:00
parent 3123560f60
commit 46b5c84cc5

View File

@ -76,9 +76,7 @@ typedef uint64_t udcell_t;
X("IMMEDIATE", OP_IMMEDIATE, g_last[-1] |= 1) \ X("IMMEDIATE", OP_IMMEDIATE, g_last[-1] |= 1) \
X("DOES>", OP_DOES, *g_last = (cell_t) && OP_DODOES; \ X("DOES>", OP_DOES, *g_last = (cell_t) && OP_DODOES; \
g_last[1] = (cell_t) ip; goto OP_EXIT) \ g_last[1] = (cell_t) ip; goto OP_EXIT) \
X("HERE", OP_HERE, DUP; tos = (cell_t) g_heap) \ X("'HEAP", OP_HEAP, DUP; tos = (cell_t) &g_heap) \
X("ALLOT", OP_ALLOT, g_heap = (cell_t *) (tos + (cell_t) g_heap); \
tos = *sp--) \
X("STATE", OP_STATE, DUP; tos = (cell_t) &g_state) \ X("STATE", OP_STATE, DUP; tos = (cell_t) &g_state) \
X("BASE", OP_BASE, DUP; tos = (cell_t) &g_base) \ X("BASE", OP_BASE, DUP; tos = (cell_t) &g_base) \
X("LAST", OP_LAST, DUP; tos = (cell_t) &g_last) \ X("LAST", OP_LAST, DUP; tos = (cell_t) &g_last) \
@ -123,23 +121,24 @@ static const char boot[] =
" : nl 10 ; : cr nl emit ; " " : nl 10 ; : cr nl emit ; "
" : 1+ 1 + ; : 1- 1 - ; " " : 1+ 1 + ; : 1- 1 - ; "
" : 2* 2 * ; : 2/ 2 / ; " " : 2* 2 * ; : 2/ 2 / ; "
" : +! ( n a -- ) swap over @ + swap ! ; "
" : bye 0 sysexit ; "
// System Dependent // Dictionary and Cells
" : here ( -- a ) 'heap @ ; "
" : allot ( n -- ) 'heap +! ; "
" : cell+ ( n -- n ) cell + ; " " : cell+ ( n -- n ) cell + ; "
" : cells ( n -- n ) cell * ; " " : cells ( n -- n ) cell * ; "
" : cell/ ( n -- n ) cell / ; " " : cell/ ( n -- n ) cell / ; "
" : aligned ( a -- a ) cell 1 - dup >r + r> invert and ; " " : aligned ( a -- a ) cell 1 - dup >r + r> invert and ; "
" : align here aligned here - allot ; " " : align here aligned here - allot ; "
" : bye 0 sysexit ; " " : , ( n -- ) here ! cell allot ; "
" : c, ( ch -- ) here c! 1 allot ; "
// Compilation State // Compilation State
" : [ 0 state ! ; immediate " " : [ 0 state ! ; immediate "
" : ] -1 state ! ; immediate " " : ] -1 state ! ; immediate "
// Compile to Dictionary
" : , here ! cell allot ; "
" : c, here c! 1 allot ; "
// Quoting Words // Quoting Words
" : ' bl parse find ; " " : ' bl parse find ; "
" : ['] ' aliteral ; immediate " " : ['] ' aliteral ; immediate "