commit b1a2f639e71bf0f337f280e44c8cd977dfb7ebef
parent 3ac7474d73020c4f6bda684475ab3350c02efa2d
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 5 Aug 2022 19:03:47 -0400
Rename r~ to rdrop
Diffstat:
11 files changed, 20 insertions(+), 21 deletions(-)
diff --git a/Makefile b/Makefile
@@ -33,8 +33,7 @@ pcrun: pc.img
.PHONY: testpc
testpc: pc.img
- cat fs/xcomp/pc/init.fs fs/xcomp/pc/inittest.fs > fs/init.fs
- mcopy -D overwrite -i pc.img fs/init.fs ::
+ cat fs/xcomp/pc/init.fs fs/xcomp/pc/inittest.fs | mcopy -D overwrite -i pc.img - ::init.fs
qemu-system-i386 -nographic -drive file=pc.img,format=raw | tee /dev/stderr | grep "All tests passed"
.PHONY: run
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -188,7 +188,7 @@ ASTIDCNT wordtbl astdatatbl ( node -- node )
: isIdent? ( tok -- f )
dup 1+ c@ identifier1st? not if drop 0 exit then
c@+ >r begin ( a )
- c@+ identifier? not if r~ drop 0 exit then next drop 1 ;
+ c@+ identifier? not if rdrop drop 0 exit then next drop 1 ;
: expectIdent ( tok -- tok ) dup isIdent? _assert ;
: isChar? ( tok c -- f ) over 1+ c@ = swap c@ 1 = and ;
: isChar?^ ( c tok -- f ) swap isChar? ; \ for "case..of"
@@ -229,7 +229,7 @@ alias noop parseExpression ( tok -- node ) \ forward declaration
_err
endcase
nextt case
- '}' of isChar?^ r~ exit endof
+ '}' of isChar?^ rdrop exit endof
',' of isChar?^ endof
_err
endcase
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -178,7 +178,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
r@ firstchild ?dup if ( node )
selop1 gennode ( value in op1 ) op1<>op2
selop1 r@ decl>op vmmov,
- then r~
+ then rdrop
then ;
'w genchildren ( Unit )
:w ( Function )
diff --git a/fs/cc/tok.fs b/fs/cc/tok.fs
@@ -34,7 +34,7 @@ create symbols2 ," <=>===!=&&||++---><<>>+=-=*=/=%=&=^=|=/**///#["
: isSym2? ( c1 c2 -- f )
A>r 23 >r symbols2 >A begin ( c1 c2 )
- over Ac@+ = over Ac@+ = and if 2drop r~ r>A 1 exit then
+ over Ac@+ = over Ac@+ = and if 2drop rdrop r>A 1 exit then
next 2drop 0 r>A ;
\ are c1/c2 either << or >>?
@@ -76,10 +76,10 @@ create _ 10 c, ," 09AZaz__$$"
else ( c1 c2 ) to putback 1 ( c1 len ) _writesym then ( tok )
dup case
S" /*" of s= drop begin ( )
- nextt? dup not if ( EOF! ) r~ exit then ( tok ) S" */" s= until
+ nextt? dup not if ( EOF! ) rdrop exit then ( tok ) S" */" s= until
nextt? endof
S" //" of s= drop begin ( )
- cc< dup not if ( EOF! ) r~ exit then LF = until
+ cc< dup not if ( EOF! ) rdrop exit then LF = until
nextt? endof
endcase
endof
diff --git a/fs/cc/tree.fs b/fs/cc/tree.fs
@@ -27,10 +27,10 @@
then ;
\ Return the next node with the specified id
: nextnodeid ( ref node id -- ref node )
- >r begin nextnode dup not if r~ exit then dup nodeid r@ = until r~ ;
+ >r begin nextnode dup not if rdrop exit then dup nodeid r@ = until rdrop ;
\ Return the parent node with the specified id
: parentnodeid ( node id -- node )
- >r begin parentnode dup not if r~ exit then dup nodeid r@ = until r~ ;
+ >r begin parentnode dup not if rdrop exit then dup nodeid r@ = until rdrop ;
: lastchild ( node -- child )
firstchild dup if begin dup nextsibling ?dup not if exit then nip again then ;
: nodedepth ( node -- n ) firstchild ?dup if nodedepth 1+ else 0 then ;
@@ -41,7 +41,7 @@
?dup while
r@ over = not while
swap 1+ swap nextsibling repeat ( R:child idx node )
- drop r~ else abort" child not found" then ;
+ drop rdrop else abort" child not found" then ;
: createnode ( id -- node ) here >r , 16 allot0 r> ;
: addnode ( node parent -- )
2dup swap to parentnode ( node parent )
diff --git a/fs/fs/fatlo.fs b/fs/fs/fatlo.fs
@@ -176,7 +176,7 @@ create fcursors( FCursorSize FCURSORCNT * allot0
: findfreecursor ( -- fcursor )
FCURSORCNT >r fcursors( begin ( a )
- dup FCUR_free? if ( found! ) r~ exit then FCursorSize + next
+ dup FCUR_free? if ( found! ) rdrop exit then FCursorSize + next
abort" out of file cursors!" ;
\ read multiple sectors in buf
@@ -205,7 +205,7 @@ create fcursors( FCursorSize FCURSORCNT * allot0
: fatreadbuf ( n fcursor -- a? n )
dup FCUR_free? if 2drop 0 exit then ( n fcursor )
dup >r FCUR_size r@ FCUR_pos - ( n maxn )
- dup 1- 0< if ( EOF ) 2drop r~ 0 exit then
+ dup 1- 0< if ( EOF ) 2drop rdrop 0 exit then
min ( n ) \ make sure that n doesn't go over size
r@ FCUR_pos r@ fatseek ( n )
r@ FCUR_bufpos r@ FCUR_)buf over - ( n a nmax )
diff --git a/fs/lib/str.fs b/fs/lib/str.fs
@@ -12,7 +12,7 @@ $100 value STR_MAXSZ
: [c]? ( c a u -- i )
?dup not if 2drop -1 exit then A>r over >r >r >A ( c )
begin dup Ac@+ = if leave then next ( c )
- A- Ac@ = if A> r> - ( i ) else r~ -1 then r>A ;
+ A- Ac@ = if A> r> - ( i ) else rdrop -1 then r>A ;
\\ append character to end of string
: sappend ( c str -- ) tuck s) c! dup c@ 1+ swap c! ;
@@ -44,7 +44,7 @@ $100 value STR_MAXSZ
\ ranges.
: rmatch ( c range -- f )
A>r >A Ac@+ >> ( len/2 ) >r begin ( c )
- dup Ac@+ Ac@+ ( c c lo hi ) =><= if drop r~ r>A 1 exit then
+ dup Ac@+ Ac@+ ( c c lo hi ) =><= if drop rdrop r>A 1 exit then
next ( c ) drop 0 r>A ;
create _ 2 c, ," 09"
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -10,7 +10,7 @@ create _buf $100 allot
begin ( dirid a )
c@+ dup '/' = if ( dirid a c )
drop swap _buf fchild ( a dirid )
- ?dup not if drop 0 r~ r>A exit then swap ( dirid a )
+ ?dup not if drop 0 rdrop r>A exit then swap ( dirid a )
0 _buf c!+ >A
else ( dirid a c )
Ac!+ _buf c@ 1+ _buf c! then
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -15,7 +15,7 @@
: again compile (br) , ; immediate
: until compile (?br) , ; immediate
: next compile (next) , ; immediate
-: leave r> r~ 1 >r >r ;
+: leave r> rdrop 1 >r >r ;
: = - not ;
: \ begin in< $0a = until ; immediate
\ hello, this is a comment!
@@ -75,14 +75,14 @@
\ has to be a single word following "of".
\ case x of = ... endof y of < ... endof ... endcase
\ is syntactic sugar for:
-\ >r x r@ = if ... else y r@ < if ... else ... then then r~
+\ >r x r@ = if ... else y r@ < if ... else ... then then rdrop
\ NOTE: if you want to access your reference value in the final "else", you
\ need to use "r@".
: case ( -- then-stopgap ) 0 compile >r ; immediate
: of ( -- jump-addr ) compile r@ ' execute, [compile] if ; immediate
alias else endof immediate
: endcase ( then-stopgap jump1? jump2? ... jumpn? -- )
- ?dup if begin [compile] then ?dup not until then compile r~ ; immediate
+ ?dup if begin [compile] then ?dup not until then compile rdrop ; immediate
\ Emitting
$20 const SPC $0d const CR $0a const LF $08 const BS
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -236,7 +236,7 @@ xcode r@
AX pspush,
ret,
-xcode r~
+xcode rdrop
ax pop,
sp CELLSZ i) add,
ax jmp,
diff --git a/posix/vm.c b/posix/vm.c
@@ -843,7 +843,7 @@ static char *opnames[OPCNT] = {
"execute", "(cell)", "(val)", "(alias)", "(does)", "(s)", "(br)", "(?br)",
"(next)", NULL, NULL, "boot<", "(emit)", "stderr", "key", "drop",
"dup", "?dup", "swap", "over", "rot", "rot>", "nip", "tuck",
- "r>", ">r", "r@", "r~", "scnt", "rcnt", ">A", "A>",
+ "r>", ">r", "r@", "rdrop", "scnt", "rcnt", ">A", "A>",
"Ac@", "Ac!", "A+", "A-", "A>r", "r>A", "[to]", "to?",
"1+", "1-", "c@", "c!", "c,", "w@", "w!", "@",
"!", "+!", ",", "+", "-", "*", "/mod", "and",
