Author: wmb
Date: 2008-02-01 04:40:36 +0100 (Fri, 01 Feb 2008)
New Revision: 805
Added:
forth/kernel/scan.fth
Modified:
cpu/ppc/kernel.bth
cpu/x86/kerncode.fth
forth/kernel/kernel.fth
Log:
Forth kernel - moved high-level implementations of string scanning
words into a separate file and implemented code versions of them for x86.
No functional change, just a speedup.
Modified: cpu/ppc/kernel.bth
===================================================================
--- cpu/ppc/kernel.bth 2008-02-01 02:29:02 UTC (rev 804)
+++ cpu/ppc/kernel.bth 2008-02-01 03:40:36 UTC (rev 805)
@@ -57,6 +57,7 @@
fload ${BP}/forth/kernel/uservars.fth
fload ${BP}/forth/kernel/double.fth
+fload ${BP}/forth/kernel/scan.fth
fload ${BP}/forth/lib/bitops.fth
fload ${BP}/cpu/ppc/kernrel.fth
Modified: cpu/x86/kerncode.fth
===================================================================
--- cpu/x86/kerncode.fth 2008-02-01 02:29:02 UTC (rev 804)
+++ cpu/x86/kerncode.fth 2008-02-01 03:40:36 UTC (rev 805)
@@ -1397,6 +1397,93 @@
dx si mov \ Restore
c;
+
+code skipwhite ( adr len -- adr' len' )
+ si dx mov
+ cld
+ cx pop
+ cx cx or 0<> if
+ si pop
+ begin
+ al lods
+ h# 20 # al cmp > if
+ si dec si push
+ cx push dx si mov
+ next
+ then
+ loopa
+ si push
+ then
+ cx push
+ dx si mov
+c;
+
+\ Adr2 points to the delimiter or to the end of the buffer
+\ Adr3 points to the character after the delimiter or to the end of the buffer
+code scantowhite ( adr1 len1 -- adr1 adr2 adr3 )
+ si dx mov
+ cld
+ cx pop
+ 0 [sp] si mov
+ cx cx or 0<> if
+ begin
+ al lods
+ h# 20 # al cmp <= if
+ si dec si push
+ si inc si push
+ dx si mov
+ next
+ then
+ loopa
+ then
+ si push
+ si push
+ dx si mov
+c;
+
+code skipchar ( adr len char -- adr' len' )
+ si dx mov
+ cld
+ bx pop \ char in bx
+ cx pop
+ cx cx or 0<> if
+ si pop
+ begin
+ al lods
+ bl al cmp
+ loope
+ 0<> if cx inc si dec then
+ si push
+ then
+ cx push
+ dx si mov
+c;
+
+\ Adr2 points to the delimiter or to the end of the buffer
+\ Adr3 points to the character after the delimiter or to the end of the buffer
+code scantochar ( adr1 len1 char -- adr1 adr2 adr3 )
+ si dx mov
+ cld
+ bx pop
+ cx pop
+ 0 [sp] si mov
+ cx cx or 0<> if
+ begin
+ al lods
+ bl al cmp
+ loopne
+ = if
+ si dec si push
+ si inc si push
+ dx si mov
+ next
+ then
+ then
+ si push
+ si push
+ dx si mov
+c;
+
\ LICENSE_BEGIN
\ Copyright (c) 2006 FirmWorks
\
Modified: forth/kernel/kernel.fth
===================================================================
--- forth/kernel/kernel.fth 2008-02-01 02:29:02 UTC (rev 804)
+++ forth/kernel/kernel.fth 2008-02-01 03:40:36 UTC (rev 805)
@@ -2763,50 +2763,6 @@
: set-input ( source-adr source-len source-id -- )
0 0 5 restore-input drop
;
-headerless
-: skipwhite ( adr1 len1 -- adr2 len2 )
- begin dup 0> while ( adr len )
- over c@ bl > if exit then
- 1 /string
- repeat ( adr' 0 )
-;
-
-\ Adr2 points to the delimiter or to the end of the buffer
-\ Adr3 points to the character after the delimiter or to the end of the buffer
-: scantowhite ( adr1 len1 -- adr1 adr2 adr3 )
- over swap ( adr1 adr1 len1 )
- begin dup 0> while ( adr1 adr len )
- over c@ bl <= if drop dup 1+ exit then
- 1 /string ( adr1 adr' len' )
- repeat ( adr1 adr2 0 )
- drop dup ( adr1 adr2 adr2 )
-;
-
-: skipchar ( adr1 len1 delim -- adr2 len2 )
- >r ( adr1 len1 ) ( r: delim )
- begin dup 0> while ( adr len )
- over c@ r@ <> if ( adr len )
- r> drop exit ( adr2 len2 )
- then ( adr len )
- 1 /string ( adr' len' )
- repeat ( adr' 0 )
- r> drop ( adr2 0 )
-;
-
-\ Adr2 points to the delimiter or to the end of the buffer
-\ Adr3 points to the character after the delimiter or to the end of the buffer
-: scantochar ( adr1 len1 char -- adr1 adr2 adr3 )
- >r ( adr1 len1 ) ( r: delim )
- over swap ( adr1 adr1 len1 )
- begin dup 0> while ( adr1 adr len )
- over c@ r@ = if ( adr1 adr len )
- r> 2drop dup 1+ exit ( adr1 adr2 adr3 )
- then ( adr1 adr len )
- 1 /string ( adr1 adr' len' )
- repeat ( adr1 adr2 0 )
- r> 2drop dup ( adr1 adr2 adr2 )
-;
-headers
: parse-word ( -- adr len )
source >in @ /string over >r ( adr1 len1 ) ( r: adr1 )
skipwhite ( adr2 len2 )
Added: forth/kernel/scan.fth
===================================================================
--- forth/kernel/scan.fth (rev 0)
+++ forth/kernel/scan.fth 2008-02-01 03:40:36 UTC (rev 805)
@@ -0,0 +1,69 @@
+purpose: High level implementations of string scanning words
+\ See license at end of file
+
+: skipwhite ( adr1 len1 -- adr2 len2 )
+ begin dup 0> while ( adr len )
+ over c@ bl > if exit then
+ 1 /string
+ repeat ( adr' 0 )
+;
+
+\ Adr2 points to the delimiter or to the end of the buffer
+\ Adr3 points to the character after the delimiter or to the end of the buffer
+: scantowhite ( adr1 len1 -- adr1 adr2 adr3 )
+ over swap ( adr1 adr1 len1 )
+ begin dup 0> while ( adr1 adr len )
+ over c@ bl <= if drop dup 1+ exit then
+ 1 /string ( adr1 adr' len' )
+ repeat ( adr1 adr2 0 )
+ drop dup ( adr1 adr2 adr2 )
+;
+
+: skipchar ( adr1 len1 delim -- adr2 len2 )
+ >r ( adr1 len1 ) ( r: delim )
+ begin dup 0> while ( adr len )
+ over c@ r@ <> if ( adr len )
+ r> drop exit ( adr2 len2 )
+ then ( adr len )
+ 1 /string ( adr' len' )
+ repeat ( adr' 0 )
+ r> drop ( adr2 0 )
+;
+
+\ Adr2 points to the delimiter or to the end of the buffer
+\ Adr3 points to the character after the delimiter or to the end of the buffer
+: scantochar ( adr1 len1 char -- adr1 adr2 adr3 )
+ >r ( adr1 len1 ) ( r: delim )
+ over swap ( adr1 adr1 len1 )
+ begin dup 0> while ( adr1 adr len )
+ over c@ r@ = if ( adr1 adr len )
+ r> 2drop dup 1+ exit ( adr1 adr2 adr3 )
+ then ( adr1 adr len )
+ 1 /string ( adr1 adr' len' )
+ repeat ( adr1 adr2 0 )
+ r> 2drop dup ( adr1 adr2 adr2 )
+;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2006 FirmWorks
+\
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END
