18 files changed, 235 insertions(+), 133 deletions(-)

M fs/doc/dict.txt
M fs/doc/struct.txt
M fs/drv/fbgrid/fbgrid.fs
M fs/drv/pc/com.fs
M fs/drv/pc/vesa.fs
M fs/drv/pc/vga.fs
M fs/fs/fat.fs
M fs/fs/fatlo.fs
M fs/gr/plane.fs
M fs/lib/file.fs
M fs/sys/grid.fs
M fs/sys/io.fs
M fs/sys/rdln.fs
M fs/sys/screen.fs
M fs/tests/kernel.fs
M fs/text/ed.fs
M fs/xcomp/bootlo.fs
M posix/glue.fs

@@ 154,11 154,14 @@ allot0     u --          Allot u and fill this space with zeroes.
 move       src dst u --  Copy u bytes from address src to address dst, moving
                          upwards.
 move,      src u --      Copy u bytes to "here" and increase "here" by u.
+-move,     src u --      Rewind "here" by u, then call "move,".
 fill       a u c --      Fill range [a, a+u] with byte c.
 align4     n --          Allot 0, 1, 2 or 3 bytes so that "here+n" is divisible
                          by 4.
 nc,        n --          Parse n numbers from input stream and write them as
                          8-bit values.
+nabort,    n --          Write address of word "abort" n times. Used for method
+                         placeholders.
 [c]?       c a u -- i    Search for character c in range [a, a+u] and yield its
                          index or -1 if not found.
 


