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