Loading cross.fs +29 −4 Original line number Diff line number Diff line Loading @@ -1058,6 +1058,18 @@ constant gwhere-struct tsourceview r> gwhere-loc ! THEN drop ; \ locations 0 Value glocs-start Variable cross-locs[] : gxt-location ( addr -- addr ) \ note that an xt was compiled at addr, for backtrace-locate functionality dup glocs-start - T 1 cells H / >r tsourceview dup r> 1+ cross-locs[] $[] cell- 2! ; \ search for ghosts : gfind ( string -- ghost true / string false ) \ searches for string in word-list ghosts \ dup count type space Loading Loading @@ -1920,6 +1932,7 @@ previous >TARGET : compile, ( xt -- ) T here H gxt-location drop dup xt>ghost >comp @ EXECUTE ; >CROSS Loading Loading @@ -2077,6 +2090,7 @@ Defer resolve-warning \ gexecute ghost, 01nov92py : (gexecute) ( ghost -- ) T here H gxt-location drop dup >comp @ EXECUTE ; : gexecute ( ghost -- ) Loading @@ -2084,6 +2098,7 @@ Defer resolve-warning (gexecute) ; : addr, ( ghost -- ) T here cell- H gxt-location drop dup 0= IF T a, H EXIT THEN dup forward? IF 1 refered 0 T a, H ELSE >link @ T a, H THEN ; Loading Loading @@ -2196,6 +2211,8 @@ X has? f83headerstring [IF] [ELSE] 0 allocate throw 0 included-files 2! [THEN] [IFDEF] loadfilename# loadfilename# off [THEN] s" kernel/main.fs" h-add-included-file ; : reset-locs ( -- ) T here H to glocs-start ; : glocs-start glocs-start ; : tsourcepos1 ( -- xpos ) [IFDEF] replace-sourceview replace-sourceview 0 to replace-sourceview ?dup ?EXIT Loading Loading @@ -2744,6 +2761,7 @@ ghost :-dummy Constant :-ghost : (:) ( ghost -- ) \ common factor of : and :noname. Prepare ;Resolve and start definition ;Resolve ! there ;Resolve cell+ ! T here cell- H gxt-location drop docol, ]comp colon-start depth T ] H ; : : ( -- colon-sys ) \ Name Loading Loading @@ -3185,6 +3203,13 @@ variable cross-boot[][] : wheres-off H 0 cross-wheres $!len ; : locs[], ( -- ) \ transfer locations to target cross-locs[] $@len cell/ T cells , H cross-locs[] $@ bounds DO I @ T , H cell +LOOP ; >CROSS \ instantiate deferred extra, now Loading kernel/comp.fs +7 −2 Original line number Diff line number Diff line Loading @@ -153,7 +153,8 @@ Defer check-shadow ( addr u wid -- ) view, dup here + dup maxaligned >align nlstring, r> 1 or A, here xt-location drop 0 A, here last ! here xt-location drop \ add location stamps on vt+cf r> 1 or A, 0 A, here last ! \ link field; before revealing, it contains the \ tagged reveal-into wordlist \ alias-mask lastflags cset Loading Loading @@ -196,7 +197,11 @@ defer header ( -- ) \ gforth ['] nextname-header IS (header) ; : noname, ( -- ) 0 last ! vt, here dup cfaligned >align 0 ( alias-mask ) , 0 , 0 , ; 0 last ! vt, here dup cfaligned >align 0 ( alias-mask ) , 0 , \ link field here xt-location drop \ add location stamps on vt+cf 0 , \ vtable field ; : noname-header ( -- ) noname, input-stream ; Loading kernel/main.fs +1 −0 Original line number Diff line number Diff line Loading @@ -70,6 +70,7 @@ has? kernel-size doc-off reset-included reset-locs include kernel/aliases.fs \ primitive aliases, are config-generated doc-on Loading kernel/pass.fs +4 −1 Original line number Diff line number Diff line Loading @@ -32,7 +32,7 @@ dup forth-wordlist has? ec 0= [IF] wordlist-id [THEN] ! Last ! unlock vt, tvtable-list @ lock vtable-list ! here to locs-start glocs-start .s cr to locs-start \ list of arrays to restore at boot align here boot[][] ! boot[][], Loading @@ -48,4 +48,7 @@ align here default-recognizer ! align here wheres ! wheres, align here locs[] ! locs[], >ram here normal-dp ! Loading
cross.fs +29 −4 Original line number Diff line number Diff line Loading @@ -1058,6 +1058,18 @@ constant gwhere-struct tsourceview r> gwhere-loc ! THEN drop ; \ locations 0 Value glocs-start Variable cross-locs[] : gxt-location ( addr -- addr ) \ note that an xt was compiled at addr, for backtrace-locate functionality dup glocs-start - T 1 cells H / >r tsourceview dup r> 1+ cross-locs[] $[] cell- 2! ; \ search for ghosts : gfind ( string -- ghost true / string false ) \ searches for string in word-list ghosts \ dup count type space Loading Loading @@ -1920,6 +1932,7 @@ previous >TARGET : compile, ( xt -- ) T here H gxt-location drop dup xt>ghost >comp @ EXECUTE ; >CROSS Loading Loading @@ -2077,6 +2090,7 @@ Defer resolve-warning \ gexecute ghost, 01nov92py : (gexecute) ( ghost -- ) T here H gxt-location drop dup >comp @ EXECUTE ; : gexecute ( ghost -- ) Loading @@ -2084,6 +2098,7 @@ Defer resolve-warning (gexecute) ; : addr, ( ghost -- ) T here cell- H gxt-location drop dup 0= IF T a, H EXIT THEN dup forward? IF 1 refered 0 T a, H ELSE >link @ T a, H THEN ; Loading Loading @@ -2196,6 +2211,8 @@ X has? f83headerstring [IF] [ELSE] 0 allocate throw 0 included-files 2! [THEN] [IFDEF] loadfilename# loadfilename# off [THEN] s" kernel/main.fs" h-add-included-file ; : reset-locs ( -- ) T here H to glocs-start ; : glocs-start glocs-start ; : tsourcepos1 ( -- xpos ) [IFDEF] replace-sourceview replace-sourceview 0 to replace-sourceview ?dup ?EXIT Loading Loading @@ -2744,6 +2761,7 @@ ghost :-dummy Constant :-ghost : (:) ( ghost -- ) \ common factor of : and :noname. Prepare ;Resolve and start definition ;Resolve ! there ;Resolve cell+ ! T here cell- H gxt-location drop docol, ]comp colon-start depth T ] H ; : : ( -- colon-sys ) \ Name Loading Loading @@ -3185,6 +3203,13 @@ variable cross-boot[][] : wheres-off H 0 cross-wheres $!len ; : locs[], ( -- ) \ transfer locations to target cross-locs[] $@len cell/ T cells , H cross-locs[] $@ bounds DO I @ T , H cell +LOOP ; >CROSS \ instantiate deferred extra, now Loading
kernel/comp.fs +7 −2 Original line number Diff line number Diff line Loading @@ -153,7 +153,8 @@ Defer check-shadow ( addr u wid -- ) view, dup here + dup maxaligned >align nlstring, r> 1 or A, here xt-location drop 0 A, here last ! here xt-location drop \ add location stamps on vt+cf r> 1 or A, 0 A, here last ! \ link field; before revealing, it contains the \ tagged reveal-into wordlist \ alias-mask lastflags cset Loading Loading @@ -196,7 +197,11 @@ defer header ( -- ) \ gforth ['] nextname-header IS (header) ; : noname, ( -- ) 0 last ! vt, here dup cfaligned >align 0 ( alias-mask ) , 0 , 0 , ; 0 last ! vt, here dup cfaligned >align 0 ( alias-mask ) , 0 , \ link field here xt-location drop \ add location stamps on vt+cf 0 , \ vtable field ; : noname-header ( -- ) noname, input-stream ; Loading
kernel/main.fs +1 −0 Original line number Diff line number Diff line Loading @@ -70,6 +70,7 @@ has? kernel-size doc-off reset-included reset-locs include kernel/aliases.fs \ primitive aliases, are config-generated doc-on Loading
kernel/pass.fs +4 −1 Original line number Diff line number Diff line Loading @@ -32,7 +32,7 @@ dup forth-wordlist has? ec 0= [IF] wordlist-id [THEN] ! Last ! unlock vt, tvtable-list @ lock vtable-list ! here to locs-start glocs-start .s cr to locs-start \ list of arrays to restore at boot align here boot[][] ! boot[][], Loading @@ -48,4 +48,7 @@ align here default-recognizer ! align here wheres ! wheres, align here locs[] ! locs[], >ram here normal-dp !
