[openfirmware] r1428 - forth/kernel
svn at openfirmware.info
svn at openfirmware.info
Fri Oct 23 11:20:34 CEST 2009
Author: wmb
Date: 2009-10-23 11:20:34 +0200 (Fri, 23 Oct 2009)
New Revision: 1428
Modified:
forth/kernel/double.fth
forth/kernel/kernel.fth
Log:
Fixed a couple of longstanding kernel bugs in words that are - apparently -
infrequently used. Tip o' the hat to Segher Boessenkool.
Modified: forth/kernel/double.fth
===================================================================
--- forth/kernel/double.fth 2009-10-22 23:34:55 UTC (rev 1427)
+++ forth/kernel/double.fth 2009-10-23 09:20:34 UTC (rev 1428)
@@ -8,9 +8,9 @@
: d0< ( d -- flag ) nip 0< ;
: d= ( d1 d2 -- flag ) d- d0= ;
: d<> ( d1 d2 -- flag ) d= 0= ;
-: d< ( d1 d2 -- flag ) rot swap 2dup <> if 2swap then 2drop < ;
+: 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- ;
: dabs ( d -- +d ) 2dup d0< if dnegate then ;
Modified: forth/kernel/kernel.fth
===================================================================
--- forth/kernel/kernel.fth 2009-10-22 23:34:55 UTC (rev 1427)
+++ forth/kernel/kernel.fth 2009-10-23 09:20:34 UTC (rev 1428)
@@ -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 -- ) >r (u.) r> over - 0 ?do ascii 0 emit loop type ;
+: 0.r (s n l -- ) 0 max >r (u.) r> over - 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#> ;
More information about the openfirmware
mailing list