commit 63afc536ff4dec04754c8c43f6fe47b31160a27f
parent 0859de540a56b4ff73567121926ce021844ad421
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 9 Jun 2023 08:14:00 -0400
Rename S[ ]S to ,[ ], and change semantics slightly
I need to make data embedded in code to fit 4b alignment under ARM and this
needs a few adjustments in the way this code is organized. This is a first step.
Diffstat:
15 files changed, 39 insertions(+), 39 deletions(-)
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -367,8 +367,8 @@ alias "x y" -- Find word "x" in system dictionary and create entry "y" of
type "alias" pointing to it.
realias w t -- Make target word "t" into an alias to word "w".
S" x" -- *IC* Yield string literal with contents "x".
-S[ -- *IC* Begin building a string. See doc/usage
-]S -- Finish building a string.
+,[ -- *IC* Begin immediate writing mode. See doc/usage
+], -- Finish immediate writing.
chain w1 w2 -- w
Defines (to "here") and returns a new word that calls w1, then w2. w1 or w2
diff --git a/fs/doc/struct.txt b/fs/doc/struct.txt
@@ -189,7 +189,7 @@ 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:
+using a combination of ",[" and "-move,". Example:
struct[ MyAbstract
smethod :foo
@@ -198,7 +198,7 @@ using a combination of "S[" and "-move,". Example:
extends MyAbstract struct[ MyImpl
sfield myfield
: impl drop 42 ;
- : :new MyAbstract :new S[ ' impl , ]S c@+ -move, 54 ( myfield ) , ;
+ : :new MyAbstract :new ,[ ' impl , ], -move, 54 ( myfield ) , ;
]struct
MyImpl :new dup :foo . \ prints 42
myfield . \ prints 54
@@ -223,7 +223,7 @@ that looks like this:
extends MyAbstract struct[ MyImpl
sfield myfield
: foo drop 42 ;
- : :new MyAbstract :new S[ :[methods] , ]S c@+ -move, 54 ( myfield ) , ;
+ : :new MyAbstract :new ,[ :[methods] , ], -move, 54 ( myfield ) , ;
]struct
With one "extender", the gain is slim (null in fact), but as extenders multiply,
@@ -249,7 +249,7 @@ involves base structures creating a "METHSZ" constant. Here's an example:
extends B struct[ C
sfield c
: :new B :new 0 ( c ) ,
- S[ A :[methods] ]S c@+ dip over A :methods( | move ;
+ ,[ A :[methods] ], dip over A :methods( | move ;
]struct
So, a bit more verbose than the direct variant, but it happens much less often.
diff --git a/fs/doc/usage.txt b/fs/doc/usage.txt
@@ -75,15 +75,16 @@ character:
Any other character following the '\' results in that character being parsed as-
is, the preceding '\' being ignored.
-## The S[ string builder
+## The ,[ immediate builder
-You can also build a string at compile time by executing arbitrary code. This
-is done through the S[ words, which writes down the length byte placeholder and
-then drops to intepret mode in the same way "[" does. When this mode is closed
-by "]S", string length is calculated and written down. Example:
+You can also build a piece of data at compile time by executing arbitrary code.
+This is done through the ,[ words, which drops to intepret mode in the same way
+"[" does. Then, it lets you write whatever you want to write. When this mode is
+closed by "],", written length is calculated, and then the resulting range is
+yielded as two "a u" literals. Example usage:
- : foo S[ $68 c, $65 c, $6c dup c, c, $6f c, ]S ;
- foo stype \ prints "hello"
+ : foo ( -- a u ) ,[ $68 c, $65 c, $6c dup c, c, $6f c, ], ;
+ foo rtype \ prints "hello"
## Coroutines
diff --git a/fs/drv/fbgrid/fbgrid.fs b/fs/drv/fbgrid/fbgrid.fs
@@ -73,7 +73,7 @@ extends Grid struct[ FbGrid
repeat rdrop rdrop rdrop ;
: :new ( -- grid )
screen width 8 / screen height 8 / Grid :new
- S[ :[methods] ]S c@+ -move, ;
+ ,[ :[methods] ], -move, ;
]struct
: fbgrid$ screen :activate FbGrid :new ['] grid rebind
diff --git a/fs/drv/pc/com.fs b/fs/drv/pc/com.fs
@@ -22,6 +22,6 @@ extends IO struct[ COM1
: 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 IO :new S[ :[methods] ]S c@+ -move, ;
+ : :new IO :new ,[ :[methods] ], -move, ;
]struct
COM1 :new structbind COM1 com1
diff --git a/fs/drv/pc/vesa.fs b/fs/drv/pc/vesa.fs
@@ -115,7 +115,7 @@ extends Screen struct[ VESA2Screen \ for VBE2
: deactivate ( self -- ) 0 to buffer vgatext! ;
: :new ( -- screen )
- 0 0 COLOR_RGB565 Screen :new ( screen ) S[ :[methods] ]S c@+ -move, ;
+ 0 0 COLOR_RGB565 Screen :new ( screen ) ,[ :[methods] ], -move, ;
]struct
$a0000 const VESABANK \ for nonlinear modes, the address of the 64K bank
@@ -151,6 +151,6 @@ extends Screen struct[ VESA1Screen \ for VBE1.2
: :new ( -- screen )
0 0 COLOR_RGB565 Screen :new ( screen )
- S[ :[methods] ]S c@+ -move, 0 ( bank ) ,
- S[ Plane :[methods] ]S c@+ dip over Plane :methods( | move ;
+ ,[ :[methods] ], -move, 0 ( bank ) ,
+ ,[ Plane :[methods] ], dip over Plane :methods( | move ;
]struct
diff --git a/fs/drv/pc/vga.fs b/fs/drv/pc/vga.fs
@@ -19,7 +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 S[ :[methods] ]S c@+ -move, ;
+ : :new ( -- grid ) _COLS _LINES Grid :new ,[ :[methods] ], -move, ;
]struct
\ Set video mode to text mode, 80x25
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -180,8 +180,8 @@ extends File struct[ FATFile
: :new ( fat -- hdl )
dup FAT drv SectorWindow :new
over to' FAT lastcursor lladd drop ( fat secwin )
- File :new >r S[ :[methods] ]S c@+ -move, \ V1=hdl
- S[ IO :[methods] ]S c@+ r@ IO :methods( swap move
+ File :new >r ,[ :[methods] ], -move, \ V1=hdl
+ ,[ IO :[methods] ], r@ IO :methods( swap move
swap ( fat ) , ( secwin ) , 0 ( flags ) , 0 ( cluster ) ,
-1 ( clusteridx ) , 0 ( entryoff ) , r> ;
]struct
@@ -205,7 +205,7 @@ struct+[ FAT
: :mountvolume ( drv -- fs )
dup SectorWindow :new over SectorWindow :new rot
dup Filesystem :new >r ( fatwin dirwin drv ) \ V1=fs
- S[ :[methods] ]S c@+ -move,
+ ,[ :[methods] ], -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!
diff --git a/fs/lib/file.fs b/fs/lib/file.fs
@@ -13,8 +13,8 @@ extends File struct[ MemFile
tuck V1 :ptr swap ( write-n a dst n ) move ( write-n ) dup V1 to+ pos
else nip then rdrop ;
: :new ( sz -- hdl )
- File :new >r S[ :[methods] ]S c@+ -move, \ V1=hdl
- S[ IO :[methods] ]S c@+ r@ IO :methods( swap move
+ File :new >r ,[ :[methods] ], -move, \ V1=hdl
+ ,[ IO :[methods] ], r@ IO :methods( swap move
dup ( bufsz ) , dup to r@ size allot r> ;
]struct
@@ -32,7 +32,7 @@ extends File struct[ DriveFile
r! readbuf ( src dst? n ) dup if
r! move r> r> :secwin :dirty! else nip rdrop then ;
: :new ( drv -- hdl )
- SectorWindow :new File :new >r S[ :[methods] ]S c@+ -move, ( secwin ) ,
- S[ IO :[methods] ]S c@+ r@ IO :methods( swap move
+ SectorWindow :new File :new >r ,[ :[methods] ], -move, ( secwin ) ,
+ ,[ IO :[methods] ], r@ IO :methods( swap move
-1 to r@ size 0 -1 r@ :secwin :move r> ;
]struct
diff --git a/fs/sys/io.fs b/fs/sys/io.fs
@@ -55,7 +55,7 @@ extends IO struct[ SumIO
V1 to res 2rdrop 2rdrop ( written-n ) ;
\ fn sig: ( sum c -- sum )
: :new ( 'fn -- hdl )
- IO :new S[ :[methods] ]S c@+ -move, swap ( 'fn ) , 0 , ;
+ IO :new ,[ :[methods] ], -move, swap ( 'fn ) , 0 , ;
]struct
extends IO struct[ MemIO
@@ -75,7 +75,7 @@ extends IO struct[ MemIO
: :eof? dup )buf swap ptr = ;
: :rewind ( hdl -- ) dup buf( swap to ptr ;
: :new ( a u -- hdl )
- IO :new >r S[ :[methods] ]S c@+ -move,
+ IO :new >r ,[ :[methods] ], -move,
over , over + , , r> ;
]struct
@@ -87,5 +87,5 @@ extends IO struct[ ByteWriter
for ( a ) c@+ V1 :writebyte next drop r> rdrop ;
: :new ( writebyte -- writer )
- IO :new S[ :[methods] ]S c@+ -move, swap ( writebyte ) , ;
+ IO :new ,[ :[methods] ], -move, swap ( writebyte ) , ;
]struct
diff --git a/fs/sys/screen.fs b/fs/sys/screen.fs
@@ -8,7 +8,7 @@ extends Plane struct[ Screen
: activated? ( self -- f ) buffer bool ;
: :new ( width height encoding -- screen )
- Plane :new ( screen ) S[ :[methods] ]S c@+ -move, 3 nabort, ;
+ Plane :new ( screen ) ,[ :[methods] ], -move, 3 nabort, ;
: :[methods] '" activate" , '" deactivate" , '" activated?" , ;
]struct
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -166,7 +166,7 @@ struct[ MyAbstract
]struct
extends MyAbstract struct[ MyImpl
: foo drop 42 ;
- : :new here S[ MyAbstract :[new] ]S c@+ move, ;
+ : :new here ,[ MyAbstract :[new] ], move, ;
]struct
MyImpl :new MyAbstract :foo 42 #eq
testend
diff --git a/fs/text/ed.fs b/fs/text/ed.fs
@@ -131,7 +131,7 @@ extends IO struct[ Edbuf
alias :empty close
: :new ( -- edbuf )
Arena :new Line SZ $200 Array :new
- IO :new S[ :[methods] ]S c@+ -move, ( arena lines edbuf )
+ IO :new ,[ :[methods] ], -move, ( arena lines edbuf )
rot ( arena ) , swap ( lines ) , 0 ( pos ) , dup :empty ;
: :goleft ( n self -- ) dup :cpos rot - max0 swap _cpos! ;
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -261,12 +261,11 @@ create _repl 3 nc, LF CR 0
drop in< dup _escapes 3 [c]? dup 0>= if nip _repl + c@ else drop then
then then ;
: ," begin "< dup -1 <> while c, repeat drop ;
+: ,[ [compile] ahead here [compile] [ ; immediate
+: ], ( jmp a -- ) here over - rot [compile] then swap litn litn ] ;
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 ] ;
-: S" _S[ ," _]S ; immediate
+: S" compiling if compile (s) else here then here 1 allot here
+ ," here -^ ( 'len len ) swap c! ; immediate
: ."
compiling if [compile] S" compile stype else
begin "< dup 0>= while emit repeat drop then ; immediate
@@ -406,7 +405,7 @@ extends IO struct[ Pipe
: writebuf writeio :writebuf ;
: flush writeio :flush ;
: :new ( readio writeio -- pipe )
- IO :new S[ :[methods] ]S c@+ -move, rot ( readio ) , swap ( writeio ) , ;
+ IO :new ,[ :[methods] ], -move, rot ( readio ) , swap ( writeio ) , ;
: _chain! ( w1 'w2 -- ) dup @ rot swap chain swap ! ;
: :addrfilter ( w self -- ) CELLSZ + _chain! ;
: :addwfilter ( w self -- ) CELLSZ << + _chain! ;
diff --git a/posix/glue.fs b/posix/glue.fs
@@ -7,7 +7,7 @@ extends Filesystem struct[ POSIXFS
alias abort newfile
alias abort newdir
alias abort remove
- : :new 0 Filesystem :new S[ :[methods] ]S c@+ -move, ;
+ : :new 0 Filesystem :new ,[ :[methods] ], -move, ;
]struct
POSIXFS :new structbind POSIXFS bootfs
