[commit] r2794 - cpu/arm forth/kernel

[repository service]

Author: wmb
Date: Sat Dec 31 21:53:45 2011
New Revision: 2794
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2794

Log:
Added d> to the high-level set of double-precision operators, and augmented the set of double operators in arm/kerncode.fth so that double.fth doesn't need to be loaded.  This fixes a compilation error in the x86 builds.

Modified:
   cpu/arm/kerncode.fth
   cpu/arm/kernel.bth
   forth/kernel/double.fth

Modified: cpu/arm/kerncode.fth
==============================================================================
--- cpu/arm/kerncode.fth	Sat Dec 31 21:53:40 2011	(r2793)
+++ cpu/arm/kerncode.fth	Sat Dec 31 21:53:45 2011	(r2794)
@@ -830,6 +830,7 @@
    psh       tos,sp
    mov       tos,tos,asr #0
 c;
+: u>d  ( n -- d )  0  ;
 code dnegate  ( d -- -d )
    pop       r0,sp
    rsbs      r0,r0,#0
@@ -892,6 +893,32 @@
 : dmax  ( xd1 xd2 -- )  2over 2over d<  if  2swap  then  2drop  ;
 : dmin  ( xd1 xd2 -- )  2over 2over d<  0=  if  2swap  then  2drop  ;

+: m+    ( d1|ud1 n -- )  s>d  d+  ;
+: 2rot  ( d1 d2 d3 -- d2 d3 d1 )  2>r 2swap 2r> 2swap  ;
+: 2nip  ( $1 $2 -- $2 )  2swap 2drop  ;
+
+: drot  ( d1 d2 d3 -- d2 d3 d1 )  2>r 2swap 2r> 2swap  ;
+: -drot ( d1 d2 d3 -- d3 d1 d2 )  drot drot  ;
+: dinvert  ( d1 -- d2 )  swap invert  swap invert  ;
+
+: dlshift  ( d1 n -- d2 )
+   tuck lshift >r                           ( low n  r: high2 )
+   2dup bits/cell  swap - rshift  r> or >r  ( low n  r: high2' )
+   lshift r>                                ( d2 )
+;
+: drshift  ( d1 n -- d2 )
+   2dup rshift >r                           ( low high n  r: high2 )
+   tuck  bits/cell swap - lshift            ( low n low2  r: high2 )
+   -rot  rshift  or                         ( low2  r: high2 )
+   r>                                       ( d2 )
+;
+: d>>a  ( d1 n -- d2 )
+   2dup rshift >r                           ( low high n  r: high2 )
+   tuck  bits/cell swap - lshift            ( low n low2  r: high2 )
+   -rot  >>a  or                            ( low2  r: high2 )
+   r>                                       ( d2 )
+;
+
 code fill       ( adr cnt char -- )
    orr       r2,tos,tos,lsl #8 
    ldmia     sp!,{r0,r1,tos}	\ r0-cnt r1-adr r2-data

Modified: cpu/arm/kernel.bth
==============================================================================
--- cpu/arm/kernel.bth	Sat Dec 31 21:53:40 2011	(r2793)
+++ cpu/arm/kernel.bth	Sat Dec 31 21:53:45 2011	(r2794)
@@ -96,7 +96,6 @@
 fload ${BP}/cpu/arm/dodoesad.fth
 fload ${BP}/cpu/arm/version.fth

-fload ${BP}/forth/kernel/double.fth  \ ???
 fload ${BP}/forth/kernel/scan.fth

fload ${BP}/cpu/arm/bitops.fth

Modified: forth/kernel/double.fth
==============================================================================
--- forth/kernel/double.fth	Sat Dec 31 21:53:40 2011	(r2793)
+++ forth/kernel/double.fth	Sat Dec 31 21:53:45 2011	(r2794)
@@ -10,6 +10,7 @@
 : d<>   ( d1 d2 -- flag )  d=  0=  ;
 : du<   ( ud1 ud2 -- flag )  rot  swap  2dup <>  if  2swap  then  2drop u<  ;
 : d<    ( d1 d2 -- flag )  2 pick over = if drop nip u< else nip < nip then  ;
+: d>    ( d1 d2 -- flag )  2swap d<  ;
 : dnegate  ( d -- -d )  0 0  2swap  d-  ;
 : dabs     ( d -- +d )  2dup  d0<  if  dnegate  then  ;