Author: wmb Date: 2009-10-23 11:30:33 +0200 (Fri, 23 Oct 2009) New Revision: 1430
Modified: forth/kernel/double.fth forth/kernel/kernel.fth Log: Second try at fixing kernel bugs.
Modified: forth/kernel/double.fth =================================================================== --- forth/kernel/double.fth 2009-10-23 09:22:37 UTC (rev 1429) +++ forth/kernel/double.fth 2009-10-23 09:30:33 UTC (rev 1430) @@ -8,7 +8,6 @@ : d0< ( d -- flag ) nip 0< ; : d= ( d1 d2 -- flag ) d- d0= ; : d<> ( d1 d2 -- flag ) d= 0= ; -: d< ( d1 d2 -- flag ) 2 pick over 2dup = if drop nip u< else nip < nip then ; : 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 ; : dnegate ( d -- -d ) 0 0 2swap d- ;
Modified: forth/kernel/kernel.fth =================================================================== --- forth/kernel/kernel.fth 2009-10-23 09:22:37 UTC (rev 1429) +++ forth/kernel/kernel.fth 2009-10-23 09:30:33 UTC (rev 1430) @@ -130,7 +130,7 @@ : (.) (s n -- a len ) dup abs <# u#s swap sign u#> ; : s. (s n -- ) (.) type space ; : .r (s n l -- ) >r (.) r> over - spaces type ; -: 0.r (s n l -- ) 0 max >r (u.) r> over - 0 ?do ascii 0 emit loop type ; +: 0.r (s n l -- ) >r (u.) r> over - 0 max 0 ?do ascii 0 emit loop type ;
: (.2) (s u -- a len ) <# u# u# u#> ; : (.4) (s u -- a len ) <# u# u# u# u# u#> ;