Inlined more words.
This commit is contained in:
@ -20,17 +20,14 @@
|
||||
: constant ( n "name" -- ) create , does> @ ;
|
||||
: variable ( "name" -- ) create 0 , ;
|
||||
|
||||
( System Variables )
|
||||
: sys: ( a -- a' "name" ) dup constant cell+ ;
|
||||
'sys sys: 'heap sys: current sys: 'context
|
||||
sys: 'latestxt sys: 'notfound
|
||||
sys: 'heap-start sys: 'heap-size sys: 'stack-cells
|
||||
sys: 'boot sys: 'boot-size
|
||||
sys: 'tib sys: #tib sys: >in
|
||||
sys: state sys: base
|
||||
sys: 'argc sys: 'argv sys: 'runner
|
||||
: context ( -- a ) 'context @ cell+ ;
|
||||
: latestxt ( -- xt ) 'latestxt @ ;
|
||||
( Stack Baseline )
|
||||
sp@ constant sp0
|
||||
rp@ constant rp0
|
||||
fp@ constant fp0
|
||||
: depth ( -- n ) sp@ sp0 - cell/ ;
|
||||
: fdepth ( -- n ) fp@ fp0 - 4 / ;
|
||||
|
||||
( Useful heap size words )
|
||||
: remaining ( -- n ) 'heap-start @ 'heap-size @ + 'heap @ - ;
|
||||
: used ( -- n ) 'heap @ sp@ 'stack-cells @ cells + - 28 + ;
|
||||
|
||||
@ -64,13 +61,6 @@
|
||||
: immediate? ( xt -- f ) >flags 1 and 0= 0= ;
|
||||
: postpone ' dup immediate? if , else aliteral ['] , , then ; immediate
|
||||
|
||||
( Stack Convience )
|
||||
sp@ constant sp0
|
||||
rp@ constant rp0
|
||||
fp@ constant fp0
|
||||
: depth ( -- n ) sp@ sp0 - cell/ ;
|
||||
: fdepth ( -- n ) fp@ fp0 - 4 / ;
|
||||
|
||||
( Rstack nest depth )
|
||||
variable nest-depth
|
||||
|
||||
|
||||
@ -77,6 +77,18 @@
|
||||
: >name ( xt -- a n ) dup >name-length swap >link& over aligned - swap ;
|
||||
: >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
|
||||
|
||||
( System Variables )
|
||||
: sys: ( a -- a' "name" ) dup constant cell+ ;
|
||||
'sys sys: 'heap sys: current sys: 'context
|
||||
sys: 'latestxt sys: 'notfound
|
||||
sys: 'heap-start sys: 'heap-size sys: 'stack-cells
|
||||
sys: 'boot sys: 'boot-size
|
||||
sys: 'tib sys: #tib sys: >in
|
||||
sys: state sys: base
|
||||
sys: 'argc sys: 'argv sys: 'runner
|
||||
: context ( -- a ) 'context @ cell+ ;
|
||||
: latestxt ( -- xt ) 'latestxt @ ;
|
||||
|
||||
: f= ( r r -- f ) f- f0= ;
|
||||
: f< ( r r -- f ) f- f0< ;
|
||||
: f> ( r r -- f ) fswap f< ;
|
||||
|
||||
@ -70,4 +70,24 @@
|
||||
X(">link&", TOLINKAT, tos = (cell_t) TOLINK(tos)) \
|
||||
X(">link", TOLINK, tos = *TOLINK(tos)) \
|
||||
X(">name", TONAME, DUP; *sp = (cell_t) TONAME(tos); tos = *TONAMELEN(tos)) \
|
||||
X(">body", TOBODY, tos = (cell_t) TOBODY(tos))
|
||||
X(">body", TOBODY, tos = (cell_t) TOBODY(tos)) \
|
||||
XV(internals, "'heap", THEAP, DUP; tos = (cell_t) &g_sys.heap) \
|
||||
Y(current, DUP; tos = (cell_t) &g_sys.current) \
|
||||
XV(internals, "'context", TCONTEXT, DUP; tos = (cell_t) &g_sys.context) \
|
||||
XV(internals, "'latestxt", TLATESTXT, DUP; tos = (cell_t) &g_sys.latestxt) \
|
||||
XV(internals, "'notfound", TNOTFOUND, DUP; tos = (cell_t) &g_sys.notfound) \
|
||||
XV(internals, "'heap-start", THEAP_START, DUP; tos = (cell_t) &g_sys.heap_start) \
|
||||
XV(internals, "'heap-size", THEAP_SIZE, DUP; tos = (cell_t) &g_sys.heap_size) \
|
||||
XV(internals, "'stack-cells", TSTACK_CELLS, DUP; tos = (cell_t) &g_sys.stack_cells) \
|
||||
XV(internals, "'boot", TBOOT, DUP; tos = (cell_t) &g_sys.boot) \
|
||||
XV(internals, "'boot-size", TBOOT_SIZE, DUP; tos = (cell_t) &g_sys.boot_size) \
|
||||
XV(internals, "'tib", TTIB, DUP; tos = (cell_t) &g_sys.tib) \
|
||||
X("#tib", NTIB, DUP; tos = (cell_t) &g_sys.ntib) \
|
||||
X(">in", TIN, DUP; tos = (cell_t) &g_sys.tin) \
|
||||
Y(state, DUP; tos = (cell_t) &g_sys.state) \
|
||||
Y(base, DUP; tos = (cell_t) &g_sys.base) \
|
||||
XV(internals, "'argc", ARGC, DUP; tos = (cell_t) &g_sys.argc) \
|
||||
XV(internals, "'argv", ARGV, DUP; tos = (cell_t) &g_sys.argv) \
|
||||
XV(internals, "'runner", RUNNER, DUP; tos = (cell_t) &g_sys.runner) \
|
||||
Y(context, DUP; tos = (cell_t) (g_sys.context + 1)) \
|
||||
Y(latestxt, DUP; tos = (cell_t) g_sys.latestxt)
|
||||
|
||||
@ -108,11 +108,6 @@ e: check-boot
|
||||
out: next
|
||||
out: for
|
||||
out: nest-depth
|
||||
out: fdepth
|
||||
out: depth
|
||||
out: fp0
|
||||
out: rp0
|
||||
out: sp0
|
||||
out: postpone
|
||||
out: recurse
|
||||
out: aft
|
||||
@ -134,13 +129,11 @@ e: check-boot
|
||||
out: [
|
||||
out: used
|
||||
out: remaining
|
||||
out: latestxt
|
||||
out: context
|
||||
out: base
|
||||
out: state
|
||||
out: >in
|
||||
out: #tib
|
||||
out: current
|
||||
out: fdepth
|
||||
out: depth
|
||||
out: fp0
|
||||
out: rp0
|
||||
out: sp0
|
||||
out: variable
|
||||
out: constant
|
||||
out: \
|
||||
@ -208,6 +201,14 @@ e: check-extra-opcodes
|
||||
out: >link
|
||||
out: >name
|
||||
out: >body
|
||||
|
||||
out: current
|
||||
out: #tib
|
||||
out: >in
|
||||
out: state
|
||||
out: base
|
||||
out: context
|
||||
out: latestxt
|
||||
;e
|
||||
|
||||
e: check-core-opcodes
|
||||
|
||||
@ -49,19 +49,15 @@ variable scope scope context cell - !
|
||||
|
||||
transfer{
|
||||
xt-find& xt-hide xt-transfer
|
||||
voc-stack-end last-vocabulary
|
||||
'context 'notfound notfound
|
||||
voc-stack-end last-vocabulary notfound
|
||||
immediate? input-buffer ?echo ?arrow. arrow
|
||||
evaluate-buffer
|
||||
'sys 'heap aliteral 'heap-start 'heap-size
|
||||
'stack-cells 'boot 'boot-size 'latestxt
|
||||
'argc 'argv 'runner 'tib
|
||||
evaluate-buffer aliteral
|
||||
leaving( )leaving leaving leaving,
|
||||
(do) (?do) (+loop)
|
||||
parse-quote digit $@ raw.s
|
||||
tib-setup input-limit
|
||||
[SKIP] [SKIP]' raw-ok
|
||||
$place zplace sys: BUILTIN_MARK
|
||||
$place zplace BUILTIN_MARK
|
||||
}transfer
|
||||
forth definitions
|
||||
|
||||
|
||||
Reference in New Issue
Block a user