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 ;