[OpenBIOS] r805 - cpu/ppc cpu/x86 forth/kernel

svn at openbios.org svn at openbios.org
Fri Feb 1 04:40:36 CET 2008


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




More information about the OpenBIOS mailing list