( Title: Test mixfloat.fs user words File: mixfloat-test.fs Log file: mixfloat.log Version: 0.9.0 Revised: July 25, 2009 Author: David N. Williams License: LGPL ) \ Copyright (C) 2005, 2009 David N. Williams ( This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or at your option any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. This code is intended to be ANS Forth compatible up to case sensitivity. Certain tests will be omitted if the nonstandard words XF@ and QF@ are undefined. ) s" mixfloat.fs" included s" ttester.fs" included true verbose ! set-exact decimal variable #errors 0 #errors ! :noname ( c-addr u -- ) ( Display an error message followed by the line that had the error. ) 1 #errors +! error1 ; error-xt ! [UNDEFINED] \\ [IF] : \\ ( -- ) -1 parse 2drop BEGIN refill 0= UNTIL ; [THEN] [UNDEFINED] 3constant [IF] : 3constant >r 2>r : 2r> postpone 2literal r> postpone literal postpone ; ; [THEN] [UNDEFINED] 4constant [IF] : 4constant 2>r 2>r : 2r> postpone 2literal 2r> postpone 2literal postpone ; ; [THEN] hex \ In the following, "maxp" and "minp" mean maximum and minimum \ positive, and "-sr", "-dr", "-xr", and "-qr", indicate single, \ double, intel extended, and quad raw formats. \ raw single precision 0 constant 0-sr 3F800000 constant 1-sr 40000000 constant 2-sr 7F7FFFFF constant maxp-sr 00800000 constant minp-sr \ normal 007FFFFF constant maxp-subn-sr 00000001 constant minp-subn-sr 7F800000 constant inf-sr 7FC00000 constant nan-sr 401A8279 constant rt2p1-sr 80000000 constant -0-sr BF800000 constant -1-sr C0000000 constant -2-sr FF7FFFFF constant -maxp-sr 80800000 constant -minp-sr 807FFFFF constant -maxp-subn-sr 80000001 constant -minp-subn-sr FF800000 constant -inf-sr FFC00000 constant -nan-sr C01A8279 constant -rt2p1-sr \ raw double precision 0 0 2constant 0-dr 00000000 3FF00000 2constant 1-dr 00000000 40000000 2constant 2-dr FFFFFFFF 7FEFFFFF 2constant maxp-dr 00000000 00100000 2constant minp-dr \ normal FFFFFFFF 000FFFFF 2constant maxp-subn-dr 00000001 00000000 2constant minp-subn-dr 00000000 7FF00000 2constant inf-dr 00000000 7FF80000 2constant nan-dr 333F9DE6 4003504F 2constant rt2p1-dr 00000000 80000000 2constant -0-dr 00000000 BFF00000 2constant -1-dr 00000000 C0000000 2constant -2-dr FFFFFFFF FFEFFFFF 2constant -maxp-dr 00000000 80100000 2constant -minp-dr FFFFFFFF 800FFFFF 2constant -maxp-subn-dr 00000001 80000000 2constant -minp-subn-dr 00000000 FFF00000 2constant -inf-dr 00000000 FFF80000 2constant -nan-dr 333F9DE6 C003504F 2constant -rt2p1-dr \ raw quad precision 0 0 0 0 4constant 0-qr 0 0 0 3FFF0000 4constant 1-qr 0 0 0 40000000 4constant 2-qr FFFFFFFF FFFFFFFF FFFFFFFF 7FFEFFFF 4constant maxp-qr 0 0 0 00010000 4constant minp-qr \ normal FFFFFFFF FFFFFFFF FFFFFFFF 0000FFFF 4constant maxp-subn-qr 1 0 0 00000000 4constant minp-subn-qr 0 0 0 7FFF0000 4constant inf-qr 0 0 0 7FFF8000 4constant nan-qr 0 0 0 80000000 4constant -0-qr 0 0 0 BFFF0000 4constant -1-qr 0 0 0 C0000000 4constant -2-qr FFFFFFFF FFFFFFFF FFFFFFFF FFFEFFFF 4constant -maxp-qr 0 0 0 80010000 4constant -minp-qr \ normal FFFFFFFF FFFFFFFF FFFFFFFF 8000FFFF 4constant -maxp-subn-qr 1 0 0 80000000 4constant -minp-subn-qr 0 0 0 FFFF0000 4constant -inf-qr 0 0 0 FFFF8000 4constant -nan-qr \ raw double extended precision 0 0 0 3constant 0-xr 0 0 3FFF8000 3constant 1-xr 0 0 40008000 3constant 2-xr FFFF0000 FFFFFFFF 7FFEFFFF 3constant maxp-xr 0 0 00018000 3constant minp-xr \ normal FFFF0000 FFFFFFFF 00007FFF 3constant maxp-subn-xr 00010000 0 00000000 3constant minp-subn-xr 0 0 7FFF8000 3constant inf-xr 0 0 7FFFC000 3constant nan-xr 0 0 80000000 3constant -0-xr 0 0 BFFF8000 3constant -1-xr 0 0 C0008000 3constant -2-xr FFFF0000 FFFFFFFF FFFEFFFF 3constant -maxp-xr 0 0 80018000 3constant -minp-xr \ normal FFFF0000 FFFFFFFF 80007FFF 3constant -maxp-subn-xr 00010000 0 80000000 3constant -minp-subn-xr 0 0 FFFF8000 3constant -inf-xr 0 0 FFFFC000 3constant -nan-xr decimal verbose @ [IF] cr [LITTLE-ENDIAN] [IF] .( Floats in memory are little-endian.) [ELSE] .( Floats in memory are big-endian.) [THEN] cr .( An address unit is ) bits/au . .( bits.) cr .( There are ) bits/cell . .( bits/cell.) cr .( There are ) bits/float . .( bits/float.) :noname ( -- fp.separate? ) depth >r 1e depth >r fdrop 2r> = ; execute cr .( Floating-point stack is ) [IF] .( *separate*) [ELSE] .( *not separate*) [THEN] .( from the data stack.) [THEN] cr testing HEX>UQ hex t{ s" 0123456789ABCDEFFEDCBA9876543210" hex>uq -> 76543210 FEDCBA98 89ABCDEF 01234567 true }t t{ s" 89ABCDEFFEDCBA9876543210"hex>uq -> 76543210 FEDCBA98 89ABCDEF 0 true }t t{ s" FEDCBA9876543210"hex>uq -> 76543210 FEDCBA98 0 0 true }t t{ s" 76543210"hex>uq -> 76543210 0 0 0 true }t t{ s" " hex>uq -> 0 0 0 0 true }t decimal testing LSHIFT>UD RSHIFT>UD hex t{ ABBBBBBC 0 lshift>ud -> ABBBBBBC 0 }t t{ ABBBBBBC 4 lshift>ud -> BBBBBBC0 A }t t{ ABBBBBBC bits/cell lshift>ud -> 0 ABBBBBBC }t t{ ABBBBBBC 0 rshift>ud -> 0 ABBBBBBC }t t{ ABBBBBBC 4 rshift>ud -> C0000000 0ABBBBBB }t t{ ABBBBBBC bits/cell rshift>ud -> ABBBBBBC 0 }t decimal testing (QLSHIFT) (QRSHIFT) QLSHIFT QRSHIFT QSHIFT hex t{ ABBBBBBB C0000000 D0000000 E0000000 4 (qlshift) -> BBBBBBB0 A C D }t t{ ABBBBBBB C0000000 D0000000 E0000000 0 (qlshift) -> ABBBBBBB C0000000 D0000000 E0000000 }t t{ ABBBBBBB C0000000 D0000000 E0000000 20 (qlshift) -> 0 ABBBBBBB C0000000 D0000000 }t t{ AAAAAAA0 B C EEEEEEEE 4 (qrshift) -> BAAAAAAA C0000000 E0000000 0EEEEEEE }t t{ AAAAAAA0 B C EEEEEEEE 0 (qrshift) -> AAAAAAA0 B C EEEEEEEE }t t{ AAAAAAA0 B C EEEEEEEE 20 (qrshift) -> B C EEEEEEEE 0 }t \ QLSHIFT and QRSHIFT are tested implicitly through QSHIFT. t{ ABBBBBBB C0000000 D0000000 E0000000 0 qshift -> ABBBBBBB C0000000 D0000000 E0000000 }t t{ ABBBBBBB C0000000 D0000000 E0000000 4 qshift -> BBBBBBB0 A C D }t t{ ABBBBBBB C0000000 D0000000 E0000000 24 qshift -> 0 BBBBBBB0 A C }t t{ ABBBBBBB C0000000 D0000000 E0000000 44 qshift -> 0 0 BBBBBBB0 A }t t{ ABBBBBBB C0000000 D0000000 E0000000 64 qshift -> 0 0 0 BBBBBBB0 }t t{ ABBBBBBB C0000000 D0000000 E0000000 84 qshift -> 0 0 0 0 }t t{ AAAAAAA0 B C EEEEEEEE -4 qshift -> BAAAAAAA C0000000 E0000000 0EEEEEEE }t t{ AAAAAAA0 B C EEEEEEEE -24 qshift -> C0000000 E0000000 0EEEEEEE 0 }t t{ AAAAAAA0 B C EEEEEEEE -44 qshift -> E0000000 0EEEEEEE 0 0 }t t{ AAAAAAA0 B C EEEEEEEE -64 qshift -> 0EEEEEEE 0 0 0 }t t{ AAAAAAA0 B C EEEEEEEE -84 qshift -> 0 0 0 0 }t decimal testing MIX>FPARTS MIX>RAW32 MIX>RAW64 MIX>RAW80 MIX>RAW128 \ MIX>FPARTS is mostly tested implicitly, but the following \ nails down that uqmant is zero when #mantbits is zero. t{ s" 0p20" mix>fparts -> 0 0 0 0 0 0 0 }t t{ s" 0.p20" mix>fparts -> 0 0 0 0 0 0 0 }t t{ s" 0.0 p200" mix>fparts -> 0 0 0 0 0 0 0 }t t{ s" .00 p-2000" mix>fparts -> 0 0 0 0 0 0 0 }t \ p = 24, emax = 127, emin = -126 t{ s" 0p" mix>raw32 -> 0-sr }t t{ s" 1p0" mix>raw32 -> 1-sr }t t{ s" 1.p0" mix>raw32 -> 1-sr }t t{ s" 1.0p1" mix>raw32 -> 2-sr }t t{ s" 20.p-4" mix>raw32 -> 2-sr }t t{ s" 1.00 p-126" mix>raw32 -> minp-sr }t t{ s" 1.0 p-149" mix>raw32 -> minp-subn-sr }t t{ s" 1p-150" mix>raw32 -> 0-sr }t t{ s" 2.0 p+127" mix>raw32 -> inf-sr }t t{ s" 1.F FFFF FFFF FFFF p+127" mix>raw32 -> maxp-sr }t t{ s" 0.F FFFF FFFF FFFF p-126" mix>raw32 -> maxp-subn-sr }t t{ s" 1.F FFFF FFFF FFFE p-127" mix>raw32 -> maxp-subn-sr }t t{ s" 1.3 504F 333F 9DE6 p+1" mix>raw32 -> rt2p1-sr }t t{ s" 1 3 504 F 333F . 9DE6 p-35" mix>raw32 -> rt2p1-sr }t t{ s" .000013 504 F 333F 9DE6 00 p 21" mix>raw32 -> rt2p1-sr }t t{ s" -0p" mix>raw32 -> -0-sr }t t{ s" -1p0" mix>raw32 -> -1-sr }t t{ s" -1.p0" mix>raw32 -> -1-sr }t t{ s" -1.0p1" mix>raw32 -> -2-sr }t t{ s" -20.p-4" mix>raw32 -> -2-sr }t t{ s" -1.00 p-126" mix>raw32 -> -minp-sr }t t{ s" -1.00 p-149" mix>raw32 -> -minp-subn-sr }t t{ s" -1p-150" mix>raw32 -> -0-sr }t t{ s" -2.0 p127" mix>raw32 -> -inf-sr }t t{ s" -1.F FFFF FFFF FFFF p127" mix>raw32 -> -maxp-sr }t t{ s" -0.F FFFF FFFF FFFF p-126" mix>raw32 -> -maxp-subn-sr }t t{ s" -1.F FFFF FFFF FFFE p-127" mix>raw32 -> -maxp-subn-sr }t t{ s" -1.3 504F 333F 9DE6 p+1" mix>raw32 -> -rt2p1-sr }t t{ s" - 1 3 504 F 333F . 9DE6 p-0035" mix>raw32 -> -rt2p1-sr }t t{ s" -.000013 504 F 333F 9DE6 00p021" mix>raw32 -> -rt2p1-sr }t t{ s" p" mix>raw32 -> 0-sr }t t{ s" 0p2000" mix>raw32 -> 0-sr }t t{ s" + p 2001" mix>raw32 -> 0-sr }t t{ s" + p 2 001" mix>raw32 -> 0-sr }t t{ s" 0.00p" mix>raw32 -> 0-sr }t t{ s" .00p-3000" mix>raw32 -> 0-sr }t t{ s" -p" mix>raw32 -> -0-sr }t t{ s" -0p2000" mix>raw32 -> -0-sr }t t{ s" - p 2001" mix>raw32 -> -0-sr }t t{ s" - p 2 001" mix>raw32 -> -0-sr }t t{ s" -0.00p " mix>raw32 -> -0-sr }t t{ s" - .00p-3000" mix>raw32 -> -0-sr }t \ Any of these should abort if uncommented. \ s" p'" mix>raw32 \ s" ++0p" mix>raw32 \ s" +0.0.p" mix>raw32 \ s" +0.0p-3.2" mix>raw32 \ s" 0p A" mix>raw32 \ p = 53, emax = 1023, emin = -1022 t{ s" 0p" mix>raw64 -> 0-dr }t t{ s" 1p0" mix>raw64 -> 1-dr }t t{ s" 1.p0" mix>raw64 -> 1-dr }t t{ s" 1.0p1" mix>raw64 -> 2-dr }t t{ s" 20.p-4" mix>raw64 -> 2-dr }t t{ s" 2p" mix>raw64 -> 2-dr }t t{ s" 200p-8" mix>raw64 -> 2-dr }t t{ s" 00002p" mix>raw64 -> 2-dr }t t{ s" .2p4" mix>raw64 -> 2-dr }t t{ s" 000 0 2p0" mix>raw64 -> 2-dr }t t{ s" 1.00 p-1022" mix>raw64 -> minp-dr }t t{ s" 1.00 p-1074" mix>raw64 -> minp-subn-dr }t t{ s" 1p-1075" mix>raw64 -> 0-dr }t t{ s" 2.0 p+1023" mix>raw64 -> inf-dr }t t{ s" 1.F FFFF FFFF FFFF p+1023" mix>raw64 -> maxp-dr }t t{ s" 0.F FFFF FFFF FFFF p-1022" mix>raw64 -> maxp-subn-dr }t t{ s" 1.F FFFF FFFF FFFF p-1023" mix>raw64 -> maxp-subn-dr }t t{ s" 1.3 504F 333F 9DE6 p+1" mix>raw64 -> rt2p1-dr }t t{ s" 1 3 504 F 333F . 9DE6 p-35" mix>raw64 -> rt2p1-dr }t t{ s" .000013 504 F 333F 9DE6 00 p 21" mix>raw64 -> rt2p1-dr }t t{ s" 0.000013 504 F 333F 9DE6 00 p 21" mix>raw64 -> rt2p1-dr }t t{ s" +1 3 504 F 333F . 9DE6 p-35" mix>raw64 -> rt2p1-dr }t t{ s" + .000013 504 F 333F 9DE6 00 p 21" mix>raw64 -> rt2p1-dr }t t{ s" +.000013 504 F 333F 9DE6 00 p 21" mix>raw64 -> rt2p1-dr }t t{ s" -0p" mix>raw64 -> -0-dr }t t{ s" -1p0" mix>raw64 -> -1-dr }t t{ s" -1.p0" mix>raw64 -> -1-dr }t t{ s" -1.0p1" mix>raw64 -> -2-dr }t t{ s" -20.p-4" mix>raw64 -> -2-dr }t t{ s" -2p" mix>raw64 -> -2-dr }t t{ s" -200p-8" mix>raw64 -> -2-dr }t t{ s" -00002p" mix>raw64 -> -2-dr }t t{ s" -.2p4" mix>raw64 -> -2-dr }t t{ s" -000 0 2p0" mix>raw64 -> -2-dr }t t{ s" -1.00 p-1022" mix>raw64 -> -minp-dr }t t{ s" -1.00 p-1074" mix>raw64 -> -minp-subn-dr }t t{ s" -1p-1075" mix>raw64 -> -0-dr }t t{ s" -2.0 p+1023" mix>raw64 -> -inf-dr }t t{ s" -1.F FFFF FFFF FFFF p+1023" mix>raw64 -> -maxp-dr }t t{ s" -0.F FFFF FFFF FFFF p-1022" mix>raw64 -> -maxp-subn-dr }t t{ s" -1.F FFFF FFFF FFFF p-1023" mix>raw64 -> -maxp-subn-dr }t t{ s" -1.3 504F 333F 9DE6 p+1" mix>raw64 -> -rt2p1-dr }t t{ s" - 1 3 504 F 333F . 9DE6 p-35" mix>raw64 -> -rt2p1-dr }t t{ s" -.000013 504 F 333F 9DE6 00p 21" mix>raw64 -> -rt2p1-dr }t t{ s" -0.000013 504 F 333F 9DE6 00 p 21" mix>raw64 -> -rt2p1-dr }t t{ s" p" mix>raw64 -> 0-dr }t t{ s" 0p2000" mix>raw64 -> 0-dr }t t{ s" + p 2001" mix>raw64 -> 0-dr }t t{ s" + p 2 001" mix>raw64 -> 0-dr }t t{ s" 0.00p" mix>raw64 -> 0-dr }t t{ s" .00p-3000" mix>raw64 -> 0-dr }t t{ s" -p" mix>raw64 -> -0-dr }t t{ s" -0p2000" mix>raw64 -> -0-dr }t t{ s" - p 2001" mix>raw64 -> -0-dr }t t{ s" - p 2 001" mix>raw64 -> -0-dr }t t{ s" -0.00p " mix>raw64 -> -0-dr }t t{ s" - .00p-3000" mix>raw64 -> -0-dr }t \ p = 113, emax = 16383, emin = -16382 t{ s" 0p" mix>raw128 -> 0-qr }t t{ s" 1p0" mix>raw128 -> 1-qr }t t{ s" 1.p0" mix>raw128 -> 1-qr }t t{ s" 1.0p1" mix>raw128 -> 2-qr }t t{ s" 20.p-4" mix>raw128 -> 2-qr }t t{ s" 2p" mix>raw128 -> 2-qr }t t{ s" 200p-8" mix>raw128 -> 2-qr }t t{ s" 00002p" mix>raw128 -> 2-qr }t t{ s" .2p4" mix>raw128 -> 2-qr }t t{ s" 000 0 2p0" mix>raw128 -> 2-qr }t t{ s" 1.00 p-16382" mix>raw128 -> minp-qr }t t{ s" 1.00 p-16494" mix>raw128 -> minp-subn-qr }t t{ s" 1p-16495" mix>raw128 -> 0-qr }t t{ s" 2.0 p+16383" mix>raw128 -> inf-qr }t t{ s" 1.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p+16383" mix>raw128 -> maxp-qr }t t{ s" 1.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p-16383" mix>raw128 -> maxp-subn-qr }t t{ s" 0.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p-16382" mix>raw128 -> maxp-subn-qr }t t{ s" -0p" mix>raw128 -> -0-qr }t t{ s" -1p0" mix>raw128 -> -1-qr }t t{ s" -1.p0" mix>raw128 -> -1-qr }t t{ s" -1.0p1" mix>raw128 -> -2-qr }t t{ s" -20.p-4" mix>raw128 -> -2-qr }t t{ s" -2p" mix>raw128 -> -2-qr }t t{ s" -200p-8" mix>raw128 -> -2-qr }t t{ s" -00002p" mix>raw128 -> -2-qr }t t{ s" -.2p4" mix>raw128 -> -2-qr }t t{ s" -000 0 2p0" mix>raw128 -> -2-qr }t t{ s" -1.00 p-16382" mix>raw128 -> -minp-qr }t t{ s" -1.00 p-16494" mix>raw128 -> -minp-subn-qr }t t{ s" -1p-16495" mix>raw128 -> -0-qr }t t{ s" -2.0 p+16383" mix>raw128 -> -inf-qr }t t{ s" -1.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p+16383" mix>raw128 -> -maxp-qr }t t{ s" -1.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p-16383" mix>raw128 -> -maxp-subn-qr }t t{ s" -0.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p-16382" mix>raw128 -> -maxp-subn-qr }t \ p = 64, emax = 16383, emin = -16382 t{ s" p" mix>raw80 -> 0-xr }t t{ s" 0p2000" mix>raw80 -> 0-xr }t t{ s" + p 2001" mix>raw80 -> 0-xr }t t{ s" + p 2 001" mix>raw80 -> 0-xr }t t{ s" 0.00p" mix>raw80 -> 0-xr }t t{ s" .00p-3000" mix>raw80 -> 0-xr }t t{ s" -p" mix>raw80 -> -0-xr }t t{ s" -0p2000" mix>raw80 -> -0-xr }t t{ s" - p 2001" mix>raw80 -> -0-xr }t t{ s" - p 2 001" mix>raw80 -> -0-xr }t t{ s" -0.00p " mix>raw80 -> -0-xr }t t{ s" - .00p-3000" mix>raw80 -> -0-xr }t t{ s" 0p" mix>raw80 -> 0-xr }t t{ s" 1p0" mix>raw80 -> 1-xr }t t{ s" 1.p0" mix>raw80 -> 1-xr }t t{ s" 1.0p1" mix>raw80 -> 2-xr }t t{ s" 20.p-4" mix>raw80 -> 2-xr }t t{ s" 2p" mix>raw80 -> 2-xr }t t{ s" 200p-8" mix>raw80 -> 2-xr }t t{ s" 00002p" mix>raw80 -> 2-xr }t t{ s" .2p4" mix>raw80 -> 2-xr }t t{ s" 000 0 2p0" mix>raw80 -> 2-xr }t t{ s" 1.00 p-16382" mix>raw80 -> minp-xr }t t{ s" 1.00 p-16445" mix>raw80 -> minp-subn-xr }t t{ s" 1p-16495" mix>raw80 -> 0-xr }t t{ s" 2.0 p+16383" mix>raw80 -> inf-xr }t t{ s" 1.FFFF FFFF FFFF FFFE p+16383" mix>raw80 -> maxp-xr }t t{ s" 0.FFFF FFFF FFFF FFFF p+16384" mix>raw80 -> maxp-xr }t t{ s" 1.F FFFF FFFF FFFF FFFF FFFF FFFF FFF p-16383" mix>raw80 -> maxp-subn-xr }t t{ s" .FFFF FFFF FFFF FFFE p-16382" mix>raw80 -> maxp-subn-xr }t t{ s" -0p" mix>raw80 -> -0-xr }t t{ s" -1p0" mix>raw80 -> -1-xr }t t{ s" -1.p0" mix>raw80 -> -1-xr }t t{ s" -1.0p1" mix>raw80 -> -2-xr }t t{ s" -20.p-4" mix>raw80 -> -2-xr }t t{ s" -2p" mix>raw80 -> -2-xr }t t{ s" -200p-8" mix>raw80 -> -2-xr }t t{ s" -00002p" mix>raw80 -> -2-xr }t t{ s" -.2p4" mix>raw80 -> -2-xr }t t{ s" -000 0 2p0" mix>raw80 -> -2-xr }t t{ s" -1.00 p-16382" mix>raw80 -> -minp-xr }t t{ s" -1.00 p-16445" mix>raw80 -> -minp-subn-xr }t t{ s" -1p-16495" mix>raw80 -> -0-xr }t t{ s" -2.0 p+16383" mix>raw80 -> -inf-xr }t t{ s" -1.F FFFF FFFF FFFF FFFF FFFF FFFF FFF p+16383" mix>raw80 -> -maxp-xr }t t{ s" -1.F FFFF FFFF FFFF FFFF FFFF FFFF FFF p-16383" mix>raw80 -> -maxp-subn-xr }t t{ s" p" mix>raw80 -> 0-xr }t t{ s" 0p2000" mix>raw80 -> 0-xr }t t{ s" + p 2001" mix>raw80 -> 0-xr }t t{ s" + p 2 001" mix>raw80 -> 0-xr }t t{ s" 0.00p" mix>raw80 -> 0-xr }t t{ s" .00p-3000" mix>raw80 -> 0-xr }t t{ s" -p" mix>raw80 -> -0-xr }t t{ s" -0p2000" mix>raw80 -> -0-xr }t t{ s" - p 2001" mix>raw80 -> -0-xr }t t{ s" - p 2 001" mix>raw80 -> -0-xr }t t{ s" -0.00p " mix>raw80 -> -0-xr }t t{ s" - .00p-3000" mix>raw80 -> -0-xr }t \ Any of these should abort if uncommented. \ s" p'" mix>raw80 \ s" ++0p" mix>raw80 \ s" +0.0.p" mix>raw80 \ s" +0.0p-3.2" mix>raw80 \ s" 0p A" mix>raw80 testing RAW32>MIX RAW64>MIX RAW80>MIX RAW128>MIX t{ 0-sr raw32>mix s" +.00 0000 p+0" compare -> 0 }t t{ 1-sr raw32>mix s" +.80 0000 p+1" compare -> 0 }t t{ 2-sr raw32>mix s" +.80 0000 p+2" compare -> 0 }t t{ minp-sr raw32>mix s" +.80 0000 p-125" compare -> 0 }t t{ maxp-subn-sr raw32>mix s" +.7F FFFF p-125" compare -> 0 }t t{ minp-subn-sr raw32>mix s" +.00 0001 p-125" compare -> 0 }t t{ inf-sr raw32>mix s" +Inf" compare -> 0 }t t{ maxp-sr raw32>mix s" +.FF FFFF p+128" compare -> 0 }t t{ nan-sr raw32>mix s" +NaN" compare -> 0 }t t{ -0-sr raw32>mix s" -.00 0000 p+0" compare -> 0 }t t{ -1-sr raw32>mix s" -.80 0000 p+1" compare -> 0 }t t{ -2-sr raw32>mix s" -.80 0000 p+2" compare -> 0 }t t{ -minp-sr raw32>mix s" -.80 0000 p-125" compare -> 0 }t t{ -maxp-subn-sr raw32>mix s" -.7F FFFF p-125" compare -> 0 }t t{ -minp-subn-sr raw32>mix s" -.00 0001 p-125" compare -> 0 }t t{ -inf-sr raw32>mix s" -Inf" compare -> 0 }t t{ -maxp-sr raw32>mix s" -.FF FFFF p+128" compare -> 0 }t t{ -nan-sr raw32>mix s" -NaN" compare -> 0 }t t{ 0-dr raw64>mix s" +0.0 0000 0000 0000 p+0" compare -> 0 }t t{ 1-dr raw64>mix s" +1.0 0000 0000 0000 p+0" compare -> 0 }t t{ 2-dr raw64>mix s" +1.0 0000 0000 0000 p+1" compare -> 0 }t t{ minp-dr raw64>mix s" +1.0 0000 0000 0000 p-1022" compare -> 0 }t t{ maxp-subn-dr raw64>mix s" +0.F FFFF FFFF FFFF p-1022" compare -> 0 }t t{ minp-subn-dr raw64>mix s" +0.0 0000 0000 0001 p-1022" compare -> 0 }t t{ inf-dr raw64>mix s" +Inf" compare -> 0 }t t{ maxp-dr raw64>mix s" +1.F FFFF FFFF FFFF p+1023" compare -> 0 }t t{ nan-dr raw64>mix s" +NaN" compare -> 0 }t t{ -0-dr raw64>mix s" -0.0 0000 0000 0000 p+0" compare -> 0 }t t{ -1-dr raw64>mix s" -1.0 0000 0000 0000 p+0" compare -> 0 }t t{ -2-dr raw64>mix s" -1.0 0000 0000 0000 p+1" compare -> 0 }t t{ -minp-dr raw64>mix s" -1.0 0000 0000 0000 p-1022" compare -> 0 }t t{ -maxp-subn-dr raw64>mix s" -0.F FFFF FFFF FFFF p-1022" compare -> 0 }t t{ -minp-subn-dr raw64>mix s" -0.0 0000 0000 0001 p-1022" compare -> 0 }t t{ -inf-dr raw64>mix s" -Inf" compare -> 0 }t t{ -maxp-dr raw64>mix s" -1.F FFFF FFFF FFFF p+1023" compare -> 0 }t t{ -nan-dr raw64>mix s" -NaN" compare -> 0 }t t{ 0-xr raw80>mix s" +.0000 0000 0000 0000 p+0" compare -> 0 }t t{ 1-xr raw80>mix s" +.8000 0000 0000 0000 p+1" compare -> 0 }t t{ 2-xr raw80>mix s" +.8000 0000 0000 0000 p+2" compare -> 0 }t t{ minp-xr raw80>mix s" +.8000 0000 0000 0000 p-16381" compare -> 0 }t t{ maxp-subn-xr raw80>mix s" +.7FFF FFFF FFFF FFFF p-16381" compare -> 0 }t t{ minp-subn-xr raw80>mix s" +.0000 0000 0000 0001 p-16381" compare -> 0 }t t{ inf-xr raw80>mix s" +Inf" compare -> 0 }t t{ maxp-xr raw80>mix s" +.FFFF FFFF FFFF FFFF p+16384" compare -> 0 }t t{ nan-xr raw80>mix s" +NaN" compare -> 0 }t t{ -0-xr raw80>mix s" -.0000 0000 0000 0000 p+0" compare -> 0 }t t{ -1-xr raw80>mix s" -.8000 0000 0000 0000 p+1" compare -> 0 }t t{ -2-xr raw80>mix s" -.8000 0000 0000 0000 p+2" compare -> 0 }t t{ -minp-xr raw80>mix s" -.8000 0000 0000 0000 p-16381" compare -> 0 }t t{ -maxp-subn-xr raw80>mix s" -.7FFF FFFF FFFF FFFF p-16381" compare -> 0 }t t{ -minp-subn-xr raw80>mix s" -.0000 0000 0000 0001 p-16381" compare -> 0 }t t{ -inf-xr raw80>mix s" -Inf" compare -> 0 }t t{ -maxp-xr raw80>mix s" -.FFFF FFFF FFFF FFFF p+16384" compare -> 0 }t t{ -nan-xr raw80>mix s" -NaN" compare -> 0 }t t{ 0-qr raw128>mix s" +0.0000 0000 0000 0000 0000 0000 0000 p+0" compare -> 0 }t t{ 1-qr raw128>mix s" +1.0000 0000 0000 0000 0000 0000 0000 p+0" compare -> 0 }t t{ 2-qr raw128>mix s" +1.0000 0000 0000 0000 0000 0000 0000 p+1" compare -> 0 }t t{ minp-qr raw128>mix s" +1.0000 0000 0000 0000 0000 0000 0000 p-16382" compare -> 0 }t t{ maxp-subn-qr raw128>mix s" +0.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p-16382" compare -> 0 }t t{ minp-subn-qr raw128>mix s" +0.0000 0000 0000 0000 0000 0000 0001 p-16382" compare -> 0 }t t{ inf-qr raw128>mix s" +Inf" compare -> 0 }t t{ maxp-qr raw128>mix s" +1.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p+16383" compare -> 0 }t t{ nan-qr raw128>mix s" +NaN" compare -> 0 }t t{ -0-qr raw128>mix s" -0.0000 0000 0000 0000 0000 0000 0000 p+0" compare -> 0 }t t{ -1-qr raw128>mix s" -1.0000 0000 0000 0000 0000 0000 0000 p+0" compare -> 0 }t t{ -2-qr raw128>mix s" -1.0000 0000 0000 0000 0000 0000 0000 p+1" compare -> 0 }t t{ -minp-qr raw128>mix s" -1.0000 0000 0000 0000 0000 0000 0000 p-16382" compare -> 0 }t t{ -maxp-subn-qr raw128>mix s" -0.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p-16382" compare -> 0 }t t{ -minp-subn-qr raw128>mix s" -0.0000 0000 0000 0000 0000 0000 0001 p-16382" compare -> 0 }t t{ -inf-qr raw128>mix s" -Inf" compare -> 0 }t t{ -maxp-qr raw128>mix s" -1.FFFF FFFF FFFF FFFF FFFF FFFF FFFF p+16383" compare -> 0 }t t{ -nan-qr raw128>mix s" -NaN" compare -> 0 }t testing HEX8>MIX HEX16>MIX HEX20>MIX HEX32>MIX \ Only one test is needed for each in the next two sections \ because of the logical equivalence of these words to \ compositions of already tested words. There are more for \ some, which used to serve as regression tests for examples. t{ s" 401A 8279" hex8>mix s" +.9A 8279 p+2" compare -> 0 }t t{ s" 3419 FCEF" hex8>mix s" +.99 FCEF p-22" compare -> 0 }t t{ s" 4003 504F 333F 9DE6" hex16>mix s" +1.3 504F 333F 9DE6 p+1" compare -> 0 }t t{ s" 3CA2 1165 F626 CDD6" hex16>mix s" +1.2 1165 F626 CDD6 p-53" compare -> 0 }t t{ minp-subn-xr raw80>hex20 hex20>mix s" +.0000 0000 0000 0001 p-16381" compare -> 0 }t t{ minp-subn-qr raw128>hex32 hex32>mix s" +0.0000 0000 0000 0000 0000 0000 0001 p-16382" compare -> 0 }t testing MIX>HEX8 MIX>HEX16 MIX>HEX20 MIX>HEX32 t{ s" 2.6a09 e4 p0" mix>hex8 s" 401A 8279" compare -> 0 }t t{ s" 0.267f 3bcc p-20" mix>hex8 s" 3419 FCEF" compare -> 0 }t t{ s" 2.6a09 e667 f3bc c p0" mix>hex16 s" 4003 504F 333F 9DE6" compare -> 0 }t t{ s" 0.908b 2fb1 366e b p-52" mix>hex16 s" 3CA2 1165 F626 CDD6" compare -> 0 }t t{ s" +.0000 0000 0000 0001 p-16381" mix>hex20 minp-subn-xr raw80>hex20 compare -> 0 }t t{ s" +0.0000 0000 0000 0000 0000 0000 0001 p-16382" mix>hex32 minp-subn-qr raw128>hex32 compare -> 0 }t testing HEX8>RAW32 HEX16>RAW64 HEX20>RAW80 HEX32>RAW128 \ Uncomment one of these to test faulty input exceptions: \ s" " hex8>raw32 \ s" 012345678" hex8>raw32 \ s" 0123h5678" hex8>raw32 \ s" " hex16>raw64 \ s" 01234567 012345678" hex16>raw64 \ s" 0x234567 012345678" hex16>raw64 \ s" 01234567 012345678 012345678" hex20>raw80 \ s" 0123456 01234567 012345678" hex20>raw80 \ s" 01234567 01234567 012345678 01234567" hex32>raw128 \ s" 0123456 01234567 01234567 01234567" hex32>raw128 hex t{ s" 0 123 4567" hex8>raw32 -> 01234567 }t t{ s" 0 123 456789AB CDEF" hex16>raw64 -> 89ABCDEF 01234567 }t t{ s" 00AB00DE" hex8>raw32 -> 00AB00DE }t t{ s" 0123 4567 89AB cdef 0123" hex20>raw80 -> 01230000 89ABCDEF 01234567 }t t{ s" 0123 4567 89AB cdef 0123 4567 89ab CDEF" hex32>raw128 -> 89ABCDEF 01234567 89ABCDEF 01234567 }t decimal testing RAW32>HEX8 RAW64>HEX16 RAW80>HEX20 RAW128>HEX32 hex t{ 00AB00DE raw32>hex8 s" 00AB 00DE" compare -> 0 }t t{ 89ABCDEF 01234567 raw64>hex16 s" 0123 4567 89AB CDEF" compare -> 0 }t t{ 89ABCDEF 01234567 89ABCDEF raw80>hex20 s" 89AB CDEF 0123 4567 89AB" compare -> 0 }t t{ 89ABCDEF 01234567 89ABCDEF 01234567 raw128>hex32 s" 0123 4567 89AB CDEF 0123 4567 89AB CDEF" compare -> 0 }t testing RAW32! RAW64! RAW80! RAW128@ RAW32@ RAW64@ RAW80@ RAW128@ : qf-fill ( -- ) qfpad 4 cells 1+ [char] U fill ; : #fbytes ( -- #bytes ) 0 4 cells 1+ 0 DO drop i qfpad i + c@ [char] U = IF LEAVE THEN LOOP ; : qf-bytes= ( s -- flag ) qfpad over compare 0= ; hex qf-fill t{ 30313233 qfpad raw32! #fbytes -> 4 }t t{ qfpad raw32@ -> 30313233 }t [LITTLE-ENDIAN] [IF] t{ s" 3210" qf-bytes= -> true }t [ELSE] t{ s" 0123" qf-bytes= -> true }t [THEN] qf-fill t{ 34353637 30313233 qfpad raw64! #fbytes -> 8 }t t{ qfpad raw64@ -> 34353637 30313233 }t [LITTLE-ENDIAN] [IF] t{ s" 76543210" qf-bytes= -> true }t [ELSE] t{ s" 01234567" qf-bytes= -> true }t [THEN] qf-fill t{ 38390000 34353637 30313233 qfpad raw80! #fbytes -> A }t t{ qfpad raw80@ -> 38390000 34353637 30313233 }t [LITTLE-ENDIAN] [IF] t{ s" 9876543210" qf-bytes= -> true }t [ELSE] t{ s" 0123456789" qf-bytes= -> true }t [THEN] qf-fill t{ 32333435 38393031 34353637 30313233 qfpad raw128! #fbytes -> 10 }t t{ qfpad raw128@ -> 32333435 38393031 34353637 30313233 }t [LITTLE-ENDIAN] [IF] t{ s" 5432109876543210" qf-bytes= -> true }t [ELSE] t{ s" 0123456789012345" qf-bytes= -> true }t [THEN] decimal \ In the rest of this file, one test for each word is \ sufficient, since we need only see that its simple \ composition is right. testing RAW32>F RAW64>F F>RAW32 F>RAW64 t{ 1-sr raw32>f -> 1e }t t{ 1-dr raw64>f -> 1e }t t{ 1e f>raw32 -> 1-sr }t t{ 1e f>raw64 -> 1-dr }t [DEFINED] XF@ [IF] testing RAW80>F F>RAW80 t{ 1-xr raw80>f -> 1e }t t{ 1e f>raw80 -> 1-xr }t [THEN] [DEFINED] QF@ [IF] testing RAW128>F F>RAW128 t{ 1-qr raw128>f -> 1e }t t{ 1e f>raw128 -> 1-qr }t [THEN] testing HEX8>F HEX16>F F>HEX8 F>HEX16 t{ s" 3F800000" hex8>f -> 1e }t t{ 1e f>hex8 s" 3F80 0000" compare -> 0 }t t{ s" 3FF00000 00000000" hex16>f -> 1e }t t{ 1e f>hex16 s" 3FF0 0000 0000 0000" compare -> 0 }t [DEFINED] XF@ [IF] testing HEX20>F F>HEX20 t{ s" 3FFF8000 00000000 0000" hex20>f -> 1e }t t{ 1e f>hex20 s" 3FFF 8000 0000 0000 0000" compare -> 0 }t [THEN] [DEFINED] QF@ [IF] testing HEX32>F F>HEX32 t{ s" 3FFF0000 00000000 00000000 00000000" hex32>f -> 1e }t t{ 1e f>hex32 s" 3FFF 0000 0000 0000 0000 0000 0000 0000" compare -> 0 }t [THEN] testing MIX>F F>MIX t{ s" 1p0" mix>f -> 1e }t t{ 1e f>mix mix>f -> 1e }t false \ change to TRUE to inspect word defaults verbose @ and [IF] see mix>raw see raw>mix see hex>raw see raw>hex see hex>mix see mix>hex see raw! see raw@ see raw>f see f>raw see hex>f see f>hex cr [THEN] verbose @ [IF] .( #ERRORS: ) #errors @ . cr [THEN]