duskos

commit 9fe93ce5ce004661fa2d1d7e6bd949a16205e1e6
parent 8c78ee84f72b344f9901bc14aac566d100e0c05b
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Tue,  9 Aug 2022 15:31:34 -0400

Make each structure have their own "last instance" buffer

This way, we can have methods that refer to other structures without losing
the current "self".

Diffstat:
M
fs/tests/kernel.fs
 | 
7
+++++++
D
fs/tests/lib/struct.fs
 | 
16
----------------
M
fs/xcomp/bootlo.fs
 | 
37
++++++++++++++++++++++---------------

3 files changed, 29 insertions(+), 31 deletions(-)
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -96,8 +96,15 @@ MyFoo baz 42 #eq
 MyFoo baz 43 #eq
 MyFoo :bleh 44 #eq
 OtherFoo :bleh 7 #eq
+\ struct selection is made at each execution, not only at compile time
 : myword MyFoo bar ;
 myword 1 #eq
 OtherFoo bar 3 #eq
 myword 1 #eq
+\ Each structure has their own "last instance" copy
+1 struct Bar baz
+instance Bar MyBar 42 ,
+Bar baz 42 #eq
+MyFoo bar 1 #eq
+Bar baz 42 #eq
 testend
diff --git a/fs/tests/lib/struct.fs b/fs/tests/lib/struct.fs
@@ -1,16 +0,0 @@
-?f<< tests/harness.fs
-?f<< lib/struct.fs
-testbegin
-\ Testing lib/struct.fs
-
-struct Pos bfield pos.x bfield pos.y
-here to Pos 42 , 12 ,
-pos.x 42 #eq
-pos.y 12 #eq
-4 to+ pos.x
-pos.x 46 #eq
-Pos ( prev ) here to Pos 102 , 34 ,
-pos.y 34 #eq
-( prev ) to Pos
-pos.y 12 #eq
-testend
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -169,33 +169,40 @@ alias noop [then]
 \ Structures
 \ Structure's structure:
 \ 4b link to field list
+\ 4b pointer to last instance used
 \ Field's structure:
 \ 4b next
 \ Xb string
 
-create _currentinst CELLSZ allot
-: (struct()) ( off -- a ) _currentinst @ + ;
-: (struct) ( off ) _currentinst @ + ?toexec ;
-: (struct:) ( off ) _currentinst @ + to? ?dup if execute else @ execute then ;
-: _parens ( off ) compiling if litn compile (struct()) else (struct()) then ;
+\ Pointer to the last instance calling a struct. If nonzero, the struct will
+\ save it in its own buffer and set this variable to 0.
+: _getinst' ( 'struct -- ''inst ) CELLSZ +  ;
+: _getinst ( 'struct -- 'inst ) _getinst' @ ;
+: (struct()) ( off 'struct -- a ) _getinst + ;
+: (struct) ( off 'struct ) _getinst + ?toexec ;
+: (struct:) ( off 'struct )
+  _getinst + to? ?dup if execute else @ execute then ;
+: _parens ( 'struct off )
+  compiling if litn litn compile (struct()) else swap (struct()) then ;
 : struct ( cnt -- )
-  doer >r here 0 ,
+  doer >r here 0 , 0 ,
   begin ( ll ) lladd word c@+ dup c, move, next drop immediate
 does> ( ??? 'struct -- ??? *to* )
     word case ( 'struct R:str )
-      S" '(" of s= drop 0 _parens endof
-      S" ')" of s= llcnt CELLSZ * ( off ) _parens endof
+      S" '(" of s= 0 _parens endof
+      S" ')" of s= dup llcnt CELLSZ * ( 'struct off ) _parens endof
       \ find field in list
-      0 swap @ begin ( cnt ll )
+      0 over @ begin ( 'struct cnt ll )
         ?dup not if curword stype abort"  field doesn't exist!" then
         dup 4 + curword s= if leave else llnext swap 1+ swap then
-      next ( cnt ll ) drop CELLSZ * ( off )
-      curword 1+ c@ ':' = if ['] (struct:) else ['] (struct) then
-      compiling if swap litn execute, else execute then
+      next ( 'struct cnt ll ) drop CELLSZ * ( 'struct off )
+      curword 1+ c@ ':' = if ['] (struct:) else ['] (struct) then >r
+      compiling if litn litn r> execute, else swap r> execute then
     endcase ;
-: _inst! _currentinst ! ;
-: instance ' doer , here _currentinst ! immediate does>
-  dup CELLSZ + compiling if litn compile _inst! else _inst! then  @ execute ;
+: _inst! ( 'inst -- )
+  dup CELLSZ + swap @ ( 'inst 'structword ) does' _getinst' ! ;
+: instance ' doer here swap , _inst! immediate does>
+  dup compiling if litn compile _inst! else _inst! then @ execute ;
 
 \ Drive API
 \ Anticipating lib/drive