commit 77260b6bcf273f01771dd71082cb9cef5eb16ffc
parent d74b61b0a4bb8bb21236260ea871d7d7cf303e7c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 24 Jun 2023 13:36:48 -0400
Change "[c]?" to "cidx" and move it to kernel
Semantics changed, allowing code to be simplified in most places.
This is the last of the complex HAL words from bootlo to be moved to the kernel.
This allows the immediate removal of "A+n,", but this could also open the door
to further shrinkage of the Low HAL.
Diffstat:
18 files changed, 66 insertions(+), 47 deletions(-)
diff --git a/fs/ar/tar.fs b/fs/ar/tar.fs
@@ -18,7 +18,7 @@ struct[ TarRecord
: :dir? type '5' = ;
create _buf 100 allot
: :name ( self -- str )
- zname 0 over 100 [c]? ( zname len )
+ zname 0 over 100 cidx not if 100 then ( zname len )
2dup 1- + c@ '/' = if 1- then ( zname len )
dup _buf c!+ swap move _buf ;
: :filesize ( self -- sz ) ofilesz 11 parseoctal ;
diff --git a/fs/comp/c/fgen.fs b/fs/comp/c/fgen.fs
@@ -81,7 +81,7 @@ code _lookup ( nref lookup -- )
-8 rs+, RSP) 4 +) !, 0 LIT>W, RSP) !, begin \ RS+0=i RS+4=totcnt
RSP) @, RSP) 4 +) compare, 0 NZ) branchC, \ not found
8 rs+, nip, exit, then
- 1 RSP) +n, CELLSZ A+n, A) @,
+ 1 RSP) +n, CELLSZ A) &) +n, A) @,
PSP) compare, NZ) branchC, drop \ Z=match
\ we have a match, add totcnt*CELLSZ to A, dereference. that's our target.
RSP) 4 +) @, 2 i) <<, RSP) !, W<>A, RSP) +, W) @, \ W=target
diff --git a/fs/comp/c/op.fs b/fs/comp/c/op.fs
@@ -30,15 +30,16 @@ create bopsprectbl BOPSCNT nc,
\ List of opids nullified by a zero. we're lazy and apply this to division
create _ 4 nc, 2 3 4 $d \ * / % &
-: nulledbyzero? ( bopid -- f ) _ 4 [c]? 0>= ;
+: nulledbyzero? ( bopid -- f ) _ 4 cidx dup if nip then ;
\ List of opids neutralized by a zero (any position).
create _ 3 nc, 0 $e $f \ + ^ |
-: neutralbyzero? ( bopid -- f ) _ 3 [c]? 0>= ;
+: neutralbyzero? ( bopid -- f ) _ 3 cidx dup if nip then ;
\ List of opids neutralized by a zero right operand
create _ 3 nc, 1 5 6 \ - << >>
-: neutralbyrzero? ( bopid -- f ) bi neutralbyzero? | _ 3 [c]? 0>= or ;
+: neutralbyrzero? ( bopid -- f )
+ bi neutralbyzero? | _ 3 cidx dup if nip then or ;
\ List of opids neutralized by a one (any position).
: neutralbyone? ( bopid -- f ) 2 = ; \ *
diff --git a/fs/comp/c/tok.fs b/fs/comp/c/tok.fs
@@ -35,7 +35,7 @@ $400 Scratchpad :new structbind Scratchpad _pad
\ list of 1 char symbols
create symbols1 ," +-*/~&<>=[](){}.%^?:;,|^\"!"
-: isSym1? ( c -- f ) symbols1 26 [c]? 0>= ;
+: isSym1? ( c -- f ) symbols1 26 cidx dup if nip then ;
\ list of 2 chars symbols
create symbols2 ," <=>===!=&&||++---><<>>+=-=*=/=%=&=^=|=/**///"
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -163,8 +163,9 @@ 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.
+cidx c a u -- ?i f Search for character c in range [a, a+u] and yield its
+ index. If found, f=1 and i is present. Otherwise, f=0
+ and i is absent.
Convenience shortcuts:
diff --git a/fs/doc/hal.txt b/fs/doc/hal.txt
@@ -280,7 +280,6 @@ ps+, n -- Add n to PSP
rs+, n -- Add n to RSP
LIT>W, n -- Set W to n
W+n, n -- Z Add n to W
-A+n, n -- Z Add n to A
W>A, -- Copy W to A
W<>A, -- Swap W and A
-W, -- W = -W
diff --git a/fs/fs/fat.fs b/fs/fs/fat.fs
@@ -29,7 +29,7 @@ extends FSInfo struct[ FATInfo
create _struct _buf ( name ) , 0 ( size ) , 0 ( dir? ) ,
create _rootname 6 c, ," (root)"
create _root _rootname , 0 , 1 ,
- : spcidx ( name -- idx ) SPC swap BUFSZ [c]? ;
+ : spcidx ( name -- idx ) SPC swap BUFSZ cidx not if BUFSZ then ;
: :read ( id fat -- info )
over not if 2drop _root exit then
_buf BUFSZ SPC fill
diff --git a/fs/lib/str.fs b/fs/lib/str.fs
@@ -12,7 +12,7 @@ create _buf STR_MAXSZ allot
rot dup c@ rot = if ( a str ) c@+ []= else 2drop 0 then ;
: zstrlen ( zstr -- len )
- 0 swap $100 [c]? ( idx ) dup 0< if abort" string too long" then ;
+ 0 swap $100 cidx not if abort" string too long" then ;
:iterator rfor ( a u -- )
?dup if
diff --git a/fs/sys/file.fs b/fs/sys/file.fs
@@ -67,8 +67,7 @@ struct[ Path
drop _buf 2 + _slen 2 - over c! ( name )
_buf 1+ c@ upcase 'A' - CELLSZ * filesystems + @ ( name fs )
?dup if 0 :new :find exit else drop 0 exit then then
- '/' _buf c@+ [c]? to _idx ( self )
- _idx 0< if _buf swap :child exit then ( self )
+ '/' _buf c@+ cidx not if _buf swap :child exit then to _idx ( self )
_idx if \ not a leading "/"
_idx _buf c! _buf swap :child ( path-or-0 )
dup not if exit then ( path )
diff --git a/fs/sys/io.fs b/fs/sys/io.fs
@@ -19,7 +19,7 @@ struct+[ IO
: :putc ( c hdl -- ) swap _buf c! _buf 1 rot :writebuf not if _ioerr then ;
: :puts ( str hdl -- ) swap c@+ rot :write ;
: :putz ( zstr hdl -- )
- over 0 swap $100 [c]? dup 0< if _ioerr then ( zstr hdl len ) swap :write ;
+ over 0 swap $100 cidx not if _ioerr then ( zstr hdl len ) swap :write ;
create _buf( $100 allot
here value _)buf
diff --git a/fs/tests/asm/hal.fs b/fs/tests/asm/hal.fs
@@ -140,7 +140,7 @@ code test14 ( -- n )
begin
1 RSP) +n,
A) @,
- 4 A+n,
+ 4 A) &) +n,
W=0>Z, NZ) branchC, drop
RSP) @, 4 rs+, exit,
test14 4 #eq
diff --git a/fs/text/ed.fs b/fs/text/ed.fs
@@ -102,11 +102,9 @@ extends IO struct[ Edbuf
rdrop r> to+ pos ;
: 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 )
- nip tuck r@ _writeline 1+ ( written-n )
- r> :appendline then ;
+ 2dup LF rot> cidx ( a u ?idx f ) if
+ nip tuck r@ _writeline 1+ ( written-n ) r> :appendline
+ else tuck r> _writeline ( written-n ) then ;
: _ensureline ( self -- )
dup :linecnt if drop else
diff --git a/fs/text/ged.fs b/fs/text/ged.fs
@@ -73,5 +73,4 @@ KEYS c@ wordtbl handlers
:w _typeline _statusline if rdln :interpret then _pagerefresh ;
: ged 0 to _top 0 to visualmode begin
- _refresh key KEYS c@+ [c]? ( idx )
- dup 0>= if handlers swap wexec else drop then again ;
+ _refresh key KEYS c@+ cidx if handlers swap wexec then again ;
diff --git a/fs/text/pager.fs b/fs/text/pager.fs
@@ -12,9 +12,8 @@ create _nextpage ," Next Page...\n"
0 to _cnt
_nextpage 13 V2 V1 execute 13 <> if abort" pager error" then
key ESC = if quit then then
- 2dup LF rot> [c]? dup 0>= if ( a n idx )
- to1+ _cnt nip 1+ ( a n )
- else ( a n -1 ) drop then r> ;
+ 2dup LF rot> cidx if ( a n idx )
+ to1+ _cnt nip 1+ ( a n ) then r> ;
: spager$
['] spagerread console :addrfilter ['] spagerwrite console :addwfilter ;
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -521,9 +521,6 @@ xcode ps+, ( n -- )
xcode W+n, ( n -- )
mov) r1 rd) rTOP i) ,) lbladdnwr abs>rel b) ,)
-xcode A+n, ( n -- )
- mov) r1 rd) rA i) ,) lbladdnwr abs>rel b) ,)
-
pc mov) 0 i) ,)
pc to lbllitwr ( n -- ) \ r0=Rd
pushret, r0 push,
@@ -864,6 +861,23 @@ pc
mov) rTOP rd) 1 i) ,)
exit,
+xcode cidx ( c a u -- ?idx f )
+ r0 ppop, \ r0=a rTOP=u
+ ldr) r1 rd) rPSP rn) ,) \ r1=c
+ mov) r2 rd) 0 i) ,) \ r2=i
+pc
+ ldr) r3 rd) r0 rn) 8b) 1 +i) post) ,)
+ cmp) r3 rn) r1 rm) ,)
+ str) z) r2 rd) rPSP rn) ,)
+ mov) z) rTOP rd) 1 i) ,)
+ return) z) ,)
+ add) r2 rdn) 1 i) ,)
+ sub) rTOP rdn) 1 i) f) ,)
+ ( pc ) abs>rel b) nz) ,)
+ xnip,
+ mov) rTOP rd) 0 i) ,)
+ exit,
+
\ Interpret loop
xcode ; ximm pushret,
wcall, popret,
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -240,14 +240,6 @@ code fill ( a u c -- )
: allot0 ( n -- ) here over 0 fill allot ;
: nc, ( n -- ) for word runword c, next ;
-code [c]? ( c a u -- i )
- W=0>Z, 0 Z) branchC,
- PSP) @!, W>A, 0 LIT>W, dup, begin \ P+8=c P+4=u P+0=i A=a
- A) 8b) @, PSP) 8 +) 8b) compare, 0 NZ) branchC, drop, 8 ps+, exit, then
- 1 A+n, 1 PSP) +n, PSP) @, PSP) 4 +) compare, NZ) branchC, drop
- drop, then
- 8 ps+, -1 LIT>W, exit,
-
\ Emitting
$20 const SPC $0d const CR $0a const LF $08 const BS $1b const ESC
alias drop emit
@@ -258,7 +250,7 @@ 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
+ drop in< dup _escapes 3 cidx if nip _repl + c@ then
then then ;
: ," begin "< dup -1 <> while c, repeat drop ;
: ,[ [compile] ahead here [compile] [ ; immediate
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -189,11 +189,6 @@ xcode W+n, ( n -- ) \ ax XX i) add, OR ax inc,/dec,
ax -1 i) cmp, forward8 jnz, $48 i) cwrite, xdrop, ret, forward!
$05 i) cwrite, L1 absjmp,
-xcode A+n, ( n -- ) \ bx XX i) add, OR bx inc,/dec,
- ax 1 i) cmp, forward8 jnz, $43 i) cwrite, xdrop, ret, forward!
- ax -1 i) cmp, forward8 jnz, $4b i) cwrite, xdrop, ret, forward!
- $c381 i) wwrite, L1 absjmp,
-
xcode W>A, ( n -- ) \ bx ax mov,
$c389 i) wwrite, ret,
@@ -421,6 +416,19 @@ xcode []= ( a1 a2 u -- f )
xnip, xnip,
ret,
+xcode cidx ( c a u -- ?idx f )
+ cx ax mov,
+ dx ax mov,
+ di si 0 d) mov, xnip,
+ ax si 0 d) mov,
+ repnz, scasb,
+ forward8 jz, xnip, ax ax xor, ret, forward! \ no match
+ dx dec,
+ dx cx sub,
+ si 0 d) dx mov,
+ ax 1 i) mov,
+ ret,
+
\ Interpret loop
0 align4 pc to lblbootptr 0 ,
diff --git a/posix/vm.c b/posix/vm.c
@@ -269,7 +269,6 @@ static void PSADD() { vm.PSP += gpc(); } // 0x08
static void RSADD() { vm.RSP += gpc(); }
static void WLIT() { vm.W = gpc(); }
static void WADDN() { vm.W += gpc(); vm.Z = vm.W == 0;}
-static void AADDN() { vm.A += gpc(); vm.Z = vm.A == 0;}
static void W2A() { vm.A = vm.W; }
static void WSWAPA() { dword n = vm.A; vm.A = vm.W; vm.W = n; }
@@ -380,6 +379,17 @@ static void ADDDISP() {
vm.W = hbankset(vm.W, hbankget(vm.W)+by)|OPHASDISP;
}
}
+static void CIDX() { // ( c a u -- ?idx f )
+ dword u = ppop();
+ dword a = ppop();
+ dword c = ppop();
+ for (dword i=0; i<u; i++) {
+ if ((dword)vm.mem[a++] == c) {
+ ppush(i); ppush(1); return;
+ }
+ }
+ ppush(0);
+}
static void MAYBEWORD() { // 0x30
dword c, a;
@@ -896,11 +906,11 @@ static void DRVWR() {
#define OPCNT 0x70
static void (*ops[OPCNT])() = {
BR, CALL, RET, BRWR, BRA, BRC, NULL, YIELD,
- PSADD, RSADD, WLIT, NULL, WADDN, AADDN, W2A, WSWAPA,
+ PSADD, RSADD, WLIT, NULL, WADDN, NULL, W2A, WSWAPA,
WFETCH, NULL, WSWAP, ADDN, WCMP, WIFETCHINC, WISTOREINC, WLEA,
WFETCH16, NULL, WSWAP16, ADDN16, WCMP16, WIFETCHINC16, WISTOREINC16, WLEA,
WFETCH8, NULL, WSWAP8, ADDN8, WCMP8, WIFETCHINC8, WISTOREINC8, WLEA,
- MOVE, BOOTRD, STDOUT, MAYBEKEY, RANGEEQ, MAKEMEM, ADDDISP, NULL,
+ MOVE, BOOTRD, STDOUT, MAYBEKEY, RANGEEQ, MAKEMEM, ADDDISP, CIDX,
MAYBEWORD, WORD, PARSE, FIND, WNF, FINDMOD, NULL, NULL,
STACKCHK, COMPWORD, RUNWORD, COMPILING, STARTCOMP, STOPCOMP, RSADDWR, COMPOP,
ALIGN4, ENTRY, CODE, CODE16, CODE8, COMPBINOP, NULL, NULL,
@@ -943,7 +953,7 @@ static void compileop(byte op) { litwr(op); cwritewr(); }
// Names for simple word-to-code mappings
static char *opnames[OPCNT-0x28] = {
- "move", "boot<", "(emit)", "(key?)", "[]=", "m)", "+)", NULL,
+ "move", "boot<", "(emit)", "(key?)", "[]=", "m)", "+)", "cidx",
"maybeword", "word", "parse", "find", "(wnf)", "findmod", NULL, NULL,
"stack?", "compword", "runword", "compiling", "]", NULL, "rs+,", NULL,
"align4", "entry", "code", "code16b", "code8b", NULL, NULL, NULL,
@@ -989,7 +999,6 @@ static void buildsysdict() {
entry("ps+,"); compileop(0x08); writewr(); retwr();
entry("LIT>W,"); compileop(0x0a); writewr(); retwr();
entry("W+n,"); compileop(0x0c); writewr(); retwr();
- entry("A+n,"); compileop(0x0d); writewr(); retwr();
entry("W>A,"); compileop(0x0e); retwr();
entry("W<>A,"); compileop(0x0f); retwr();
entry("@,"); compopwr(0x10); retwr();
