Miroirs/planckforth
1
0
Fork 0
mirror of https://github.com/nineties/planckforth synced 2025-01-14 08:01:27 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Change semantics of here and latest

Browse source
This commit is contained in:
Koichi Nakamura 2021-01-02 09:40:40 +09:00
parent d218a9eda2
commit 4af7b69472
1 changed files with 25 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
core.fs
View file

@ -426,8 +426,8 @@ set-immediate \
alias-builtin bye Q alias-builtin bye Q
alias-builtin cell C alias-builtin cell C
alias-builtin here h alias-builtin &here h
alias-builtin latest l alias-builtin &latest l
alias-builtin key k alias-builtin key k
alias-builtin emit t alias-builtin emit t
alias-builtin branch j alias-builtin branch j
@ -456,6 +456,9 @@ alias-builtin xor ^
: c, B ; : c, B ;
: cmove, m ; : cmove, m ;
: here &here @ ;
: latest &latest @ ;
\ === Compilers === \ === Compilers ===
\ compile: ( n -- ) \ compile: ( n -- )
@ -486,7 +489,7 @@ alias-builtin xor ^
\ ( -- xt ) \ ( -- xt )
: :noname : :noname
here @ here
[ docol ] literal , \ compile docol [ docol ] literal , \ compile docol
] \ enter compile mode ] \ enter compile mode
; ;
@ -527,7 +530,7 @@ alias-builtin xor ^
\ ( -- ) \ ( -- )
\ Round up 'here' to nearlest multiple to CELL \ Round up 'here' to nearlest multiple to CELL
: align here @ aligned here ! ; : align here aligned &here ! ;
\ === Stack Manipulation === \ === Stack Manipulation ===
@ -601,13 +604,13 @@ alias-builtin xor ^
\ runtime: ( n -- ) \ runtime: ( n -- )
: if : if
compile 0branch compile 0branch
here @ 0 , \ save location of offset, fill dummy here 0 , \ save location of offset, fill dummy
; immediate ; immediate
\ compile: ( orig -- ) \ compile: ( orig -- )
\ runtime: ( -- ) \ runtime: ( -- )
: then : then
here @ \ ( orig dest ) here \ ( orig dest )
over - \ ( orig offset ) over - \ ( orig offset )
swap ! \ fill offset to orig swap ! \ fill offset to orig
; immediate ; immediate
@ -616,10 +619,10 @@ alias-builtin xor ^
\ runtime: ( -- ) \ runtime: ( -- )
: else : else
compile branch compile branch
here @ 0 , \ save location of offset, fill dummy here 0 , \ save location of offset, fill dummy
swap swap
\ fill offset, here-orig1, to orig1 \ fill offset, here-orig1, to orig1
here @ here
over - over -
swap ! swap !
; immediate ; immediate
@ -643,21 +646,21 @@ alias-builtin xor ^
\ compile: ( -- dest ) \ compile: ( -- dest )
\ runtime: ( -- ) \ runtime: ( -- )
: begin : begin
here @ \ save location here \ save location
; immediate ; immediate
\ compile: ( dest -- ) \ compile: ( dest -- )
\ runtime: ( n -- ) \ runtime: ( n -- )
: until : until
compile 0branch compile 0branch
here @ - , \ fill offset here - , \ fill offset
; immediate ; immediate
\ compile: ( dest -- ) \ compile: ( dest -- )
\ runtime: ( -- ) \ runtime: ( -- )
: again : again
compile branch compile branch
here @ - , \ fill offset here - , \ fill offset
; immediate ; immediate
\ compile: ( dest -- dest orig ) \ compile: ( dest -- dest orig )
@ -666,7 +669,7 @@ alias-builtin xor ^
\ orig=location of while \ orig=location of while
: while : while
compile 0branch compile 0branch
here @ 0 , \ save location, fill dummy here 0 , \ save location, fill dummy
; immediate ; immediate
\ compile: ( dest orig -- ) \ compile: ( dest orig -- )
@ -676,8 +679,8 @@ alias-builtin xor ^
: repeat : repeat
swap swap
compile branch compile branch
here @ - , \ fill offset from here to begin here - , \ fill offset from here to begin
here @ over - swap ! \ backfill offset from while to here here over - swap ! \ backfill offset from while to here
; immediate ; immediate
\ === Recursive Call === \ === Recursive Call ===
@ -685,7 +688,7 @@ alias-builtin xor ^
\ recursive call. \ recursive call.
\ compiles xt of current definition \ compiles xt of current definition
: recurse : recurse
latest @ >cfa , latest >cfa ,
; immediate ; immediate
\ === Case === \ === Case ===
@ -777,8 +780,8 @@ alias-builtin xor ^
\ allocate n bytes \ allocate n bytes
: allot ( n -- c-addr ) : allot ( n -- c-addr )
here @ swap here swap
here +! &here +!
; ;
( === create and does> === ) ( === create and does> === )
@ -791,25 +794,25 @@ alias-builtin xor ^
\ When the word is executed, it pushs value of here \ When the word is executed, it pushs value of here
\ at the end of the entry. \ at the end of the entry.
: create : create
latest @ , \ fill link latest , \ fill link
here @ cell- latest ! \ update latest here cell- &latest ! \ update latest
word word
dup c, cmove, align \ fill length and name dup c, cmove, align \ fill length and name
docol , \ compile docol docol , \ compile docol
['] lit , ['] lit ,
here @ 3 cells + , \ compile the address here 3 cells + , \ compile the address
['] nop , \ does>, if any, will fill this cell ['] nop , \ does>, if any, will fill this cell
['] exit , \ compile exit ['] exit , \ compile exit
; ;
: does>-helper : does>-helper
latest @ >cfa latest >cfa
3 cells + tuck ! \ replace nop 3 cells + tuck ! \ replace nop
; ;
: does> : does>
0 [compile] literal \ literal for xt 0 [compile] literal \ literal for xt
here @ cell- \ save addr of xt here cell- \ save addr of xt
\ fill xt and exit after docol of latest \ fill xt and exit after docol of latest
compile does>-helper compile does>-helper