@@ 268,6 271,7 @@ find       name 'dict -- word-or-0
   match was found.
 '          "x" -- w  Find x in system dictionary and error out if not found.
 [']        "x" --    *I* Find x and compile its address as a literal.
+'"         "x" --    *I* Compile x as a string followed by a call to '.
 w>e        w -- e    Yield an entry (linked list pointer) from a word reference.
 e>w        e -- w    Yield a word reference (executable) from an entry.
 entry      'dict s --

@@ 163,11 163,97 @@ Warning: do not augment a struct with new fields if it has already been extended
 by another struct because this will generate slot conflicts. You can augment a
 struct that has been extended, that will work, but only with non-field words.
 
-## Name conventions
+## Structure conventions
+
+What is described above is the structure mechanism. That's how it works. If you
+look at how structures are used in Dusk OS, you'll see some patterns emerge that
+aren't described above. Those are conventions. You don't have to follow them in
+your own code, but if you want to interact with Dusk structures, you need to
+know about them.
 
 A structure begins with an uppercase letter and a word in a namespace that is
 intended to be called from the outside (so, not only methods) begin with a ":".
 
+A structure "constructor" has the name ":new". Is is expected to consume
+initialization arguments from PS and yield a single element: the address of the
+created structure.
+
+Structure allocation is often made directly to "here" (with dynamic allocation
+details left to the caller), but not always.
+
+When a structure extends another, it's common practive for the extending struct
+to call its base struct's ":new" method and add to it.
+
+Structure methods initialization is a bit tricky. The whole point of those
+methods is to allow a structure that extends another structure to override them.
+For this to be done harmoniously, the "extender" struct, at *compile* time,
+needs to make a list of those methods it want to write, and overwrite the
+methods that were written by the base struct. For simplicity, this is often done
+using a combination of "S[" and "-move,". Example:
+
+    struct[ MyAbstract
+      smethod :foo
+      : :new here ['] abort , ;
+    ]struct
+    extends MyAbstract struct[ MyImpl
+      sfield myfield
+      : impl drop 42 ;
+      : :new MyAbstract :new S[ ' impl , ]S c@+ -move, 54 ( myfield ) , ;
+    ]struct
+    MyImpl :new dup :foo . \ prints 42
+    myfield . \ prints 54
+
+For this to work, methods need to be the last fields of the struct (but
+"extenders" can add other fields on top of it), which is another convention that
+Dusk OS follows.
+
+Because the pattern above requires every struct "extender" to repeat the name
+of the methods and because this is tedious and verbose, another convention
+emerges from that: Method implementations have the name of the method, minus the
+":" prefix, and base structs have a ":[methods]" word that dynamically look for
+those names and write them. Then, "extenders" call this method at compile time
+and write this string down in their ":new" implementation. This results in code
+that looks like this:
+
+    struct[ MyAbstract
+      smethod :foo
+      : :new here ['] abort , ;
+      : :[methods] '" foo" , ;
+    ]struct
+    extends MyAbstract struct[ MyImpl
+      sfield myfield
+      : foo drop 42 ;
+      : :new MyAbstract :new S[ :[methods] , ]S c@+ -move, 54 ( myfield ) , ;
+    ]struct
+
+With one "extender", the gain is slim (null in fact), but as extenders multiply,
+this patterns allows us to minimize code duplication and make changes in base
+structures much easier.
+
+Note that this pattern only works for direct extension overrides (the most
+frequent case). If a struct extender needs to override a method from a structure
+more than 1 level deep in the hierarchy, the pattern is a bit more complex and
+involves base structures creating a "METHSZ" constant. Here's an example:
+
+    struct[ A
+      sfield a
+      SZ &+ :methods(
+      smethod :foo
+      : :new here 0 ( a ) , ['] abort , ;
+      : :[methods] '" foo" , ;
+    ]struct
+    extends A struct[ B
+      sfield b
+      : :new A :new 0 ( b ) , ;
+    ]struct
+    extends B struct[ C
+      sfield c
+      : :new B :new 0 ( c ) ,
+        S[ A :[methods] ]S c@+ dip over A :methods( | move ;
+    ]struct
+
+So, a bit more verbose than the direct variant, but it happens much less often.
+
 ## API
 
 struct[ "name"  -- Create a struct named "name" and enter its definition

@@ 73,10 73,7 @@ extends Grid struct[ FbGrid
     repeat rdrop rdrop rdrop ;
   : :new ( -- grid )
     screen width 8 / screen height 8 / Grid :new
-    ['] cell! over ['] :cell! sfield!
-    ['] cursor! over ['] :cursor! sfield!
-    ['] newln over ['] :newln sfield!
-    ['] highlight over ['] :highlight sfield! ;
+    S[ :[methods] ]S c@+ -move, ;
 ]struct
 
 : fbgrid$ screen :activate FbGrid :new ['] grid rebind

@@ 19,10 19,9 @@ $3f8 const COMPORT
 
 extends IO struct[ COM1
   create _buf 0 c,
-  : _readbuf ( n self -- a? read-n )
+  : readbuf ( n self -- a? read-n )
     2drop com>? if _buf tuck c! 1 else 0 then ;
-  : _writebuf ( a n self -- written-n )
-    2drop c@ >com 1 ;
-  : :new here 0 , ['] _readbuf , ['] _writebuf , ['] drop dup , , ;
+  : writebuf ( a n self -- written-n ) 2drop c@ >com 1 ;
+  : :new IO :new S[ :[methods] ]S c@+ -move, ;
 ]struct
 COM1 :new structbind COM1 com1

@@ 102,7 102,7 @@ $111 value vesamode
 
 extends Screen struct[ VESA2Screen \ for VBE2
   \ Here, we deal only with linear modes
-  : _activate ( self -- )
+  : activate ( self -- )
     vesamode _modeinfo dup VBEModeInfo :linear? _assert ( mode )
     _curmode :self VBEModeInfo SZ move
     0 vesamode $4000 or $4f02 int10h ( self bx ax )


@@ 112,12 112,10 @@ extends Screen struct[ VESA2Screen \ for VBE2
     _curmode pitch over to pitch
     _curmode framebuffer swap to buffer ;
 
-  : _deactivate ( self -- ) 0 to buffer vgatext! ;
+  : deactivate ( self -- ) 0 to buffer vgatext! ;
 
   : :new ( -- screen )
-    0 0 COLOR_RGB565 Screen :new ( screen )
-    ['] _activate over ['] :activate sfield!
-    ['] _deactivate over ['] :deactivate sfield! ;
+    0 0 COLOR_RGB565 Screen :new ( screen ) S[ :[methods] ]S c@+ -move, ;
 ]struct
 
 $a0000 const VESABANK \ for nonlinear modes, the address of the 64K bank


@@ 130,7 128,7 @@ extends Screen struct[ VESA1Screen \ for VBE1.2
   0 value bank \ currently activated bank
   1 value bankmult
 
-  : _activate ( self -- )
+  : activate ( self -- )
     vesamode _modeinfo dup VBEModeInfo :linear? not _assert
     dup VBEModeInfo winfuncptr _assert ( mode )
     _curmode :self VBEModeInfo SZ move


@@ 142,19 140,17 @@ extends Screen struct[ VESA1Screen \ for VBE1.2
     $40 _curmode granularity / to bankmult
     VESABANK swap to buffer ;
 
-  : _deactivate ( self -- ) 0 to buffer vgatext! ;
+  : deactivate ( self -- ) 0 to buffer vgatext! ;
 
   : _bank! ( n -- )
     dup bankmult * 0 $4f05 int10h 2drop ( dup 1 $4f05 int10h 2drop ) to bank ;
 
   : _?bank! ( off -- ) 16 rshift dup bank = if drop else _bank! then ;
 
-  : _xyoffbank ( x y self -- n ) _xyoff dup _?bank! $ffff and ;
+  : xyoff ( x y self -- n ) Plane xyoff dup _?bank! $ffff and ;
 
   : :new ( -- screen )
     0 0 COLOR_RGB565 Screen :new ( screen )
-    0 ( bank ) ,
-    ['] _activate over ['] :activate sfield!
-    ['] _deactivate over ['] :deactivate sfield!
-    ['] _xyoffbank over ['] :xyoff sfield! ;
+    S[ :[methods] ]S c@+ -move, 0 ( bank ) ,
+    S[ Plane :[methods] ]S c@+ dip over Plane :methods( | move ;
 ]struct

@@ 19,12 19,7 @@ extends Grid struct[ VgaGrid
   create _tbl $f , $7f ,
   : highlight ( f pos -- ) << _mem( + 1+ swap bool CELLSZ * _tbl + @ swap c! ;
 
-  : :new ( -- grid )
-    _COLS _LINES Grid :new
-    ['] cell! over ['] :cell! sfield!
-    ['] cursor! over ['] :cursor! sfield!
-    ['] newln over ['] :newln sfield! 
-    ['] highlight over ['] :highlight sfield! ;
+  : :new ( -- grid ) _COLS _LINES Grid :new S[ :[methods] ]S c@+ -move, ;
 ]struct
 
 \ Set video mode to text mode, 80x25

@@ 113,12 113,12 @@ $e5 const DIRFREE
   r> findfreedirentry dup DirEntry SZ 0 fill ( direntry )
   fnbuf( over DirEntry NAMESZ move ( direntry ) ;
 
-:realias :newfile ( dirid name self -- id ) >r
+:realias newfile ( dirid name self -- id ) >r
   r@ _newentry ( dirent ) r@ writecursector r> :getid ;
 
 : _makedir ( dirent -- dirent ) $10 over to DirEntry attr ;
 
-:realias :newdir ( dirid name self -- id )
+:realias newdir ( dirid name self -- id )
   r! allocatecluster0 >r ( dirid name ) \ V1=self V2=cluster
   V1 _newentry ( dirent ) _makedir ( dirent )
   V2 over to DirEntry cluster V1 writecursector ( dirent )


@@ 142,10 142,10 @@ $e5 const DIRFREE
   swap r@ :FirstSectorOfCluster ( dst sec )
   swap r@ secpercluster swap r> writesectors ;
 
-:realias :info ( id self -- info ) FATInfo :read ;
+:realias info ( id self -- info ) FATInfo :read ;
 
 \ TODO: deallocate the chain before clearing the entry
-:realias :remove ( id self -- )
+:realias remove ( id self -- )
   tuck :getdirentry ( dirent ) DIRFREE swap c! writecursector ;
 
 \ Read next sector if a sequential read is available, else return false.


@@ 159,7 159,7 @@ $e5 const DIRFREE
   dup DirEntry :lastentry? if drop 0 else
     dup DirEntry :iterable? not if V1 _next then then ( entry ) rdrop ;
 
-:realias :iter ( dirid previd self -- id-or-0 ) >r >r \ V1=self V2=previd
+:realias iter ( dirid previd self -- id-or-0 ) >r >r \ V1=self V2=previd
   V1 :getdirentry V1 :readdir V1 :dirwin :buf( DirEntry SZ - V2 if begin ( entry )
       V1 _next dup while dup V1 :getid V2 <> while repeat then then ( entry-or-0 )
   dup if V1 _next dup if V1 :getid then then 2rdrop ;


@@ 204,7 204,7 @@ create _FATTemplate
 ]struct
 
 struct+[ FATFile
-  : _flush ( hdl -- )
+  :realias flush ( hdl -- )
     r! :dirty? not if rdrop exit then ( )
     \ save buffer
     r@ cluster r@ :buf( r@ :fat writecluster ( )


@@ 213,7 213,6 @@ struct+[ FATFile
     r@ :fat writecursector
     \ undirty the cursor
     r@ flags $fffffffd and to r> flags ;
-  current ' :flush realias
 
   \ grow fcursor to newsz, if needed
   : _grow ( newsz self -- )


@@ 227,7 226,7 @@ struct+[ FATFile
     V1 size V1 :fat :ClusterSize / ?dup if
       for ( cluster ) V1 :fat FAT@+ next then ( cluster ) drop rdrop ;
 
-  : _writebuf ( buf n self -- n )
+  :realias writebuf ( buf n self -- n )
     dup :free? if 2drop drop 0 exit then ( buf n self )
     r! pos over + r@ _grow ( src n )
     \ TODO: this seek below doesn't seem right. The buffer should be at all times


@@ 237,13 236,11 @@ struct+[ FATFile
     r@ :)buf r@ :ptr - ( src n nmax )
     min ( src n ) r@ :ptr swap ( src dst n )
     r! move r> ( n ) r@ pos over + r> :seek ;
-  current ' :writebuf realias
 
   \ TODO: deallocate truncated FATs if appropriate
-  : _truncate ( self -- )
+  :realias truncate ( self -- )
     dup pos ( self pos )
     2dup swap to size ( self pos )
     over :dirent to DirEntry filesize ( self )
     :fat writecursector ;
-  current ' :truncate realias
 ]struct

@@ 137,7 137,7 @@ $18 const HDRSZ
   swap r@ :FirstSectorOfCluster ( dst sec )
   swap r@ secpercluster swap r> :readsectors ;
 
-: :child ( dirid name self -- id-or-0 ) >r
+: child ( dirid name self -- id-or-0 ) >r
   fnbuf! r@ :getdirentry r@ :readdir r@ :findindir
   dup if r@ :getid then rdrop ;
 ]struct


@@ 162,15 162,15 @@ extends File struct[ FATFile
   : :dirent ( self -- dirent ) bi entryoff | :fat :getdirentry ;
   : :cluster0 ( self -- cl ) :dirent DirEntry cluster ;
 
-  alias abort :writebuf
-  alias drop :flush
-  alias abort :truncate
+  alias abort writebuf
+  alias drop flush
+  alias abort truncate
 
   : _poscluster ( self -- idx ) bi pos | bufsz / ;
   : _inbounds? ( self -- f ) bi _poscluster | clusteridx = ;
   \ set self to pos. If new pos crosses cluster boundaries compared to current
   \ pos, flush current buffer and read a new sector from disk.
-  : :seek ( pos self -- )
+  : seek ( pos self -- )
     dup :free? if 2drop exit then >r ( pos ) \ V1=self
     dup 0< if abort" can't seek to negative pos" then
     V1 to pos V1 _inbounds? not if


@@ 178,7 178,7 @@ extends File struct[ FATFile
       V1 :cluster0 ( idx cl ) swap for ( cl ) V1 :fat :FAT@ next ( cl )
       dup V1 :buf( V1 :fat :readcluster ( cl ) V1 to cluster then rdrop ;
 
-  : :readbuf ( n self -- a? n )
+  : readbuf ( n self -- a? n )
     dup :free? if 2drop 0 exit then ( n self )
     bi+ size | pos - ( n self maxn )
     dup 1- 0< if ( EOF ) 2drop drop 0 exit then swap >r ( n maxn ) \ V1=self


@@ 187,19 187,19 @@ extends File struct[ FATFile
     r@ :ptr r@ :)buf over - ( n a nmax )
     rot min ( a n ) dup r> to+ pos ( a n ) ;
 
-  : :close ( self -- ) dup :flush :release ;
+  : close ( self -- ) dup :flush :release ;
   : :open ( direntry self -- )
     r! :hold dup V1 :fat :getid ( dirent entryoff ) \ V1=self
     r@ to entryoff DirEntry filesize r@ to size ( )
     0 to r@ pos -1 to r> clusteridx ;
 
   : :new ( fat -- hdl )
-    0 align4 dup to' FAT lastcursor lladd ( fat newll ) drop here >r
-    0 ( putback ) , ['] :readbuf , ['] :writebuf , ['] :flush , ['] :close ,
-    0 ( pos ) , 0 ( size ) , 0 ( bufptr ) , dup FAT :ClusterSize ( bufsz ) ,
-    ['] :seek , ['] :truncate , ( fat ) , 0 ( flags ) , 0 ( cluster ) ,
+    0 align4 dup to' FAT lastcursor lladd drop ( fat )
+    File :new >r S[ :[methods] ]S c@+ -move, ( fat ) \ V1=hdl
+    S[ IO :[methods] ]S c@+ r@ IO :methods( swap move
+    dup ( fat ) , 0 ( flags ) , 0 ( cluster ) ,
     -1 ( clusteridx ) , 0 ( entryoff ) ,
-    here r@ to bufptr r@ bufsz allot r> ;
+    here r@ to bufptr FAT :ClusterSize dup allot r@ to bufsz r> ;
 ]struct
 
 struct+[ FAT


@@ 208,21 208,20 @@ struct+[ FAT
       ?dup while dup CELLSZ + FATFile :free? not while llnext repeat
       nip CELLSZ + else FATFile :new then ;
 
-  : :open ( id self -- hdl )
+  : open ( id self -- hdl )
     tuck :getdirentry swap :findfreecursor ( dirent hdl )
     tuck FATFile :open ;
 
-  alias abort :info
-  alias abort :iter
-  alias abort :newfile
-  alias abort :newdir
-  alias abort :remove
+  alias abort info
+  alias abort iter
+  alias abort newfile
+  alias abort newdir
+  alias abort remove
 
   : :mountvolume ( drv -- fs )
     dup SectorWindow :new over SectorWindow :new rot
-    here >r ( fatwin dirwin rot ) \ V1=fs
-    dup , 0 ( flags ) , ['] :child , ['] :info , ['] :open ,
-    ['] :iter , ['] :newfile , ['] :newdir , ['] :remove ,
+    dup Filesystem :new >r ( fatwin dirwin drv ) \ V1=fs
+    S[ :[methods] ]S c@+ -move,
     0 ( bufcluster ) , 0 ( lastcursor ) , rot ( fatwin ) , swap ( dirwin ) ,
     \ At this point, "here" points to the FAT-header-to-be. Read the first sector
     \ directly in "here": we'll have the header right here!

@@ 13,11 13,12 @@ extends Rect struct[ Plane
   sfield ty
   sfield color
   sfield buffer
+  SZ &+ :methods(
   smethod :xyoff ( x y self -- n )
 
   : _colorbytes ( id -- nbytes ) colorbpp >> >> >> ;
 
-  : _xyoff ( x y self -- n )
+  : xyoff ( x y self -- n )
     tuck pitch * rot> encoding _colorbytes * + ;
 
   : _addr ( self -- a )


@@ 26,7 27,8 @@ extends Rect struct[ Plane
   : :new ( width height encoding -- plane )
     >r >r >r 0 0 r> r> Rect :new ( rect )
     r> ( encoding ) dup , _colorbytes over Rect width * ( pitch ) ,
-    0 ( tx ) , 0 ( ty ) , 0 ( color ) , 0 ( buffer ) , ['] _xyoff , ;
+    0 ( tx ) , 0 ( ty ) , 0 ( color ) , 0 ( buffer ) , ['] xyoff , ;
+  : :[methods] '" xyoff" , ;
 
   : :allotbuf ( self -- ) >r \ V1=self
     here r@ pitch r@ height * allot r> to buffer ;

@@ 2,36 2,37 @@
 
 extends File struct[ MemFile
   : _maxn ( n hdl -- real-n ) >r V1 pos + V1 size min r> pos - ;
-  : _readbuf ( n hdl -- a? read-n )
+  : readbuf ( n hdl -- a? read-n )
     >r V1 _maxn ( read-n ) dup if V1 :ptr swap dup V1 to+ pos then rdrop ;
-  : _writebuf ( a n hdl -- written-n )
+  : writebuf ( a n hdl -- written-n )
     >r V1 _maxn ( a write-n ) dup if ( a write-n )
       tuck V1 :ptr swap ( write-n a dst n ) move ( write-n ) dup V1 to+ pos
       else nip then rdrop ;
-  : _seek ( pos hdl -- ) to pos ;
-  : :new ( sz -- hdl ) here swap ( hdl sz )
-    0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] drop ,
-    0 ( pos ) , dup ( size ) , over SZ + ( bufptr ) , dup ( bufsz ) ,
-    ['] _seek , ( sz ) allot ;
+  : seek ( pos hdl -- ) to pos ;
+  alias drop truncate
+  : :new ( sz -- hdl )
+    File :new >r S[ :[methods] ]S c@+ -move, ( sz ) \ V1=hdl
+    S[ IO :[methods] ]S c@+ r@ IO :methods( swap move
+    dup to r@ size dup to r@ bufsz here to r@ bufptr allot r> ;
 ]struct
 
 extends File struct[ DriveFile
   sfield secwin
   : :secwin [compile] secwin [compile] SectorWindow ; immediate
-  : _flush :secwin :flush ;
-  : _seek ( pos self -- ) to pos ;
-  : _readbuf ( n self -- a? read-n )
+  : flush :secwin :flush ;
+  : seek ( pos self -- ) to pos ;
+  : readbuf ( n self -- a? read-n )
     over if
       swap >r bi+ pos | :secwin :seek ( self a? n ) r> min
       dup if rot over swap to+ pos then
       else drop then ;
-  : _writebuf ( a n self -- written-n )
-    r! _readbuf ( src dst? n ) dup if
+  : writebuf ( a n self -- written-n )
+    r! readbuf ( src dst? n ) dup if
       r! move r> r> :secwin :dirty! else nip rdrop then ;
+  alias drop truncate
   : :new ( drv -- hdl )
-    SectorWindow :new here ( secwin hdl )
-    0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] _flush , ['] drop ,
-    0 ( pos ) , -1 ( size ) , over SectorWindow :buf( ( bufptr ) ,
-    over SectorWindow :drv secsz ( bufsz ) , ['] _seek , ['] drop ( truncate ) ,
-    swap ( secwin ) , dup 0 -1 rot :secwin :move ;
+    SectorWindow :new File :new >r S[ :[methods] ]S c@+ -move, ( secwin ) ,
+    S[ IO :[methods] ]S c@+ r@ IO :methods( swap move
+    -1 to r@ size r@ :secwin :buf( to r@ bufptr
+    r@ :secwin :drv secsz to r@ bufsz 0 -1 r@ :secwin :move r> ;
 ]struct

@@ 39,9 39,11 @@ extends ByteWriter struct[ Grid
   : :spitoff ( self -- )
     ['] _emit swap ['] :writebyte sfield! ;
 
+  alias 2drop highlight
+  : :[methods] '" cell!" , '" cursor!" , '" newln" , '" highlight" , ;
   : :new ( cols lines -- grid )
     ['] _emit ByteWriter :new rot ( cols ) , swap ( lines ) , 0 , 0 ,
-    ['] abort , ['] abort , ['] abort , ['] 2drop , ;
+    4 nabort, ;
 
   : _dbgnum! ( n pos self -- )
     tuck :spiton tuck :.x :spitoff ;

@@ 48,14 48,14 @@ extends IO struct[ SumIO
   sfield fn
   sfield res
 
-  : _writebuf ( a n hdl -- written-n )
+  alias _ioerr readbuf
+  : writebuf ( a n hdl -- written-n )
     dup >r fn >r swap >r dup >r V1 res for ( n r ) \ V1=hdl V2=fn V3=a
       8b to@+ V3 V2 execute next ( n r )
     V1 to res 2rdrop 2rdrop ( written-n ) ;
   \ fn sig: ( sum c -- sum )
-  : :new ( 'fn -- hdl ) here swap ( hdl 'fn )
-    0 ( putback ) , ['] _ioerr , ['] _writebuf , ['] drop , ['] drop ,
-    ( 'fn ) , 0 , ;
+  : :new ( 'fn -- hdl )
+    IO :new S[ :[methods] ]S c@+ -move, swap ( 'fn ) , 0 , ;
 ]struct
 
 extends IO struct[ MemIO


@@ 64,9 64,9 @@ extends IO struct[ MemIO
   sfield ptr
 
   : _bounds ( n hdl -- n ) dup )buf swap ptr - min ;
-  : _readbuf ( n hdl -- a? read-n ) >r \ V1=self
+  : readbuf ( n hdl -- a? read-n ) >r \ V1=self
     V1 _bounds dup if r@ ptr swap dup to+ r> ptr else rdrop then ;
-  : _writebuf ( a n hdl -- written-n ) >r \ V1=self
+  : writebuf ( a n hdl -- written-n ) >r \ V1=self
     V1 _bounds dup if ( a n )
       dup >r V1 ptr ( src n dst ) swap move \ V2=n
       r> dup r> ( n n hdl ) to+ ptr ( written-n )


@@ 75,17 75,17 @@ extends IO struct[ MemIO
   : :eof? dup )buf swap ptr = ;
   : :rewind ( hdl -- ) dup buf( swap to ptr ;
   : :new ( a u -- hdl )
-    here >r 0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] drop ,
+    IO :new >r S[ :[methods] ]S c@+ -move,
     over , over + , , r> ;
 ]struct
 
 extends IO struct[ ByteWriter
   smethod :writebyte ( c self -- )
 
-  : _writebuf ( a n self -- written-n ) >r dup >r \ V1=self V2=n
+  alias _ioerr readbuf
+  : writebuf ( a n self -- written-n ) >r r! \ V1=self V2=n
     for ( a ) c@+ V1 :writebyte next drop r> rdrop ;
 
   : :new ( writebyte -- writer )
-    here 0 ( putback ) , ['] _ioerr , ['] _writebuf , ['] drop , ['] drop ,
-    swap ( writebyte ) , ;
+    IO :new S[ :[methods] ]S c@+ -move, swap ( writebyte ) , ;
 ]struct

@@ 23,10 23,10 @@ extends MemIO struct[ Rdln
     begin key V1 :lntype until
     V1 ptr V1 to )buf V1 :rewind r> )buf 1- c@ ESC <> ;
   : _readbuf2 ( n hdl -- a? read-n )
-    dup :eof? if begin ."  ok\n" dup :typeline until nl> then _readbuf ;
+    dup :eof? if begin ."  ok\n" dup :typeline until nl> then readbuf ;
   : :reset ['] _readbuf2 over ['] :readbuf sfield! dup )buf swap to ptr ;
   : :interpret
-    ['] _readbuf over ['] :readbuf sfield!
+    ['] readbuf over ['] :readbuf sfield!
     MemIO :interpret :reset ;
   : :new MemIO :new dup :reset ;
 ]struct

@@ 6,11 6,10 @@ extends Plane struct[ Screen
   smethod :deactivate ( self -- )
   smethod :activated? ( self -- f )
 
-  : _activated? ( self -- f ) buffer bool ;
-
+  : activated? ( self -- f ) buffer bool ;
   : :new ( width height encoding -- screen )
-    Plane :new ( screen )
-    ['] abort , ['] abort , ['] _activated? , ;
+    Plane :new ( screen ) S[ :[methods] ]S c@+ -move, 3 nabort, ;
+  : :[methods] '" activate" , '" deactivate" , '" activated?" , ;
 ]struct
 
 0 structbind Screen screen

@@ 158,4 158,15 @@ extends Foo struct[ Bazooka
 create data3 7 , 9 c, ' mybleh , 999 ,
 data3 Bazooka bling 999 #eq
 data3 Bazooka baz 9 #eq
+
+\ Test abstract method override mechanism
+struct[ MyAbstract
+  smethod :foo
+  : :[new] '" foo" , ;
+]struct
+extends MyAbstract struct[ MyImpl
+  : foo drop 42 ;
+  : :new here S[ MyAbstract :[new] ]S c@+ move, ;
+]struct
+MyImpl :new MyAbstract :foo 42 #eq
 testend

@@ 84,7 84,7 @@ extends IO struct[ Edbuf
   : :lastline? bi :lpos | :linecnt 1- = ;
   : _eof? ( self -- f ) bi :lastline? | _eol? and ;
   create _lf LF c,
-  : _readbuf ( n self -- a? read-n ) >r ( n ) \ V1=self
+  : readbuf ( n self -- a? read-n ) >r ( n ) \ V1=self
     r@ _eof? if rdrop drop 0 exit then
     r@ _eol? if drop 1 r@ :godown 0 r> _cpos! _lf 1 exit then
     r@ :sel Line cnt r@ :cpos - ( n1 n2 )


@@ 101,7 101,7 @@ extends IO struct[ Edbuf
     tuck V1 :cpos V2 Line :insert ( u )
     rdrop r> to+ pos ;
 
-  : _writebuf ( a n self -- written-n ) >r \ V1=self
+  : writebuf ( a n self -- written-n ) >r \ V1=self
     2dup LF rot> [c]? ( a u idx ) dup 0< if
       drop tuck r> _writeline ( written-n )
     else ( a u idx )


@@ 128,11 128,11 @@ extends IO struct[ Edbuf
       lpos V1 :lpos V1 :sel Line cnt bool + ( linehi linelo )
       tuck - 1+ swap V1 lines Array :delete V1 _ensureline then rdrop ;
 
+  alias :empty close
   : :new ( -- edbuf )
-    Arena :new Line SZ $200 Array :new here ( arena lines edbuf ) >r
-    0 ( putback ) , ['] _readbuf , ['] _writebuf , ['] drop , ['] :empty ,
-    swap ( arena ) , ( lines ) , 0 ( pos ) ,
-    r> dup :empty ;
+    Arena :new Line SZ $200 Array :new
+    IO :new S[ :[methods] ]S c@+ -move, ( arena lines edbuf )
+    rot ( arena ) , swap ( lines ) , 0 ( pos ) , dup :empty ;
 
   : :goleft ( n self -- ) dup :cpos rot - max0 swap _cpos! ;
   : :goright ( n self -- ) dup :cpos rot + over _cpos! _cbounds ;

@@ 253,23 253,25 @@ alias drop emit
 : nl> LF emit ; : spc> SPC emit ;
 :realias rtype ( a u ) for c@+ emit next drop ;
 : stype ( str -- ) c@+ rtype ;
-create _escapes 'n' c, 'r' c, '0' c,
-create _repl    LF  c, CR  c, 0   c,
+create _escapes 3 nc, 'n' 'r' '0'
+create _repl    3 nc, LF  CR  0
 : "< ( -- c )
   in< dup '"' = if drop -1 else dup '\' = if
     drop in< dup _escapes 3 [c]? dup 0>= if nip _repl + c@ else drop then
   then then ;
 : ," begin "< dup -1 <> while c, repeat drop ;
 code (s) r@ W>A, W) 8b) @, 1 W+n, RSP) +, rdrop W<>A, branchA,
-: _S compiling if compile (s) else here then here 1 allot here ;
-: S[ _S [compile] [ ; immediate
-: ]S ( str -- ) here -^ ( 'len len ) swap c! ;
-: S" _S ," [compile] ]S ; immediate
+: _S[ compiling if compile (s) else here then here 1 allot here ;
+: S[ _S[ [compile] [ ; immediate
+: _]S ( str -- ) here -^ ( 'len len ) swap c! ;
+: ]S _]S ] ;
+: S" _S[ ," _]S ; immediate
 : ."
   compiling if [compile] S" compile stype else
     begin "< dup 0>= while emit repeat drop then ; immediate
 : abort" [compile] ." compile abort ; immediate
 : word" [compile] S" NEXTWORD litn compile ! ; immediate
+: '" [compile] word" compile ' ; immediate
 
 code []= ( a1 a2 u -- f )
   W=0>Z, 0 Z) branchC, PSP) @!, W>A, begin \ P+4=a1 P+0=u A=a2


@@ 289,6 291,7 @@ code move ( src dst u -- )
   8 ps+, drop, exit,
 
 : move, ( src u -- ) here swap dup allot move ;
+: -move, ( src u -- ) here over - swap move ;
 
 \ Structures
 0 value _extends


@@ 321,7 324,7 @@ code move ( src dst u -- )
   else
     word" :self" code exit, \ :self is our root
     sysdict @ to _curroot then
-  word" SZ" code _cur e>w structsz' litn compile @ exit,
+  word" SZ" code _cur e>w structsz' litn W) @, exit,
 does> ( 'struct )
     _structfind
     dup 1- c@ $80 and not compiling and \ compile only if not immediate


@@ 361,11 364,12 @@ create _ 0 , EMETA_8B , EMETA_16B ,
   does> CELLSZ + @ over + @ execute ;
 : ssmethod doer CELLSZ STRUCTFIELD_STATICMETHOD _sfield
   does> CELLSZ + @ swap + @ execute ;
+: nabort, ( n -- ) ['] abort swap for dup , next drop ;
 
 \ 4b link to struct
 \ 4b link to data
 : structbind ( 'data -- ) ' doer , , immediate does> ( 'bind -- *to* )
-  @+ swap compiling if litn compile @ else @ swap then execute ;
+  @+ swap compiling if dup, m) @, else @ swap then execute ;
 : rebind ( 'data 'bind -- ) does' CELLSZ + ! ;
 
 struct[ Drive


@@ 373,10 377,13 @@ struct[ Drive
   sfield seccnt
   smethod :sec@ ( sec dst drv -- )
   smethod :sec! ( sec src drv -- )
+  : :new ( secsz seccnt -- drv ) here rot , swap , ;
+  : :[methods] '" sec@" , '" sec!" , ;
 ]struct
 
 struct[ IO
   sfield putback
+  SZ &+ :methods(
   smethod :readbuf   ( n hdl -- a? read-n )
   smethod :writebuf  ( a n hdl -- written-n )
   smethod :flush     ( hdl -- )


@@ 384,23 391,25 @@ struct[ IO
   : :getc ( hdl -- c )
     dup putback ?dup if ( hdl c ) 0 rot to putback else ( hdl )
       1 swap :readbuf if c@ else -1 ( EOF ) then then ;
+  : :new here 0 ( putback ) , 4 nabort, ;
+  alias drop close
+  alias drop flush
+  : :[methods] '" readbuf" , '" writebuf" , '" flush" , '" close" , ;
 ]struct
 
 extends IO struct[ Pipe
   sfield readio
   sfield writeio
 
-  : _readbuf readio :readbuf ;
-  : _writebuf writeio :writebuf ;
-  : _flush writeio :flush ;
+  : readbuf readio :readbuf ;
+  : writebuf writeio :writebuf ;
+  : flush writeio :flush ;
   : :new ( readio writeio -- pipe )
-    here 0 , ['] _readbuf , ['] _writebuf , ['] _flush , ['] drop ,
-    rot ( readio ) , swap ( writeio ) , ;
+    IO :new S[ :[methods] ]S c@+ -move, rot ( readio ) , swap ( writeio ) , ;
   : _chain! ( w1 'w2 -- ) dup @ rot swap chain swap ! ;
   : :addrfilter ( w self -- ) CELLSZ + _chain! ;
   : :addwfilter ( w self -- ) CELLSZ << + _chain! ;
-  : :filters$ ( self -- )
-    ['] _readbuf swap CELLSZ + !+ ['] _writebuf swap ! ;
+  : :filters$ ( self -- ) ['] readbuf swap CELLSZ + !+ ['] writebuf swap ! ;
 ]struct
 
 : _ioerr abort" Invalid I/O" ;


@@ 426,7 435,7 @@ struct+[ IO
 
 struct[ Filesystem
   sfield drv
-  sfield flags \ b0=writeable
+  sfield flags
   smethod :child
   smethod :info
   smethod :open


@@ 436,12 445,16 @@ struct[ Filesystem
   smethod :remove
   : :drv [compile] drv [compile] Drive ; immediate
   : :writeable? flags 1 and ;
+  : :new ( drv -- fs ) here swap ( drv ) , 0 ( flags ) , 7 nabort, ;
+  : :[methods]
+    '" child" , '" info" , '" open" , '" iter" ,
+    '" newfile" , '" newdir" , '" remove" , ;
 ]struct
 \ bootfs holds a reference to boot FS. This is used until the full sys/file
 \ subsystem takes over with Path mechanics.
-0 value bootfs \ has to be set before first use
+0 value bootfs
 extends IO struct[ File
-  sfield pos      \ offset from beginning of file
+  sfield pos
   sfield size
   sfield bufptr
   sfield bufsz


@@ 450,6 463,9 @@ extends IO struct[ File
   : :buf( bufptr ;
   : :)buf bi :buf( | bufsz + ;
   : :ptr bi+ pos | bufsz mod swap :buf( + ;
+  : :new ( -- hdl )
+    IO :new 0 ( pos ) , 0 ( size ) , 0 ( bufptr ) , 0 ( bufsz ) , 2 nabort, ;
+  : :[methods] '" seek" , '" truncate" , ;
 ]struct
 
 \ File loading

@@ 1,17 1,15 @@
-: _ doer ' , does> nip @ execute ;
-_ _:child _fchild    _ _:open _fopen  _ _:info _finfo _ _:iter _fiter
-
-create _POSIXFS
-  0 , 0 ,
-  ' _:child ,
-  ' _:info ,
-  ' _:open ,
-  ' _:iter ,
-  ' abort ,
-  ' abort ,
-  ' abort ,
-
-_POSIXFS to bootfs
+extends Filesystem struct[ POSIXFS
+  : _ doer ' , does> nip @ execute ;
+  _ child _fchild
+  _ open _fopen
+  _ info _finfo
+  _ iter _fiter
+  alias abort newfile
+  alias abort newdir
+  alias abort remove
+  : :new 0 Filesystem :new S[ :[methods] ]S c@+ -move, ;
+]struct
+POSIXFS :new to bootfs
 
 : mountImage ( imgname -- drv )
   _mountdrv here 512 , -1 , ['] _drv@ , ['] _drv! , ;