commit c0619bcc7fbd7cdfe3fec9f396f99ec3356bd4f4
parent c99f4d5c72eab0d29c2135dd8cc2ba9a93719f50
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 14:54:55 -0400
Make guarding A systematic
In Collapse OS, not guarding A could be reasonable for performances purposes,
but on modern machines, the incovenience is not worth it. I'd like to use the A
register more liberally in high-level code, so I'd like that when I use A, I can
be confident that it will stay the same. Therefore, A has to be guarded
everywhere.
Diffstat:
| M | xcomp.txt | | | 34 | +++++++++++++++++++--------------- |
1 file changed, 19 insertions(+), 15 deletions(-)
diff --git a/xcomp.txt b/xcomp.txt
@@ -27,35 +27,39 @@ alias (psufl)
: << <<c drop ;
: >> >>c drop ;
: move ( src dst u -- ) ?dup if
- >r >A begin ( src ) c@+ Ac!+ next drop then ;
+ A>r >r >A begin ( src ) c@+ Ac!+ next drop r>A then ;
: move, ( a u -- ) here over allot swap move ;
: ws? SPC <= ;
: boot< in> c@+ swap to in> ;
alias in<?
alias in<
: curword ( -- sa sl ) 'curword 1+ 'curword c@ ;
-: word ( -- sa sl ) \ Guards *A*
+: word ( -- sa sl )
A>r 0 begin drop in< dup ws? not until ( c )
'curword 1+ >A begin ( c ) Ac!+ in<? dup ws? until drop
A> 'curword - 1- ( len ) 'curword c! curword r>A ;
-: [c]? ( c a u -- i ) \ Guards A
+: [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 ;
-: _ ( sl -- n? f ) \ parse unsigned decimal
+: _c ( A:sa sl -- n? f ) \ parse char
+ 3 = if A+ A+ Ac@ ''' = if A- Ac@ 1 exit then then 0 ;
+create tbl-0-f ," 0123456789abcdef"
+: _h ( A:sa sl -- n? f ) \ parse hex
+ 1- >r A+ ( skip $ ) 0 begin ( r )
+ 16 * Ac@+ ( r c ) $20 or tbl-0-f $10 [c]?
+ dup 0< if 2drop r~ 0 exit then + next ( r ) 1 ;
+: _ud ( A:sa sl -- n? f ) \ parse unsigned decimal
>r 0 begin ( r )
10 * Ac@+ ( r c ) '0' - dup 9 > if
2drop r~ 0 exit then + next ( r ) 1 ;
-create tbl-0-f ," 0123456789abcdef"
-: parse ( sa sl -- n? f ) \ *A*
- over c@ ''' = if ( sa sl )
- 3 = if 1+ dup 1+ c@ ''' = if c@ 1 exit then then
- drop 0 exit then ( sa sl )
- over c@ '$' = if ( sa sl ) 1- >r 1+ >A 0 begin ( r )
- 16 * Ac@+ ( r c ) $20 or tbl-0-f $10 [c]?
- dup 0< if 2drop r~ 0 exit then + next ( r ) 1 exit then
- swap >A dup 1 > Ac@ '-' = and if ( sl )
- A+ 1- _ if 0 -^ 1 else 0 then else _ then ;
+: _d ( A:sa sl -- n? f ) \ parse decimal
+ dup 1 > Ac@ '-' = and if ( sl )
+ A+ 1- _ud if 0 -^ 1 else 0 then
+ else _ud then ;
+: parse ( sa sl -- n? f )
+ A>r swap >A Ac@ ''' = if ( sl ) _c else ( sl )
+ Ac@ '$' = if ( sl ) _h else _d then then r>A ;
: []= ( a1 a2 u -- f ) \ Guards A
?dup not if 2drop 1 exit then A>r >r >A ( a1 )
begin Ac@+ over c@ = not if r~ r>A drop 0 exit then 1+ next
@@ -64,7 +68,7 @@ create tbl-0-f ," 0123456789abcdef"
: wordname ( w -- sa sl ) dup wordlen swap 5 - over - swap ;
: prevword ( w -- w ) dup if 5 - @ then ;
: immediate? ( w -- f ) 1- c@ $80 and ;
-: find ( sa sl -- w? f ) \ Guards A
+: find ( sa sl -- w? f )
A>r >r >A current begin ( w R:sl )
dup wordlen r@ = if ( w )
A> over wordname ( w a1 a2 u )
