duskos

commit 2a73a534610193d46664a9b52fff12a0e26bd0d6
parent f23e217f3b5b3d406fbf65d20d545fe8ba2cfc32
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Tue, 20 Jun 2023 21:39:51 -0400

Add word "here#"

This will be needed a lot to keep alignment discipline.

Diffstat:
M
fs/doc/dict.txt
 | 
1
+
M
fs/lib/drivelo.fs
 | 
2
+-
M
fs/xcomp/bootlo.fs
 | 
13
+++++++------

3 files changed, 9 insertions(+), 7 deletions(-)
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -151,6 +151,7 @@ width", a value that can be 1, 2 or 4 depending of the width of the operation.
 
 allot      u --          Increase here by u.
 allot0     u --          Allot u and fill this space with zeroes.
+here#      -- a          Align here to 4b and return it.
 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.
diff --git a/fs/lib/drivelo.fs b/fs/lib/drivelo.fs
@@ -24,5 +24,5 @@ struct[ SectorWindow
     else rdrop 2drop 0 then ;
   : :next bi+ sec 1+ | :drv secsz * swap :seek ;
   : :new ( drv -- secwin )
-    here >r dup , 0 , 1 , -1 , 0 , Drive secsz allot r> ;
+    here# >r dup , 0 , 1 , -1 , 0 , Drive secsz allot r> ;
 ]struct
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -180,12 +180,13 @@ _to to' noop _addr,
 : _toexec ( a -- ) compiling if m) then toptr@ execute ;
 : value doer , immediate does> _toexec ;
 : here HERE _toexec ; immediate
+: here# 0 align4 here ;
 : alias ' code branch, drop ;
 
 alias @ llnext
 : llend ( ll -- lastll ) begin dup llnext ?dup while nip repeat ( ll ) ;
 : llappend ( elem ll -- ) llend ! ;
-: lladd ( ll -- newll ) here swap llappend here 0 , ;
+: lladd ( ll -- newll ) here# swap llappend here 0 , ;
 
 \ Entry metadata
 : &+ ( n -- ) code W+n, exit, ;
@@ -199,7 +200,7 @@ alias @ llnext
 : _ ( w -- w-or-0 ) dup ['] noop = if drop 0 then ;
 : chain ( w1 w2 -- w )
   _ swap _ tuck over and? if
-    here rot execute, swap branch, drop else ?swap nip then ;
+    here# rot execute, swap branch, drop else ?swap nip then ;
 alias noop idle
 
 alias execute | immediate
@@ -371,7 +372,7 @@ struct[ Drive
   sfield seccnt
   smethod :sec@ ( sec dst drv -- )
   smethod :sec! ( sec src drv -- )
-  : :new ( secsz seccnt -- drv ) here rot , swap , ;
+  : :new ( secsz seccnt -- drv ) here# rot , swap , ;
   : :[methods] '" sec@" , '" sec!" , ;
 ]struct
 
@@ -385,7 +386,7 @@ 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, ;
+  : :new here# 0 ( putback ) , 4 nabort, ;
   alias drop close
   alias drop flush
   : :[methods] '" readbuf" , '" writebuf" , '" flush" , '" close" , ;
@@ -439,7 +440,7 @@ struct[ Filesystem
   smethod :remove
   : :drv [compile] drv [compile] Drive ; immediate
   : :writeable? flags 1 and ;
-  : :new ( drv -- fs ) here swap ( drv ) , 0 ( flags ) , 7 nabort, ;
+  : :new ( drv -- fs ) here# swap ( drv ) , 0 ( flags ) , 7 nabort, ;
   : :[methods]
     '" child" , '" info" , '" open" , '" iter" ,
     '" newfile" , '" newdir" , '" remove" , ;
@@ -463,7 +464,7 @@ extends IO struct[ File
   floaded begin ( id ll )
     ?dup while 2dup CELLSZ + @ <> while llnext repeat
     2drop 1 else drop 0 then ;
-: floaded, ( id -- ) dup floaded? if drop else here to@! floaded , , then ;
+: floaded, ( id -- ) dup floaded? if drop else here# to@! floaded , , then ;
 : \s console readio IO :close ;
 : fload ( fs id -- )
   dup floaded, swap Filesystem :open IO :interpret File :close ;