ifhub/inform7
1
0
Fork 0
mirror of https://github.com/ganelson/inform.git synced 2024-07-05 16:44:21 +03:00
Code Issues Projects Releases Wiki Activity
inform7/inform6/Tests/Test Cases/glulxercise-G.inf
Graham Nelson 8f772a2948 More ambitious test cases added
2022-03-05 23:03:22 +00:00

10549 lines
325 KiB
INI
Executable file
Raw Blame History

!% $MEMORY_MAP_EXTENSION=256
Constant Story "Glulxercise";
Constant Headline "A Glulx interpreter unit test^";
Release 9;
Serial "161114";
! Written by Andrew Plotkin (erkyrath@eblong.com).
! This unit test suite, and its functions, are in the public domain.
! To compile this canonically, do "inform -G glulxercise.inf". No other
! options.
! Comment out the following line if you are using an Inform 6 compiler
! that lacks the new floating-point opcodes.
Constant FLOAT_OPCODES_AVAILABLE;
Constant GG_MAINWIN_ROCK 201;
Constant GG_SAVESTR_ROCK 301;
Constant GG_SCRIPTSTR_ROCK 302;
Constant GG_SCRIPTFREF_ROCK 401;
Constant GG_SAVEFREF_ROCK 402;
Global gg_mainwin = 0;
Global gg_savestr = 0;
Global gg_savefref = 0;
Global gg_scriptfref = 0;
Global gg_scriptstr = 0;
Array gg_event --> 4;
Array gg_arguments --> 8;
!Constant HDR_MAGICNUMBER $00; ! long word
Constant HDR_GLULXVERSION $04; ! long word
!Constant HDR_RAMSTART $08; ! long word
Constant HDR_EXTSTART $0C; ! long word
Constant HDR_ENDMEM $10; ! long word
!Constant HDR_STACKSIZE $14; ! long word
!Constant HDR_STARTFUNC $18; ! long word
Constant HDR_DECODINGTBL $1C; ! long word
!Constant HDR_CHECKSUM $20; ! long word
!Constant ROM_INFO $24; ! four ASCII characters
!Constant ROM_MEMORYLAYOUT $28; ! long word
!Constant ROM_INFORMVERSION $2C; ! four ASCII characters
!Constant ROM_COMPVERSION $30; ! four ASCII characters
Constant ROM_GAMERELEASE $34; ! short word
Constant ROM_GAMESERIAL $36; ! six ASCII characters
Constant INPUT_BUFFER_LEN = 260; ! No extra byte necessary
Constant MAX_BUFFER_WORDS = 20;
Constant PARSE_BUFFER_LEN = 244; ! 4 + MAX_BUFFER_WORDS*4;
Array buffer buffer INPUT_BUFFER_LEN;
Array parse --> PARSE_BUFFER_LEN/WORDSIZE;
Global allstackdepth;
Global failures = 0;
Global total_failures = 0;
[ Main ix;
GGInitialise();
! deal with some compiler warnings
ix = PrintShortName;
if (startovertest-->0 == 1234 && startovertest-->1 == 2 && startovertest-->2 == 0) {
! Part of UndoRestartTest.
new_line;
print "A voice booooms out: You've been here before!^^";
startovertest-->1 = 3;
startovertest-->2 = 3;
print "Restoring undo...^";
@restoreundo ix;
print "Undo failed (", ix, ")! Exiting.^";
@quit;
}
new_line;
Banner();
new_line;
LookSub();
TestLoop();
print "^Exiting via return. (Try ~opquit~ for @@64quit, ~glkquit~ for glk_exit().)^";
print "^Goodbye.^";
];
[ GGInitialise res;
@gestalt 4 2 res; ! Test if this interpreter has Glk.
if (res == 0) {
! Without Glk, we're entirely screwed.
quit;
}
! Set the VM's I/O system to be Glk.
@setiosys 2 0;
! First, we must go through all the Glk objects that exist, and see
! if we created any of them. One might think this strange, since the
! program has just started running, but remember that the player might
! have just typed "restart".
GGRecoverObjects();
! Now, gg_mainwin might already be set. If not, set it.
if (gg_mainwin == 0) {
! Open the story window.
gg_mainwin = glk($0023, 0, 0, 0, 3, GG_MAINWIN_ROCK); ! window_open
if (gg_mainwin == 0) {
! If we can't even open one window, there's no point in going on.
quit;
}
}
else {
! There was already a story window.
! glk($002A, gg_mainwin); ! window_clear
}
glk($002F, gg_mainwin); ! set_window
];
[ GGRecoverObjects id;
! If GGRecoverObjects() has been called, all these stored IDs are
! invalid, so we start by clearing them all out.
! (In fact, after a restoreundo, some of them may still be good.
! For simplicity, though, we assume the general case.)
gg_mainwin = 0;
gg_scriptfref = 0;
gg_scriptstr = 0;
gg_savefref = 0;
gg_savestr = 0;
id = glk($0040, 0, gg_arguments); ! stream_iterate
while (id) {
switch (gg_arguments-->0) {
GG_SAVESTR_ROCK: gg_savestr = id;
GG_SCRIPTSTR_ROCK: gg_scriptstr = id;
}
id = glk($0040, id, gg_arguments); ! stream_iterate
}
id = glk($0020, 0, gg_arguments); ! window_iterate
while (id) {
switch (gg_arguments-->0) {
GG_MAINWIN_ROCK: gg_mainwin = id;
}
id = glk($0020, id, gg_arguments); ! window_iterate
}
id = glk($0064, 0, gg_arguments); ! fileref_iterate
while (id) {
switch (gg_arguments-->0) {
GG_SAVEFREF_ROCK: gg_savefref = id;
GG_SCRIPTFREF_ROCK: gg_scriptfref = id;
}
id = glk($0064, id, gg_arguments); ! fileref_iterate
}
];
[ Keyboard;
while (true) {
print ">";
KeyboardPrimitive(buffer, parse);
if (parse-->0)
break;
}
];
[ KeyboardPrimitive a_buffer a_table done;
done = false;
glk($00D0, gg_mainwin, a_buffer+WORDSIZE, INPUT_BUFFER_LEN-WORDSIZE, 0); ! request_line_event
while (~~done) {
glk($00C0, gg_event); ! select
switch (gg_event-->0) {
3: ! evtype_LineInput
if (gg_event-->1 == gg_mainwin) {
a_buffer-->0 = gg_event-->2;
done = true;
}
}
}
Tokenise__(a_buffer,a_table);
];
Array gg_tokenbuf -> DICT_WORD_SIZE;
[ Tokenise__ buf tab
cx numwords len bx ix wx wpos wlen val res dictlen entrylen;
len = buf-->0;
buf = buf+WORDSIZE;
! First, split the buffer up into words. We use the standard Infocom
! list of word separators (comma, period, double-quote).
cx = 0;
numwords = 0;
while (cx < len) {
while (cx < len && buf->cx == ' ') cx++;
if (cx >= len) break;
bx = cx;
if (buf->cx == '.' or ',' or '"') cx++;
else {
while (cx < len && buf->cx ~= ' ' or '.' or ',' or '"') cx++;
}
tab-->(numwords*3+2) = (cx-bx);
tab-->(numwords*3+3) = WORDSIZE+bx;
numwords++;
if (numwords >= MAX_BUFFER_WORDS) break;
}
tab-->0 = numwords;
! Now we look each word up in the dictionary.
dictlen = #dictionary_table-->0;
entrylen = DICT_WORD_SIZE + 7;
for (wx=0 : wx<numwords : wx++) {
wlen = tab-->(wx*3+2);
wpos = tab-->(wx*3+3);
! Copy the word into the gg_tokenbuf array, clipping to DICT_WORD_SIZE
! characters and lower case.
if (wlen > DICT_WORD_SIZE) wlen = DICT_WORD_SIZE;
cx = wpos - WORDSIZE;
for (ix=0 : ix<wlen : ix++) gg_tokenbuf->ix = glk($00A0, buf->(cx+ix));
for (: ix<DICT_WORD_SIZE : ix++) gg_tokenbuf->ix = 0;
val = #dictionary_table + WORDSIZE;
@binarysearch gg_tokenbuf DICT_WORD_SIZE val entrylen dictlen 1 1 res;
tab-->(wx*3+1) = res;
}
];
[ Banner i ix;
if (Story ~= 0) {
glk($0086, 3); ! set header style
print (string) Story;
glk($0086, 0); ! set normal style
}
if (Headline ~= 0) print ": ", (string) Headline;
print "Release ";
@aloads ROM_GAMERELEASE 0 i;
print i;
print " / Serial number ";
for (i=0 : i<6 : i++) print (char) ROM_GAMESERIAL->i;
print " / Inform v"; inversion;
print ", compiler options ";
i = false;
#Ifdef STRICT_MODE;
print "S"; i++;
#Endif; ! STRICT_MODE
#Ifdef INFIX;
print "X"; i++;
#Ifnot;
#Ifdef DEBUG;
print "D"; i++;
#Endif; ! DEBUG
#Endif; ! INFIX
if (~~i) print "(none)";
new_line;
@gestalt 1 0 ix;
print "Interpreter version ", ix / $10000, ".", (ix & $FF00) / $100,
".", ix & $FF, " / ";
@gestalt 0 0 ix;
print "VM ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, " / ";
ix = HDR_GLULXVERSION-->0;
print "game file format ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, "^";
];
[ TestLoop wd paddr plen ix obj found;
while (true) {
new_line;
if (failures) {
print failures, " uncounted test failures!^^";
failures = 0;
}
Keyboard();
wd = parse-->1;
if (wd == 'quit' or 'q//' or 'exit')
return;
found = nothing;
objectloop (obj ofclass TestClass) {
paddr = obj.&name;
plen = obj.#name / WORDSIZE;
for (ix=0 : ix<plen : ix++) {
if (paddr-->ix == wd) {
found = obj;
break;
}
}
if (found)
break;
}
if (~~found) {
print "I don't understand that command.^";
continue;
}
allstackdepth = 0;
found.testfunc();
}
];
Attribute meta;
Class TestClass
with
short_name 0,
testfunc TestNothing,
fail_count;
Class TestFloatClass
class TestClass;
[ PrintShortName obj;
if (obj provides short_name && obj.short_name) {
print (string) obj.short_name;
rtrue;
}
if (obj ofclass TestClass) {
print (address) obj.name;
rtrue;
}
print (object) obj;
];
[ Hex val byte initial ix;
print "$";
initial = true;
for (ix=0 : ix<8 : ix++) {
@ushiftr val 28 byte;
@shiftl val 4 val;
byte = byte & $0F;
if (byte == 0 && initial && ix < 7)
continue;
initial = false;
if (byte <= 9)
print (char) (byte+'0');
else
print (char) (byte-10+'A');
}
];
[ string_to_array val arr arrlen str oldstr len;
oldstr = glk($0048); ! stream_get_current
str = glk($0043, arr, arrlen, 1, 0); ! stream_open_memory
if (str == 0) return 0;
glk($0047, str); ! stream_set_current
if (val->0 == $c0 or $c1)
val();
else
@streamstr val;
glk($0047, oldstr); ! stream_set_current
@copy $ffffffff sp;
@copy str sp;
@glk $0044 2 0; ! stream_close
@copy sp len;
@copy sp 0;
return len;
];
[ func_to_array _vararg_count arr arrlen func str oldstr len;
@copy sp arr;
@copy sp arrlen;
@copy sp func;
_vararg_count = _vararg_count-3;
oldstr = glk($0048); ! stream_get_current
str = glk($0043, arr, arrlen, 1, 0); ! stream_open_memory
if (str == 0) return 0;
glk($0047, str); ! stream_set_current
@call func _vararg_count 0;
glk($0047, oldstr); ! stream_set_current
@copy $ffffffff sp;
@copy str sp;
@glk $0044 2 0; ! stream_close
@copy sp len;
@copy sp 0;
return len;
];
[ string_to_uniarray val arr arrlen str oldstr len;
oldstr = glk($0048); ! stream_get_current
str = glk($0139, arr, arrlen, 1, 0); ! stream_open_memory_uni
if (str == 0) return 0;
glk($0047, str); ! stream_set_current
if (val->0 == $c0 or $c1)
val();
else
@streamstr val;
glk($0047, oldstr); ! stream_set_current
@copy $ffffffff sp;
@copy str sp;
@glk $0044 2 0; ! stream_close
@copy sp len;
@copy sp 0;
return len;
];
[ check val wanted;
if (val == wanted) {
print val;
rtrue;
}
failures++;
print val, " (should be ", wanted, " FAIL)";
rfalse;
];
[ check_nonzero val;
if (val) {
print (Hex) val;
rtrue;
}
failures++;
print val, " (should be nonzero FAIL)";
rfalse;
];
[ check_range val wantmin wantmax;
if (val >= wantmin && val <= wantmax) {
print val;
rtrue;
}
failures++;
print val, " (should be in [", wantmin, "..", wantmax, "] FAIL)";
rfalse;
];
[ check_hex val wanted;
if (val == wanted) {
print (Hex) val;
rtrue;
}
failures++;
print (Hex) val, " (should be ", (Hex) wanted, " FAIL)";
rfalse;
];
[ check_list _vararg_count arr ix wanted;
@copy sp arr;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp wanted;
if (ix)
print ", ";
if (wanted == arr-->ix) {
print wanted;
}
else {
failures++;
print arr-->ix, " (should be ", wanted, " FAIL)";
}
}
];
[ check_bytelist _vararg_count arr ix wanted val;
@copy sp arr;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp wanted;
if (ix)
print ", ";
@aloadb arr ix val;
if (wanted == val) {
print wanted;
}
else {
failures++;
print val, " (should be ", wanted, " FAIL)";
}
}
];
[ check_str str len newlen ix good ch;
good = true;
newlen = string_to_array(str, bigbuffer2, BIGBUFSIZE);
if (newlen ~= len) {
good = false;
}
else {
for (ix=0 : ix<len : ix++) {
if (bigbuffer->ix ~= bigbuffer2->ix)
good = false;
}
}
print "~";
for (ix=0 : ix<len : ix++) {
ch = bigbuffer->ix;
@streamchar ch;
}
print "~ len ", len;
if (~~good) {
failures++;
print " (should be ~";
for (ix=0 : ix<newlen : ix++) {
ch = bigbuffer2->ix;
@streamchar ch;
}
print "~ len ", newlen, ", FAIL)";
}
];
[ check_ustr str len newlen ix good ch;
good = true;
newlen = string_to_uniarray(str, bigubuffer2, BIGBUFSIZE);
if (newlen ~= len) {
good = false;
}
else {
for (ix=0 : ix<len : ix++) {
if (bigubuffer-->ix ~= bigubuffer2-->ix)
good = false;
}
}
print "~";
for (ix=0 : ix<len : ix++) {
ch = bigubuffer-->ix;
@streamunichar ch;
}
print "~ len ", len;
if (~~good) {
failures++;
print " (should be ~";
for (ix=0 : ix<newlen : ix++) {
ch = bigubuffer2-->ix;
@streamunichar ch;
}
print "~ len ", newlen, ", FAIL)";
}
];
[ count_failures val;
print "^";
if (failures) {
val = failures;
total_failures = total_failures + failures;
failures = 0;
print_ret val, " tests failed.";
}
else {
"Passed.";
}
];
[ run_all_tests cla obj startfail res ix;
startfail = total_failures;
objectloop (obj ofclass cla) {
if (obj has meta)
continue;
res = total_failures;
print "^";
allstackdepth = 148;
obj.testfunc();
obj.fail_count = total_failures - res;
}
res = total_failures - startfail;
if (res == 0) {
"^All tests passed.";
}
else {
print "^", res, " tests failed overall: ";
ix = 0;
objectloop (obj ofclass cla) {
if (obj.fail_count) {
if (ix)
print ", ";
print (name) obj, " (", obj.fail_count, ")";
ix++;
}
}
".";
}
];
TestClass LookAction
with name 'look' 'l//' 'help' '?//',
testfunc LookSub,
has meta;
TestClass VersionAction
with name 'version',
testfunc Banner,
has meta;
TestClass OpQuitAction
with name 'opquit' 'opq' 'opexit',
testfunc [;
print "^Exiting via @@64quit. (Try ~quit~ for return, ~glkquit~ for glk_exit().)^";
print "^Goodbye.^";
@quit;
],
has meta;
TestClass GlkQuitAction
with name 'glkquit' 'glkq' 'glkexit',
testfunc [ val;
print "^Exiting via glk_exit(). (Try ~quit~ for return, ~opquit~ for @@64quit.)^";
print "^Goodbye.^";
@glk $0001 0 val; ! exit
],
has meta;
TestClass AllAction
with name 'all',
testfunc [;
print "All tests:^";
run_all_tests(TestClass);
],
has meta;
TestClass AllFloatAction
with name 'allfloat' 'floatall',
testfunc [;
print "All floating-point tests:^";
run_all_tests(TestFloatClass);
],
has meta;
[ TestNothing;
"Nothing happens.";
];
[ LookSub obj ix;
print "A voice booooms out: Welcome to the test chamber.^^";
print "Type ~help~ to repeat this message, ~quit~ to exit,
~all~ to run all tests, or one of the following test options: ";
ix = 0;
objectloop (obj ofclass TestClass) {
if (obj has meta)
continue;
if (ix) print ", ";
print "~", (name) obj, "~";
ix++;
}
print ".^";
if (total_failures) {
print "^", total_failures, " tests have failed so far in this run.^";
}
];
Global testglobal;
Global testglobal2;
TestClass OperandTest
with name 'operand' 'operands',
testfunc [ val;
print "Basic operand access:^^";
@nop; ! we have to test it somewhere.
! discards have no effect
@copy testglobal 0;
@copy val 0;
@copy $12356 0;
@copy 99 sp;
@copy sp 0;
@stkcount val;
print "stkcount="; check(val, 0); print "^";
@copy 0 val;
print "Constants: zero="; check(val, 0); print ", ";
@copy (-1) val;
print "-1="; check(val, -1); print ", ";
@copy (16) val;
print "16="; check(val, 16); print ", ";
@copy (-$81) val;
print "-$81="; check_hex(val, -$81); print ", ";
@copy ($100) val;
print "$100="; check_hex(val, $100); print ", ";
@copy (-$8000) val;
print "-$8000="; check_hex(val, -$8000); print ", ";
@copy ($10000) val;
print "$10000="; check_hex(val, $10000); print ", ";
@copy ($7FFFFFFF) val;
print "$7FFFFFFF="; check_hex(val, $7FFFFFFF); print ", ";
@copy ($80000000) val;
print "$80000000="; check_hex(val, $80000000); print ", ";
@copy ($CDEF1234) val;
print "$CDEF1234="; check_hex(val, $CDEF1234); print "^";
@add 0 0 val;
print "Constants: zero="; check(val, 0); print ", ";
@add 0 (-1) val;
print "-1="; check(val, -1); print ", ";
@add 0 (16) val;
print "16="; check(val, 16); print ", ";
@add 0 (-$81) val;
print "-$81="; check_hex(val, -$81); print ", ";
@add 0 ($100) val;
print "$100="; check_hex(val, $100); print ", ";
@add 0 (-$8000) val;
print "-$8000="; check_hex(val, -$8000); print ", ";
@add 0 ($10000) val;
print "$10000="; check_hex(val, $10000); print ", ";
@add 0 ($7FFFFFFF) val;
print "$7FFFFFFF="; check_hex(val, $7FFFFFFF); print ", ";
@add 0 ($80000000) val;
print "$80000000="; check_hex(val, $80000000); print ", ";
@add 0 ($CDEF1234) val;
print "$CDEF1234="; check_hex(val, $CDEF1234); print "^";
testglobal = 123;
@copy testglobal val;
print "Global to local 123="; check(val, 123);
print "="; check(#globals_array --> #g$testglobal, 123); print ", ";
val = 321;
@copy val testglobal;
val = 0;
@copy testglobal val;
print "local to global 321="; check(val, 321);
print "="; check(#globals_array --> #g$testglobal, 321); print "^";
@copy 456 sp;
val = 0;
@copy sp val;
print "Stack: 456="; check(val, 456); print ", ";
@copy 933 sp;
val = noop();
@copy sp val;
print "Stack: 933="; check(val, 933); print "^";
testglobal = 123;
@copy testglobal sp;
val = 0;
@copy sp val;
print "Global to stack: 123="; check(val, 123); print "^";
@copy 789 sp;
@copy sp sp; ! might as well check this case
@copy sp val;
print "Stack to stack: 789="; check(val, 789); print ", ";
@copy 1234 sp;
val = noop();
@copy sp sp; ! might as well check this case
@copy sp val;
print "Stack to stack: 1234="; check(val, 1234); print "^";
count_failures();
];
TestClass ArithTest
with name 'arith',
testfunc [ val;
print "Integer arithmetic:^^";
@add 2 2 val;
print "2+2="; check(val, 4); print ", ";
@add (-2) (-3) val;
print "-2+-3="; check(val, -5); print ", ";
@add 3 (-4) val;
print "3+-4="; check(val, -1); print ", ";
@add (-4) 5 val;
print "-4+5="; check(val, 1); print ", ";
@add $7FFFFFFF $7FFFFFFE val;
print "$7FFFFFFF+$7FFFFFFE="; check(val, -3); print ", ";
@add $80000000 $80000000 val;
print "$80000000+$80000000="; check(val, 0); print "^";
testglobal = 6; testglobal2 = 8;
@add testglobal testglobal2 val;
print "Globals 6+8="; check(val, 14); print "^";
@sub 2 2 val;
print "2-2="; check(val, 0); print ", ";
@sub (-2) 3 val;
print "-2-3="; check(val, -5); print ", ";
@sub 3 4 val;
print "3-4="; check(val, -1); print ", ";
@sub (-4) (-5) val;
print "-4-(-5)="; check(val, 1); print ", ";
@sub $7FFFFFFF $7FFFFFFE val;
print "$7FFFFFFF-$7FFFFFFE="; check(val, 1); print ", ";
@sub $80000000 $80000001 val;
print "$80000000-$80000001="; check(val, -1); print ", ";
@sub $7FFFFFFF $80000001 val;
print "$7FFFFFFF-$80000001="; check(val, -2); print "^";
testglobal = 6; testglobal2 = 8;
@sub testglobal testglobal2 val;
print "Globals 6-8="; check(val, -2); print "^";
@mul 2 2 val;
print "2*2="; check(val, 4); print ", ";
@mul (-2) (-3) val;
print "-2*-3="; check(val, 6); print ", ";
@mul 3 (-4) val;
print "3*-4="; check(val, -12); print ", ";
@mul (-4) 5 val;
print "-4*5="; check(val, -20); print ", ";
@mul $10000 $10000 val;
print "$10000*$10000 (trunc)="; check(val, 0); print ", ";
@mul 311537 335117 val;
print "311537*335117 (trunc)="; check_hex(val, 1322129725); print "^";
testglobal = -6; testglobal2 = -8;
@mul testglobal testglobal2 val;
print "Globals -6*-8="; check(val, 48); print "^";
@div 12 3 val;
print "12/3="; check(val, 4); print ", ";
@div 11 2 val;
print "11/2="; check(val, 5); print ", ";
@div (-11) 2 val;
print "-11/2="; check(val, -5); print ", ";
@div 11 (-2) val;
print "11/-2="; check(val, -5); print ", ";
@div (-11) (-2) val;
print "-11/-2="; check(val, 5); print ", ";
@div $7fffffff 2 val;
print "$7fffffff/2="; check_hex(val, $3fffffff); print ", ";
@div $7fffffff (-2) val;
print "$7fffffff/-2="; check_hex(val, -$3fffffff); print ", ";
@div (-$7fffffff) 2 val;
print "-$7fffffff/2="; check_hex(val, -$3fffffff); print ", ";
@div (-$7fffffff) (-2) val;
print "-$7fffffff/-2="; check_hex(val, $3fffffff); print ", ";
@div $80000000 2 val;
print "$80000000/2="; check_hex(val, $C0000000); print ", ";
@div $80000000 (-2) val;
print "$80000000/(-2)="; check_hex(val, $40000000); print ", ";
@div $80000000 1 val;
print "$80000000/1="; check_hex(val, $80000000); print "^";
testglobal = -48; testglobal2 = -8;
@div testglobal testglobal2 val;
print "Globals -48/-8="; check(val, 6); print ", ";
testglobal = 48; testglobal2 = 7;
@div testglobal testglobal2 val;
print "48/7="; check(val, 6); print ", ";
testglobal = 48; testglobal2 = -7;
@div testglobal testglobal2 val;
print "48/-7="; check(val, -6); print ", ";
testglobal = -48; testglobal2 = 7;
@div testglobal testglobal2 val;
print "-48/7="; check(val, -6); print ", ";
testglobal = -48; testglobal2 = -7;
@div testglobal testglobal2 val;
print "-48/-7="; check(val, 6); print "^";
@mod 12 3 val;
print "12%3="; check(val, 0); print ", ";
@mod 13 5 val;
print "13%5="; check(val, 3); print ", ";
@mod (-13) 5 val;
print "-13%5="; check(val, -3); print ", ";
@mod 13 (-5) val;
print "13%-5="; check(val, 3); print ", ";
@mod (-13) (-5) val;
print "-13%-5="; check(val, -3); print ", ";
@mod $7fffffff 7 val;
print "$7fffffff%7="; check(val, 1); print ", ";
@mod (-$7fffffff) 7 val;
print "-$7fffffff%7="; check(val, -1); print ", ";
@mod $7fffffff (-7) val;
print "$7fffffff%-7="; check(val, 1); print ", ";
@mod (-$7fffffff) (-7) val;
print "-$7fffffff%-7="; check(val, -1); print ", ";
@mod $80000000 7 val;
print "$80000000%7="; check(val, -2); print ", ";
@mod $80000000 (-7) val;
print "$80000000%-7="; check(val, -2); print ", ";
@mod $80000000 2 val;
print "$80000000%2="; check(val, 0); print ", ";
@mod $80000000 (-2) val;
print "$80000000%-2="; check(val, 0); print ", ";
@mod $80000000 1 val;
print "$80000000%1="; check(val, 0); print "^";
testglobal = 49; testglobal2 = 8;
@mod testglobal testglobal2 val;
print "Globals 49%8="; check(val, 1); print ", ";
testglobal = 49; testglobal2 = -8;
@mod testglobal testglobal2 val;
print "49%-8="; check(val, 1); print ", ";
testglobal = -49; testglobal2 = 8;
@mod testglobal testglobal2 val;
print "-49%8="; check(val, -1); print ", ";
testglobal = -49; testglobal2 = -8;
@mod testglobal testglobal2 val;
print "-49%-8="; check(val, -1); print "^";
@neg 0 val;
print "-(0)="; check(val, 0); print ", ";
@neg 5 val;
print "-(5)="; check(val, -5); print ", ";
@neg (-5) val;
print "-(-5)="; check(val, 5); print ", ";
@neg $7FFFFFFF val;
print "-($7FFFFFFF)="; check(val, $80000001); print ", ";
@neg $80000001 val;
print "-($80000001)="; check(val, $7FFFFFFF); print ", ";
@neg $80000000 val;
print "-($80000000)="; check_hex(val, $80000000); print "^";
testglobal = $80000001;
@neg testglobal val;
print "global -($80000001)="; check(val, $7FFFFFFF); print "^";
count_failures();
];
TestClass BigMulTest
with name 'bigmul',
testfunc [ val loc1 loc2;
print "Large integer multiplication:^^";
@mul 51537 35117 val;
print "51537*35117="; check_hex(val, 1809824829); print "^";
@mul (-51539) 35117 val;
print "-51539*35117="; check_hex(val, -1809895063); print "^";
@mul 51537 (-35119) val;
print "51537*-35119="; check_hex(val, -1809927903); print "^";
@mul (-51539) (-35119) val;
print "-51539*-35119="; check_hex(val, 1809998141); print "^";
loc1 = 51537;
loc2 = 35117;
@mul loc1 loc2 val;
print "51537*35117 (loc)="; check_hex(val, 1809824829); print "^";
testglobal = 51537;
testglobal2 = 35117;
@mul testglobal testglobal2 val;
print "51537*35117 (glob)="; check_hex(val, 1809824829); print "^";
loc1 = $5432FEDB;
loc2 = -1;
@mul loc1 loc2 val;
print "$5432FEDB*-1 (loc)="; check_hex(val, -$5432FEDB); print "^";
testglobal = $1C10FF9E;
loc2 = -3;
@mul testglobal loc2 val;
print "$1C10FF9E*-3 (glob,loc)="; check_hex(val, -$5432FEDA); print "^";
new_line;
testglobal = $7654321;
@mul testglobal 1 val;
print "$7654321*1="; check_hex(val, $7654321); print "^";
@mul testglobal 2 val;
print "$7654321*2="; check_hex(val, $ECA8642); print "^";
@mul testglobal 4 val;
print "$7654321*4="; check_hex(val, $1D950C84); print "^";
@mul testglobal 5 val;
print "$7654321*5="; check_hex(val, $24FA4FA5); print "^";
@mul testglobal 8 val;
print "$7654321*8="; check_hex(val, $3B2A1908); print "^";
@mul testglobal 16 val;
print "$7654321*16="; check_hex(val, $76543210); print "^";
@mul testglobal 32 val;
print "$7654321*32="; check_hex(val, $ECA86420); print "^";
@mul testglobal 64 val;
print "$7654321*64="; check_hex(val, $D950C840); print "^";
@mul testglobal 128 val;
print "$7654321*128="; check_hex(val, $B2A19080); print "^";
@mul testglobal 256 val;
print "$7654321*256="; check_hex(val, $65432100); print "^";
@mul testglobal 1024 val;
print "$7654321*1024="; check_hex(val, $950C8400); print "^";
@mul testglobal 32768 val;
print "$7654321*32768="; check_hex(val, $A1908000); print "^";
@mul testglobal 65536 val;
print "$7654321*65536="; check_hex(val, $43210000); print "^";
new_line;
testglobal = $7654321;
@mul 1 testglobal val;
print "1*$7654321="; check_hex(val, $7654321); print "^";
@mul 2 testglobal val;
print "2*$7654321="; check_hex(val, $ECA8642); print "^";
@mul 4 testglobal val;
print "4*$7654321="; check_hex(val, $1D950C84); print "^";
@mul 5 testglobal val;
print "5*$7654321="; check_hex(val, $24FA4FA5); print "^";
@mul 8 testglobal val;
print "8*$7654321="; check_hex(val, $3B2A1908); print "^";
@mul 16 testglobal val;
print "16*$7654321="; check_hex(val, $76543210); print "^";
@mul 32 testglobal val;
print "32*$7654321="; check_hex(val, $ECA86420); print "^";
@mul 64 testglobal val;
print "64*$7654321="; check_hex(val, $D950C840); print "^";
@mul 128 testglobal val;
print "128*$7654321="; check_hex(val, $B2A19080); print "^";
@mul 256 testglobal val;
print "256*$7654321="; check_hex(val, $65432100); print "^";
@mul 1024 testglobal val;
print "1024*$7654321="; check_hex(val, $950C8400); print "^";
@mul 32768 testglobal val;
print "32768*$7654321="; check_hex(val, $A1908000); print "^";
@mul 65536 testglobal val;
print "65536*$7654321="; check_hex(val, $43210000); print "^";
new_line;
@mul $7FFFFFFF $7FFFFFFF val;
print "$7FFFFFFF*$7FFFFFFF (trunc)="; check_hex(val, 1); print "^";
testglobal = $7FFFFFFF;
testglobal2 = $7FFFFFFE;
@mul testglobal testglobal2 val;
print "$7FFFFFFF*$7FFFFFFE (glob,trunc)="; check_hex(val, $80000002); print "^";
loc1 = -$7FFFFFFE;
loc2 = $7FFFFFFE;
@mul loc1 loc2 val;
print "-$7FFFFFFE*$7FFFFFFE (loc,trunc)="; check_hex(val, -4); print "^";
@mul $10000003 $10000007 val;
print "$10000003*$10000007 (trunc)="; check_hex(val, $A0000015); print "^";
testglobal = $10000001;
testglobal2 = $10000003;
@mul testglobal testglobal2 val;
print "$10000001*$10000003 (glob,trunc)="; check_hex(val, $40000003); print "^";
loc1 = -$10000005;
loc2 = $10000007;
@mul loc1 loc2 val;
print "-$10000005*$10000007 (loc,trunc)="; check_hex(val, $3FFFFFDD); print "^";
count_failures();
];
TestClass CompoundVarTest
with name 'comvar' 'compvar',
testfunc [ loc1 loc2;
print "Compound variable juggling:^^";
@copy 5 loc1;
@copy loc1 loc2;
@copy 6 loc1;
print "6="; check(loc1, 6); print ", ";
print "5="; check(loc2, 5); print "^";
@copy 3 loc1;
@add loc1 loc1 loc1;
@add loc1 loc1 loc2;
print "12="; check(loc2, 12); print ", ";
@copy 2 loc1;
@mul loc1 loc1 loc1;
@mul loc1 loc1 loc2;
print "16="; check(loc2, 16); print ", ";
@copy 3 loc1;
@add loc1 loc1 loc1;
@mul loc1 loc1 loc2;
print "36="; check(loc2, 36); print ", ";
@copy 4 loc1;
@mul loc1 loc1 loc1;
@add loc1 loc1 loc2;
print "32="; check(loc2, 32); print "^";
@copy 7 sp;
@copy sp loc1;
@copy loc1 loc2;
print "7="; check(loc2, 7); print ", ";
@copy 5 testglobal;
@add testglobal 1 loc1;
@copy loc1 sp;
@copy sp loc2;
print "6="; check(loc1, 6); print ", ";
print "6="; check(loc2, 6); print "^";
@copy 8 sp;
@copy 6 testglobal;
@add testglobal 1 loc1;
@copy loc1 sp;
@copy sp loc2;
@stkcopy 1;
print "7="; check(loc1, 7); print ", ";
print "7="; check(loc2, 7); print "^";
@copy sp loc1;
@copy sp loc2;
print "8="; check(loc1, 8); print ", ";
print "8="; check(loc2, 8); print "^";
count_failures();
];
TestClass CompoundArithTest
with name 'comarith' 'comparith',
testfunc [ val xloc yloc zloc;
print "Compound arithmetic expressions:^^";
xloc = 7;
yloc = 2;
zloc = -4;
val = (xloc + yloc) * zloc;
print "(7+2)*-4="; check(val, -36); print ", ";
testglobal = 7;
yloc = 2;
zloc = -4;
noop();
val = (testglobal + yloc) * zloc;
print "(7+2)*-4="; check(val, -36); print "^";
xloc = $10000;
yloc = $10000;
zloc = 16;
val = (xloc * yloc) / zloc + 1;
print "($10000*$10000)/16+1="; check(val, 1); print ", ";
xloc = $10000;
yloc = $10000;
zloc = 16;
noop();
val = (xloc * yloc) / zloc + 1;
print "($10000*$10000)/16+1="; check(val, 1); print "^";
xloc = $7FFFFFFF;
yloc = 2;
zloc = 16;
val = (xloc + yloc) / zloc;
print "($7FFFFFFF+2)/16="; check(val, -$7FFFFFF); print ", ";
xloc = $7FFFFFFF;
yloc = 2;
zloc = 16;
noop();
val = (xloc + yloc) / zloc;
print "($7FFFFFFF+2)/16="; check(val, -$7FFFFFF); print "^";
xloc = -$7FFFFFFF;
yloc = 2;
zloc = 16;
val = (xloc - yloc) / zloc;
print "(-$7FFFFFFF-2)/16="; check(val, $7FFFFFF); print ", ";
xloc = -$7FFFFFFF;
yloc = 2;
zloc = 16;
noop();
val = (xloc - yloc) / zloc;
print "(-$7FFFFFFF-2)/16="; check(val, $7FFFFFF); print "^";
count_failures();
];
TestClass BitwiseTest
with name 'bitwise' 'bits' 'bit',
testfunc [ val;
print "Bitwise arithmetic:^^";
@bitand 0 0 val;
print "0&0="; check_hex(val, 0); print ", ";
@bitand $FFFFFFFF 0 val;
print "$FFFFFFFF&0="; check_hex(val, 0); print ", ";
@bitand $FFFFFFFF $FFFFFFFF val;
print "$FFFFFFFF&$FFFFFFFF="; check_hex(val, $FFFFFFFF); print ", ";
@bitand $0137FFFF $FFFF7310 val;
print "$0137FFFF&$FFFF7310="; check_hex(val, $01377310); print ", ";
@bitand $35 $56 val;
print "$35&56="; check_hex(val, $14); print "^";
@bitor 0 0 val;
print "0|0="; check_hex(val, 0); print ", ";
@bitor $FFFFFFFF 0 val;
print "$FFFFFFFF|0="; check_hex(val, $FFFFFFFF); print ", ";
@bitor $FFFFFFFF $FFFFFFFF val;
print "$FFFFFFFF|$FFFFFFFF="; check_hex(val, $FFFFFFFF); print ", ";
@bitor $01370000 $00007310 val;
print "$01370000|$00007310="; check_hex(val, $01377310); print ", ";
@bitor $35 $56 val;
print "$35|56="; check_hex(val, $77); print "^";
@bitxor 0 0 val;
print "0", "@@94", "0="; check_hex(val, 0); print ", ";
@bitxor $FFFFFFFF 0 val;
print "$FFFFFFFF", "@@94", "0="; check_hex(val, $FFFFFFFF); print ", ";
@bitxor $FFFFFFFF $FFFFFFFF val;
print "$FFFFFFFF", "@@94", "$FFFFFFFF="; check_hex(val, 0); print ", ";
@bitxor $0137FFFF $00007310 val;
print "$0137FFFF", "@@94", "$00007310="; check_hex(val, $01378CEF); print ", ";
@bitxor $35 $56 val;
print "$35", "@@94", "56="; check_hex(val, $63); print "^";
@bitnot 0 val;
print "!0="; check_hex(val, $FFFFFFFF); print ", ";
@bitnot 1 val;
print "!1="; check_hex(val, $FFFFFFFE); print ", ";
@bitnot $F val;
print "!$F="; check_hex(val, $FFFFFFF0); print ", ";
@bitnot $80000000 val;
print "!$80000000="; check_hex(val, $7FFFFFFF); print "^";
count_failures();
];
TestClass ShiftTest
with name 'shift',
testfunc [ val res ix;
print "Bit shifts:^^";
@shiftl $1001 0 val;
print "$1001<<0="; check_hex(val, $1001); print ", ";
@shiftl $1001 1 val;
print "$1001<<1="; check_hex(val, $2002); print ", ";
@shiftl $1001 4 val;
print "$1001<<4="; check_hex(val, $10010); print ", ";
@shiftl $1001 10 val;
print "$1001<<10="; check_hex(val, $400400); print ", ";
@shiftl $1001 16 val;
print "$1001<<16="; check_hex(val, $10010000); print ", ";
@shiftl $1001 24 val;
print "$1001<<24="; check_hex(val, $01000000); print ", ";
@shiftl $1001 31 val;
print "$1001<<31="; check_hex(val, $80000000); print ", ";
@shiftl $1001 32 val;
print "$1001<<32="; check_hex(val, 0); print ", ";
@shiftl $1001 (-1) val;
print "$1001<<-1="; check_hex(val, 0); print "^";
@shiftl (-2) 0 val;
print "-2<<0="; check(val, -2); print ", ";
@shiftl (-2) 1 val;
print "-2<<1="; check(val, -4); print ", ";
@shiftl (-2) 7 val;
print "-2<<7="; check(val, -256); print ", ";
@shiftl (-2) 31 val;
print "-2<<31="; check(val, 0); print "^";
testglobal = 1;
res = 1;
for (ix=0 : ix<32 : ix++) {
@shiftl testglobal ix val;
print "1<<", ix, "="; check_hex(val, res); print ", ";
res = res+res;
}
@shiftl testglobal ix val;
print "1<<", ix, "="; check(val, 0); print ", ";
ix = -1;
@shiftl testglobal ix val;
print "1<<", ix, "="; check(val, 0); print "^";
@ushiftr $1001 0 val;
print "$1001u>>0="; check_hex(val, $1001); print ", ";
@ushiftr $1001 1 val;
print "$1001u>>1="; check_hex(val, $800); print ", ";
@ushiftr $1001 2 val;
print "$1001u>>2="; check_hex(val, $400); print ", ";
@ushiftr $1001 6 val;
print "$1001u>>6="; check_hex(val, $40); print ", ";
@ushiftr $1001 12 val;
print "$1001u>>12="; check_hex(val, $1); print ", ";
@ushiftr $1001 13 val;
print "$1001u>>13="; check_hex(val, $0); print ", ";
@ushiftr $1001 31 val;
print "$1001u>>31="; check_hex(val, $0); print ", ";
@ushiftr $1001 32 val;
print "$1001u>>32="; check_hex(val, $0); print "^";
@ushiftr $7FFFFFFF 0 val;
print "$7FFFFFFFu>>0="; check_hex(val, $7FFFFFFF); print ", ";
@ushiftr $7FFFFFFF 1 val;
print "$7FFFFFFFu>>1="; check_hex(val, $3FFFFFFF); print ", ";
@ushiftr $7FFFFFFF 2 val;
print "$7FFFFFFFu>>2="; check_hex(val, $1FFFFFFF); print ", ";
@ushiftr $7FFFFFFF 6 val;
print "$7FFFFFFFu>>6="; check_hex(val, $1FFFFFF); print ", ";
@ushiftr $7FFFFFFF 12 val;
print "$7FFFFFFFu>>12="; check_hex(val, $7FFFF); print ", ";
@ushiftr $7FFFFFFF 13 val;
print "$7FFFFFFFu>>13="; check_hex(val, $3FFFF); print ", ";
@ushiftr $7FFFFFFF 30 val;
print "$7FFFFFFFu>>30="; check_hex(val, $1); print ", ";
@ushiftr $7FFFFFFF 31 val;
print "$7FFFFFFFu>>31="; check_hex(val, $0); print ", ";
@ushiftr $7FFFFFFF 32 val;
print "$7FFFFFFFu>>32="; check_hex(val, $0); print "^";
@ushiftr (-1) 0 val;
print "-1u>>0="; check_hex(val, -1); print ", ";
@ushiftr (-1) 1 val;
print "-1u>>1="; check_hex(val, $7FFFFFFF); print ", ";
@ushiftr (-1) 2 val;
print "-1u>>2="; check_hex(val, $3FFFFFFF); print ", ";
@ushiftr (-1) 6 val;
print "-1u>>6="; check_hex(val, $3FFFFFF); print ", ";
@ushiftr (-1) 12 val;
print "-1u>>12="; check_hex(val, $FFFFF); print ", ";
@ushiftr (-1) 13 val;
print "-1u>>13="; check_hex(val, $7FFFF); print ", ";
@ushiftr (-1) 30 val;
print "-1u>>30="; check_hex(val, $3); print ", ";
@ushiftr (-1) 31 val;
print "-1u>>31="; check_hex(val, $1); print ", ";
@ushiftr (-1) 32 val;
print "-1u>>32="; check_hex(val, $0); print ", ";
@ushiftr (-1) 33 val;
print "-1u>>33="; check_hex(val, $0); print ", ";
@ushiftr (-1) (-1) val;
print "-1u>>-1="; check_hex(val, $0); print "^";
testglobal = -1;
res = $7fffffff;
for (ix=1 : ix<32 : ix++) {
@ushiftr testglobal ix val;
print "-1u>>", ix, "="; check_hex(val, res); print ", ";
res = res / 2;
}
@ushiftr testglobal ix val;
print "-1u>>", ix, "="; check(val, 0); print ", ";
ix = -1;
@ushiftr testglobal ix val;
print "-1u>>", ix, "="; check(val, 0); print "^";
@sshiftr $1001 0 val;
print "$1001s>>0="; check_hex(val, $1001); print ", ";
@sshiftr $1001 1 val;
print "$1001s>>1="; check_hex(val, $800); print ", ";
@sshiftr $1001 2 val;
print "$1001s>>2="; check_hex(val, $400); print ", ";
@sshiftr $1001 6 val;
print "$1001s>>6="; check_hex(val, $40); print ", ";
@sshiftr $1001 12 val;
print "$1001s>>12="; check_hex(val, $1); print ", ";
@sshiftr $1001 13 val;
print "$1001s>>13="; check_hex(val, $0); print ", ";
@sshiftr $1001 31 val;
print "$1001s>>31="; check_hex(val, $0); print ", ";
@sshiftr $1001 32 val;
print "$1001s>>32="; check_hex(val, $0); print "^";
@sshiftr $7FFFFFFF 0 val;
print "$7FFFFFFFs>>0="; check_hex(val, $7FFFFFFF); print ", ";
@sshiftr $7FFFFFFF 1 val;
print "$7FFFFFFFs>>1="; check_hex(val, $3FFFFFFF); print ", ";
@sshiftr $7FFFFFFF 2 val;
print "$7FFFFFFFs>>2="; check_hex(val, $1FFFFFFF); print ", ";
@sshiftr $7FFFFFFF 6 val;
print "$7FFFFFFFs>>6="; check_hex(val, $1FFFFFF); print ", ";
@sshiftr $7FFFFFFF 12 val;
print "$7FFFFFFFs>>12="; check_hex(val, $7FFFF); print ", ";
@sshiftr $7FFFFFFF 13 val;
print "$7FFFFFFFs>>13="; check_hex(val, $3FFFF); print ", ";
@sshiftr $7FFFFFFF 30 val;
print "$7FFFFFFFs>>30="; check_hex(val, $1); print ", ";
@sshiftr $7FFFFFFF 31 val;
print "$7FFFFFFFs>>31="; check_hex(val, $0); print ", ";
@sshiftr $7FFFFFFF 32 val;
print "$7FFFFFFFs>>32="; check_hex(val, $0); print "^";
@sshiftr (-1) 0 val;
print "-1s>>0="; check(val, -1); print ", ";
@sshiftr (-1) 1 val;
print "-1s>>1="; check(val, -1); print ", ";
@sshiftr (-1) 31 val;
print "-1s>>31="; check(val, -1); print ", ";
@sshiftr (-1) 32 val;
print "-1s>>32="; check(val, -1); print ", ";
@sshiftr (-1) 33 val;
print "-1s>>33="; check(val, -1); print ", ";
@sshiftr (-1) (-1) val;
print "-1s>>-1="; check(val, -1); print "^";
@sshiftr (-1000) 0 val;
print "-1000s>>0="; check(val, -1000); print ", ";
@sshiftr (-1000) 1 val;
print "-1000s>>1="; check(val, -500); print ", ";
@sshiftr (-1000) 2 val;
print "-1000s>>2="; check(val, -250); print ", ";
@sshiftr (-1000) 4 val;
print "-1000s>>4="; check(val, -63); print ", ";
@sshiftr (-1000) 6 val;
print "-1000s>>6="; check(val, -16); print ", ";
@sshiftr (-1000) 9 val;
print "-1000s>>9="; check(val, -2); print ", ";
@sshiftr (-1000) 31 val;
print "-1000s>>31="; check(val, -1); print ", ";
@sshiftr (-1000) 32 val;
print "-1000s>>32="; check(val, -1); print ", ";
@sshiftr (-1000) 33 val;
print "-1000s>>33="; check(val, -1); print ", ";
@sshiftr (-1000) (-1) val;
print "-1000s>>-1="; check(val, -1); print "^";
testglobal = -1;
for (ix=0 : ix<32 : ix++) {
@sshiftr testglobal ix val;
print "-1s>>", ix, "="; check(val, -1); print ", ";
}
@sshiftr testglobal ix val;
print "-1s>>", ix, "="; check(val, -1); print ", ";
ix = -1;
@sshiftr testglobal ix val;
print "-1s>>", ix, "="; check(val, -1); print "^";
count_failures();
];
TestClass TruncCopyTest
with name 'trunc' 'truncating' 'copy',
testfunc [ val;
print "Truncating copies:^^";
! I6 doesn't let us test 2-byte and 1-byte local variables
testglobal2 = $01020304;
@copys $12345678 testglobal2;
@copy testglobal2 val;
print "$12345678 s:> glob $01020304="; check_hex(val, $56780304); print ", ";
@copys $80818283 sp;
@copy sp val;
print "$80818283 s:> stack="; check_hex(val, $8283); print ", ";
testglobal = $fedcba98;
testglobal2 = $02030405;
@copys testglobal testglobal2;
@copy testglobal2 val;
print "glob $fedcba98 s:> glob $02030405="; check_hex(val, $fedc0405); print ", ";
testglobal = $fedcba98;
@copys testglobal sp;
@copy sp val;
print "glob $fedcba98 s:> stack="; check_hex(val, $fedc); print ", ";
testglobal2 = $03040506;
@copy $7654321f sp;
@copys sp testglobal2;
@copy testglobal2 val;
print "stack $7654321f s:> glob $03040506="; check_hex(val, $321f0506); print ", ";
testglobal2 = $04050607;
testglobal = $654321fe;
@copy testglobal sp;
@copys sp testglobal2;
@copy testglobal2 val;
print "stack $654321fe s:> glob $04050607="; check_hex(val, $21fe0607); print ", ";
@copy $674523f1 sp;
@copys sp sp;
@copy sp val;
print "stack $674523f1 s:> stack="; check_hex(val, $23f1); print ", ";
@copy $67452301 sp; noop();
@copys sp sp;
@copy sp val;
print "stack $67452301 s:> stack="; check_hex(val, $2301); print "^";
testglobal2 = $01020304;
@copyb $12345678 testglobal2;
@copy testglobal2 val;
print "$12345678 b:> glob $01020304="; check_hex(val, $78020304); print ", ";
@copyb $80818283 sp;
@copy sp val;
print "$80818283 b:> stack="; check_hex(val, $83); print ", ";
testglobal = $fedcba98;
testglobal2 = $02030405;
@copyb testglobal testglobal2;
@copy testglobal2 val;
print "glob $fedcba98 b:> glob $02030405="; check_hex(val, $fe030405); print ", ";
testglobal = $fedcba98;
@copyb testglobal sp;
@copy sp val;
print "glob $fedcba98 b:> stack="; check_hex(val, $fe); print ", ";
testglobal2 = $03040506;
@copy $7654321f sp;
@copyb sp testglobal2;
@copy testglobal2 val;
print "stack $7654321f b:> glob $03040506="; check_hex(val, $1f040506); print ", ";
testglobal2 = $04050607;
testglobal = $654321fe;
@copy testglobal sp;
@copyb sp testglobal2;
@copy testglobal2 val;
print "stack $654321fe b:> glob $04050607="; check_hex(val, $fe050607); print ", ";
@copy $674523f1 sp;
@copyb sp sp;
@copy sp val;
print "stack $674523f1 b:> stack="; check_hex(val, $f1); print ", ";
@copy $67452301 sp; noop();
@copyb sp sp;
@copy sp val;
print "stack $67452301 b:> stack="; check_hex(val, $01); print "^";
count_failures();
];
TestClass ExtendTest
with name 'extend' 'sex',
testfunc [ val;
print "Sign-extend:^^";
@sexb $00 val;
print "sexb($00)="; check_hex(val, 0); print ", ";
@sexb $01 val;
print "sexb($01)="; check_hex(val, 1); print ", ";
@sexb $7f val;
print "sexb($7f)="; check_hex(val, $7f); print ", ";
@sexb $80 val;
print "sexb($80)="; check_hex(val, $ffffff80); print ", ";
@sexb $fe val;
print "sexb($fe)="; check_hex(val, -2); print ", ";
@sexb $ff val;
print "sexb($ff)="; check_hex(val, -1); print ", ";
@sexb $100 val;
print "sexb($100)="; check_hex(val, 0); print ", ";
@sexb $ffffff01 val;
print "sexb($ffffff01)="; check_hex(val, 1); print ", ";
@sexb $7f0f0ff0 val;
print "sexb($7f0f0ff0)="; check_hex(val, -16); print "^";
testglobal = $02;
@sexb testglobal sp;
@copy sp val;
print "sexb($02)="; check_hex(val, 2); print ", ";
@copy $0f sp;
@sexb sp testglobal;
val = testglobal;
print "sexb($0f)="; check_hex(val, $0f); print ", ";
testglobal = $ff;
@sexb testglobal sp;
@copy sp val;
print "sexb($ff)="; check_hex(val, -1); print ", ";
testglobal = $100;
@sexb testglobal sp;
@copy sp val;
print "sexb($100)="; check_hex(val, 0); print ", ";
@copy $ffffff01 sp;
@sexb sp sp;
@copy sp val;
print "sexb($ffffff01)="; check_hex(val, 1); print ", ";
testglobal = $7f1f1ff1;
@sexb testglobal testglobal2;
print "sexb($7f1f1ff1)="; check_hex(testglobal2, -15); print "^";
@sexs $00 val;
print "sexs($00)="; check_hex(val, 0); print ", ";
@sexs $01 val;
print "sexs($01)="; check_hex(val, 1); print ", ";
@sexs $7fff val;
print "sexs($7fff)="; check_hex(val, $7fff); print ", ";
@sexs $8000 val;
print "sexs($8000)="; check_hex(val, $ffff8000); print ", ";
@sexs $fffe val;
print "sexs($fffe)="; check_hex(val, -2); print ", ";
@sexs $ffff val;
print "sexs($ffff)="; check_hex(val, -1); print ", ";
@sexs $10000 val;
print "sexs($10000)="; check_hex(val, 0); print ", ";
@sexs $ffff0001 val;
print "sexs($ffff0001)="; check_hex(val, 1); print ", ";
@sexs $7f0ff00f val;
print "sexs($7f0ff00f)="; check_hex(val, $fffff00f); print "^";
testglobal = $102;
@sexs testglobal sp;
@copy sp val;
print "sexs($102)="; check_hex(val, $102); print ", ";
@copy $0fffff sp;
@sexs sp testglobal;
val = testglobal;
print "sexs($0fffff)="; check_hex(val, -1); print ", ";
testglobal = $fffe;
@sexs testglobal sp;
@copy sp val;
print "sexs($fffe)="; check_hex(val, -2); print ", ";
testglobal = $10000;
@sexs testglobal sp;
@copy sp val;
print "sexs($10000)="; check_hex(val, 0); print ", ";
@copy $ffff0001 sp;
@sexs sp sp;
@copy sp val;
print "sexs($ffff0001)="; check_hex(val, 1); print ", ";
testglobal = $7f1ffff1;
@sexs testglobal testglobal2;
print "sexs($7f1ffff1)="; check_hex(testglobal2, -15); print "^";
count_failures();
];
Array testarray -> $01 $02 $03 $04 $ff $fe $fd $fc $0 $0 $0 $f;
Array testarray2 -> $7f $00 $80 $02 $01 $00 $ff $ff;
TestClass AloadTest
with name 'aload',
testfunc [ val arr;
print "Array loads:^^";
print "Array sequence: "; check_hex(testarray2 - testarray, 12); print "^";
@aload testarray 0 val;
print "arr-->0="; check_hex(val, $01020304); print ", ";
@aload testarray 1 val;
print "arr-->1="; check_hex(val, $fffefdfc); print ", ";
@aload testarray 2 val;
print "arr-->2="; check_hex(val, $f); print "^";
arr = testarray+1;
@aload arr 0 val;
print "arr+1-->0="; check_hex(val, $020304ff); print ", ";
@aload arr 1 val;
print "arr+1-->1="; check_hex(val, $fefdfc00); print ", ";
arr = testarray+2;
@aload arr 0 val;
print "arr+2-->0="; check_hex(val, $0304fffe); print ", ";
@aload arr 1 val;
print "arr+2-->1="; check_hex(val, $fdfc0000); print ", ";
arr = testarray+3;
@aload arr 0 val;
print "arr+3-->0="; check_hex(val, $04fffefd); print ", ";
@aload arr 1 val;
print "arr+3-->1="; check_hex(val, $fc000000); print ", ";
arr = testarray+4;
@aload arr (-1) val;
print "arr+4-->-1="; check_hex(val, $01020304); print ", ";
@aload arr 0 val;
print "arr+4-->0="; check_hex(val, $fffefdfc); print ", ";
@aload arr 1 val;
print "arr+4-->1="; check_hex(val, $f); print "^";
arr = testarray2;
@aload testarray2 (-1) val;
print "arr2-->-1="; check_hex(val, $f); print ", ";
val = -1;
@aload testarray2 val val;
print "arr2-->-1="; check_hex(val, $f); print ", ";
@aload arr (-1) val;
print "arr2-->-1="; check_hex(val, $f); print ", ";
val = -1;
@aload arr val val;
print "arr2-->-1="; check_hex(val, $f); print ", ";
!
@aload testarray2 (-1) sp;
@copy sp val;
print "arr2-->-1="; check_hex(val, $f); print ", ";
val = -1;
@aload testarray2 val sp;
@copy sp val;
print "arr2-->-1="; check_hex(val, $f); print ", ";
@aload arr (-1) sp;
@copy sp val;
print "arr2-->-1="; check_hex(val, $f); print ", ";
val = -1;
@aload arr val sp;
@copy sp val;
print "arr2-->-1="; check_hex(val, $f); print "^";
@aload testarray2 0 val;
print "arr2-->0="; check_hex(val, $7f008002); print ", ";
val = 0;
@aload testarray2 val val;
print "arr2-->0="; check_hex(val, $7f008002); print ", ";
@aload arr 0 val;
print "arr2-->0="; check_hex(val, $7f008002); print ", ";
val = 0;
@aload arr val val;
print "arr2-->0="; check_hex(val, $7f008002); print ", ";
!
@aload testarray2 0 sp;
@copy sp val;
print "arr2-->0="; check_hex(val, $7f008002); print ", ";
val = 0;
@aload testarray2 val sp;
@copy sp val;
print "arr2-->0="; check_hex(val, $7f008002); print ", ";
@aload arr 0 sp;
@copy sp val;
print "arr2-->0="; check_hex(val, $7f008002); print ", ";
val = 0;
@aload arr val sp;
@copy sp val;
print "arr2-->0="; check_hex(val, $7f008002); print "^";
@aload testarray2 1 val;
print "arr2-->1="; check_hex(val, $100ffff); print ", ";
val = 1;
@aload testarray2 val val;
print "arr2-->1="; check_hex(val, $100ffff); print ", ";
@aload arr 1 val;
print "arr2-->1="; check_hex(val, $100ffff); print ", ";
val = 1;
@aload arr val val;
print "arr2-->1="; check_hex(val, $100ffff); print ", ";
!
@aload testarray2 1 sp;
@copy sp val;
print "arr2-->1="; check_hex(val, $100ffff); print ", ";
val = 1;
@aload testarray2 val sp;
@copy sp val;
print "arr2-->1="; check_hex(val, $100ffff); print ", ";
@aload arr 1 sp;
@copy sp val;
print "arr2-->1="; check_hex(val, $100ffff); print ", ";
val = 1;
@aload arr val sp;
@copy sp val;
print "arr2-->1="; check_hex(val, $100ffff); print "^";
@aloads testarray 0 val;
print "arr=>0="; check_hex(val, $0102); print ", ";
@aloads testarray 1 val;
print "arr=>1="; check_hex(val, $0304); print ", ";
@aloads testarray 2 val;
print "arr=>2="; check_hex(val, $fffe); print ", ";
@aloads testarray 3 val;
print "arr=>3="; check_hex(val, $fdfc); print ", ";
@aloads testarray 4 val;
print "arr=>4="; check_hex(val, $0); print ", ";
@aloads testarray 5 val;
print "arr=>5="; check_hex(val, $f); print "^";
arr = testarray+1;
@aloads arr 0 val;
print "arr+1=>0="; check_hex(val, $0203); print ", ";
@aloads arr 1 val;
print "arr+1=>1="; check_hex(val, $04ff); print ", ";
arr = testarray+2;
@aloads arr 0 val;
print "arr+2=>0="; check_hex(val, $0304); print ", ";
@aloads arr 1 val;
print "arr+2=>1="; check_hex(val, $fffe); print ", ";
arr = testarray+3;
@aloads arr 0 val;
print "arr+3=>0="; check_hex(val, $04ff); print ", ";
@aloads arr 1 val;
print "arr+3=>1="; check_hex(val, $fefd); print ", ";
arr = testarray+4;
@aloads arr (-1) val;
print "arr+4=>-1="; check_hex(val, $0304); print ", ";
@aloads arr 0 val;
print "arr+4=>0="; check_hex(val, $fffe); print ", ";
@aloads arr 1 val;
print "arr+4=>1="; check_hex(val, $fdfc); print "^";
arr = testarray2;
@aloads testarray2 (-1) val;
print "arr2=>-1="; check_hex(val, $f); print ", ";
val = -1;
@aloads testarray2 val val;
print "arr2=>-1="; check_hex(val, $f); print ", ";
@aloads arr (-1) val;
print "arr2=>-1="; check_hex(val, $f); print ", ";
val = -1;
@aloads arr val val;
print "arr2=>-1="; check_hex(val, $f); print ", ";
!
@aloads testarray2 (-1) sp;
@copy sp val;
print "arr2=>-1="; check_hex(val, $f); print ", ";
val = -1;
@aloads testarray2 val sp;
@copy sp val;
print "arr2=>-1="; check_hex(val, $f); print ", ";
@aloads arr (-1) sp;
@copy sp val;
print "arr2=>-1="; check_hex(val, $f); print ", ";
val = -1;
@aloads arr val sp;
@copy sp val;
print "arr2=>-1="; check_hex(val, $f); print "^";
@aloads testarray2 0 val;
print "arr2=>0="; check_hex(val, $7f00); print ", ";
val = 0;
@aloads testarray2 val val;
print "arr2=>0="; check_hex(val, $7f00); print ", ";
@aloads arr 0 val;
print "arr2=>0="; check_hex(val, $7f00); print ", ";
val = 0;
@aloads arr val val;
print "arr2=>0="; check_hex(val, $7f00); print ", ";
!
@aloads testarray2 0 sp;
@copy sp val;
print "arr2=>0="; check_hex(val, $7f00); print ", ";
val = 0;
@aloads testarray2 val sp;
@copy sp val;
print "arr2=>0="; check_hex(val, $7f00); print ", ";
@aloads arr 0 sp;
@copy sp val;
print "arr2=>0="; check_hex(val, $7f00); print ", ";
val = 0;
@aloads arr val sp;
@copy sp val;
print "arr2=>0="; check_hex(val, $7f00); print "^";
@aloads testarray2 1 val;
print "arr2=>1="; check_hex(val, $8002); print ", ";
val = 1;
@aloads testarray2 val val;
print "arr2=>1="; check_hex(val, $8002); print ", ";
@aloads arr 1 val;
print "arr2=>1="; check_hex(val, $8002); print ", ";
val = 1;
@aloads arr val val;
print "arr2=>1="; check_hex(val, $8002); print ", ";
!
@aloads testarray2 1 sp;
@copy sp val;
print "arr2=>1="; check_hex(val, $8002); print ", ";
val = 1;
@aloads testarray2 val sp;
@copy sp val;
print "arr2=>1="; check_hex(val, $8002); print ", ";
@aloads arr 1 sp;
@copy sp val;
print "arr2=>1="; check_hex(val, $8002); print ", ";
val = 1;
@aloads arr val sp;
@copy sp val;
print "arr2=>1="; check_hex(val, $8002); print "^";
@aloadb testarray 0 val;
print "arr->0="; check_hex(val, $01); print ", ";
@aloadb testarray 1 val;
print "arr->1="; check_hex(val, $02); print ", ";
@aloadb testarray 4 val;
print "arr->4="; check_hex(val, $ff); print ", ";
@aloadb testarray 5 val;
print "arr->5="; check_hex(val, $fe); print ", ";
@aloadb testarray 11 val;
print "arr->11="; check_hex(val, $f); print "^";
arr = testarray+1;
@aloadb arr 0 val;
print "arr+1->0="; check_hex(val, $02); print ", ";
@aloadb arr 1 val;
print "arr+1->1="; check_hex(val, $03); print ", ";
arr = testarray+2;
@aloadb arr 0 val;
print "arr+2->0="; check_hex(val, $03); print ", ";
@aloadb arr 1 val;
print "arr+2->1="; check_hex(val, $04); print ", ";
arr = testarray+3;
@aloadb arr 0 val;
print "arr+3->0="; check_hex(val, $04); print ", ";
@aloadb arr 1 val;
print "arr+3->1="; check_hex(val, $ff); print ", ";
arr = testarray+4;
@aloadb arr (-1) val;
print "arr+4->-1="; check_hex(val, $04); print ", ";
@aloadb arr 0 val;
print "arr+4->0="; check_hex(val, $ff); print ", ";
@aloadb arr 1 val;
print "arr+4->1="; check_hex(val, $fe); print "^";
arr = testarray2;
@aloadb testarray2 (-1) val;
print "arr2->-1="; check_hex(val, $f); print ", ";
val = -1;
@aloadb testarray2 val val;
print "arr2->-1="; check_hex(val, $f); print ", ";
@aloadb arr (-1) val;
print "arr2->-1="; check_hex(val, $f); print ", ";
val = -1;
@aloadb arr val val;
print "arr2->-1="; check_hex(val, $f); print ", ";
!
@aloadb testarray2 (-1) sp;
@copy sp val;
print "arr2->-1="; check_hex(val, $f); print ", ";
val = -1;
@aloadb testarray2 val sp;
@copy sp val;
print "arr2->-1="; check_hex(val, $f); print ", ";
@aloadb arr (-1) sp;
@copy sp val;
print "arr2->-1="; check_hex(val, $f); print ", ";
val = -1;
@aloadb arr val sp;
@copy sp val;
print "arr2->-1="; check_hex(val, $f); print "^";
@aloadb testarray2 0 val;
print "arr2->0="; check_hex(val, $7f); print ", ";
val = 0;
@aloadb testarray2 val val;
print "arr2->0="; check_hex(val, $7f); print ", ";
@aloadb arr 0 val;
print "arr2->0="; check_hex(val, $7f); print ", ";
val = 0;
@aloadb arr val val;
print "arr2->0="; check_hex(val, $7f); print ", ";
!
@aloadb testarray2 0 sp;
@copy sp val;
print "arr2->0="; check_hex(val, $7f); print ", ";
val = 0;
@aloadb testarray2 val sp;
@copy sp val;
print "arr2->0="; check_hex(val, $7f); print ", ";
@aloadb arr 0 sp;
@copy sp val;
print "arr2->0="; check_hex(val, $7f); print ", ";
val = 0;
@aloadb arr val sp;
@copy sp val;
print "arr2->0="; check_hex(val, $7f); print "^";
@aloadb testarray2 2 val;
print "arr2->2="; check_hex(val, $80); print ", ";
val = 2;
@aloadb testarray2 val val;
print "arr2->2="; check_hex(val, $80); print ", ";
@aloadb arr 2 val;
print "arr2->2="; check_hex(val, $80); print ", ";
val = 2;
@aloadb arr val val;
print "arr2->2="; check_hex(val, $80); print ", ";
!
@aloadb testarray2 2 sp;
@copy sp val;
print "arr2->2="; check_hex(val, $80); print ", ";
val = 2;
@aloadb testarray2 val sp;
@copy sp val;
print "arr2->2="; check_hex(val, $80); print ", ";
@aloadb arr 2 sp;
@copy sp val;
print "arr2->2="; check_hex(val, $80); print ", ";
val = 2;
@aloadb arr val sp;
@copy sp val;
print "arr2->2="; check_hex(val, $80); print "^";
count_failures();
];
Array destarray -> 12;
Array destarray2 -> 12;
TestClass AstoreTest
with name 'astore',
testfunc [ val arr;
print "Array stores:^^";
print "Array sequence: "; check_hex(destarray2 - destarray, 12); print "^";
arr = destarray;
for (val=0 : val<24 : val++)
arr->val = 0;
@astore destarray 0 $02030405;
@aload destarray 0 val;
print "arr-->0="; check_hex(val, $02030405); print ", ";
@astore destarray 1 $fefdfcdb;
@aload destarray 1 val;
print "arr-->1="; check_hex(val, $fefdfcdb); print ", ";
@astore destarray 2 $e0f;
@aload destarray 2 val;
print "arr-->2="; check_hex(val, $0e0f); print "^";
arr = destarray+1;
@astore arr 0 $12131415;
@aload arr 0 val;
print "arr+1-->0="; check_hex(val, $12131415); print ", ";
@aload destarray 0 val; check_hex(val, $02121314); print "/";
@aload destarray 1 val; check_hex(val, $15fdfcdb); print ", ";
@astore arr 1 $e0e1e2e3;
@aload arr 1 val;
print "arr+1-->1="; check_hex(val, $e0e1e2e3); print ", ";
@aload destarray 0 val; check_hex(val, $02121314); print "/";
@aload destarray 1 val; check_hex(val, $15e0e1e2); print "/";
@aload destarray 2 val; check_hex(val, $e3000e0f); print ", ";
arr = destarray+2;
@astore arr 0 $12345678;
@aload arr 0 val;
print "arr+2-->0="; check_hex(val, $12345678); print ", ";
@aload destarray 0 val; check_hex(val, $02121234); print "/";
@aload destarray 1 val; check_hex(val, $5678e1e2); print ", ";
@astore arr 1 $fedcba99;
@aload arr 1 val;
print "arr+2-->1="; check_hex(val, $fedcba99); print ", ";
arr = destarray+3;
@astore arr 0 $44556677;
@aload arr 0 val;
print "arr+3-->0="; check_hex(val, $44556677); print ", ";
@aload destarray 0 val; check_hex(val, $02121244); print "/";
@aload destarray 1 val; check_hex(val, $556677dc); print ", ";
@astore arr 1 $51413121;
@aload arr 1 val;
print "arr+3-->1="; check_hex(val, $51413121); print ", ";
@aload destarray 0 val; check_hex(val, $02121244); print "/";
@aload destarray 1 val; check_hex(val, $55667751); print "/";
@aload destarray 2 val; check_hex(val, $4131210f); print ", ";
arr = destarray+4;
@astore arr (-1) $21436587;
@aload arr (-1) val;
print "arr+4-->-1="; check_hex(val, $21436587); print ", ";
@astore arr 0 $31425364;
@aload arr 0 val;
print "arr+4-->0="; check_hex(val, $31425364); print ", ";
@astore arr 1 $41526374;
@aload arr 1 val;
print "arr+4-->1="; check_hex(val, $41526374); print ", ";
@aload destarray 0 val; check_hex(val, $21436587); print "/";
@aload destarray 1 val; check_hex(val, $31425364); print "/";
@aload destarray 2 val; check_hex(val, $41526374); print "^";
arr = destarray2;
testglobal = destarray2-4;
@astore destarray2 (-1) $d0000001;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $d0000001); print ", ";
val = -1;
@astore destarray2 val $d1000002;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $d1000002); print ", ";
@astore arr (-1) $d2000003;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $d2000003); print ", ";
val = -1;
@astore arr val $d3000004;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $d3000004); print ", ";
!
@copy $e0000001 sp;
@astore destarray2 (-1) sp;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $e0000001); print ", ";
val = -1;
@copy $e1000011 sp;
@astore destarray2 val sp;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $e1000011); print ", ";
@copy $e2000021 sp;
@astore arr (-1) sp;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $e2000021); print ", ";
val = -1;
@copy $e3000031 sp;
@astore arr val sp;
@aload testglobal 0 val;
print "arr2-->-1="; check_hex(val, $e3000031); print "^";
testglobal = destarray2;
@astore destarray2 0 $f1223310;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f1223310); print ", ";
val = 0;
@astore destarray2 val $f2223311;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f2223311); print ", ";
@astore arr 0 $f3223312;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f3223312); print ", ";
val = 0;
@astore arr val $f4223313;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f4223313); print ", ";
!
@copy $f5223315 sp;
@astore destarray2 0 sp;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f5223315); print ", ";
val = 0;
@copy $f6223316 sp;
@astore destarray2 val sp;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f6223316); print ", ";
@copy $f7223317 sp;
@astore arr 0 sp;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f7223317); print ", ";
val = 0;
@copy $f8223318 sp;
@astore arr val sp;
@aload testglobal 0 val;
print "arr2-->0="; check_hex(val, $f8223318); print "^";
testglobal = destarray2+4;
@astore destarray2 1 $1;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $1); print ", ";
val = 1;
@astore destarray2 val $2;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $2); print ", ";
@astore arr 1 $3;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $3); print ", ";
val = 1;
@astore arr val $4;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $4); print ", ";
!
@copy $5 sp;
@astore destarray2 1 sp;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $5); print ", ";
val = 1;
@copy $6 sp;
@astore destarray2 val sp;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $6); print ", ";
@copy $7 sp;
@astore arr 1 sp;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $7); print ", ";
val = 1;
@copy $8 sp;
@astore arr val sp;
@aload testglobal 0 val;
print "arr2-->1="; check_hex(val, $8); print "^";
arr = destarray;
for (val=0 : val<24 : val++)
arr->val = 0;
@astores destarray 0 $02030405;
@aload destarray 0 val;
print "arr=>0="; check_hex(val, $04050000); print ", ";
@astores destarray 1 $fefdfcdb;
@aload destarray 0 val;
print "arr=>1="; check_hex(val, $0405fcdb); print ", ";
@astores destarray 2 $e0f;
@aload destarray 1 val;
print "arr=>2="; check_hex(val, $0e0f0000); print "^";
arr = destarray+1;
@astores arr 0 $12131415;
@aloads arr 0 val;
print "arr+1=>0="; check_hex(val, $1415); print ", ";
@aload destarray 0 val; check_hex(val, $041415db); print "/";
@aload destarray 1 val; check_hex(val, $0e0f0000); print ", ";
@astores arr 1 $e0e1e2e3;
@aloads arr 1 val;
print "arr+1=>1="; check_hex(val, $e2e3); print ", ";
@aload destarray 0 val; check_hex(val, $041415e2); print "/";
@aload destarray 1 val; check_hex(val, $e30f0000); print ", ";
arr = destarray+2;
@astores arr 0 $12345678;
@aloads arr 0 val;
print "arr+2=>0="; check_hex(val, $5678); print ", ";
@aload destarray 0 val; check_hex(val, $04145678); print "/";
@aload destarray 1 val; check_hex(val, $e30f0000); print ", ";
@astores arr 1 $fedcba99;
@aloads arr 1 val;
print "arr+2=>1="; check_hex(val, $ba99); print ", ";
@aload destarray 0 val; check_hex(val, $04145678); print "/";
@aload destarray 1 val; check_hex(val, $ba990000); print ", ";
arr = destarray+3;
@astores arr 0 $44556677;
@aloads arr 0 val;
print "arr+3=>0="; check_hex(val, $6677); print ", ";
@aload destarray 0 val; check_hex(val, $04145666); print "/";
@aload destarray 1 val; check_hex(val, $77990000); print ", ";
@astores arr 1 $51413121;
@aloads arr 1 val;
print "arr+3=>1="; check_hex(val, $3121); print ", ";
@aload destarray 0 val; check_hex(val, $04145666); print "/";
@aload destarray 1 val; check_hex(val, $77312100); print ", ";
arr = destarray+4;
@astores arr (-1) $21436587;
@aloads arr (-1) val;
print "arr+4=>-1="; check_hex(val, $6587); print ", ";
@astores arr 0 $31425364;
@aloads arr 0 val;
print "arr+4=>0="; check_hex(val, $5364); print ", ";
@astores arr 1 $41526374;
@aloads arr 1 val;
print "arr+4=>1="; check_hex(val, $6374); print ", ";
@aload destarray 0 val; check_hex(val, $04146587); print "/";
@aload destarray 1 val; check_hex(val, $53646374); print "^";
arr = destarray2;
testglobal = destarray2-4;
@astore testglobal 0 $99990000;
@astore testglobal 1 $98979695;
@astores destarray2 (-1) $d00ff001;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $f001); print ", ";
val = -1;
@astores destarray2 val $d10ee002;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $e002); print ", ";
@astores arr (-1) $d20dd003;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $d003); print ", ";
val = -1;
@astores arr val $d30cc004;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $c004); print ", ";
!
@copy $e00ff001 sp;
@astores destarray2 (-1) sp;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $f001); print ", ";
val = -1;
@copy $e10ee011 sp;
@astores destarray2 val sp;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $e011); print ", ";
@copy $e20dd021 sp;
@astores arr (-1) sp;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $d021); print ", ";
val = -1;
@copy $e30cc031 sp;
@astores arr val sp;
@aloads testglobal 1 val;
print "arr2=>-1="; check_hex(val, $c031); print "^";
@aload testglobal 0 val;
print "pre-guard="; check_hex(val, $9999c031); print ", ";
@aload testglobal 1 val;
print "post-guard="; check_hex(val, $98979695); print "^";
testglobal = destarray2;
@astore testglobal 0 $98979695;
@astores destarray2 0 $f1223310;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3310); print ", ";
val = 0;
@astores destarray2 val $f2223311;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3311); print ", ";
@astores arr 0 $f3223312;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3312); print ", ";
val = 0;
@astores arr val $f4223313;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3313); print ", ";
!
@copy $f5223315 sp;
@astores destarray2 0 sp;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3315); print ", ";
val = 0;
@copy $f6223316 sp;
@astores destarray2 val sp;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3316); print ", ";
@copy $f7223317 sp;
@astores arr 0 sp;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3317); print ", ";
val = 0;
@copy $f8223318 sp;
@astores arr val sp;
@aloads testglobal 0 val;
print "arr2=>0="; check_hex(val, $3318); print "^";
@aload testglobal 0 val;
print "post-guard="; check_hex(val, $33189695); print "^";
testglobal = destarray2+4;
@astore testglobal 0 $98979695;
@astores destarray2 2 $1;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $1); print ", ";
val = 2;
@astores destarray2 val $2;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $2); print ", ";
@astores arr 2 $3;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $3); print ", ";
val = 2;
@astores arr val $4;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $4); print ", ";
!
@copy $5 sp;
@astores destarray2 2 sp;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $5); print ", ";
val = 2;
@copy $6 sp;
@astores destarray2 val sp;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $6); print ", ";
@copy $7 sp;
@astores arr 2 sp;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $7); print ", ";
val = 2;
@copy $8 sp;
@astores arr val sp;
@aloads testglobal 0 val;
print "arr2=>2="; check_hex(val, $8); print "^";
@aload testglobal 0 val;
print "post-guard="; check_hex(val, $00089695); print "^";
arr = destarray;
for (val=0 : val<24 : val++)
arr->val = 0;
@astoreb destarray 0 $02030405;
@aload destarray 0 val;
print "arr=>0="; check_hex(val, $05000000); print ", ";
@astoreb destarray 1 $fefdfcdb;
@aload destarray 0 val;
print "arr=>1="; check_hex(val, $05db0000); print ", ";
@astoreb destarray 2 $e0f;
@aload destarray 0 val;
print "arr=>2="; check_hex(val, $05db0f00); print ", ";
@astoreb destarray 3 $5263;
@aload destarray 0 val;
print "arr=>3="; check_hex(val, $05db0f63); print "^";
arr = destarray+1;
@astoreb arr 0 $12131415;
@aloadb arr 0 val;
print "arr+1=>0="; check_hex(val, $15); print ", ";
@aload destarray 0 val; check_hex(val, $05150f63); print "/";
@aload destarray 1 val; check_hex(val, $00000000); print ", ";
@astoreb arr 1 $e0e1e2e3;
@aloadb arr 1 val;
print "arr+1=>1="; check_hex(val, $e3); print ", ";
@aload destarray 0 val; check_hex(val, $0515e363); print "/";
@aload destarray 1 val; check_hex(val, $00000000); print ", ";
arr = destarray+2;
@astoreb arr 0 $12345678;
@aloadb arr 0 val;
print "arr+2=>0="; check_hex(val, $78); print ", ";
@aload destarray 0 val; check_hex(val, $05157863); print "/";
@aload destarray 1 val; check_hex(val, $00000000); print ", ";
@astoreb arr 1 $fedcba99;
@aloadb arr 1 val;
print "arr+2=>1="; check_hex(val, $99); print ", ";
@aload destarray 0 val; check_hex(val, $05157899); print "/";
@aload destarray 1 val; check_hex(val, $00000000); print ", ";
arr = destarray+3;
@astoreb arr 0 $44556677;
@aloadb arr 0 val;
print "arr+3=>0="; check_hex(val, $77); print ", ";
@aload destarray 0 val; check_hex(val, $05157877); print "/";
@aload destarray 1 val; check_hex(val, $00000000); print ", ";
@astoreb arr 1 $51413121;
@aloadb arr 1 val;
print "arr+3=>1="; check_hex(val, $21); print ", ";
@aload destarray 0 val; check_hex(val, $05157877); print "/";
@aload destarray 1 val; check_hex(val, $21000000); print ", ";
arr = destarray+4;
@astoreb arr (-1) $21436587;
@aloadb arr (-1) val;
print "arr+4=>-1="; check_hex(val, $87); print ", ";
@astoreb arr 0 $31425364;
@aloadb arr 0 val;
print "arr+4=>0="; check_hex(val, $64); print ", ";
@astoreb arr 1 $41526374;
@aloadb arr 1 val;
print "arr+4=>1="; check_hex(val, $74); print ", ";
@aload destarray 0 val; check_hex(val, $05157887); print "/";
@aload destarray 1 val; check_hex(val, $64740000); print "^";
arr = destarray2;
testglobal = destarray2-4;
@astore testglobal 0 $99999900;
@astore testglobal 1 $98979695;
@astoreb destarray2 (-1) $d00ff001;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $01); print ", ";
val = -1;
@astoreb destarray2 val $d10ee002;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $02); print ", ";
@astoreb arr (-1) $d20dd003;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $03); print ", ";
val = -1;
@astoreb arr val $d30cc004;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $04); print ", ";
!
@copy $e00ff001 sp;
@astoreb destarray2 (-1) sp;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $01); print ", ";
val = -1;
@copy $e10ee011 sp;
@astoreb destarray2 val sp;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $11); print ", ";
@copy $e20dd021 sp;
@astoreb arr (-1) sp;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $21); print ", ";
val = -1;
@copy $e30cc031 sp;
@astoreb arr val sp;
@aloadb testglobal 3 val;
print "arr2=>-1="; check_hex(val, $31); print "^";
@aload testglobal 0 val;
print "pre-guard="; check_hex(val, $99999931); print ", ";
@aload testglobal 1 val;
print "post-guard="; check_hex(val, $98979695); print "^";
testglobal = destarray2;
@astore testglobal 0 $98979695;
@astoreb destarray2 0 $f1223310;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $10); print ", ";
val = 0;
@astoreb destarray2 val $f2223311;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $11); print ", ";
@astoreb arr 0 $f3223312;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $12); print ", ";
val = 0;
@astoreb arr val $f4223313;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $13); print ", ";
!
@copy $f5223315 sp;
@astoreb destarray2 0 sp;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $15); print ", ";
val = 0;
@copy $f6223316 sp;
@astoreb destarray2 val sp;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $16); print ", ";
@copy $f7223317 sp;
@astoreb arr 0 sp;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $17); print ", ";
val = 0;
@copy $f8223318 sp;
@astoreb arr val sp;
@aloadb testglobal 0 val;
print "arr2=>0="; check_hex(val, $18); print "^";
@aload testglobal 0 val;
print "post-guard="; check_hex(val, $18979695); print "^";
testglobal = destarray2+2;
@astore testglobal 0 $98979695;
@astoreb destarray2 2 $1;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $1); print ", ";
val = 2;
@astoreb destarray2 val $2;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $2); print ", ";
@astoreb arr 2 $3;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $3); print ", ";
val = 2;
@astoreb arr val $4;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $4); print ", ";
!
@copy $5 sp;
@astoreb destarray2 2 sp;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $5); print ", ";
val = 2;
@copy $6 sp;
@astoreb destarray2 val sp;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $6); print ", ";
@copy $7 sp;
@astoreb arr 2 sp;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $7); print ", ";
val = 2;
@copy $8 sp;
@astoreb arr val sp;
@aloadb testglobal 0 val;
print "arr2=>2="; check_hex(val, $8); print "^";
@aload testglobal 0 val;
print "post-guard="; check_hex(val, $08979695); print "^";
count_failures();
];
TestClass ArrayBitTest
with name 'arraybit' 'aloadbit' 'astorebit' 'abit' 'abits',
testfunc [ val ix res arr;
print "Aloadbit and astorebit:^^";
for (ix=0 : ix<16 : ix++) {
res = 0;
if (ix == 0 or 9)
res = 1;
@aloadbit testarray ix val;
print "bit ", ix, "="; check(val, res); print ", ";
}
print "^";
for (ix=-8 : ix<16 : ix++) {
res = 0;
@copy ix sp;
@copy testarray2 sp;
if (ix < -4 || (ix >= 0 && ix < 7))
res = 1;
@aloadbit sp sp val;
print "bit ", ix, "="; check(val, res); print ", ";
}
print "^";
for (ix=-8 : ix<16 : ix++) {
res = 0;
if (ix < -4 || (ix >= 0 && ix < 7))
res = 1;
@aloadbit testarray2 ix val;
print "bit ", ix, "="; check(val, res); print ", ";
}
print "^";
@aloadbit testarray2 22 val;
print "bit 22="; check(val, 0); print ", ";
@aloadbit testarray2 23 val;
print "bit 23="; check(val, 1); print ", ";
@aloadbit testarray2 24 val;
print "bit 24="; check(val, 0); print ", ";
@aloadbit testarray2 25 val;
print "bit 25="; check(val, 1); print "^";
@aloadbit testarray2 (-31) val;
print "bit -31="; check(val, 0); print ", ";
@aloadbit testarray2 (-32) val;
print "bit -32="; check(val, 0); print ", ";
@aloadbit testarray2 (-33) val;
print "bit -33="; check(val, 1); print ", ";
@aloadbit testarray2 (-34) val;
print "bit -34="; check(val, 1); print "^";
arr = testarray2+1;
@aloadbit arr 14 val;
print "bit 22="; check(val, 0); print ", ";
@aloadbit arr 15 val;
print "bit 23="; check(val, 1); print ", ";
@aloadbit arr 16 val;
print "bit 24="; check(val, 0); print ", ";
@aloadbit arr 17 val;
print "bit 25="; check(val, 1); print "^";
@aloadbit arr (-39) val;
print "bit -31="; check(val, 0); print ", ";
@aloadbit arr (-40) val;
print "bit -32="; check(val, 0); print ", ";
@aloadbit arr (-41) val;
print "bit -33="; check(val, 1); print ", ";
@aloadbit arr (-42) val;
print "bit -34="; check(val, 1); print "^";
arr = destarray;
for (val=0 : val<24 : val++)
arr->val = 0;
@astoreb destarray 1 $ff;
@astorebit destarray 1 1;
@aloadb destarray 0 val;
print "bit 1 on="; check_hex(val, $2); print ", ";
@astorebit destarray 6 $ff;
@aloadb destarray 0 val;
print "bit 6 on="; check_hex(val, $42); print ", ";
@astorebit destarray 3 $80000000;
@aloadb destarray 0 val;
print "bit 3 on="; check_hex(val, $4a); print ", ";
@astorebit destarray 0 0;
@aloadb destarray 0 val;
print "bit 0 off="; check_hex(val, $4a); print ", ";
@astorebit destarray 6 0;
@aloadb destarray 0 val;
print "bit 6 off="; check_hex(val, $0a); print "^";
@astorebit destarray 15 0;
@aloadb destarray 1 val;
print "bit 15 off="; check_hex(val, $7f); print ", ";
@astorebit destarray 12 2;
@aloadb destarray 1 val;
print "bit 12 on="; check_hex(val, $7f); print ", ";
@astorebit destarray 8 0;
@aloadb destarray 1 val;
print "bit 8 off="; check_hex(val, $7e); print "^";
@astorebit destarray2 (-1) 1;
@aloadb destarray2 (-1) val;
print "bit -1 on="; check_hex(val, $80); print ", ";
@astorebit destarray2 (-8) 1;
@aloadb destarray2 (-1) val;
print "bit -8 on="; check_hex(val, $81); print "^";
@astore destarray 0 0;
res = 0;
for (ix=0 : ix < 32 : ix++) {
arr = (8*(3-(ix/8)) + (ix&7));
@shiftl 1 arr arr;
res = res | arr;
@astorebit destarray ix 1;
@aload destarray 0 val;
check_hex(val, res); print ", ";
}
print "^";
res = -1;
for (ix=0 : ix < 32 : ix++) {
arr = (8*(3-(ix/8)) + (ix&7));
@shiftl 1 arr arr;
res = res & (~arr);
@copy ix sp;
@copy destarray sp;
if (testglobal) testglobal++;
@astorebit sp sp 0;
@aload destarray 0 val;
check_hex(val, res); print ", ";
}
print "^";
count_failures();
];
TestClass CallTest
with name 'call',
testfunc [ val;
print "Call and tailcall:^^";
val = arg2adder();
print "arg2adder()="; check(val, 0); print ", ";
val = arg2adder(4);
print "arg2adder(4)="; check(val, 4); print ", ";
val = arg2adder(4, 6);
print "arg2adder(4,6)="; check(val, 10); print ", ";
val = arg2adder(4, 6, 1);
print "arg2adder(4,6,1)="; check(val, 10); print "^";
val = arghasher(4, 6, 1);
print "hash(4,6,1)="; check(val, 19); print "^";
testglobal = 0;
val = tailcalltest(2, 3, 4);
print "tailcalltest(2,3,4)="; check(val, 18); print ", ";
print "testglobal="; check(testglobal, 2); print "^";
count_failures();
];
[ tailcalltest ix jx kx;
testglobal++;
ix = ix+jx+kx;
@copy ix sp;
if (1) @tailcall tailcall2test 1;
testglobal = 99;
return 99;
];
[ tailcall2test val;
testglobal++;
return val*2;
];
TestClass CallStackTest
with name 'callstack',
testfunc [ val;
print "Call with various stack arrangements:^^";
val = arghasher(6, 3, 5, 4, 2);
print "hash(6,3,5,4,2)="; check(val, 53); print "^";
@copy 99 sp;
@copy 1 sp; @copy 3 sp; @copy 2 sp; @copy 5 sp; @copy 4 sp;
@copy arghasher sp;
@call sp 5 sp;
@copy sp val;
print "hash(4,5,2,3,1)="; check(val, 37); print ", ";
@copy sp val;
print "guard value="; check(val, 99); print "^";
@copy 98 sp;
@copy 2 sp; @copy 4 sp; @copy 5 sp; @copy 3 sp; @copy 6 sp;
@copy 5 sp;
@copy arghasher sp;
@call sp sp val;
print "hash(6,3,5,4,2)="; check(val, 53); print ", ";
@copy sp val;
print "guard value="; check(val, 98); print "^";
@copy 1 sp; @copy 3 sp; @copy 2 sp;
noop();
@copy 5 sp; @copy 4 sp;
@call arghasher 5 val;
print "hash(4,5,2,3,1)="; check(val, 37); print "^";
@copy 2 sp; @copy 4 sp; @copy 5 sp;
noop();
@copy 3 sp; @copy 6 sp;
@copy 5 sp;
@call arghasher sp val;
print "hash(6,3,5,4,2)="; check(val, 53); print "^";
@callf arghasher val;
print "hash()="; check(val, 0); print "^";
@callfi arghasher 7 val;
print "hash(7)="; check(val, 7); print ", ";
@copy 8 sp;
@callfi arghasher sp val;
print "hash(8)="; check(val, 8); print "^";
@copy 99 sp;
@copy 9 sp;
@copy arghasher sp;
@callfi sp sp sp;
@copy sp val;
print "hash(9)="; check(val, 9); print ", ";
@copy sp val;
print "guard value="; check(val, 99); print "^";
@copy 98 sp;
@copy 8 sp; @copy 7 sp;
@call arghasher 2 0;
@copy sp val;
print "guard value="; check(val, 98); print "^";
@callfii arghasher 6 7 val;
print "hash(6,7)="; check(val, 20); print ", ";
@callfiii arghasher 5 7 2 val;
print "hash(5,7,2)="; check(val, 25); print "^";
testglobal = 0;
@copy 99 sp;
@copy 1 sp; @copy 3 sp; @copy 2 sp; @copy 5 sp; @copy 4 sp;
@copy arghasher sp;
if (testglobal) testglobal++;
@call sp 5 sp;
@copy sp val;
print "hash(4,5,2,3,1)="; check(val, 37); print ", ";
@copy sp val;
print "guard value="; check(val, 99); print "^";
@copy 98 sp;
@copy 2 sp; @copy 4 sp; @copy 5 sp; @copy 3 sp; @copy 6 sp;
@copy 5 sp;
@copy arghasher sp;
if (testglobal) testglobal++;
@call sp sp val;
print "hash(6,3,5,4,2)="; check(val, 53); print ", ";
@copy sp val;
print "guard value="; check(val, 98); print "^";
@copy 1 sp; @copy 3 sp; @copy 2 sp;
noop();
@copy 5 sp; @copy 4 sp;
if (testglobal) testglobal++;
@call arghasher 5 val;
print "hash(4,5,2,3,1)="; check(val, 37); print "^";
@copy 2 sp; @copy 4 sp; @copy 5 sp;
noop();
@copy 3 sp; @copy 6 sp;
@copy 5 sp;
if (testglobal) testglobal++;
@call arghasher sp val;
print "hash(6,3,5,4,2)="; check(val, 53); print "^";
@callf arghasher val;
print "hash()="; check(val, 0); print "^";
@callfi arghasher 7 val;
print "hash(7)="; check(val, 7); print ", ";
@copy 8 sp;
if (testglobal) testglobal++;
@callfi arghasher sp val;
print "hash(8)="; check(val, 8); print "^";
@copy 99 sp;
@copy 9 sp;
@copy arghasher sp;
if (testglobal) testglobal++;
@callfi sp sp sp;
@copy sp val;
print "hash(9)="; check(val, 9); print ", ";
@copy sp val;
print "guard value="; check(val, 99); print "^";
@copy 98 sp;
@copy 8 sp; @copy 7 sp;
if (testglobal) testglobal++;
@call arghasher 2 0;
@copy sp val;
print "guard value="; check(val, 98); print "^";
count_failures();
];
[ arg2adder ix jx;
return ix+jx;
];
[ arghasher _vararg_count res ix val;
res = 0;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val;
res = res + (ix+1) * val;
}
return res;
];
[ noop;
];
TestClass JumpTest
with name 'jump' 'branch',
testfunc [ val;
print "Jumps and branches:^^";
val = 0;
.P0;
val++;
if (val < 5) {
@jump ?P0;
}
print "Jump loop 5="; check(val, 5); print "^";
val = 0;
@jz val ?P1jz_t;
val = false; @jump ?P1jz_f;
.P1jz_t;
val = true;
.P1jz_f;
print "jz 0="; check(val, 1); print ", ";
val = 1;
@jz val ?P2jz_t;
val = false; @jump ?P2jz_f;
.P2jz_t;
val = true;
.P2jz_f;
print "jz 1="; check(val, 0); print ", ";
val = -1;
@jz val ?P3jz_t;
val = false; @jump ?P3jz_f;
.P3jz_t;
val = true;
.P3jz_f;
print "jz -1="; check(val, 0); print "^";
val = 0;
@jnz val ?P1jnz_t;
val = false; @jump ?P1jnz_f;
.P1jnz_t;
val = true;
.P1jnz_f;
print "jnz 0="; check(val, 0); print ", ";
val = $1000000;
@jnz val ?P4jnz_t;
val = false; @jump ?P4jnz_f;
.P4jnz_t;
val = true;
.P4jnz_f;
print "jnz $1000000="; check(val, 1); print ", ";
val = 1;
@jnz val ?P2jnz_t;
val = false; @jump ?P2jnz_f;
.P2jnz_t;
val = true;
.P2jnz_f;
print "jnz 1="; check(val, 1); print ", ";
val = -1;
@jnz val ?P3jnz_t;
val = false; @jump ?P3jnz_f;
.P3jnz_t;
val = true;
.P3jnz_f;
print "jnz -1="; check(val, 1); print "^";
testglobal = 0;
val = test_jumpabs();
print "jumpabs test="; check(val, 33); print ", ";
check(testglobal, 44); print "^";
count_failures();
];
[ test_jumpabs pos loc;
pos = test_jumpabs_2+5;
loc = 22;
@jumpabs pos;
];
[ test_jumpabs_2 pos loc;
pos = 0;
loc = loc+11;
testglobal = 44;
return loc;
];
TestClass JumpFormTest
with name 'jumpform',
testfunc [ val;
print "Jump with various operand forms:^^";
val = 1;
@"B1:32" ?P1;
return;
.P1;
val = 2;
@"B1:32" ?P2;
val = 3;
.P2;
print "Test A0="; check(val, 2); print "^";
@copy 91 sp;
val = 4;
@"B1:32" ?P3;
return;
.P3;
val = 5;
@"B1:32" ?P4;
val = 6;
.P4;
print "Test A1="; check(val, 5); print ", ";
@copy sp val;
print "guard val="; check(val, 91); print "^";
val = test_jump0();
print "Test B0="; check(val, 0); print ", ";
val = test_jump1();
print "B1="; check(val, 1); print "^";
val = test_var_jump0();
print "Test C0="; check(val, 0); print ", ";
val = test_var_jump1();
print "C1="; check(val, 1); print "^";
val = test_var_jump(0);
print "Test D0="; check(val, 0); print ", ";
val = test_var_jump(1);
print "D1="; check(val, 1); print "^";
val = test_computed_jump(2);
print "Test E0="; check(val, 2); print ", ";
val = test_computed_jump(5);
print "E1="; check(val, 3); print ", ";
val = test_computed_jump(8);
print "E2="; check(val, 4); print ", ";
val = test_computed_jump(11);
print "E3="; check(val, 5); print ", ";
val = test_computed_jump(14);
print "E4="; check(val, 6); print "^";
val = test_push_computed_jump(2);
print "Test F0="; check(val, 2); print ", ";
val = test_push_computed_jump(5);
print "F1="; check(val, 3); print ", ";
val = test_push_computed_jump(8);
print "F2="; check(val, 9); print "^";
print "^Jump-if-zero with various operand forms:^^";
val = test_jz0(0);
print "Test B0="; check(val, 0); print ", ";
val = test_jz1(0);
print "B1="; check(val, 1); print ", ";
val = test_jz1(1);
print "B2="; check(val, 99); print ", ";
val = test_jz1(-1);
print "B3="; check(val, 99); print "^";
val = test_push_computed_jz(0, 2);
print "Test F0="; check(val, 2); print ", ";
val = test_push_computed_jz(0, 5);
print "F1="; check(val, 3); print ", ";
val = test_push_computed_jz(0, 8);
print "F2="; check(val, 9); print ", ";
val = test_push_computed_jz(0, 10);
print "F3="; check(val, 5); print ", ";
val = test_push_computed_jz(123, 10);
print "F4="; check(val, 2); print ", ";
val = test_push_computed_jz(0, 0);
print "F5="; check(val, 0); print ", ";
val = test_push_computed_jz(0, 1);
print "F6="; check(val, 1); print "^";
print "^Jump-if-equal with various operand forms:^^";
val = test_jeq0(4, 4);
print "Test B0="; check(val, 0); print ", ";
val = test_jeq1(5, 5);
print "B1="; check(val, 1); print ", ";
val = test_jeq1(5, 0);
print "B2="; check(val, 99); print "^";
val = test_push_computed_jeq(7, 7, 2);
print "Test F0="; check(val, 2); print ", ";
val = test_push_computed_jeq(7, 7, 5);
print "F1="; check(val, 3); print ", ";
val = test_push_computed_jeq(7, 7, 8);
print "F2="; check(val, 9); print ", ";
val = test_push_computed_jeq(7, 7, 10);
print "F3="; check(val, 5); print ", ";
val = test_push_computed_jeq(7, 6, 10);
print "F4="; check(val, 2); print ", ";
val = test_push_computed_jeq(-1, -1, 1);
print "F5="; check(val, 1); print ", ";
val = test_push_computed_jeq(0, 0, 0);
print "F6="; check(val, 0); print "^";
count_failures();
];
[ test_jump0;
@"1:32" 0;
return 99;
];
[ test_jump1;
@"1:32" 1;
return 99;
];
[ test_var_jump loc;
@"1:32" loc;
return 99;
];
[ test_var_jump0 loc;
loc = 0;
@"1:32" loc;
return 99;
];
[ test_var_jump1 loc;
loc = 1;
@"1:32" loc;
return 99;
];
[ test_computed_jump loc;
@"1:32" loc;
@"1:49" 2;
@"1:49" 3;
@"1:49" 4;
@"1:49" 5;
@"1:49" 6;
];
[ test_push_computed_jump loc;
@copy 9 sp;
@"1:32" loc;
@"1:49" 2;
@"1:49" 3;
@"1:49" sp;
@"1:49" 5;
@"1:49" 6;
];
[ test_jz0 val;
@"2:34" val 0;
return 99;
];
[ test_jz1 val;
@"2:34" val 1;
return 99;
];
[ test_push_computed_jz val loc;
@copy 9 sp;
@"2:34" val loc;
@"1:49" 2;
@"1:49" 3;
@"1:49" sp;
@"1:49" 5;
@"1:49" 6;
];
[ test_jeq0 val1 val2;
@"3:36" val1 val2 0;
return 99;
];
[ test_jeq1 val1 val2;
@"3:36" val1 val2 1;
return 99;
];
[ test_push_computed_jeq val1 val2 loc;
@copy 9 sp;
@"3:36" val1 val2 loc;
@"1:49" 2;
@"1:49" 3;
@"1:49" sp;
@"1:49" 5;
@"1:49" 6;
];
Array branch_results --> 10;
TestClass CompareTest
with name 'compare',
testfunc [;
print "Compare branches:^^";
test_branch_jgt(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jgt 2: "; check_list(branch_results, 1, 1, 1, 0, 0, 0, 1); print "^";
test_branch_jgt(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jgt -2: "; check_list(branch_results, 1, 0, 0, 0, 0, 0, 0, 1); print "^";
test_branch_jge(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jge 2: "; check_list(branch_results, 1, 1, 1, 1, 0, 0, 1); print "^";
test_branch_jge(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jge -2: "; check_list(branch_results, 1, 1, 0, 0, 0, 0, 0, 1); print "^";
test_branch_jlt(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jlt 2: "; check_list(branch_results, 0, 0, 0, 0, 1, 1, 0); print "^";
test_branch_jlt(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jlt -2: "; check_list(branch_results, 0, 0, 1, 1, 1, 1, 1, 0); print "^";
test_branch_jle(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jle 2: "; check_list(branch_results, 0, 0, 0, 1, 1, 1, 0); print "^";
test_branch_jle(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jle -2: "; check_list(branch_results, 0, 1, 1, 1, 1, 1, 1, 0); print "^";
test_branch_jgtu(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jgtu 2: "; check_list(branch_results, 0, 1, 1, 0, 0, 0, 0); print "^";
test_branch_jgtu(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jgtu -2: "; check_list(branch_results, 1, 0, 0, 1, 1, 1, 1, 1); print "^";
test_branch_jgeu(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jgeu 2: "; check_list(branch_results, 0, 1, 1, 1, 0, 0, 0); print "^";
test_branch_jgeu(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jgeu -2: "; check_list(branch_results, 1, 1, 0, 1, 1, 1, 1, 1); print "^";
test_branch_jltu(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jltu 2: "; check_list(branch_results, 1, 0, 0, 0, 1, 1, 1); print "^";
test_branch_jltu(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jltu -2: "; check_list(branch_results, 0, 0, 1, 0, 0, 0, 0, 0); print "^";
test_branch_jleu(2, -1, 0, 1, 2, 3, $7fffffff, $80000000);
print "jleu 2: "; check_list(branch_results, 1, 0, 0, 1, 1, 1, 1); print "^";
test_branch_jleu(-2, -3, -2, -1, 0, 1, 3, $7fffffff, $80000000);
print "jleu -2: "; check_list(branch_results, 0, 1, 1, 0, 0, 0, 0, 0); print "^";
count_failures();
];
[ test_branch_jgt _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jgt val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
[ test_branch_jge _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jge val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
[ test_branch_jlt _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jlt val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
[ test_branch_jle _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jle val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
[ test_branch_jgtu _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jgtu val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
[ test_branch_jgeu _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jgeu val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
[ test_branch_jltu _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jltu val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
[ test_branch_jleu _vararg_count val1 ix val2 res;
@copy sp val1;
_vararg_count--;
for (ix=0 : ix<_vararg_count : ix++) {
@copy sp val2;
res = 1;
@jleu val1 val2 ?YES;
res = 0;
.YES;
branch_results-->ix = res;
}
];
TestClass StackTest
with name 'stack',
testfunc [ val eight;
print "Stack operations:^^";
@stkcount val;
print "stkcount="; check(val, 0); print ", ";
@copy 5 sp;
@stkcount val;
print "stkcount="; check(val, 1); print ", ";
@copy 6 sp;
@stkcount val;
print "stkcount="; check(val, 2); print ", ";
@copy 77 sp;
@stkcount sp;
@copy sp val;
@copy sp 0;
print "stkcount="; check(val, 3); print ", ";
noop();
@copy 7 sp;
noop();
@stkcount val;
print "stkcount="; check(val, 3); print ", ";
noop();
@stkcount sp;
@copy sp val;
print "stkcount="; check(val, 3); print ", ";
@stkcount testglobal;
@copy testglobal val;
print "stkcount="; check(val, 3); print "^";
! 5 6 7
noop();
@stkswap;
@sub sp sp val;
print "sp-sp="; check(val, -1); print ", ";
! 5
noop();
@copy 2 sp;
@stkswap;
@sub sp sp val;
print "sp-sp="; check(val, 3); print ", ";
!
@copy 5 sp;
@copy 4 sp;
@stkswap;
@sub sp sp val;
print "sp-sp="; check(val, 1); print "^";
eight = 8;
@copy 7 sp; @copy eight sp; @copy 9 sp;
@stkpeek 0 val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
@stkpeek 1 val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
@stkpeek 2 val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; @copy 9 sp;
noop();
@stkpeek 0 val;
print "peek 0="; check(val, 9); print ", ";
noop();
@stkpeek 1 val;
print "peek 1="; check(val, 8); print ", ";
noop();
@stkpeek 2 val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
@stkpeek 0 val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
@stkpeek 1 val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
@stkpeek 2 val;
print "peek 2="; check(val, 7); print "^";
@copy sp val; @copy sp val; @copy sp val;
@stkcount val;
print "count="; check(val, 0); print "^";
@copy 7 sp; @copy eight sp; @copy 9 sp;
@stkpeek 0 sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
@stkpeek 1 sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
@stkpeek 2 sp; @copy sp val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; @copy 9 sp;
noop();
@stkpeek 0 sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
noop();
@stkpeek 1 sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
noop();
@stkpeek 2 sp; @copy sp val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
@stkpeek 0 sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
@stkpeek 1 sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
@stkpeek 2 sp; @copy sp val;
print "peek 2="; check(val, 7); print "^";
@copy sp val; @copy sp val; @copy sp val;
@stkcount val;
print "count="; check(val, 0); print "^";
@copy 7 sp; @copy eight sp; @copy 9 sp;
testglobal=0; @stkpeek testglobal sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
testglobal=1; @stkpeek testglobal sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
testglobal=2; @stkpeek testglobal sp; @copy sp val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; @copy 9 sp;
noop();
testglobal=0; @stkpeek testglobal sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
noop();
testglobal=1; @stkpeek testglobal sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
noop();
testglobal=2; @stkpeek testglobal sp; @copy sp val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
testglobal=0; @stkpeek testglobal sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
testglobal=1; @stkpeek testglobal sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
testglobal=2; @stkpeek testglobal sp; @copy sp val;
print "peek 2="; check(val, 7); print "^";
@copy sp val; @copy sp val; @copy sp val;
@stkcount val;
print "count="; check(val, 0); print "^";
@copy 7 sp; @copy eight sp; @copy 9 sp;
testglobal=0; @stkpeek testglobal val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
testglobal=1; @stkpeek testglobal val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; @copy 9 sp;
testglobal=2; @stkpeek testglobal val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; @copy 9 sp;
noop();
testglobal=0; @stkpeek testglobal val;
print "peek 0="; check(val, 9); print ", ";
noop();
testglobal=1; @stkpeek testglobal val;
print "peek 1="; check(val, 8); print ", ";
noop();
testglobal=2; @stkpeek testglobal val;
print "peek 2="; check(val, 7); print ", ";
@copy sp val; @copy sp val; @copy sp val;
!
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
testglobal=0; @stkpeek testglobal val;
print "peek 0="; check(val, 9); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
testglobal=1; @stkpeek testglobal val;
print "peek 1="; check(val, 8); print ", ";
@copy sp val; @copy sp val; @copy sp val;
@copy 7 sp; @copy eight sp; noop(); @copy 9 sp;
testglobal=2; @stkpeek testglobal val;
print "peek 2="; check(val, 7); print "^";
@copy sp val; @copy sp val; @copy sp val;
@stkcount val;
print "count="; check(val, 0); print "^";
@copy 7 sp; @copy eight sp; @copy 9 sp;
@copy 1 sp;
@stkpeek sp sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
@copy 1 sp;
noop();
@stkpeek sp sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
noop();
@copy 1 sp;
@stkpeek sp sp; @copy sp val;
print "peek 1="; check(val, 8); print ", ";
!
@copy 0 sp;
@stkpeek sp sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
@copy 0 sp;
noop();
@stkpeek sp sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
noop();
@copy 0 sp;
@stkpeek sp sp; @copy sp val;
print "peek 0="; check(val, 9); print ", ";
!
testglobal = 2;
@copy testglobal sp;
@stkpeek sp sp; @copy sp val;
print "peek 2="; check(val, 7); print ", ";
@copy testglobal sp;
noop();
@stkpeek sp sp; @copy sp val;
print "peek 2="; check(val, 7); print ", ";
noop();
@copy testglobal sp;
@stkpeek sp sp; @copy sp val;
print "peek 2="; check(val, 7); print "^";
!
@copy sp val; @copy sp val; @copy sp val;
@stkcount val;
print "count="; check(val, 0); print "^";
@copy 2 sp; @copy 3 sp; @copy 4 sp;
@stkcount val;
@call arghasher val val;
print "hash(4,3,2)="; check(val, 16); print ", ";
@copy 2 sp; @copy 3 sp; @copy 5 sp;
@stkcopy 3;
@stkcount val;
@call arghasher val val;
print "hash(5,3,2,5,3,2)="; check(val, 64); print ", ";
@copy 2 sp; @copy 3 sp; @copy 4 sp; noop();
@stkcopy 3;
@stkcount val;
@call arghasher val val;
print "hash(4,3,2,4,3,2)="; check(val, 59); print ", ";
@copy 2 sp; @copy 3 sp; noop(); @copy 5 sp;
@stkcopy 3;
@stkcount val;
@call arghasher val val;
print "hash(5,3,2,5,3,2)="; check(val, 64); print "^";
@stkcopy 0;
@stkcount val;
print "stkcount="; check(val, 0); print "^";
testglobal = 3;
@copy 2 sp; @copy 3 sp; @copy 5 sp;
@stkcopy testglobal;
@stkcount val;
@call arghasher val val;
print "hash(5,3,2,5,3,2)="; check(val, 64); print ", ";
@copy 2 sp; @copy 3 sp; @copy 4 sp; noop();
@stkcopy testglobal;
@stkcount val;
@call arghasher val val;
print "hash(4,3,2,4,3,2)="; check(val, 59); print ", ";
@copy 2 sp; @copy 3 sp; noop(); @copy 5 sp;
@stkcopy testglobal;
@stkcount val;
@call arghasher val val;
print "hash(5,3,2,5,3,2)="; check(val, 64); print "^";
@stkcount val;
print "stkcount="; check(val, 0); print "^";
@copy 5 sp; @copy 4 sp; @copy 3 sp;
@copy 2 sp;
@stkcopy sp;
@stkcount val;
@call arghasher val val;
print "hash(3,4,3,4,5)="; check(val, 61); print ", ";
@copy 5 sp; @copy 4 sp; noop(); @copy 3 sp;
@copy 2 sp;
@stkcopy sp;
@stkcount val;
@call arghasher val val;
print "hash(3,4,3,4,5)="; check(val, 61); print ", ";
@copy 5 sp; @copy 4 sp; @copy 3 sp;
@copy 2 sp; noop();
@stkcopy sp;
@stkcount val;
@call arghasher val val;
print "hash(3,4,3,4,5)="; check(val, 61); print ", ";
@copy 5 sp; @copy 4 sp; @copy 3 sp;
noop(); @copy 2 sp;
@stkcopy sp;
@stkcount val;
@call arghasher val val;
print "hash(3,4,3,4,5)="; check(val, 61); print "^";
@stkcount val;
print "stkcount="; check(val, 0); print "^";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkcount val;
@call arghasher val val;
print "hash(6,4,3,2,1)="; check(val, 36); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 0 1;
@stkcount val;
@call arghasher val val;
print "hash(6,4,3,2,1)="; check(val, 36); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 2 4;
@stkcount val;
@call arghasher val val;
print "hash(6,4,3,2,1)="; check(val, 36); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 3 1;
@stkcount val;
@call arghasher val val;
print "hash(4,3,6,2,1)="; check(val, 41); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 3 (-1);
@stkcount val;
@call arghasher val val;
print "hash(3,6,4,2,1)="; check(val, 40); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 3 (-2);
@stkcount val;
@call arghasher val val;
print "hash(4,3,6,2,1)="; check(val, 41); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 3 2;
@stkcount val;
@call arghasher val val;
print "hash(3,6,4,2,1)="; check(val, 40); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 3 3;
@stkcount val;
@call arghasher val val;
print "hash(6,4,3,2,1)="; check(val, 36); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@stkroll 3 (-6);
@stkcount val;
@call arghasher val val;
print "hash(6,4,3,2,1)="; check(val, 36); print "^";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@copy 1 sp; @copy 4 sp;
@stkroll sp sp;
@stkcount val;
@call arghasher val val;
print "hash(4,3,2,6,1)="; check(val, 45); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@copy (-1) sp; @copy 4 sp;
@stkroll sp sp;
@stkcount val;
@call arghasher val val;
print "hash(2,6,4,3,1)="; check(val, 43); print "^";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@copy 1 sp; @copy 4 sp;
noop();
@stkroll sp sp;
@stkcount val;
@call arghasher val val;
print "hash(4,3,2,6,1)="; check(val, 45); print ", ";
@copy 1 sp; @copy 2 sp; @copy 3 sp; @copy 4 sp; @copy 6 sp;
@copy (-1) sp; @copy 4 sp;
noop();
@stkroll sp sp;
@stkcount val;
@call arghasher val val;
print "hash(2,6,4,3,1)="; check(val, 43); print "^";
count_failures();
];
TestClass GestaltTest
with name 'gestalt',
testfunc [ val;
print "Gestalt:^^";
@gestalt 4 0 val; ! IOSystem
print "gestalt(4,0)="; check(val, 1); print ", ";
@gestalt 4 1 val; ! IOSystem
print "gestalt(4,1)="; check(val, 1); print ", ";
@gestalt 4 99 val; ! IOSystem
print "gestalt(4,99)="; check(val, 0); print "^";
@gestalt 1234 5678 val;
print "gestalt(1234,5678)="; check(val, 0); print "^";
testglobal = 0;
@gestalt 4 1 testglobal; ! IOSystem
print "gestalt(4,1)="; check(testglobal, 1); print "^";
@copy 99 sp;
@gestalt 4 1 sp;
@copy sp val;
print "gestalt(4,1)="; check(val, 1); print "^";
@copy sp val;
print "guard="; check(val, 99); print "^";
count_failures();
];
TestClass ThrowTest
with name 'throw' 'catch' 'exception' 'continuation',
testfunc [ val tok;
print "Catch/throw:^^";
testglobal = 0;
val = test_catch_jump0();
print "catch 0="; check(val, 0); print ", ";
print "token="; check(testglobal, 248+allstackdepth); print "^";
testglobal = 0;
val = test_catch_jump1();
print "catch 1="; check(val, 1); print ", ";
print "token="; check(testglobal, 248+allstackdepth); print "^";
testglobal = 0;
val = test_catch_jump1sp();
print "catch 1 sp="; check(val, 1); print ", ";
print "token="; check(testglobal, 248+allstackdepth); print "^";
testglobal = 0;
@copy 77 sp;
val = test_catch_discard();
print "catch discard="; check(val, 100); print ", ";
print "token="; check(testglobal, 252+allstackdepth); print ", ";
@copy sp val;
print "guard="; check(val, 77); print "^";
testglobal = 0;
val = test_catch_computed(5);
print "catch computed="; check(val, 99); print ", ";
print "thrown="; check(testglobal, 97); print ", ";
print "token="; check(testglobal2, 256+allstackdepth); print "^";
testglobal = 0;
testglobal2 = 0;
val = 88;
@catch testglobal ?Catch1;
jump Throw1;
.Catch1;
testglobal2 = testglobal;
val = recurse_throw(testglobal, 100, 5);
testglobal = 0;
testglobal2 = 0;
.Throw1;
print "global catch="; check(testglobal, 105); print ", ";
print "token="; check(testglobal2, 220+allstackdepth); print ", ";
print "guard="; check(val, 88); print "^";
testglobal = 0;
testglobal2 = 0;
val = 87;
@catch testglobal ?Catch2;
jump Throw2;
.Catch2;
testglobal2 = testglobal;
val = recurse_throw_sp(testglobal, 100, 6);
testglobal = 0;
testglobal2 = 0;
.Throw2;
print "global catch="; check(testglobal, 106); print ", ";
print "token="; check(testglobal2, 220+allstackdepth); print ", ";
print "guard="; check(val, 87); print "^";
testglobal = 0;
testglobal2 = 0;
val = 86;
@catch testglobal ?Catch3;
jump Throw3;
.Catch3;
testglobal2 = testglobal;
val = recurse_throw_spnoop(testglobal, 100, 7);
testglobal = 0;
testglobal2 = 0;
.Throw3;
print "global catch="; check(testglobal, 107); print ", ";
print "token="; check(testglobal2, 220+allstackdepth); print ", ";
print "guard="; check(val, 86); print "^";
tok = 0;
testglobal2 = 0;
val = 88;
@catch tok ?Catch4;
jump Throw4;
.Catch4;
testglobal2 = tok;
val = recurse_throw(tok, 100, 5);
tok = 0;
testglobal2 = 0;
.Throw4;
print "local catch="; check(tok, 105); print ", ";
print "token="; check(testglobal2, 220+allstackdepth); print ", ";
print "guard="; check(val, 88); print "^";
tok = 0;
testglobal = 0;
testglobal2 = 0;
val = 87;
@catch sp ?Catch5;
testglobal++;
jump Throw5;
.Catch5;
@copy sp testglobal2;
val = recurse_throw(testglobal2, 100, 4);
tok = 0;
testglobal2 = 0;
.Throw5;
@copy sp tok;
print "local catch="; check(tok, 104); print ", ";
print "token="; check(testglobal2, 220+allstackdepth); print ", ";
print "count="; check(testglobal, 1); print ", ";
print "guard="; check(val, 87); print "^";
count_failures();
];
[ test_catch_jump0;
@"2:50" testglobal 0;
testglobal = 98;
return 99;
];
[ test_catch_jump1;
noop();
@"2:50" testglobal 1;
testglobal = 98;
return 99;
];
[ test_catch_jump1sp;
@copy 1 sp;
noop();
@"2:50" testglobal sp;
testglobal = 98;
return 99;
];
[ test_catch_discard;
@catch testglobal ?Catch;
testglobal = 98;
return 99;
.Catch;
return 100;
];
[ test_catch_computed loc dummy;
@"2:50" testglobal loc;
@"1:49" 99;
!.Catch;
testglobal2 = testglobal;
@"2:51" 97 testglobal;
testglobal = 0;
dummy = 0;
return 0;
];
[ recurse_throw token val depth;
if (depth == 0)
@throw val token;
else
recurse_throw(token, val+1, depth-1);
return 99;
];
[ recurse_throw_sp token val depth;
if (depth == 0) {
@copy token sp;
@copy val sp;
@throw sp sp;
}
else
recurse_throw(token, val+1, depth-1);
return 99;
];
[ recurse_throw_spnoop token val depth;
if (depth == 0) {
@copy token sp;
@copy val sp;
noop();
@throw sp sp;
}
else
recurse_throw(token, val+1, depth-1);
return 99;
];
TestClass StreamNumTest
with name 'streamnum',
testfunc [ val;
print "Printing integers:^^";
testglobal = 0;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("0", val); print "^";
testglobal = 1;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("1", val); print "^";
testglobal = -1;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("-1", val); print "^";
testglobal = 9999;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("9999", val); print "^";
testglobal = -9999;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("-9999", val); print "^";
testglobal = 1234579;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("1234579", val); print "^";
testglobal = -97654321;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("-97654321", val); print "^";
testglobal = $7FFFFFFF;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("2147483647", val); print "^";
testglobal = $80000001;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("-2147483647", val); print "^";
testglobal = $80000000;
val = string_to_array(numberprint, bigbuffer, BIGBUFSIZE);
check_str("-2147483648", val); print "^";
count_failures();
];
! The following is imported from encode-table.
! -----------
Array encoding_table -> 0 0 3 178 0 0 0 133 0 0 0 12 0 0 0 0 21 0 0 0
199 0 0 0 0 30 0 0 0 98 0 0 0 0 39 0 0 0 63 0 0 0 0 48 0
0 0 61 0 0 0 0 57 0 0 0 59 2 115 2 121 2 123 0 0 0 0 72 0 0
0 74 2 125 0 0 0 0 83 0 0 0 85 2 101 0 0 0 0 94 0 0 0 96 2
97 2 98 0 0 0 0 107 0 0 0 175 0 0 0 0 116 0 0 0 151 0 0 0 0
125 0 0 0 138 0 0 0 0 134 0 0 0 136 2 100 2 105 0 0 0 0 147 0 0
0 149 2 110 2 111 0 0 0 0 160 0 0 0 173 0 0 0 0 169 0 0 0 171 2
112 2 116 2 34 0 0 0 0 184 0 0 0 197 0 0 0 0 193 0 0 0 195 2 91
2 93 2 58 0 0 0 0 208 0 0 2 110 0 0 0 0 217 0 0 0 218 1 0 0
0 0 227 0 0 1 31 0 0 0 0 236 0 0 1 29 0 0 0 0 245 0 0 0 250
9 0 0 0 0 0 0 0 1 3 0 0 1 16 0 0 0 1 12 0 0 1 14 2 84
2 232 0 0 0 1 25 0 0 1 27 2 236 2 242 2 46 0 0 0 1 40 0 0 1
179 0 0 0 1 49 0 0 1 104 0 0 0 1 58 0 0 1 79 0 0 0 1 67 0
0 1 69 2 249 3 99 111 110 116 97 105 110 115 0 0 0 0 1 88 0 0 1 99 3
115 117 98 115 116 114 105 110 103 0 4 0 0 0 101 0 0 0 1 113 0 0 1 132 0
0 0 1 122 0 0 1 127 4 0 0 0 111 4 0 0 3 177 0 0 0 1 141 0 0
1 146 4 0 0 48 169 5 0 0 0 115 0 0 0 101 0 0 0 118 0 0 0 101 0
0 0 114 0 0 0 97 0 0 0 108 0 0 0 0 0 0 0 1 188 0 0 2 23 0
0 0 1 197 0 0 1 252 0 0 0 1 206 0 0 1 247 5 0 0 0 115 0 0 0
117 0 0 0 98 0 0 0 115 0 0 0 116 0 0 0 114 0 0 0 105 0 0 0 110
0 0 0 103 0 0 0 0 8 0 0 0 0 0 0 0 2 5 0 0 2 10 8 0 0
0 0 10 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 32 0 0 2 71 0
0 0 2 41 0 0 2 58 10 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0
10 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 80 0 0 2 97 10 0 0
0 0 0 0 0 2 0 0 0 0 0 0 0 0 11 0 0 0 0 0 0 0 1 0 0
0 0 0 0 0 2 119 0 0 3 71 0 0 0 2 128 0 0 2 248 0 0 0 2 137
0 0 2 213 0 0 0 2 146 0 0 2 200 0 0 0 2 155 0 0 2 198 0 0 0
2 164 0 0 2 181 11 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 11 0
0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 2 10 0 0 0 2 209 0 0 2
211 2 39 2 96 0 0 0 2 222 0 0 2 235 0 0 0 2 231 0 0 2 233 2 99
2 102 0 0 0 2 244 0 0 2 246 2 103 2 106 0 0 0 3 1 0 0 3 36 0
0 0 3 10 0 0 3 23 0 0 0 3 19 0 0 3 21 2 107 2 109 0 0 0 3
32 0 0 3 34 2 113 2 114 0 0 0 3 45 0 0 3 58 0 0 0 3 54 0 0
3 56 2 117 2 118 0 0 0 3 67 0 0 3 69 2 119 2 120 0 0 0 3 80 0
0 3 143 0 0 0 3 89 0 0 3 130 0 0 0 3 98 0 0 3 111 0 0 0 3
107 0 0 3 109 2 122 2 224 0 0 0 3 120 0 0 3 125 9 0 0 0 0 9 0
0 0 0 0 0 0 3 139 0 0 3 141 2 32 2 48 0 0 0 3 152 0 0 3 165
0 0 0 3 161 0 0 3 163 2 49 2 50 0 0 0 3 174 0 0 3 176 2 104 2
108;
Array encoding_patches --> 8 13 17 22 26 31 35 40 44 49 53 64
68 75 79 86 90 99 103 108 112 117 121 126 130 139 143 152 156
161 165 176 180 185 189 200 204 209 213 219 223 228 232 237 241 251
255 260 264 273 277 288 292 297 301 306 310 315 319 336 340 361 365
370 374 389 393 436 440 445 449 454 458 509 513 536 540 545 549 584
588 623 627 632 636 641 645 650 654 659 663 668 672 713 717 726 730
735 739 748 752 761 765 770 774 779 783 792 796 805 809 814 818 827
831 840 844 849 853 858 862 867 871 880 884 899 903 912 916 921 925
934 938 0;
Global table_patched = false;
! Call this before you do "@setstringtbl encoding_table".
[ patch_encoding_table addr ix;
if (table_patched) return;
table_patched = true;
ix = 0;
while (1) {
addr = encoding_patches-->ix;
if (addr == 0) break;
addr = addr + encoding_table;
addr-->0 = addr-->0 + encoding_table;
ix++;
}
addr = encoding_table + 246; addr-->0 = double_indirect+8;
addr = encoding_table + 504; addr-->0 = argprint;
addr = encoding_table + 518; addr-->0 = hello_str;
addr = encoding_table + 523; addr-->0 = argprint;
addr = encoding_table + 531; addr-->0 = 1;
addr = encoding_table + 554; addr-->0 = argprint;
addr = encoding_table + 562; addr-->0 = 1;
addr = encoding_table + 566; addr-->0 = 2;
addr = encoding_table + 571; addr-->0 = hello_str;
addr = encoding_table + 579; addr-->0 = 1;
addr = encoding_table + 593; addr-->0 = nativeprint;
addr = encoding_table + 601; addr-->0 = "foo";
addr = encoding_table + 605; addr-->0 = "bar";
addr = encoding_table + 610; addr-->0 = double_indirect+0;
addr = encoding_table + 618; addr-->0 = 1;
addr = encoding_table + 677; addr-->0 = double_indirect+4;
addr = encoding_table + 685; addr-->0 = 2;
addr = encoding_table + 689; addr-->0 = 3;
addr = encoding_table + 694; addr-->0 = double_indirect+8;
addr = encoding_table + 702; addr-->0 = hello_str;
addr = encoding_table + 706; addr-->0 = bye_str;
addr = encoding_table + 889; addr-->0 = double_indirect+0;
addr = encoding_table + 894; addr-->0 = double_indirect+4;
];
! Double-indirect references: (start out as all zeroes)
Array double_indirect --> 3 ;
! String objects
Array alphabet2_str -> $E1 28 63 17 216 116 246 137 243 197 191 148 100
101 181 6 234 102 187 219 195 67 0;
Array alphabet_str -> $E1 28 63 17 216 116 246 137 243 197 191 148 100
101 181 6 234 102 187 219 195 67 0;
Array bye_str -> $E1 60 100 1;
Array dindir012_str -> $E1 120 170 181 158 107 173 5 5;
Array dindir0_1_str -> $E1 120 123 191 223 20;
Array dindir0_str -> $E1 120 251 201 111 10;
Array dindir1_23_str -> $E1 248 248 128 63 20;
Array dindir1_str -> $E1 248 248 217 31 10;
Array dindir2_hello_bye_str -> $E1 248 250 160 191 20;
Array dindir2_str -> $E1 248 122 225 47 5;
Array dinquote2_str -> $E1 168 71 227 98 60 210 20;
Array hello_str -> $E1 31 251 127 57;
Array highbit_str -> $E1 199 210 178 242 134 0;
Array indirargprint_12_str -> $E1 166 199 6;
Array indirargprint_1_str -> $E1 166 219 6;
Array indirargprint_str -> $E1 166 211 6;
Array indirhello_1_str -> $E1 166 215 6;
Array indirhello_str -> $E1 166 203 6;
Array indirnativeprint_foobar_str -> $E1 166 207 6;
Array mix_str -> $E1 37 159 8 174 198 171 253 146 90 132 230 75
133 10 3 117 24;
Array newline_str -> $E1 195 0;
Array null_str -> $E1 1;
Array substring_str -> $E1 186 73 7;
Array subunistring_str -> $E1 186 67 7;
Array unicode_str -> $E1 220 177 181 45;
! -----------
Array cstring_str -> $E0 'C' ' ' 's' 't' 'r' 'i' 'n' 'g' '.' 0;
Array cunistring_str --> $E2000000 'C' ' ' $DC 'n' $EF 'c' 'o' $3B4 'e' ' ' $201C $30A9 $201D 0;
Constant BIGBUFSIZE 256;
Array bigbuffer -> BIGBUFSIZE;
Array bigbuffer2 -> BIGBUFSIZE;
Array bigubuffer --> BIGBUFSIZE;
Array bigubuffer2 --> BIGBUFSIZE;
TestClass StringsTest
with name 'strings' 'string',
testfunc [ val;
print "String table decoding:^^";
patch_encoding_table();
print "Basic strings: ";
val = tablestring(hello_str);
check_str("hello", val);
print " is len "; check(val, 5); print ", ";
val = tablestring(bye_str);
check_str("bye", val); print ", ";
val = tablestring(null_str);
check_str("", val); print ", ";
val = tablestring(alphabet_str);
check_str("abcdefghijklmnopqrstuvwxyz", val); print ", ";
val = tablestring(highbit_str);
check_str("@@224@@232@@236@@242@@249", val); print ", ";
val = tablestring(newline_str);
check_str("^", val); print ", ";
val = tablestring(mix_str);
check_str("This contains several node types.^", val); print "^";
print "Unicode strings: ";
val = tableustring(hello_str);
check_ustr("hello", val); print ", ";
val = tableustring(alphabet2_str);
check_ustr("abcdefghijklmnopqrstuvwxyz", val); print ", ";
val = tableustring(unicode_str);
check_ustr("a@{e0}@{3b1}@{30a9}", val); print "^";
print "C-style strings: ";
val = tableustring(cstring_str);
check_ustr("C string.", val); print "^";
val = tableustring(cunistring_str);
check_ustr("C @{DC}n@{EF}co@{3B4}e @{201C}@{30A9}@{201D}", val); print "^";
print "Substrings: ";
val = tablestring(substring_str);
check_str("~substring~", val); print ", ";
val = tablestring(subunistring_str);
check_str("~substring~", val); print "^";
print "References: ";
val = tablestring(indirhello_str);
check_str("[hello]", val); print ", ";
val = tablestring(indirhello_1_str);
check_str("[hello]", val); print ", ";
val = tablestring(indirargprint_str);
check_str("[]", val); print ", ";
val = tablestring(indirargprint_1_str);
check_str("[1]", val); print ", ";
val = tablestring(indirargprint_12_str);
check_str("[1 2]", val); print ", ";
val = tablestring(indirnativeprint_foobar_str);
check_str("[foo bar]", val); print "^";
print "Indirect references: ";
double_indirect-->0 = bye_str;
val = tablestring(dindir0_str);
check_str("{0:bye:0}", val); print ", ";
double_indirect-->0 = substring_str;
val = tablestring(dindir0_str);
check_str("{0:~substring~:0}", val); print ", ";
double_indirect-->0 = hello_str;
double_indirect-->1 = dindir0_str;
val = tablestring(dindir1_str);
check_str("{1:{0:hello:0}:1}", val); print ", ";
double_indirect-->0 = byehello_func;
val = tablestring(dindir1_str);
check_str("{1:{0:bye hello:0}:1}", val); print ", ";
double_indirect-->0 = argprint;
val = tablestring(dindir0_1_str);
check_str("{0:1:0}", val); print ", ";
double_indirect-->1 = argprint;
val = tablestring(dindir1_23_str);
check_str("{1:2 3:1}", val); print ", ";
double_indirect-->2 = argprintstr;
val = tablestring(dindir2_hello_bye_str);
check_str("{2:hello bye:2}", val); print ", ";
double_indirect-->2 = null_str;
val = tablestring(dinquote2_str);
check_str("{~'``'~}", val); print "^";
print "Multiple references: ";
double_indirect-->0 = hello_str;
double_indirect-->1 = bye_str;
double_indirect-->2 = cstring_str;
val = tablestring(dindir012_str);
check_str("{hello...bye...C string.}", val); print ", ";
testglobal = 0;
double_indirect-->0 = dindir1_str;
double_indirect-->1 = counterprint;
double_indirect-->2 = byehello_func;
val = tablestring(dindir012_str);
check_str("{{1:+0:1}...+1...bye hello}", val); print ", ";
print "counter="; check(testglobal, 2); print "^";
print "Indirect references with unicode: ";
double_indirect-->2 = unicode_str;
val = tableustring(dindir2_str);
check_ustr("{2:a@{e0}@{3b1}@{30a9}:2}", val); print "^";
count_failures();
];
[ tablestring val len;
@setstringtbl encoding_table;
len = string_to_array(val, bigbuffer, BIGBUFSIZE);
val = HDR_DECODINGTBL-->0;
@setstringtbl val;
return len;
];
[ tableustring val len;
@setstringtbl encoding_table;
len = string_to_uniarray(val, bigubuffer, BIGBUFSIZE);
val = HDR_DECODINGTBL-->0;
@setstringtbl val;
return len;
];
[ argprint _vararg_count ix;
for (ix=0 : ix<_vararg_count : ix++) {
if (ix) @streamchar 32;
@streamnum sp;
}
];
[ argprintstr _vararg_count ix;
for (ix=0 : ix<_vararg_count : ix++) {
if (ix) @streamchar 32;
@streamstr sp;
}
];
[ nativeprint _vararg_count ix val;
val = HDR_DECODINGTBL-->0;
@setstringtbl val;
for (ix=0 : ix<_vararg_count : ix++) {
if (ix) @streamchar 32;
@streamstr sp;
}
@setstringtbl encoding_table;
];
[ numberprint;
@streamnum testglobal;
];
[ counterprint;
@streamchar '+';
@streamnum testglobal;
testglobal++;
];
[ byehello_func;
@streamstr bye_str;
@streamchar 32;
@streamstr hello_str;
];
Constant RAMSTRINGBUFLEN 16;
Array ramstringbuf -> RAMSTRINGBUFLEN;
TestClass RamStringsTest
with name 'ramstrings' 'ramstring',
testfunc [ val str ix;
print "String table decoding in RAM:^^";
str = "Decode test.";
val = string_to_array(str, bigbuffer, BIGBUFSIZE);
check_str(str, val); print "^";
str = "Another test.";
for (ix=0 : ix<RAMSTRINGBUFLEN : ix++)
ramstringbuf->ix = str->ix;
val = string_to_array(ramstringbuf, bigbuffer, BIGBUFSIZE);
check_str(str, val); print "^";
str = "Third test.";
for (ix=0 : ix<RAMSTRINGBUFLEN : ix++)
ramstringbuf->ix = str->ix;
val = string_to_array(ramstringbuf, bigbuffer, BIGBUFSIZE);
check_str(str, val); print "^";
str = "";
for (ix=0 : ix<RAMSTRINGBUFLEN : ix++)
ramstringbuf->ix = str->ix;
val = string_to_array(ramstringbuf, bigbuffer, BIGBUFSIZE);
check_str(str, val); print "^";
count_failures();
];
TestClass IOSysTest
with name 'iosys',
testfunc [ val;
print "I/O mode switching:^^";
@setiosys 0 0;
val = string_to_array("static null", bigbuffer, BIGBUFSIZE);
@setiosys 2 0;
check_str("", val); print ", ";
@setiosys 2 0;
val = string_to_array("static glk", bigbuffer, BIGBUFSIZE);
@setiosys 2 0;
check_str("static glk", val); print ", ";
@setiosys 1 prependequal;
val = string_to_array("static filter", bigbuffer, BIGBUFSIZE);
@setiosys 2 0;
check_str("=s=t=a=t=i=c= =f=i=l=t=e=r", val); print "^";
@setiosys 1 prependuequal;
val = string_to_uniarray(cunistring_str, bigubuffer, BIGBUFSIZE);
@setiosys 2 0;
check_ustr("=C= =@{DC}=n=@{EF}=c=o=@{3B4}=e= =@{201C}=@{30A9}=@{201D}", val); print "^";
testglobal=0; testglobal2=0;
@setiosys testglobal testglobal2;
val = string_to_array(iosys_tester, bigbuffer, BIGBUFSIZE);
@setiosys 2 0;
check_str("", val); print ", ";
print "guard="; check(testglobal, 99); print "^";
@setiosys 0 0;
testglobal=2; testglobal2=0;
@setiosys testglobal testglobal2;
val = string_to_array(iosys_tester, bigbuffer, BIGBUFSIZE);
@setiosys 2 0;
check_str("string, chr 0, -100 -2", val); print ", ";
print "guard="; check(testglobal, 99); print "^";
testglobal=1; testglobal2=surroundbracket;
@setiosys testglobal testglobal2;
val = string_to_array(iosys_tester, bigbuffer, BIGBUFSIZE);
@setiosys 2 0;
check_str("<s><t><r><i><n><g><,>< ><c><h><r>< ><0><,>< ><-><1><0><0>< ><-><2>", val); print ", ";
print "guard="; check(testglobal, 99); print "^";
testglobal=1; testglobal2=surroundbracket;
@setiosys testglobal testglobal2;
val = string_to_uniarray(iosys_tester, bigubuffer, BIGBUFSIZE);
@setiosys 2 0;
check_ustr("<s><t><r><i><n><g><,>< ><c><h><r>< ><0><,>< ><-><1><0><0>< ><-><2>", val); print ", ";
print "guard="; check(testglobal, 99); print "^";
@getiosys testglobal testglobal2;
print "current="; check(testglobal, 2); print ", ";
check(testglobal2, 0); print "^";
@setiosys 1 appendequal;
@getiosys sp sp;
@setiosys 2 0;
@stkswap;
@copy sp val;
print "current="; check(val, 1); print ", ";
@copy sp val;
check(val, appendequal); print "^";
print "Changing in mid-string: ";
@setiosys 1 surroundonce;
val = string_to_array(printhash_func, bigbuffer, BIGBUFSIZE);
@getiosys testglobal testglobal2;
print "current="; check(testglobal, 2); print ", ";
check(testglobal2, 0); print ", ";
check_str("<#>.", val); print ", ";
@setiosys 1 surroundonce;
val = string_to_array("abcde", bigbuffer, BIGBUFSIZE);
@getiosys testglobal testglobal2;
print "current="; check(testglobal, 2); print ", ";
check(testglobal2, 0); print ", ";
check_str("<a>bcde", val); print ", ";
@setiosys 1 surroundonce;
val = string_to_array(print123_func, bigbuffer, BIGBUFSIZE);
@getiosys testglobal testglobal2;
print "current="; check(testglobal, 2); print ", ";
check(testglobal2, 0); print ", ";
check_str("<1>23", val); print "^";
count_failures();
];
TestClass IOSys2Test
with name 'iosys2',
testfunc [ val;
print "I/O mode with different store operands:^";
print "This tests for a bug in older Glulxe (version 0.4.5 and
earlier). Calling @@64getiosys with two different store
operands (e.g., a local variable and a global variable)
did the wrong thing in those releases.
Because the bug has been around for so long,
the spec recommends not doing what this test does.^^";
val = -1;
testglobal = -1;
@getiosys testglobal val;
print "current="; check(testglobal, 2); print ", ";
check(val, 0); print "^";
count_failures();
];
Array ccomma_str -> $E0 ',' ' ' 0;
[ iosys_tester loc;
print "string";
@streamstr ccomma_str;
@streamchar 'c'; @streamchar 'h'; @streamchar 'r'; @streamchar ' ';
@streamnum 0;
@streamunichar ',';
@streamunichar ' ';
@streamnum (-100);
loc = ' ';
@streamchar loc;
loc = 2;
loc = 0-loc;
@streamnum loc;
testglobal = 99;
];
[ printhash_func;
@streamchar '#';
@streamchar '.';
];
[ print123_func;
@streamnum 123;
];
TestClass FilterTest
with name 'filter' 'filterio',
testfunc [ val;
print "Filter iosys mode:^^";
patch_encoding_table();
print "Basic strings: ";
val = tablefilterstring(hello_str);
check_str("=h=e=l=l=o", val); print ", ";
val = tablefilterrstring(bye_str);
check_str("b=y=e=", val); print ", ";
val = tablefilterstring(mix_str);
check_str("=T=h=i=s= =c=o=n=t=a=i=n=s= =s=e=v=e=r=a=l= =n=o=d=e= =t=y=p=e=s=.=^", val); print ", ";
val = tablefilterstring(cunistring_str);
check_str("=C= =@{DC}=n=@{EF}=c=o=@{B4}=e= =@{1C}=@{A9}=@{1D}", val); print "^";
print "References: ";
val = tablefilterstring(indirhello_str);
check_str("=[=h=e=l=l=o=]", val); print ", ";
val = tablefilterstring(indirargprint_12_str);
check_str("=[=1= =2=]", val); print ", ";
val = tablefilterstring(indirnativeprint_foobar_str);
check_str("=[=f=o=o= =b=a=r=]", val); print "^";
print "Multiple references: ";
double_indirect-->0 = hello_str;
double_indirect-->1 = bye_str;
double_indirect-->2 = cstring_str;
val = tablefilterstring(dindir012_str);
check_str("={=h=e=l=l=o=.=.=.=b=y=e=.=.=.=C= =s=t=r=i=n=g=.=}", val); print ", ";
double_indirect-->0 = bracketfilter;
double_indirect-->1 = indirhello_str;
double_indirect-->2 = indirargprint_12_str;
val = tablefilterstring(dindir012_str);
check_str("={<.><.><.><[><h><e><l><l><o><]><.><.><.><[><1>< ><2><]><}>", val); print ", ";
testglobal = 0;
double_indirect-->0 = dindir1_str;
double_indirect-->1 = counterprint;
double_indirect-->2 = byehello_func;
val = tablefilterstring(dindir012_str);
check_str("={={=1=:=+=0=:=1=}=.=.=.=+=1=.=.=.=b=y=e= =h=e=l=l=o=}", val); print ", ";
print "counter="; check(testglobal, 2); print ", ";
testglobal = 0;
double_indirect-->0 = cstring_str;
double_indirect-->1 = counterprint;
double_indirect-->2 = cunistring_str;
val = tablefilterstring(dindir012_str);
check_str("={=C= =s=t=r=i=n=g=.=.=.=.=+=0=.=.=.=C= =@{DC}=n=@{EF}=c=o=@{B4}=e= =@{1C}=@{A9}=@{1D}=}", val); print ", ";
print "counter="; check(testglobal, 1); print "^";
count_failures();
];
[ tablefilterstring val len;
@setstringtbl encoding_table;
@setiosys 1 prependequal;
len = string_to_array(val, bigbuffer, BIGBUFSIZE);
val = HDR_DECODINGTBL-->0;
@setiosys 2 0;
@setstringtbl val;
return len;
];
[ tablefilterrstring val len;
@setiosys 1 appendequal;
@setstringtbl encoding_table;
len = string_to_array(val, bigbuffer, BIGBUFSIZE);
val = HDR_DECODINGTBL-->0;
@setstringtbl val;
@setiosys 2 0;
return len;
];
[ bracketfilter;
@setiosys 1 surroundbracket;
];
[ prependequal ch;
glk($0080, '='); ! put_char
glk($0080, ch); ! put_char
];
[ prependuequal ch;
glk($0080, '='); ! put_char
glk($0128, ch); ! put_char_uni
];
[ appendequal ch;
glk($0080, ch); ! put_char
glk($0080, '='); ! put_char
];
[ surroundbracket ch;
glk($0080, '<'); ! put_char
glk($0080, ch); ! put_char
glk($0080, '>'); ! put_char
];
[ surroundonce ch;
@setiosys 2 0;
@streamchar '<';
@streamchar ch;
@streamchar '>';
];
TestClass NullIOTest
with name 'nullio',
testfunc [ val;
print "Null iosys mode:^^";
patch_encoding_table();
print "Basic strings: ";
val = tablenullstring(hello_str);
check_str("", val); print ", ";
val = tablenullrstring(bye_str);
check_str("", val); print ", ";
val = tablenullstring(mix_str);
check_str("", val); print ", ";
val = tablenullstring(cunistring_str);
check_str("", val); print "^";
print "References: ";
val = tablenullstring(indirhello_str);
check_str("", val); print ", ";
val = tablenullstring(indirargprint_12_str);
check_str("", val); print ", ";
val = tablenullstring(indirnativeprint_foobar_str);
check_str("", val); print "^";
print "Multiple references: ";
double_indirect-->0 = hello_str;
double_indirect-->1 = bye_str;
double_indirect-->2 = cstring_str;
val = tablenullstring(dindir012_str);
check_str("", val); print ", ";
double_indirect-->0 = indirhello_str;
double_indirect-->1 = bracketfilter;
double_indirect-->2 = indirargprint_12_str;
val = tablenullstring(dindir012_str);
check_str("<.><.><.><[><1>< ><2><]><}>", val); print ", ";
testglobal = 0;
double_indirect-->0 = dindir1_str;
double_indirect-->1 = counterprint;
double_indirect-->2 = byehello_func;
val = tablenullstring(dindir012_str);
check_str("", val); print ", ";
print "counter="; check(testglobal, 2); print ", ";
testglobal = 0;
double_indirect-->0 = cunistring_str;
double_indirect-->1 = counterprint;
double_indirect-->2 = cstring_str;
val = tablenullstring(dindir012_str);
check_str("", val); print ", ";
print "counter="; check(testglobal, 1); print "^";
count_failures();
];
[ tablenullstring val len;
@setstringtbl encoding_table;
@setiosys 0 0;
len = string_to_array(val, bigbuffer, BIGBUFSIZE);
val = HDR_DECODINGTBL-->0;
@setiosys 2 0;
@setstringtbl val;
return len;
];
[ tablenullrstring val len;
@setiosys 0 0;
@setstringtbl encoding_table;
len = string_to_array(val, bigbuffer, BIGBUFSIZE);
val = HDR_DECODINGTBL-->0;
@setstringtbl val;
@setiosys 2 0;
return len;
];
TestClass GlkTest
with name 'glk',
testfunc [ val addr strlen;
print "Glk opcode:^^";
@copy 'A' sp;
@glk $A0 1 val;
print "lowercase 'A'="; check(val, 'a'); print ", ";
testglobal = 'B';
@copy testglobal sp;
@glk $A0 1 val;
print "lowercase 'B'="; check(val, 'b'); print ", ";
testglobal = 'C';
@copy testglobal sp;
val = noop();
@glk $A0 1 val;
print "lowercase 'C'="; check(val, 'c'); print "^";
@copy 'A' sp;
@glk $A0 1 sp;
@copy sp val;
print "lowercase 'A'="; check(val, 'a'); print ", ";
testglobal = 'B';
@copy testglobal sp;
@glk $A0 1 sp;
@copy sp val;
print "lowercase 'B'="; check(val, 'b'); print ", ";
testglobal = 'C';
@copy testglobal sp;
val = noop();
@glk $A0 1 sp;
@copy sp val;
print "lowercase 'C'="; check(val, 'c'); print "^";
@copy 'D' sp;
testglobal = 1;
@glk $A0 testglobal val;
print "lowercase 'D'="; check(val, 'd'); print ", ";
@copy 'E' sp;
@copy 1 sp;
@glk $A0 sp val;
print "lowercase 'E'="; check(val, 'e'); print ", ";
@copy 'F' sp;
@copy 1 sp;
val = noop();
@glk $A0 sp val;
print "lowercase 'F'="; check(val, 'f'); print "^";
@copy 'D' sp;
testglobal2 = $A0;
testglobal = 1;
@glk testglobal2 testglobal val;
print "lowercase 'D'="; check(val, 'd'); print ", ";
@copy 'E' sp;
@copy 1 sp;
@copy $A0 sp;
@glk sp sp val;
print "lowercase 'E'="; check(val, 'e'); print ", ";
@copy 'F' sp;
@copy 1 sp;
@copy $A0 sp;
val = noop();
@glk sp sp val;
print "lowercase 'F'="; check(val, 'f'); print "^";
@copy 999 sp;
@copy 'G' sp;
testglobal2 = $A0;
testglobal = 1;
@glk testglobal2 testglobal sp;
@copy sp val;
print "lowercase 'G'="; check(val, 'g'); print ", ";
@copy 'H' sp;
@copy 1 sp;
@copy $A0 sp;
@glk sp sp sp;
@copy sp val;
print "lowercase 'H'="; check(val, 'h'); print ", ";
@copy 'I' sp;
@copy 1 sp;
@copy $A0 sp;
val = noop();
@glk sp sp sp;
@copy sp val;
print "lowercase 'I'="; check(val, 'i'); print "^";
@copy sp val;
print "guard="; check(val, 999); print "^";
addr = #globals_array + (4 * #g$testglobal);
testglobal = 0;
@copy addr sp;
@copy 0 sp;
@glk $20 2 val;
print "window="; check(val, gg_mainwin); print ", rock="; check(testglobal, GG_MAINWIN_ROCK); print "^";
testglobal = 0;
@copy addr sp;
@copy 0 sp;
@copy 2 sp;
@copy $20 sp;
@glk sp sp val;
print "window="; check(val, gg_mainwin); print ", rock="; check(testglobal, GG_MAINWIN_ROCK); print "^";
testglobal = 0;
@copy addr sp;
@copy 0 sp;
@copy 2 sp;
@copy $20 sp;
noop();
@glk sp sp val;
print "window="; check(val, gg_mainwin); print ", rock="; check(testglobal, GG_MAINWIN_ROCK); print "^";
testglobal = 0;
@copy (-1) sp;
@copy 0 sp;
@glk $20 2 sp;
@copy sp val;
@copy sp testglobal;
print "window="; check(val, gg_mainwin); print ", rock="; check(testglobal, GG_MAINWIN_ROCK); print "^";
gg_arguments-->0 = 1; gg_arguments-->1 = 2; gg_arguments-->2 = 3; gg_arguments-->3 = 4;
@copy gg_arguments sp;
@glk $C1 1 val;
print "select_poll="; check(val, 0); print ", result="; check(gg_arguments-->0, 0); check(gg_arguments-->1, 0); check(gg_arguments-->2, 0); check(gg_arguments-->3, 0); print "^";
@copy 999 sp;
@copy (-1) sp;
@glk $C1 1 val;
print "select_poll="; check(val, 0); print ", result=";
@copy sp val; check(val, 0); @copy sp val; check(val, 0); @copy sp val; check(val, 0); @copy sp val; check(val, 0); print "^";
@copy sp val;
print "guard="; check(val, 999); print "^";
strlen = string_to_uniarray("UP-case @{C3}@{E4}@{394}@{3B5}@{414}.", bigubuffer, BIGBUFSIZE);
@copy strlen sp;
@copy BIGBUFSIZE sp;
@copy bigubuffer sp;
@glk $120 3 val;
print "len="; check(val, strlen); print " ";
check_ustr("up-case @{E3}@{E4}@{3B4}@{3B5}@{434}.", val);
count_failures();
];
TestClass GiDispaTest
with name 'gidispa' 'dispa',
testfunc [ val;
print "Glk dispatch layer:^^";
val = string_to_uniarray(gidispa_testfunc, bigubuffer, BIGBUFSIZE);
check_ustr("XYZ@{42F} C string. C @{DC}n@{EF}co@{3B4}e @{201C}@{30A9}@{201D} 123 @{2155}@{2156}@{2157}.", val); print "^";
print "length: "; check(val, 37); print "^";
count_failures();
];
Array gidispa_bytebuf -> '1' '2' '3' '4';
Array gidispa_wordbuf --> $2155 $2156 $2157 $2158;
[ gidispa_testfunc;
glk($0080, 'X'); ! put_char
glk($0080, 'Y'+$FE00); ! put_char
glk($0128, 'Z'); ! put_char_uni
glk($0128, $042F); ! put_char_uni
print " ";
glk($0082, cstring_str); ! put_string
print " ";
glk($0129, cunistring_str); ! put_string_uni
print " ";
glk($0084, gidispa_bytebuf, 3); ! put_buffer
print " ";
glk($012A, gidispa_wordbuf, 3); ! put_buffer
@streamchar '.';
];
Array histogram --> 16;
TestClass RandomTest
with name 'random',
testfunc [ val ix hibit lobit;
print "Random-number generator:^";
print "NOTE: Tests may, very occasionally, fail through sheer bad
luck. If so, try this test again.^^";
@setrandom 0;
for (ix=0 : ix<4 : ix++) {
histogram-->ix = 0;
}
for (ix=0 : ix<240 : ix++) {
@random 4 val;
(histogram-->val)++;
}
print "Random 4: ";
for (ix=0 : ix<4 : ix++) {
print ix, "="; check_range(histogram-->ix, 30, 90); print ", ";
}
print "^";
for (ix=0 : ix<5 : ix++) {
histogram-->ix = 0;
}
for (ix=0 : ix<240 : ix++) {
@random (-5) val;
val = -val;
(histogram-->val)++;
}
print "Random -5: ";
for (ix=0 : ix<5 : ix++) {
print ix, "="; check_range(histogram-->ix, 24, 72); print ", ";
}
print "^";
for (ix=0 : ix<4 : ix++) {
histogram-->ix = 0;
}
hibit = 0;
lobit = 0;
for (ix=0 : ix<240 : ix++) {
@random 0 val;
if (val < 0)
hibit++;
else
lobit++;
val = val & 3;
(histogram-->val)++;
}
print "Random 0: ";
for (ix=0 : ix<4 : ix++) {
print ix, "="; check_range(histogram-->ix, 30, 90); print ", ";
}
print "lobit="; check_range(lobit, 100, 140); print ", ";
print "hibit="; check_range(hibit, 100, 140); print ", ";
print "^";
testglobal = 4;
for (ix=0 : ix<4 : ix++) {
histogram-->ix = 0;
}
for (ix=0 : ix<240 : ix++) {
@random testglobal val;
(histogram-->val)++;
}
print "Random 4 global: ";
for (ix=0 : ix<4 : ix++) {
print ix, "="; check_range(histogram-->ix, 30, 90); print ", ";
}
print "^";
testglobal = -5;
for (ix=0 : ix<5 : ix++) {
histogram-->ix = 0;
}
for (ix=0 : ix<240 : ix++) {
@random testglobal val;
val = -val;
(histogram-->val)++;
}
print "Random -5 global: ";
for (ix=0 : ix<5 : ix++) {
print ix, "="; check_range(histogram-->ix, 24, 72); print ", ";
}
print "^";
testglobal = 0;
for (ix=0 : ix<4 : ix++) {
histogram-->ix = 0;
}
hibit = 0;
lobit = 0;
for (ix=0 : ix<240 : ix++) {
@random testglobal val;
if (val < 0)
hibit++;
else
lobit++;
val = val & 3;
(histogram-->val)++;
}
print "Random 0 global: ";
for (ix=0 : ix<4 : ix++) {
print ix, "="; check_range(histogram-->ix, 30, 90); print ", ";
}
print "lobit="; check_range(lobit, 100, 140); print ", ";
print "hibit="; check_range(hibit, 100, 140); print ", ";
print "^";
hibit = 0;
lobit = $FFFFFFFF;
for (ix=0 : ix<24 : ix++) {
@random 0 val;
hibit = hibit | val;
lobit = lobit & val;
}
print "Accumulated bits: hi="; check(hibit, $FFFFFFFF); print ", ";
print "lo="; check(lobit, 0); print ", ";
print "^";
count_failures();
];
TestClass DRandomTest
with name 'nonrandom' 'detrandom' 'deterministic',
testfunc [ val ix orig0;
print "Random numbers in deterministic mode:^^";
@setrandom 1;
for (ix=0 : ix<16 : ix++) {
@random 0 val;
histogram-->ix = val;
}
orig0 = histogram-->0;
@setrandom 1;
print "setrandom 1: ";
for (ix=0 : ix<16 : ix++) {
@random 0 val;
check(val, histogram-->ix); print ", ";
}
print "^";
@setrandom 100;
for (ix=0 : ix<16 : ix++) {
@random 0 val;
histogram-->ix = val;
}
@setrandom 100;
print "setrandom 100: ";
for (ix=0 : ix<16 : ix++) {
@random 0 val;
check(val, histogram-->ix); print ", ";
}
print "^";
val = (orig0 ~= histogram-->0);
print "Sequences different: "; check(val, 1); print "^";
count_failures();
];
Array search_a -> $1 $3 $5 $7 $9 $2 $4 $6 $8 $A $80 $90 $A0 $A1 $30 $31
$20 $0 $0 $0 $31 $0 $0 $1 $FF $FE $FD $FC $0 $0 $1 $2;
Array search_b -> $1 $3 $5 $7 $9 $B $D $F $20 $21 $28 $2D $2E $2F $30 $31
$40 $42 $44 $46 $50 $53 $57 $59 $E0 $E1 $E2 $E3 $FC $FD $FE $FF;
Array search_c --> $01030507 0 $080A8090 0 $20000000 0 $FFFEFDFC 0
$31020406 0 $A0A13031 0 $31000001 0 $00000102 0;
TestClass SearchTest
with name 'search',
testfunc [ val ix;
print "Search opcodes:^^";
if (search_c-->1 == 0) {
search_c-->1 = search_c + 4*14;
search_c-->15 = search_c + 4*2;
search_c-->3 = search_c + 4*12;
search_c-->13 = search_c + 4*4;
search_c-->5 = search_c + 4*10;
search_c-->11 = search_c + 4*6;
search_c-->7 = search_c + 4*8;
}
print "Linear:^";
@linearsearch $A1 1 search_a 1 32 0 0 val;
print "got "; check(val, search_a+13); print ", ";
@linearsearch $A1 1 search_a 1 32 0 4 val;
print "got "; check(val, 13); print ", ";
@linearsearch $A1 1 search_a 1 8 0 0 val;
print "got "; check(val, 0); print ", ";
@linearsearch $A1 1 search_a 1 8 0 4 val;
print "got "; check(val, -1); print "^";
@linearsearch $FFA1 1 search_a 1 32 0 0 val;
print "got "; check(val, search_a+13); print ", ";
@linearsearch $FF8097A1 1 search_a 1 32 0 4 val;
print "got "; check(val, 13); print "^";
@push 999;
@push 0; @push 0; @push 32; @push 1; @push search_a; @push 1; @push $31;
@linearsearch sp sp sp sp sp sp sp val;
print "got "; check(val, search_a+15); print ", ";
@push 4; @push 0; @push 32; @push 1; @push search_a; @push 1; @push $31;
@linearsearch sp sp sp sp sp sp sp sp;
@copy sp val;
print "got "; check(val, 15); print ", ";
@copy sp val;
print "guard="; check(val, 999); print "^";
destarray->0 = $A1;
@linearsearch destarray 1 search_a 1 32 0 1 val;
print "got "; check(val, search_a+13); print ", ";
@linearsearch destarray 1 search_a 1 32 0 5 val;
print "got "; check(val, 13); print ", ";
@linearsearch destarray 1 search_a 1 8 0 1 val;
print "got "; check(val, 0); print ", ";
@linearsearch destarray 1 search_a 1 8 0 5 val;
print "got "; check(val, -1); print "^";
@linearsearch $FC 1 search_a 1 32 0 2 val;
print "got "; check(val, 0); print ", ";
@linearsearch $FC 1 search_a 1 32 0 6 val;
print "got "; check(val, -1); print ", ";
@linearsearch $00 1 search_a 1 32 0 2 val;
print "got "; check(val, search_a+17); print ", ";
@linearsearch $00 1 search_a 1 32 0 6 val;
print "got "; check(val, 17); print "^";
@linearsearch $FC 1 search_a 1 (-1) 0 2 val;
print "got "; check(val, 0); print ", ";
@linearsearch $FC 1 search_a 1 (-1) 0 6 val;
print "got "; check(val, -1); print ", ";
@linearsearch $80 1 search_a 1 (-1) 0 2 val;
print "got "; check(val, search_a+10); print ", ";
@linearsearch $80 1 search_a 1 (-1) 0 6 val;
print "got "; check(val, 10); print "^";
@linearsearch $A0A1 2 search_a 2 16 0 0 val;
print "got "; check(val, search_a+12); print ", ";
@linearsearch $A0A1 2 search_a 2 16 0 4 val;
print "got "; check(val, 6); print ", ";
@linearsearch $FFFFA0A1 2 search_a 2 16 0 4 val;
print "got "; check(val, 6); print ", ";
@linearsearch $A0A2 2 search_a 2 16 0 4 val;
print "got "; check(val, -1); print ", ";
@linearsearch $A130 2 search_a 4 8 1 0 val;
print "got "; check(val, search_a+12); print ", ";
@linearsearch $FEFDA130 2 search_a 4 8 1 4 val;
print "got "; check(val, 3); print "^";
destarray->0 = $A0;
destarray->1 = $A1;
@linearsearch destarray 2 search_a 2 16 0 1 val;
print "got "; check(val, search_a+12); print ", ";
@linearsearch destarray 2 search_a 2 16 0 5 val;
print "got "; check(val, 6); print ", ";
destarray->0 = $A1;
destarray->1 = $30;
@linearsearch destarray 2 search_a 4 8 1 1 val;
print "got "; check(val, search_a+12); print ", ";
@linearsearch destarray 2 search_a 4 8 1 5 val;
print "got "; check(val, 3); print "^";
@linearsearch $FEFD 2 search_a 4 8 1 0 val;
print "got "; check(val, search_a+24); print ", ";
@linearsearch $FEFD 2 search_a 4 8 1 4 val;
print "got "; check(val, 6); print ", ";
@linearsearch $FEFD 2 search_a 4 8 1 2 val;
print "got "; check(val, 0); print ", ";
@linearsearch $FEFD 2 search_a 4 8 1 6 val;
print "got "; check(val, -1); print "^";
@linearsearch $09020406 4 search_a 4 8 0 0 val;
print "got "; check(val, search_a+4); print ", ";
@linearsearch $09020406 4 search_a 4 8 0 4 val;
print "got "; check(val, 1); print ", ";
@linearsearch $09020409 4 search_a 4 8 0 0 val;
print "got "; check(val, 0); print ", ";
@linearsearch $09020409 4 search_a 4 8 0 4 val;
print "got "; check(val, -1); print "^";
histogram-->0 = $080A8090;
@linearsearch histogram 4 search_a 4 8 0 1 val;
print "got "; check(val, search_a+8); print ", ";
@linearsearch histogram 4 search_a 4 8 0 5 val;
print "got "; check(val, 2); print ", ";
histogram-->0 = $080A8000;
@linearsearch histogram 4 search_a 4 8 0 1 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $000A8090;
@linearsearch histogram 4 search_a 4 8 0 5 val;
print "got "; check(val, -1); print "^";
@linearsearch $FDFC0000 4 search_a 5 6 1 0 val;
print "got "; check(val, search_a+25); print ", ";
@linearsearch $FDFC0000 4 search_a 5 6 1 4 val;
print "got "; check(val, 5); print ", ";
histogram-->0 = $FDFC0000;
@linearsearch histogram 4 search_a 5 6 1 1 val;
print "got "; check(val, search_a+25); print ", ";
@linearsearch histogram 4 search_a 5 6 1 5 val;
print "got "; check(val, 5); print "^";
histogram-->0 = $FEFDFC00;
histogram-->1 = $00019999;
@linearsearch histogram 6 search_a 8 4 1 1 val;
print "got "; check(val, search_a+24); print ", ";
@linearsearch histogram 6 search_a 8 4 1 5 val;
print "got "; check(val, 3); print ", ";
@linearsearch histogram 8 search_a 8 4 1 1 val;
print "got "; check(val, 0); print ", ";
@linearsearch histogram 8 search_a 8 4 1 5 val;
print "got "; check(val, -1); print ", ";
histogram-->0 = $FEFDFC00;
histogram-->1 = $00020000;
@linearsearch histogram 6 search_a 8 4 1 1 val;
print "got "; check(val, 0); print ", ";
@linearsearch histogram 6 search_a 8 4 1 5 val;
print "got "; check(val, -1); print ", ";
histogram-->0 = $0EFDFC00;
histogram-->1 = $00010000;
@linearsearch histogram 6 search_a 8 4 1 1 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $FEFDFC01;
histogram-->1 = $00010000;
@linearsearch histogram 6 search_a 8 4 1 5 val;
print "got "; check(val, -1); print "^";
histogram-->0 = $01030507;
histogram-->1 = $09020406;
@linearsearch histogram 8 search_a 16 2 0 1 val;
print "got "; check(val, search_a+0); print ", ";
@linearsearch histogram 8 search_a 16 2 0 5 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $080A8090;
histogram-->1 = $A0A13031;
@linearsearch histogram 8 search_a 16 2 0 1 val;
print "got "; check(val, 0); print ", ";
@linearsearch histogram 8 search_a 16 2 0 5 val;
print "got "; check(val, -1); print ", ";
@linearsearch histogram 8 search_a 16 2 8 1 val;
print "got "; check(val, search_a+0); print ", ";
@linearsearch histogram 8 search_a 16 2 8 5 val;
print "got "; check(val, 0); print "^";
print "Binary:^";
@binarysearch $2F 1 search_b 1 32 0 0 val;
print "got "; check(val, search_b+13); print ", ";
@binarysearch $2F 1 search_b 1 32 0 4 val;
print "got "; check(val, 13); print ", ";
@binarysearch $2F 1 search_b 1 8 0 0 val;
print "got "; check(val, 0); print ", ";
@binarysearch $2F 1 search_b 1 8 0 4 val;
print "got "; check(val, -1); print "^";
@binarysearch $FF2F 1 search_b 1 32 0 0 val;
print "got "; check(val, search_b+13); print ", ";
@binarysearch $FF80972F 1 search_b 1 32 0 4 val;
print "got "; check(val, 13); print "^";
@push 999;
@push 0; @push 0; @push 32; @push 1; @push search_b; @push 1; @push $31;
@binarysearch sp sp sp sp sp sp sp val;
print "got "; check(val, search_b+15); print ", ";
@push 4; @push 0; @push 32; @push 1; @push search_b; @push 1; @push $31;
@binarysearch sp sp sp sp sp sp sp sp;
@copy sp val;
print "got "; check(val, 15); print ", ";
@copy sp val;
print "guard="; check(val, 999); print "^";
print "got ";
for (ix=0 : ix<32 : ix++) {
val = search_b->ix;
@binarysearch val 1 search_b 1 32 0 0 val;
check(val, search_b+ix); print ", ";
}
print "^";
print "got ";
for (ix=0 : ix<31 : ix++) {
val = search_b->ix;
@binarysearch val 1 search_b 1 31 0 0 val;
check(val, search_b+ix); print ", ";
}
print "^";
destarray->0 = $2F;
@binarysearch destarray 1 search_b 1 32 0 1 val;
print "got "; check(val, search_b+13); print ", ";
@binarysearch destarray 1 search_b 1 32 0 5 val;
print "got "; check(val, 13); print ", ";
@binarysearch destarray 1 search_b 1 8 0 1 val;
print "got "; check(val, 0); print ", ";
@binarysearch destarray 1 search_b 1 8 0 5 val;
print "got "; check(val, -1); print "^";
@binarysearch $2E2F 2 search_b 2 16 0 0 val;
print "got "; check(val, search_b+12); print ", ";
@binarysearch $2E2F 2 search_b 2 16 0 4 val;
print "got "; check(val, 6); print ", ";
@binarysearch $FFFF2E2F 2 search_b 2 16 0 4 val;
print "got "; check(val, 6); print ", ";
@binarysearch $2E2E 2 search_b 2 16 0 4 val;
print "got "; check(val, -1); print ", ";
@binarysearch $2F30 2 search_b 4 8 1 0 val;
print "got "; check(val, search_b+12); print ", ";
@binarysearch $FEFD2F30 2 search_b 4 8 1 4 val;
print "got "; check(val, 3); print "^";
destarray->0 = $2E;
destarray->1 = $2F;
@binarysearch destarray 2 search_b 2 16 0 1 val;
print "got "; check(val, search_b+12); print ", ";
@binarysearch destarray 2 search_b 2 16 0 5 val;
print "got "; check(val, 6); print ", ";
destarray->0 = $2F;
destarray->1 = $30;
@binarysearch destarray 2 search_b 4 8 1 1 val;
print "got "; check(val, search_b+12); print ", ";
@binarysearch destarray 2 search_b 4 8 1 5 val;
print "got "; check(val, 3); print "^";
@binarysearch $E1E2 2 search_b 4 8 1 0 val;
print "got "; check(val, search_b+24); print ", ";
@binarysearch $E1E2 2 search_b 4 8 1 4 val;
print "got "; check(val, 6); print "^";
@binarysearch $090B0D0F 4 search_b 4 8 0 0 val;
print "got "; check(val, search_b+4); print ", ";
@binarysearch $090B0D0F 4 search_b 4 8 0 4 val;
print "got "; check(val, 1); print ", ";
@binarysearch $090B0D0E 4 search_b 4 8 0 0 val;
print "got "; check(val, 0); print ", ";
@binarysearch $090B0D0E 4 search_b 4 8 0 4 val;
print "got "; check(val, -1); print "^";
histogram-->0 = $2021282D;
@binarysearch histogram 4 search_b 4 8 0 1 val;
print "got "; check(val, search_b+8); print ", ";
@binarysearch histogram 4 search_b 4 8 0 5 val;
print "got "; check(val, 2); print ", ";
histogram-->0 = $20212800;
@binarysearch histogram 4 search_b 4 8 0 1 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $0021282D;
@binarysearch histogram 4 search_b 4 8 0 5 val;
print "got "; check(val, -1); print "^";
@binarysearch $E2E3FCFD 4 search_b 5 6 1 0 val;
print "got "; check(val, search_b+25); print ", ";
@binarysearch $E2E3FCFD 4 search_b 5 6 1 4 val;
print "got "; check(val, 5); print ", ";
histogram-->0 = $E2E3FCFD;
@binarysearch histogram 4 search_b 5 6 1 1 val;
print "got "; check(val, search_b+25); print ", ";
@binarysearch histogram 4 search_b 5 6 1 5 val;
print "got "; check(val, 5); print "^";
histogram-->0 = $E1E2E3FC;
histogram-->1 = $FDFE9999;
@binarysearch histogram 6 search_b 8 4 1 1 val;
print "got "; check(val, search_b+24); print ", ";
@binarysearch histogram 6 search_b 8 4 1 5 val;
print "got "; check(val, 3); print ", ";
@binarysearch histogram 8 search_b 8 4 1 1 val;
print "got "; check(val, 0); print ", ";
@binarysearch histogram 8 search_b 8 4 1 5 val;
print "got "; check(val, -1); print ", ";
histogram-->0 = $E1E2E3FC;
histogram-->1 = $FDFD0000;
@binarysearch histogram 6 search_b 8 4 1 1 val;
print "got "; check(val, 0); print ", ";
@binarysearch histogram 6 search_b 8 4 1 5 val;
print "got "; check(val, -1); print ", ";
histogram-->0 = $01E2E3FC;
histogram-->1 = $FDFE0000;
@binarysearch histogram 6 search_b 8 4 1 1 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $FEFDFC01;
histogram-->1 = $FDFE0000;
@binarysearch histogram 6 search_b 8 4 1 5 val;
print "got "; check(val, -1); print "^";
histogram-->0 = $01030507;
histogram-->1 = $090B0D0F;
@binarysearch histogram 8 search_b 16 2 0 1 val;
print "got "; check(val, search_b+0); print ", ";
@binarysearch histogram 8 search_b 16 2 0 5 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $2021282D;
histogram-->1 = $2E2F3031;
@binarysearch histogram 8 search_b 16 2 0 1 val;
print "got "; check(val, 0); print ", ";
@binarysearch histogram 8 search_b 16 2 0 5 val;
print "got "; check(val, -1); print ", ";
@binarysearch histogram 8 search_b 16 2 8 1 val;
print "got "; check(val, search_b+0); print ", ";
@binarysearch histogram 8 search_b 16 2 8 5 val;
print "got "; check(val, 0); print "^";
print "Linked:^";
@linkedsearch $01 1 search_c 0 4 0 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $FFFFFFFF01 1 search_c 0 4 0 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $31 1 search_c 0 4 0 val;
print "got "; check(val, search_c+6*8); print ", ";
@linkedsearch $00 1 search_c 0 4 0 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $08 1 search_c 0 4 0 val;
print "got "; check(val, search_c+1*8); print ", ";
@linkedsearch $A1 1 search_c 0 4 0 val;
print "got "; check(val, 0); print "^";
@linkedsearch $01 1 search_c 0 4 2 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $31 1 search_c 0 4 2 val;
print "got "; check(val, 0); print ", ";
@linkedsearch $00 1 search_c 0 4 2 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $08 1 search_c 0 4 2 val;
print "got "; check(val, 0); print ", ";
@linkedsearch $A1 1 search_c 0 4 2 val;
print "got "; check(val, 0); print "^";
@linkedsearch $0103 2 search_c 0 4 0 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $FFFF0103 2 search_c 0 4 0 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $3100 2 search_c 0 4 0 val;
print "got "; check(val, search_c+6*8); print ", ";
@linkedsearch $0000 2 search_c 0 4 0 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $080A 2 search_c 0 4 0 val;
print "got "; check(val, search_c+1*8); print ", ";
@linkedsearch $A130 2 search_c 0 4 0 val;
print "got "; check(val, 0); print ", ";
@linkedsearch $0104 2 search_c 0 4 0 val;
print "got "; check(val, 0); print ", ";
@linkedsearch $0203 2 search_c 0 4 0 val;
print "got "; check(val, 0); print "^";
@linkedsearch $0103 2 search_c 0 4 2 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $3100 2 search_c 0 4 2 val;
print "got "; check(val, 0); print ", ";
@linkedsearch $0000 2 search_c 0 4 2 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $080A 2 search_c 0 4 2 val;
print "got "; check(val, 0); print ", ";
@linkedsearch $A130 2 search_c 0 4 2 val;
print "got "; check(val, 0); print "^";
@linkedsearch $0305 2 search_c 1 4 0 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $0001 2 search_c 1 4 0 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $0000 2 search_c 1 4 0 val;
print "got "; check(val, search_c+6*8); print ", ";
@linkedsearch $FEFD 2 search_c 1 4 0 val;
print "got "; check(val, search_c+3*8); print ", ";
@linkedsearch $0103 2 search_c 1 4 0 val;
print "got "; check(val, 0); print "^";
@linkedsearch $0305 2 search_c 1 4 2 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $0001 2 search_c 1 4 2 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $0000 2 search_c 1 4 2 val;
print "got "; check(val, search_c+6*8); print ", ";
@linkedsearch $FEFD 2 search_c 1 4 2 val;
print "got "; check(val, 0); print ", ";
@linkedsearch $0103 2 search_c 1 4 2 val;
print "got "; check(val, 0); print "^";
@linkedsearch $01030507 4 search_c 0 4 0 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $31000001 4 search_c 0 4 0 val;
print "got "; check(val, search_c+6*8); print ", ";
@linkedsearch $00000102 4 search_c 0 4 0 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $080A8090 4 search_c 0 4 0 val;
print "got "; check(val, search_c+1*8); print ", ";
@linkedsearch $A0A23031 4 search_c 0 4 0 val;
print "got "; check(val, 0); print "^";
@linkedsearch $01030507 4 search_c 0 4 2 val;
print "got "; check(val, search_c+0); print ", ";
@linkedsearch $31000001 4 search_c 0 4 2 val;
print "got "; check(val, search_c+6*8); print ", ";
@linkedsearch $00000102 4 search_c 0 4 2 val;
print "got "; check(val, search_c+7*8); print ", ";
@linkedsearch $080A8090 4 search_c 0 4 2 val;
print "got "; check(val, search_c+1*8); print ", ";
@linkedsearch $A0A23031 4 search_c 0 4 2 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $01000000;
@linkedsearch histogram 1 search_c 0 4 1 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $01FFFFFF;
@linkedsearch histogram 1 search_c 0 4 1 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $31000000;
@linkedsearch histogram 1 search_c 0 4 1 val;
print "got "; check(val, search_c+6*8); print ", ";
histogram-->0 = $00000000;
@linkedsearch histogram 1 search_c 0 4 1 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $08000000;
@linkedsearch histogram 1 search_c 0 4 1 val;
print "got "; check(val, search_c+1*8); print ", ";
histogram-->0 = $A1000000;
@linkedsearch histogram 1 search_c 0 4 1 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $01000000;
@linkedsearch histogram 1 search_c 0 4 3 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $31000000;
@linkedsearch histogram 1 search_c 0 4 3 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $00000000;
@linkedsearch histogram 1 search_c 0 4 3 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $08000000;
@linkedsearch histogram 1 search_c 0 4 3 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $A1000000;
@linkedsearch histogram 1 search_c 0 4 3 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $01030000;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $0103FFFF;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $31000000;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, search_c+6*8); print ", ";
histogram-->0 = $00000000;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $080A0000;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, search_c+1*8); print ", ";
histogram-->0 = $A1300000;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $01040000;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $02030000;
@linkedsearch histogram 2 search_c 0 4 1 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $01030000;
@linkedsearch histogram 2 search_c 0 4 3 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $31000000;
@linkedsearch histogram 2 search_c 0 4 3 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $00000000;
@linkedsearch histogram 2 search_c 0 4 3 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $080A0000;
@linkedsearch histogram 2 search_c 0 4 3 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $A1300000;
@linkedsearch histogram 2 search_c 0 4 3 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $03050000;
@linkedsearch histogram 2 search_c 1 4 1 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $00010000;
@linkedsearch histogram 2 search_c 1 4 1 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $00000000;
@linkedsearch histogram 2 search_c 1 4 1 val;
print "got "; check(val, search_c+6*8); print ", ";
histogram-->0 = $FEFD0000;
@linkedsearch histogram 2 search_c 1 4 1 val;
print "got "; check(val, search_c+3*8); print ", ";
histogram-->0 = $01030000;
@linkedsearch histogram 2 search_c 1 4 1 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $03050000;
@linkedsearch histogram 2 search_c 1 4 3 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $00010000;
@linkedsearch histogram 2 search_c 1 4 3 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $00000000;
@linkedsearch histogram 2 search_c 1 4 3 val;
print "got "; check(val, search_c+6*8); print ", ";
histogram-->0 = $FEFD0000;
@linkedsearch histogram 2 search_c 1 4 3 val;
print "got "; check(val, 0); print ", ";
histogram-->0 = $01030000;
@linkedsearch histogram 2 search_c 1 4 3 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $01030507;
@linkedsearch histogram 4 search_c 0 4 1 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $31000001;
@linkedsearch histogram 4 search_c 0 4 1 val;
print "got "; check(val, search_c+6*8); print ", ";
histogram-->0 = $00000102;
@linkedsearch histogram 4 search_c 0 4 1 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $080A8090;
@linkedsearch histogram 4 search_c 0 4 1 val;
print "got "; check(val, search_c+1*8); print ", ";
histogram-->0 = $A0A23031;
@linkedsearch histogram 4 search_c 0 4 1 val;
print "got "; check(val, 0); print "^";
histogram-->0 = $01030507;
@linkedsearch histogram 4 search_c 0 4 3 val;
print "got "; check(val, search_c+0); print ", ";
histogram-->0 = $31000001;
@linkedsearch histogram 4 search_c 0 4 3 val;
print "got "; check(val, search_c+6*8); print ", ";
histogram-->0 = $00000102;
@linkedsearch histogram 4 search_c 0 4 3 val;
print "got "; check(val, search_c+7*8); print ", ";
histogram-->0 = $080A8090;
@linkedsearch histogram 4 search_c 0 4 3 val;
print "got "; check(val, search_c+1*8); print ", ";
histogram-->0 = $A0A23031;
@linkedsearch histogram 4 search_c 0 4 3 val;
print "got "; check(val, 0); print "^";
@push 999;
@push 0; @push 4; @push 0; @push search_c; @push 1; @push $31;
@linkedsearch sp sp sp sp sp sp val;
print "got "; check(val, search_c+6*8); print ", ";
@push 0; @push 4; @push 0; @push search_c; @push 1; @push $08;
@linkedsearch sp sp sp sp sp sp sp;
@copy sp val;
print "got "; check(val, search_c+1*8); print ", ";
@copy sp val;
print "guard="; check(val, 999); print "^";
count_failures();
];
[ fill_array_seq arr ix val;
for (ix=0 : ix<12 : ix++) {
val = ix+1;
@astoreb arr ix val;
}
];
[ fill_array_val arr val ix;
for (ix=0 : ix<12 : ix++) {
@astoreb arr ix val;
}
];
TestClass MemZeroTest
with name 'mzero' 'memzero',
testfunc [ addr val;
print "mzero opcode:^^";
@gestalt 6 0 val; ! MemCopy
if (~~val) {
print "This interpreter does not support @@64mzero.^";
count_failures();
return;
}
fill_array_seq(destarray);
addr = destarray+4;
@mzero 0 addr;
print "0, arr+4: ";
check_bytelist(destarray, 1,2,3,4,5,6,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
addr = destarray+4;
@mzero 1 addr;
print "1, arr+4: ";
check_bytelist(destarray, 1,2,3,4,0,6,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
testglobal = destarray;
@mzero 6 testglobal;
print "6, arr+0: ";
check_bytelist(destarray, 0,0,0,0,0,0,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
addr = destarray+2;
@copy addr sp;
@copy 3 sp;
@mzero sp sp;
print "3, arr+2: ";
check_bytelist(destarray, 1,2,0,0,0,6,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
addr = destarray+3;
@copy addr sp;
@copy 4 sp;
noop();
@mzero sp sp;
print "4, arr+3: ";
check_bytelist(destarray, 1,2,3,0,0,0,0,8,9,10,11,12); print "^";
count_failures();
];
TestClass MemCopyTest
with name 'mcopy' 'memcopy',
testfunc [ addr addr2 val;
print "mcopy opcode:^^";
@gestalt 6 0 val; ! MemCopy
if (~~val) {
print "This interpreter does not support @@64mcopy.^";
count_failures();
return;
}
fill_array_seq(destarray);
addr = destarray+4;
addr2 = destarray+6;
@mcopy 0 addr addr2;
print "0, arr+4, arr+6: ";
check_bytelist(destarray, 1,2,3,4,5,6,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
addr = destarray+8;
addr2 = destarray+6;
@mcopy 0 addr addr2;
print "0, arr+8, arr+6: ";
check_bytelist(destarray, 1,2,3,4,5,6,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
addr = destarray+4;
addr2 = destarray+4;
@mcopy 4 addr addr2;
print "4, arr+4, arr+4: ";
check_bytelist(destarray, 1,2,3,4,5,6,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
addr = destarray+4;
addr2 = destarray+6;
@mcopy 5 addr addr2;
print "5, arr+4, arr+6: ";
check_bytelist(destarray, 1,2,3,4,5,6,5,6,7,8,9,12); print "^";
fill_array_seq(destarray);
addr = destarray+6;
addr2 = destarray+4;
@mcopy 5 addr addr2;
print "5, arr+6, arr+4: ";
check_bytelist(destarray, 1,2,3,4,7,8,9,10,11,10,11,12); print "^";
fill_array_seq(destarray);
testglobal = destarray+1;
testglobal2 = destarray+8;
@mcopy 3 testglobal testglobal2;
print "3, arr+1, arr+8: ";
check_bytelist(destarray, 1,2,3,4,5,6,7,8,2,3,4,12); print "^";
fill_array_seq(destarray);
val = destarray+1;
@copy val sp;
val = destarray+8;
@copy val sp;
@copy 3 sp;
@mcopy sp sp sp;
print "3, arr+8, arr+1: ";
check_bytelist(destarray, 1,9,10,11,5,6,7,8,9,10,11,12); print "^";
fill_array_seq(destarray);
val = destarray+1;
@copy val sp;
val = destarray+8;
@copy val sp;
@copy 2 sp;
noop();
@mcopy sp sp sp;
print "2, arr+8, arr+1: ";
check_bytelist(destarray, 1,9,10,4,5,6,7,8,9,10,11,12); print "^";
count_failures();
];
TestClass UndoTest
with name 'undo',
testfunc [ val loc;
print "Undo:^^";
@gestalt 3 0 val; ! Undo
if (val)
print "Interpreter claims to support undo.^^";
else
print "Interpreter claims to not support undo. (Continuing test anyway...)^^";
@restoreundo val;
print "Restore without saveundo: "; check(val, 1); print "^";
testglobal = 0;
@restoreundo testglobal;
print "Restore without saveundo: "; check(testglobal, 1); print "^";
val = 0;
@restoreundo sp;
@copy sp val;
print "Restore without saveundo: "; check(val, 1); print "^";
loc = 99;
testglobal = 999;
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
loc = 77;
testglobal = 777;
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
print "loc="; check(loc, 99); print " glob="; check(testglobal, 999); print "^";
loc = 98;
testglobal = 998;
@saveundo testglobal2;
if (testglobal2 == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (testglobal2 == 0) {
print "Undo saved...^";
! The following changes will be undone.
loc = 77;
testglobal = 777;
failures++;
print "Restoring undo...^";
@restoreundo testglobal2;
if (testglobal2 == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", testglobal2, "^";
}
failures++;
count_failures();
return;
}
else if (testglobal2 ~= -1) {
print "Unknown @@64saveundo return value: ", testglobal2, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(testglobal2, -1); print ".^";
print "loc="; check(loc, 98); print " glob="; check(testglobal, 998); print "^";
loc = 97;
testglobal = 997;
val = undo_depth_check();
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
loc = 77;
testglobal = 777;
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
print "loc="; check(loc, 97); print " glob="; check(testglobal, 997); print "^";
loc = 98;
testglobal = 998;
testglobal2 = -99;
@saveundo sp;
@pull testglobal2;
if (testglobal2 == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (testglobal2 == 0) {
print "Undo saved...^";
! The following changes will be undone.
loc = 77;
testglobal = 777;
testglobal2 = -99;
failures++;
print "Restoring undo...^";
@restoreundo sp;
@pull testglobal2;
if (testglobal2 == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", testglobal2, "^";
}
failures++;
count_failures();
return;
}
else if (testglobal2 ~= -1) {
print "Unknown @@64saveundo return value: ", testglobal2, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(testglobal2, -1); print ".^";
print "loc="; check(loc, 98); print " glob="; check(testglobal, 998); print "^";
@push 9;
loc = 99;
testglobal = 999;
testglobal2 = -999;
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
loc = 77;
testglobal = 777;
testglobal2 = -777;
@pull val;
print "guard="; check(val, 9); print "^";
val = 7;
failures++;
print "Restoring undo...^";
@restoreundo testglobal2;
if (testglobal2 == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", testglobal2, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
print "loc="; check(loc, 99); print " glob="; check(testglobal, 999); print " glob2="; check(testglobal2, -999); print "^";
@pull val;
print "guard="; check(val, 9); print "^";
count_failures();
];
[ undo_depth_check;
return undo_depth_check2(11, 22, 33);
];
[ undo_depth_check2 foo bar baz val;
bar = 1;
foo = bar;
baz = foo;
@saveundo val;
return val;
];
TestClass MultiUndoTest
with name 'multiundo',
testfunc [ val loc;
print "Multi-level undo:^^";
@gestalt 3 0 val; ! Undo
if (val)
print "Interpreter claims to support undo.^^";
else
print "Interpreter claims to not support undo. (Continuing test anyway...)^^";
loc = 99;
testglobal = 999;
@saveundo val;
if (val == 1) {
print "First @@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo 1 saved...^";
! The following changes will be undone.
loc = 77;
testglobal = 777;
failures++;
@saveundo val;
if (val == 1) {
print "Second @@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo 2 saved...^";
! The following changes will be undone.
loc = 55;
testglobal = 555;
failures++;
print "Restoring undo 2...^";
@restoreundo val;
if (val == 1) {
print "Second @@64restoreundo failed (value 1)!^";
}
else {
print "Second @@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo 2 succeeded, return value "; check(val, -1); print ".^";
print "loc="; check(loc, 77); print " glob="; check(testglobal, 777); print "^";
print "Restoring undo 1...^";
@restoreundo val;
if (val == 1) {
print "First @@64restoreundo failed (value 1)!^";
}
else {
print "First @@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo 1 succeeded, return value "; check(val, -1); print ".^";
print "loc="; check(loc, 99); print " glob="; check(testglobal, 999); print "^";
count_failures();
];
! @hasundo/@discardundo are not yet supported by either Inform or interpreters. So this test is commented out for now.
#iftrue 0;
TestClass ExtUndoTest
with name 'extundo',
testfunc [ val loc;
print "ExtUndo:^^";
@gestalt 12 0 val; ! ExtUndo
if (~~val) {
print "Interpreter claims to not support extended undo. Skipping test.^^";
count_failures();
return;
}
@protect destarray 4;
destarray->0 = 0;
destarray->1 = 0; ! protected failures
print "No undo states: ";
@hasundo val;
print "val="; check(val, 1);
@hasundo testglobal;
print " testglobal="; check(testglobal, 1); print "^";
destarray->0 = destarray->0 + 1;
print "counter="; check(destarray->0, 1); print "^";
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
else if (val == 0) {
print "Undo saved...^";
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
else {
print "@@64saveundo restored when it should have been discarded.^";
failures++;
count_failures();
return;
}
@hasundo val;
print "val="; check(val, 0);
@hasundo testglobal;
print " testglobal="; check(testglobal, 0); print "^";
destarray->0 = destarray->0 + 1;
print "counter="; check(destarray->0, 2); print "^";
@discardundo;
print "Undo discarded...^";
@hasundo val;
print "val="; check(val, 1);
@hasundo testglobal;
print " testglobal="; check(testglobal, 1); print "^";
destarray->0 = destarray->0 + 1;
print "counter="; check(destarray->0, 3); print "^";
print "^";
loc = 99;
testglobal = 999;
@saveundo val;
if (val == 1) {
print "First @@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo 1 saved...^";
! The following changes will be undone.
loc = 77;
testglobal = 777;
destarray->0 = destarray->0 + 1;
print "counter="; check(destarray->0, 4); print "^";
@saveundo val;
if (val == 1) {
print "Second @@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo 2 saved...^";
! The following changes will NOT be undone.
loc = 55;
testglobal = 555;
destarray->0 = destarray->0 + 1;
print "counter="; check(destarray->0, 5); print "^";
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "loc="; check(loc, 55); print " glob="; check(testglobal, 555); print "^";
@discardundo;
print "Undo 2 discarded...^";
destarray->0 = destarray->0 + 1;
print "counter="; check(destarray->0, 6); print "^";
@hasundo val;
print "val="; check(val, 0);
@hasundo testglobal2;
print " testglobal="; check(testglobal2, 0); print "^";
if (failures)
destarray->1 = destarray->1 + 1;
print "Restoring undo 1...^";
@restoreundo val;
if (val == 1) {
print "First @@64restoreundo failed (value 1)!^";
}
else {
print "First @@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo 1 succeeded, return value "; check(val, -1); print ".^";
print "loc="; check(loc, 99); print " glob="; check(testglobal, 999); print "^";
destarray->0 = destarray->0 + 1;
print "counter="; check(destarray->0, 7); print "^";
@protect 0 0;
print "^";
print "End of test: ";
@hasundo val;
print "val="; check(val, 1);
@hasundo testglobal;
print " testglobal="; check(testglobal, 1); print "^";
print "Protected failures="; check(destarray->1, 0); print "^";
count_failures();
];
#endif; ! @hasundo/@discardundo
TestClass RestoreTest
with name 'restore',
testfunc [ res loc1 loc2;
print "Restore:^^";
if (gg_savefref) {
print "gg_savefref already existed!^";
failures++;
count_failures();
return;
}
gg_savefref = glk($0060, 1, GG_SAVEFREF_ROCK); ! fileref_create_temp
if (~~gg_savefref) {
print "Unable to create fileref!^";
failures++;
jump cleanup;
}
delete_if_exists(gg_savefref);
print "Simple restore.^";
loc1 = 111;
loc2 = 222;
testglobal = 333;
gg_savestr = glk($0042, gg_savefref, $01, GG_SAVESTR_ROCK); ! stream_open_file
if (~~gg_savestr) {
print "Unable to open stream!^";
failures++;
jump cleanup;
}
print "Saving...^";
@save gg_savestr res;
if (res == -1) {
! Come back from @restore
print "Restore succeeded!^";
print "loc1="; check(loc1, 111); print " loc2="; check(loc2, 222); print " glob="; check(testglobal, 333); print "^";
GGRecoverObjects();
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
jump restore_2;
}
if (res) {
print "Save failed!^";
failures++;
jump cleanup;
}
print "Saved.^";
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
! These values will be restored over
loc1 = 5;
loc2 = 6;
testglobal = 7;
gg_savestr = glk($0042, gg_savefref, $02, GG_SAVESTR_ROCK); ! stream_open_file
if (~~gg_savestr) {
print "Unable to open stream!^";
failures++;
jump cleanup;
}
print "Restoring...^";
@restore gg_savestr res;
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
print "Restore failed!^";
failures++;
jump cleanup;
.restore_2;
print "Restore with stack.^";
loc1 = 55555;
loc2 = 6666;
testglobal = 777;
@push 888888;
gg_savestr = glk($0042, gg_savefref, $01, GG_SAVESTR_ROCK); ! stream_open_file
if (~~gg_savestr) {
print "Unable to open stream!^";
failures++;
jump cleanup;
}
print "Saving...^";
@save gg_savestr res;
if (res == -1) {
! Come back from @restore
print "Restore succeeded!^";
@pull testglobal2;
print "*sp="; check(testglobal2, 888888); print "^";
print "loc1="; check(loc1, 55555); print " loc2="; check(loc2, 6666); print " glob="; check(testglobal, 777); print "^";
GGRecoverObjects();
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
jump restore_3;
}
if (res) {
print "Save failed!^";
failures++;
jump cleanup;
}
print "Saved.^";
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
! These values will be restored over
loc1 = 1;
loc2 = 2;
testglobal = 3;
gg_savestr = glk($0042, gg_savefref, $02, GG_SAVESTR_ROCK); ! stream_open_file
if (~~gg_savestr) {
print "Unable to open stream!^";
failures++;
jump cleanup;
}
print "Restoring...^";
@restore gg_savestr res;
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
print "Restore failed!^";
failures++;
jump cleanup;
.restore_3;
print "Restore nested.^";
loc1 = 1;
loc2 = 2;
testglobal = 3;
gg_savestr = glk($0042, gg_savefref, $01, GG_SAVESTR_ROCK); ! stream_open_file
if (~~gg_savestr) {
print "Unable to open stream!^";
failures++;
jump cleanup;
}
print "Saving...^";
res = save_nested();
if (res == -1) {
! Come back from @restore
print "Restore succeeded!^";
print "loc1="; check(loc1, 1); print " loc2="; check(loc2, 2); print " glob="; check(testglobal, 3); print "^";
GGRecoverObjects();
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
jump restore_4;
}
if (res) {
print "Save failed!^";
failures++;
jump cleanup;
}
print "Saved.^";
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
! These values will be restored over
loc1 = 5;
loc2 = 6;
testglobal = 7;
gg_savestr = glk($0042, gg_savefref, $02, GG_SAVESTR_ROCK); ! stream_open_file
if (~~gg_savestr) {
print "Unable to open stream!^";
failures++;
jump cleanup;
}
print "Restoring...^";
res = restore_nested();
glk($0044, gg_savestr, 0); ! stream_close
gg_savestr = 0;
print "Restore failed!^";
failures++;
jump cleanup;
.restore_4;
print "Done.^";
.cleanup;
print "Cleaning up fileref.^";
if (gg_savefref) {
delete_if_exists(gg_savefref);
glk($0063, gg_savefref); ! fileref_destroy
gg_savefref = 0;
}
count_failures();
];
[ save_nested res locx locy;
locx = 10;
locy = 41;
@save gg_savestr res;
if (res == -1) {
! Come back from @restore
print "locx="; check(locx, 10); print " locy="; check(locy, 41); print "^";
return res;
}
if (res) {
print "Save failed! (inner)^";
return res;
}
locx = 1;
locy = 1;
return res;
];
[ restore_nested res;
@restore gg_savestr res;
print "Restore failed! (inner)^";
return res;
];
[ delete_if_exists fref val;
val = glk($0067, fref); ! fileref_does_file_exist
if (val) {
print "(Deleting existing save file)^";
glk($0066, fref); ! fileref_delete_file
}
];
TestClass VerifyTest
with name 'verify',
testfunc [ val;
print "Verify:^^";
@verify val;
print "verify="; check(val, 0); print "^";
@verify testglobal;
print "verify="; check(testglobal, 0); print "^";
@verify sp;
@copy sp val;
print "verify="; check(val, 0); print "^";
count_failures();
];
TestClass ProtectTest
with name 'protect',
testfunc [ val addr;
print "Protect:^^";
@gestalt 3 0 val; ! Undo
if (~~val)
print "Interpreter claims to not support undo. (Continuing test anyway...)^^";
addr = destarray+3;
@protect addr 6;
fill_array_seq(destarray);
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
fill_array_val(destarray, 99);
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
print "Protected 3,6: ";
check_bytelist(destarray, 1,2,3,99,99,99,99,99,99,10,11,12); print "^";
addr = destarray+6;
@copy 1 sp;
@copy addr sp;
@protect sp sp;
fill_array_seq(destarray);
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
fill_array_val(destarray, 99);
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
print "Protected 6,1: ";
check_bytelist(destarray, 1,2,3,4,5,6,99,8,9,10,11,12); print "^";
@protect 0 0;
fill_array_seq(destarray);
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
fill_array_val(destarray, 99);
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
print "Unprotected: ";
check_bytelist(destarray, 1,2,3,4,5,6,7,8,9,10,11,12); print "^";
count_failures();
];
TestClass MemSizeTest
with name 'memsize' 'msize',
testfunc [ val res addr extstart endmem newendmem;
print "Memory-size extension:^^";
extstart = HDR_EXTSTART-->0;
endmem = HDR_ENDMEM-->0;
@gestalt 2 0 val; ! ResizeMem
if (~~val) {
print "Interpreter claims to not support memory resizing.^^";
@getmemsize val;
print "Initial memsize="; check_hex(val, endmem); print "^";
print "Trying @@64setmemsize, which should fail...^";
newendmem = endmem + $100;
@setmemsize newendmem res;
print "@@64setmemsize="; check(res, 1); print "^";
count_failures();
return;
}
if (extstart == endmem) {
print "This game file was compiled with a version of Inform
that does not understand the $MEMORY_MAP_EXTENSION option.^";
}
else {
print "ExtStart=", (Hex) extstart, "; ";
print "EndMem="; check_hex(endmem, extstart+$100); print "^";
}
@getmemsize val;
print "Initial memsize="; check_hex(val, endmem); print "^";
addr = endmem-2;
val = addr->0;
print "Value at ", (Hex)addr, "="; check(val, 0); print "^";
addr = endmem-1;
addr->0 = 75;
val = addr->0;
print "Write/read at ", (Hex)addr, "="; check(val, 75); print "^";
newendmem = endmem + $100;
@setmemsize newendmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "New memsize="; check_hex(val, newendmem); print "^";
addr = endmem-1;
addr->0 = 75;
val = addr->0;
print "Write/read at ", (Hex)addr, "="; check(val, 75); print "^";
addr = newendmem-1;
addr->0 = 234;
val = addr->0;
print "Write/read at ", (Hex)addr, "="; check(val, 234); print "^";
@setmemsize endmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "Restored memsize="; check_hex(val, endmem); print "^";
@setmemsize newendmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "New memsize="; check_hex(val, newendmem); print "^";
addr = newendmem-1;
val = addr->0;
print "Write/read at ", (Hex)addr, "="; check(val, 0); print "^";
@setmemsize endmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "Restored memsize="; check_hex(val, endmem); print "^";
count_failures();
];
TestClass UndoMemSizeTest
with name 'undomemsize' 'undomem' 'undomsize',
short_name "undomemsize",
testfunc [ val res addr extstart endmem newendmem;
print "Undo of memory-size extension:^^";
@gestalt 2 0 val; ! ResizeMem
if (~~val) {
print "Interpreter claims to not support memory resizing. Skipping test.^^";
count_failures();
return;
}
@gestalt 3 0 val; ! Undo
if (~~val) {
print "Interpreter claims to not support undo. Skipping test.^^";
count_failures();
return;
}
extstart = HDR_EXTSTART-->0;
endmem = HDR_ENDMEM-->0;
print "ExtStart=", (Hex) extstart, "; ";
print "EndMem="; check_hex(endmem, extstart+$100); print "^";
@getmemsize val;
print "Original memsize="; check_hex(val, endmem); print "^";
addr = endmem + $80;
newendmem = endmem + $100;
@setmemsize newendmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "New memsize="; check_hex(val, newendmem); print "^";
fill_array_seq(addr);
print "Wrote: ", (Hex) addr, ": ";
check_bytelist(addr, 1,2,3,4,5,6,7,8,9,10,11,12); print "^";
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
fill_array_val(addr, 99);
@setmemsize endmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "Shrunk memsize="; check_hex(val, endmem); print "^";
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
@getmemsize val;
print "Restored memsize="; check_hex(val, newendmem); print "^";
print "Restored: ", (Hex) addr, ": ";
check_bytelist(addr, 1,2,3,4,5,6,7,8,9,10,11,12); print "^";
val = addr+1;
@protect val 5;
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
fill_array_val(addr, 77);
@setmemsize endmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "Shrunk memsize="; check_hex(val, endmem); print "^";
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
@getmemsize val;
print "Restored memsize="; check_hex(val, newendmem); print "^";
print "Restored: ", (Hex) addr, ": ";
check_bytelist(addr, 1,0,0,0,0,0,7,8,9,10,11,12); print "^";
@protect 0 0;
@setmemsize endmem res;
print "@@64setmemsize="; check(res, 0); print "^";
@getmemsize val;
print "Restored memsize="; check_hex(val, endmem); print "^";
count_failures();
];
Array startovertest --> 4;
TestClass UndoRestartTest
with name 'undorestart',
short_name "undorestart",
testfunc [ val;
print "Undo of restart:^^";
@gestalt 3 0 val; ! Undo
if (~~val) {
print "Interpreter claims to not support undo. Skipping test.^^";
count_failures();
return;
}
@protect startovertest 8;
startovertest-->0 = 1234;
startovertest-->1 = 1;
startovertest-->2 = 1; ! unprotected
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
startovertest-->1 = 2;
startovertest-->2 = 2;
failures++;
@push 999;
@restart;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
print "Magic number "; check(startovertest-->0, 1234);
print ", "; check(startovertest-->1, 3);
print ", "; check(startovertest-->2, 1); print "^";
startovertest-->0 = 0;
startovertest-->1 = 0;
startovertest-->2 = 0;
count_failures();
];
TestClass HeapTest
with name 'heap',
testfunc [ val endmem newendmem blk1 blk2 blk3;
print "Heap:^^";
@gestalt 7 0 val; ! MAlloc
if (~~val) {
print "Interpreter claims to not support heap allocation. Skipping test.^^";
count_failures();
return;
}
endmem = HDR_ENDMEM-->0;
@getmemsize val;
print "Original memsize="; check_hex(val, endmem); print "^";
@gestalt 8 0 val; ! MAllocHeap
print "Current heap: "; check_hex(val, 0); print "^";
print "Allocating 16...^";
@malloc 16 blk1;
if (blk1 == 0) {
failures++;
print "Allocation failed.^";
count_failures();
return;
}
@gestalt 8 0 val; ! MAllocHeap
print "Heap starts at "; check_hex(val, endmem);
@getmemsize newendmem;
print ", ends at ", (Hex) newendmem, "^";
if (newendmem <= endmem) {
failures++;
print "Heap size is not positive.^";
}
if (blk1 < endmem || blk1+16 > newendmem) {
failures++;
print "Block is outside heap.^";
}
print "Allocating 512...^";
@malloc 512 blk2;
if (blk2 == 0) {
failures++;
print "Allocation failed.^";
count_failures();
return;
}
@gestalt 8 0 val; ! MAllocHeap
print "Heap starts at "; check_hex(val, endmem);
@getmemsize newendmem;
print ", ends at ", (Hex) newendmem, "^";
if (newendmem <= endmem) {
failures++;
print "Heap size is not positive.^";
}
if (blk2 < endmem || blk2+512 > newendmem) {
failures++;
print "Block is outside heap.^";
}
print "Freeing 16...^";
@mfree blk1;
@getmemsize newendmem;
print "Heap ends at ", (Hex) newendmem, "^";
@gestalt 8 0 val; ! MAllocHeap
if (val == 0) {
failures++;
print "Heap is inactive.^";
}
if (blk2 < endmem || blk2+512 > newendmem) {
failures++;
print "Block is outside heap.^";
}
print "Freeing 512...^";
@mfree blk2;
@gestalt 8 0 val; ! MAllocHeap
print "Final heap: "; check_hex(val, 0); print "^";
endmem = HDR_ENDMEM-->0;
@getmemsize val;
print "Final memsize="; check_hex(val, endmem); print "^";
@malloc 19 blk1;
print "blk1(19)="; check_nonzero(blk1); print ", ";
@malloc 23 blk2;
print "blk2(23)="; check_nonzero(blk2); print ", ";
@malloc 17 blk3;
print "blk3(17)="; check_nonzero(blk3); print "^";
@mfree blk2;
print "free blk2, ";
@malloc 23 blk2;
print "blk2(23)="; check_nonzero(blk2); print "^";
@mfree blk1;
print "free blk1, ";
@malloc 19 blk1;
print "blk1(19)="; check_nonzero(blk1); print "^";
@mfree blk2;
print "free blk2, ";
@malloc 23 blk2;
print "blk2(23)="; check_nonzero(blk2); print "^";
@mfree blk1;
print "free blk1, ";
@mfree blk2;
print "free blk2^";
@malloc 25 blk1;
print "blk1(25)="; check_nonzero(blk1); print ", ";
@malloc 17 blk2;
print "blk2(17)="; check_nonzero(blk2); print "^";
@mfree blk2;
print "free blk2, ";
@malloc 41 blk2;
print "blk2(41)="; check_nonzero(blk2); print "^";
@mfree blk1;
print "free blk1, ";
@mfree blk2;
print "free blk2, ";
@mfree blk3;
print "free blk3^";
@gestalt 8 0 val; ! MAllocHeap
print "Final heap: "; check_hex(val, 0); print "^";
endmem = HDR_ENDMEM-->0;
@getmemsize val;
print "Final memsize="; check_hex(val, endmem); print "^";
count_failures();
];
TestClass UndoHeapTest
with name 'undoheap',
testfunc [ val endmem newendmem blk1 blk2;
print "Heap:^^";
@gestalt 7 0 val; ! MAlloc
if (~~val) {
print "Interpreter claims to not support heap allocation. Skipping test.^^";
count_failures();
return;
}
@gestalt 3 0 val; ! Undo
if (~~val) {
print "Interpreter claims to not support undo. Skipping test.^^";
count_failures();
return;
}
endmem = HDR_ENDMEM-->0;
@getmemsize val;
print "Original memsize="; check_hex(val, endmem); print "^";
@gestalt 8 0 val; ! MAllocHeap
print "Current heap: "; check_hex(val, 0); print "^";
print "Allocating 16...^";
@malloc 16 blk1;
if (blk1 == 0) {
failures++;
print "Allocation failed.^";
count_failures();
return;
}
print "Allocating 512...^";
@malloc 512 blk2;
if (blk2 == 0) {
failures++;
print "Allocation failed.^";
count_failures();
return;
}
@gestalt 8 0 val; ! MAllocHeap
print "Heap starts at "; check_hex(val, endmem);
@getmemsize newendmem;
print ", ends at ", (Hex) newendmem, "^";
if (newendmem <= endmem) {
failures++;
print "Heap size is not positive.^";
}
@saveundo val;
if (val == 1) {
print "@@64saveundo failed!^";
failures++;
count_failures();
return;
}
if (val == 0) {
print "Undo saved...^";
! The following changes will be undone.
print "Freeing 16...^";
@mfree blk1;
print "Freeing 512...^";
@mfree blk2;
@gestalt 8 0 val; ! MAllocHeap
print "Final heap: "; check_hex(val, 0); print "^";
failures++;
print "Restoring undo...^";
@restoreundo val;
if (val == 1) {
print "@@64restoreundo failed (value 1)!^";
}
else {
print "@@64restoreundo failed with unknown return value: ", val, "^";
}
failures++;
count_failures();
return;
}
else if (val ~= -1) {
print "Unknown @@64saveundo return value: ", val, "^";
failures++;
count_failures();
return;
}
print "Undo succeeded, return value "; check(val, -1); print ".^";
@gestalt 8 0 val; ! MAllocHeap
print "Heap starts at "; check_hex(val, endmem);
@getmemsize newendmem;
print ", ends at ", (Hex) newendmem, "^";
if (newendmem <= endmem) {
failures++;
print "Heap size is not positive.^";
}
print "Freeing 16...^";
@mfree blk1;
print "Freeing 512...^";
@mfree blk2;
@gestalt 8 0 val; ! MAllocHeap
print "Final heap: "; check_hex(val, 0); print "^";
endmem = HDR_ENDMEM-->0;
@getmemsize val;
print "Final memsize="; check_hex(val, endmem); print "^";
count_failures();
];
[ do_failure;
failures++;
];
TestClass AccelTest
with name 'acceleration' 'accel' 'accelfunc' 'accelparam',
short_name "acceleration",
testfunc [ val;
print "Acceleration:^";
print "(This tests only the operands. For a complete test of the
accelfunc and accelparam opcodes, see accelfunctest.ulx.)^^";
@copy 987 sp;
@accelfunc 9999 do_failure;
val = 9999;
@accelfunc val do_failure;
testglobal = 9999;
@accelfunc testglobal do_failure;
@copy do_failure sp;
@copy 9999 sp;
@accelfunc sp sp;
@accelfunc 0 do_failure;
@accelparam 9999 1234;
val = 9999;
@accelparam val 1234;
testglobal = 9999;
@accelparam testglobal 1234;
@copy 1234 sp;
@copy 9999 sp;
@accelparam sp sp;
@accelparam 0 1234;
@copy sp val;
print "guard="; check(val, 987); print "^";
count_failures();
];
#ifdef FLOAT_OPCODES_AVAILABLE;
Constant M_0 = $0;
Constant M_1 = $3F800000;
Constant M_N1 = $BF800000; ! -1
Constant M_PI = $40490FDB;
Constant M_NPI = $C0490FDB;
Constant M_2PI = $40C90FDB; ! 2*pi
Constant M_PI2 = $3FC90FDB; ! pi/2
Constant M_NPI2 = $BFC90FDB;
Constant M_E = $402DF854;
Constant M_E2 = $40EC7326; ! e^2
Constant M_N0 = $80000000; ! negative zero
Constant M_INF = $7F800000; ! infinity
Constant M_NINF = $FF800000; ! negative infinity
Constant M_NAN = $7F800001; ! one of many NaN values
Constant M_NNAN = $FF800001; ! another, with a sign bit
! Print a float. This uses exponential notation ("[-]N.NNNe[+-]NN") if
! the exponent is not between 6 and -4. If it is (that is, if the
! absolute value is near 1.0) then it uses decimal notation ("[-]NNN.NNNNN").
! The precision is the number of digits after the decimal point
! (at least one, no more than eight). The default is five, because
! beyond that rounding errors creep in, and even exactly-represented
! float values are printed with trailing fudgy digits.
[ Float val prec pval;
pval = val & $7FFFFFFF;
@jz pval ?UseFloatDec;
@jfge pval $49742400 ?UseFloatExp; ! 1000000.0
@jflt pval $38D1B717 ?UseFloatExp; ! 0.0001
.UseFloatDec;
return FloatDec(val, prec);
.UseFloatExp;
return FloatExp(val, prec);
];
Array PowersOfTen --> 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000;
! Print a float in exponential notation: "[-]N.NNNe[+-]NN".
! The precision is the number of digits after the decimal point
! (at least one, no more than eight). The default is five, because
! beyond that rounding errors creep in, and even exactly-represented
! float values are printed with trailing fudgy digits.
[ FloatExp val prec log10val expo fexpo idig ix pow10;
if (prec == 0)
prec = 5;
if (prec > 8)
prec = 8;
pow10 = PowersOfTen --> prec;
! Knock off the sign bit first.
if (val & $80000000) {
@streamchar '-';
val = val & $7FFFFFFF;
}
@jisnan val ?IsNan;
@jisinf val ?IsInf;
if (val == $0) {
expo = 0;
idig = 0;
jump DoPrint;
}
! Take as an example val=123.5, with precision=6. The desired
! result is "1.23000e+02".
@log val sp;
@fdiv sp $40135D8E log10val; ! $40135D8E is log(10)
@floor log10val fexpo;
@ftonumn fexpo expo;
! expo is now the exponent (as an integer). For our example, expo=2.
@fsub log10val fexpo sp;
@numtof prec sp;
@fadd sp sp sp;
@fmul sp $40135D8E sp;
@exp sp sp;
! The stack value is now exp((log10val - fexpo + prec) * log(10)).
! We've shifted the decimal point left by expo digits (so that
! it's after the first nonzero digit), and then right by prec
! digits. In our example, that would be 1235000.0.
@ftonumn sp idig;
! Round to an integer, and we have 1235000. Notice that this is
! exactly the digits we want to print (if we stick a decimal point
! after the first).
.DoPrint;
if (idig >= 10*pow10) {
! Rounding errors have left us outside the decimal range of
! [1.0, 10.0) where we should be. Adjust to the next higher
! exponent.
expo++;
@div idig 10 idig;
}
for (ix=0 : ix<=prec : ix++) {
@div idig pow10 sp;
@mod sp 10 sp;
@streamnum sp;
if (ix == 0)
@streamchar '.';
@div pow10 10 pow10;
}
! Print the exponent. Convention is to use at least two digits.
@streamchar 'e';
if (expo < 0) {
@streamchar '-';
@neg expo expo;
}
else {
@streamchar '+';
}
if (expo < 10)
@streamchar '0';
@streamnum expo;
rtrue;
.IsNan;
@streamstr "NaN";
rtrue;
.IsInf;
@streamstr "Inf";
rtrue;
];
! Print a float in decimal notation: "[-]NNN.NNNNN".
! The precision is the number of digits after the decimal point
! (at least one, no more than eight). The default is five, because
! beyond that rounding errors creep in, and even exactly-represented
! float values are printed with trailing fudgy digits.
[ FloatDec val prec log10val int fint extra0 frac idig ix pow10;
if (prec == 0)
prec = 5;
if (prec > 8)
prec = 8;
pow10 = PowersOfTen --> prec;
! Knock off the sign bit first.
if (val & $80000000) {
@streamchar '-';
val = val & $7FFFFFFF;
}
@jisnan val ?IsNan;
@jisinf val ?IsInf;
! Take as an example val=123.5, with precision=6. The desired result
! is "123.50000".
extra0 = 0;
@fmod val $3F800000 frac fint; ! $3F800000 is 1.0.
@ftonumz fint int;
! This converts the integer part of the value to an integer value;
! in our example, 123.
if (int == $7FFFFFFF) {
! Looks like the integer part of the value is bigger than
! we can store in an int variable. (It could be as large
! as 3e+38.) We're going to have to use a log function to
! reduce it by some number of factors of 10, and then pad
! with zeroes.
@log fint sp;
@fdiv sp $40135D8E log10val; ! $40135D8E is log(10)
@ftonumz log10val extra0;
@sub extra0 8 extra0;
! extra0 is the number of zeroes we'll be padding with.
@numtof extra0 sp;
@fsub log10val sp sp;
@fmul sp $40135D8E sp;
@exp sp sp;
! The stack value is now exp((log10val - extra0) * log(10)).
! We've shifted the decimal point far enough left to leave
! about eight digits, which is all we can print as an integer.
@ftonumz sp int;
}
! Print the integer part.
@streamnum int;
for (ix=0 : ix<extra0 : ix++)
@streamchar '0';
@streamchar '.';
! Now we need to print the frac part, which is .5.
@log frac sp;
@fdiv sp $40135D8E log10val; ! $40135D8E is log(10)
@numtof prec sp;
@fadd log10val sp sp;
@fmul sp $40135D8E sp;
@exp sp sp;
! The stack value is now exp((frac + prec) * log(10)).
! We've shifted the decimal point right by prec
! digits. In our example, that would be 50000.0.
@ftonumn sp idig;
! Round to an integer, and we have 50000. Notice that this is
! exactly the (post-decimal-point) digits we want to print.
.DoPrint;
if (idig >= pow10) {
! Rounding errors have left us outside the decimal range of
! [0.0, 1.0) where we should be. I'm not sure this is possible,
! actually, but we'll just adjust downward.
idig = pow10 - 1;
}
@div pow10 10 pow10;
for (ix=0 : ix<prec : ix++) {
@div idig pow10 sp;
@mod sp 10 sp;
@streamnum sp;
@div pow10 10 pow10;
}
rtrue;
.IsNan;
@streamstr "NaN";
rtrue;
.IsInf;
@streamstr "Inf";
rtrue;
];
[ check_float val wanted;
if (val == wanted) {
print (Float) val;
rtrue;
}
failures++;
print (Float) val, " or ", (Hex) val;
print " (should be ", (Float) wanted, " or ", (Hex) wanted, " FAIL)";
rfalse;
];
[ check_float_e val wanted eps;
@jfne val wanted eps ?Bad;
if (1) { ! if (abs(val-wanted) <= eps)...
print (char) '~', (Float) val;
rtrue;
}
.Bad;
failures++;
print (Float) val, " or ", (Hex) val;
print " (should be near ", (Float) wanted, " or ", (Hex) wanted, " FAIL)";
rfalse;
];
[ check_isnan val;
if ((val & $7F800000 == $7F800000) && (val & $7FFFFF ~= 0)) {
if (val & $80000000)
print "-";
print "NaN";
rtrue;
}
failures++;
print (Float) val, " or ", (Hex) val;
print " (should be a NaN, FAIL)";
rfalse;
];
TestFloatClass FloatConvTest
with name 'floatconv',
testfunc [ val val2;
print "Floating-point conversion:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
testglobal = M_0;
@fadd testglobal M_0 val;
print "0="; check_hex(val, M_0); print ", ";
testglobal = M_N0;
@fadd testglobal M_N0 val;
print "-0="; check_hex(val, M_N0); print ", ";
testglobal = M_1;
@fadd testglobal M_0 val;
print "1="; check_hex(val, M_1); print ", ";
testglobal = $00010000;
@fadd testglobal M_0 val;
print "9.2e-41="; check_hex(val, $00010000); print ", ";
testglobal = $00200001;
@fadd testglobal M_0 val;
print "2.9e-39="; check_hex(val, $00200001); print ", ";
testglobal = $007FFFFF;
@fadd testglobal M_0 val;
print "1.2e-38="; check_hex(val, $007FFFFF); print ", ";
testglobal = $00800000;
@fadd testglobal M_0 val;
print "1.2e-38="; check_hex(val, $00800000); print ", ";
testglobal = $08000000;
@fadd testglobal M_0 val;
print "3.8e-34="; check_hex(val, $08000000); print ", ";
testglobal = $7F7FFFFF;
@fadd testglobal M_0 val;
print "3.4e+38="; check_hex(val, $7F7FFFFF); print ", ";
testglobal = M_INF;
@fadd testglobal M_0 val;
print "Inf="; check_hex(val, M_INF); print ", ";
testglobal = M_NINF;
@fadd testglobal M_0 val;
print "-Inf="; check_hex(val, M_NINF); print "^";
new_line;
@numtof 0 val;
print "numtof 0="; check_hex(val, 0); print ", ";
@numtof 1 val;
print "numtof 1="; check_hex(val, $3F800000); print ", ";
@numtof -1 val;
print "numtof -1="; check_hex(val, $BF800000); print ", ";
@numtof 2 val;
print "numtof 2="; check_hex(val, $40000000); print ", ";
@numtof -2 val;
print "numtof -2="; check_hex(val, $C0000000); print ", ";
@numtof 33 val;
print "numtof 33="; check_hex(val, $42040000); print ", ";
@numtof -33 val;
print "numtof -33="; check_hex(val, $C2040000); print ", ";
@numtof 100 val;
print "numtof 100="; check_hex(val, $42C80000); print ", ";
@numtof -100 val;
print "numtof -100="; check_hex(val, $C2C80000); print ", ";
@numtof 12345 val;
print "numtof 12345="; check_hex(val, $4640E400); print ", ";
@numtof -12345 val;
print "numtof -12345="; check_hex(val, $C640E400); print ", ";
@numtof 9876543 val;
print "numtof 9876543="; check_hex(val, $4B16B43F); print ", ";
@numtof -9876543 val;
print "numtof -9876543="; check_hex(val, $CB16B43F); print ", ";
@numtof $1000000 val;
print "numtof $1000000="; check_hex(val, $4B800000); print ", ";
@numtof -$1000000 val;
print "numtof -$1000000="; check_hex(val, $CB800000); print ", ";
@numtof $1000001 val;
print "numtof $1000001="; check_hex(val, $4B800000); print ", ";
@numtof -$1000001 val;
print "numtof -$1000001="; check_hex(val, $CB800000); print ", ";
@numtof $1234CDEF val;
print "numtof $1234CDEF="; check_hex(val, $4D91A66F); print ", ";
@numtof -$1234CDEF val;
print "numtof -$1234CDEF="; check_hex(val, $CD91A66F); print ", ";
@numtof $7FFFFFFF val;
print "numtof $7FFFFFFF="; check_hex(val, $4F000000); print ", ";
@numtof -$7FFFFFFF val;
print "numtof -$7FFFFFFF="; check_hex(val, $CF000000); print ", ";
@numtof $80000000 val;
print "numtof $80000000="; check_hex(val, $CF000000); print "^";
val2 = 0;
@numtof val2 val;
print "numtof 0="; check_hex(val, 0); print ", ";
val2 = 1;
@numtof val2 val;
print "numtof 1="; check_hex(val, $3F800000); print ", ";
val2 = -1;
@numtof val2 val;
print "numtof -1="; check_hex(val, $BF800000); print ", ";
val2 = 2;
@numtof val2 val;
print "numtof 2="; check_hex(val, $40000000); print ", ";
val2 = -2;
@numtof val2 val;
print "numtof -2="; check_hex(val, $C0000000); print ", ";
val2 = 33;
@numtof val2 val;
print "numtof 33="; check_hex(val, $42040000); print ", ";
val2 = -33;
@numtof val2 val;
print "numtof -33="; check_hex(val, $C2040000); print ", ";
val2 = 100;
@numtof val2 val;
print "numtof 100="; check_hex(val, $42C80000); print ", ";
val2 = -100;
@numtof val2 val;
print "numtof -100="; check_hex(val, $C2C80000); print ", ";
val2 = 12345;
@numtof val2 val;
print "numtof 12345="; check_hex(val, $4640E400); print ", ";
val2 = -12345;
@numtof val2 val;
print "numtof -12345="; check_hex(val, $C640E400); print ", ";
val2 = 9876543;
@numtof val2 val;
print "numtof 9876543="; check_hex(val, $4B16B43F); print ", ";
val2 = -9876543;
@numtof val2 val;
print "numtof -9876543="; check_hex(val, $CB16B43F); print ", ";
val2 = $1000000;
@numtof val2 val;
print "numtof $1000000="; check_hex(val, $4B800000); print ", ";
val2 = -$1000000;
@numtof val2 val;
print "numtof -$1000000="; check_hex(val, $CB800000); print ", ";
val2 = $1000001;
@numtof val2 val;
print "numtof $1000001="; check_hex(val, $4B800000); print ", ";
val2 = -$1000001;
@numtof val2 val;
print "numtof -$1000001="; check_hex(val, $CB800000); print ", ";
val2 = $1234CDEF;
@numtof val2 val;
print "numtof $1234CDEF="; check_hex(val, $4D91A66F); print ", ";
val2 = -$1234CDEF;
@numtof val2 val;
print "numtof -$1234CDEF="; check_hex(val, $CD91A66F); print ", ";
val2 = $7FFFFFFF;
@numtof val2 val;
print "numtof $7FFFFFFF="; check_hex(val, $4F000000); print ", ";
val2 = -$7FFFFFFF;
@numtof val2 val;
print "numtof -$7FFFFFFF="; check_hex(val, $CF000000); print ", ";
val2 = $80000000;
@numtof val2 val;
print "numtof $80000000="; check_hex(val, $CF000000); print "^";
testglobal = 0;
@numtof testglobal val;
print "numtof 0="; check_hex(val, 0); print ", ";
testglobal = 1;
@numtof testglobal val;
print "numtof 1="; check_hex(val, $3F800000); print ", ";
testglobal = -1;
@numtof testglobal val;
print "numtof -1="; check_hex(val, $BF800000); print ", ";
testglobal = 2;
@numtof testglobal val;
print "numtof 2="; check_hex(val, $40000000); print ", ";
testglobal = -2;
@numtof testglobal val;
print "numtof -2="; check_hex(val, $C0000000); print ", ";
testglobal = 33;
@numtof testglobal val;
print "numtof 33="; check_hex(val, $42040000); print ", ";
testglobal = -33;
@numtof testglobal val;
print "numtof -33="; check_hex(val, $C2040000); print ", ";
testglobal = 100;
@numtof testglobal val;
print "numtof 100="; check_hex(val, $42C80000); print ", ";
testglobal = -100;
@numtof testglobal val;
print "numtof -100="; check_hex(val, $C2C80000); print ", ";
testglobal = 12345;
@numtof testglobal val;
print "numtof 12345="; check_hex(val, $4640E400); print ", ";
testglobal = -12345;
@numtof testglobal val;
print "numtof -12345="; check_hex(val, $C640E400); print ", ";
testglobal = 9876543;
@numtof testglobal val;
print "numtof 9876543="; check_hex(val, $4B16B43F); print ", ";
testglobal = -9876543;
@numtof testglobal val;
print "numtof -9876543="; check_hex(val, $CB16B43F); print ", ";
testglobal = $1000000;
@numtof testglobal val;
print "numtof $1000000="; check_hex(val, $4B800000); print ", ";
testglobal = -$1000000;
@numtof testglobal val;
print "numtof -$1000000="; check_hex(val, $CB800000); print ", ";
testglobal = $1000001;
@numtof testglobal val;
print "numtof $1000001="; check_hex(val, $4B800000); print ", ";
testglobal = -$1000001;
@numtof testglobal val;
print "numtof -$1000001="; check_hex(val, $CB800000); print ", ";
testglobal = $1234CDEF;
@numtof testglobal val;
print "numtof $1234CDEF="; check_hex(val, $4D91A66F); print ", ";
testglobal = -$1234CDEF;
@numtof testglobal val;
print "numtof -$1234CDEF="; check_hex(val, $CD91A66F); print ", ";
testglobal = $7FFFFFFF;
@numtof testglobal val;
print "numtof $7FFFFFFF="; check_hex(val, $4F000000); print ", ";
testglobal = -$7FFFFFFF;
@numtof testglobal val;
print "numtof -$7FFFFFFF="; check_hex(val, $CF000000); print ", ";
testglobal = $80000000;
@numtof testglobal val;
print "numtof $80000000="; check_hex(val, $CF000000); print "^";
@push 0;
noop();
@numtof sp val;
print "numtof 0="; check_hex(val, 0); print ", ";
@push 1;
@numtof sp val;
print "numtof 1="; check_hex(val, $3F800000); print ", ";
@push -1;
noop();
@numtof sp val;
print "numtof -1="; check_hex(val, $BF800000); print ", ";
@push 2;
@numtof sp val;
print "numtof 2="; check_hex(val, $40000000); print ", ";
@push -2;
noop();
@numtof sp val;
print "numtof -2="; check_hex(val, $C0000000); print ", ";
@push 33;
@numtof sp val;
print "numtof 33="; check_hex(val, $42040000); print ", ";
@push -33;
noop();
@numtof sp val;
print "numtof -33="; check_hex(val, $C2040000); print ", ";
@push 100;
@numtof sp val;
print "numtof 100="; check_hex(val, $42C80000); print ", ";
@push -100;
noop();
@numtof sp val;
print "numtof -100="; check_hex(val, $C2C80000); print ", ";
@push 12345;
@numtof sp val;
print "numtof 12345="; check_hex(val, $4640E400); print ", ";
@push -12345;
noop();
@numtof sp val;
print "numtof -12345="; check_hex(val, $C640E400); print ", ";
@push 9876543;
@numtof sp val;
print "numtof 9876543="; check_hex(val, $4B16B43F); print ", ";
@push -9876543;
noop();
@numtof sp val;
print "numtof -9876543="; check_hex(val, $CB16B43F); print ", ";
@push $1000000;
@numtof sp val;
print "numtof $1000000="; check_hex(val, $4B800000); print ", ";
@push -$1000000;
noop();
@numtof sp val;
print "numtof -$1000000="; check_hex(val, $CB800000); print ", ";
@push $1000001;
@numtof sp val;
print "numtof $1000001="; check_hex(val, $4B800000); print ", ";
@push -$1000001;
noop();
@numtof sp val;
print "numtof -$1000001="; check_hex(val, $CB800000); print ", ";
@push $1234CDEF;
@numtof sp val;
print "numtof $1234CDEF="; check_hex(val, $4D91A66F); print ", ";
@push -$1234CDEF;
noop();
@numtof sp val;
print "numtof -$1234CDEF="; check_hex(val, $CD91A66F); print ", ";
@push $7FFFFFFF;
noop();
@numtof sp val;
print "numtof $7FFFFFFF="; check_hex(val, $4F000000); print ", ";
@push -$7FFFFFFF;
noop();
@numtof sp val;
print "numtof -$7FFFFFFF="; check_hex(val, $CF000000); print ", ";
@push $80000000;
noop();
@numtof sp sp;
@copy sp val;
print "numtof $80000000="; check_hex(val, $CF000000); print "^";
new_line;
@ftonumz M_0 val; ! 0.0
print "ftonumz 0.0="; check_hex(val, 0); print ", ";
@ftonumz M_N0 val; ! -0.0
print "ftonumz -0.0="; check_hex(val, 0); print ", ";
@ftonumz $3F666666 val; ! 0.9
print "ftonumz 0.9="; check_hex(val, 0); print ", ";
@ftonumz $BF666666 val; ! -0.9
print "ftonumz -0.9="; check_hex(val, 0); print ", ";
@ftonumz $3F800000 val; ! 1.0
print "ftonumz 1.0="; check_hex(val, 1); print ", ";
@ftonumz $BF800000 val; ! -1.0
print "ftonumz -1.0="; check_hex(val, -1); print ", ";
@ftonumz $3FE00000 val; ! 1.75
print "ftonumz 1.75="; check_hex(val, 1); print ", ";
@ftonumz $BFE00000 val; ! -1.75
print "ftonumz -1.75="; check_hex(val, -1); print ", ";
@ftonumz $40000000 val; ! 2.0
print "ftonumz 2.0="; check_hex(val, 2); print ", ";
@ftonumz $C0000000 val; ! -2.0
print "ftonumz -2.0="; check_hex(val, -2); print ", ";
@ftonumz $4121999A val; ! 10.1
print "ftonumz 10.1="; check_hex(val, 10); print ", ";
@ftonumz $C121999A val; ! -10.1
print "ftonumz -10.1="; check_hex(val, -10); print ", ";
@ftonumz $4479FFFF val; ! 999.99995
print "ftonumz 999.99995="; check_hex(val, 999); print ", ";
@ftonumz $C479FFFF val; ! -999.99995
print "ftonumz -999.99995="; check_hex(val, -999); print ", ";
@ftonumz $4B800000 val; ! $1000000
print "ftonumz $1000000="; check_hex(val, $1000000); print ", ";
@ftonumz $CB800000 val; ! -$1000000
print "ftonumz -$1000000="; check_hex(val, -$1000000); print ", ";
@ftonumz $4EFFFFFE val; ! $7FFFFF00
print "ftonumz $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
@ftonumz $CEFFFFFE val; ! -$7FFFFF00
print "ftonumz -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
@ftonumz $4F000000 val; ! $80000000
print "ftonumz $80000000="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumz $CF000000 val; ! -$80000000
print "ftonumz -$80000000="; check_hex(val, $80000000); print ", ";
@ftonumz $4F100000 val; ! $90000000
print "ftonumz $90000000="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumz $CF100000 val; ! -$90000000
print "ftonumz -$90000000="; check_hex(val, $80000000); print ", ";
@ftonumz $4F412345 val; ! $C1234500
print "ftonumz $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumz $CF412345 val; ! -$C1234500
print "ftonumz -$C1234500="; check_hex(val, $80000000); print ", ";
@ftonumz $4F800000 val; ! $100000000
print "ftonumz $100000000="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumz $CF800000 val; ! -$100000000
print "ftonumz -$100000000="; check_hex(val, $80000000); print ", ";
@ftonumz $78D18A8B val; ! 3.4e+34
print "ftonumz 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumz $F8D18A8B val; ! -3.4e+34
print "ftonumz -3.4e+34="; check_hex(val, $80000000); print ", ";
@ftonumz M_INF val;
print "ftonumz +Inf="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumz M_NINF val;
print "ftonumz -Inf="; check_hex(val, $80000000); print ", ";
@ftonumz M_NAN val;
print "ftonumz +NaN="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumz M_NNAN val;
print "ftonumz -NaN="; check_hex(val, $80000000); print "^";
testglobal = M_0; @ftonumz testglobal val; ! 0.0
print "ftonumz 0.0="; check_hex(val, 0); print ", ";
testglobal = M_N0; @ftonumz testglobal val; ! -0.0
print "ftonumz -0.0="; check_hex(val, 0); print ", ";
testglobal = $3F666666; @ftonumz testglobal val; ! 0.9
print "ftonumz 0.9="; check_hex(val, 0); print ", ";
testglobal = $BF666666; @ftonumz testglobal val; ! -0.9
print "ftonumz -0.9="; check_hex(val, 0); print ", ";
testglobal = $3F800000; @ftonumz testglobal val; ! 1.0
print "ftonumz 1.0="; check_hex(val, 1); print ", ";
testglobal = $BF800000; @ftonumz testglobal val; ! -1.0
print "ftonumz -1.0="; check_hex(val, -1); print ", ";
testglobal = $3FE00000; @ftonumz testglobal val; ! 1.75
print "ftonumz 1.75="; check_hex(val, 1); print ", ";
testglobal = $BFE00000; @ftonumz testglobal val; ! -1.75
print "ftonumz -1.75="; check_hex(val, -1); print ", ";
testglobal = $40000000; @ftonumz testglobal val; ! 2.0
print "ftonumz 2.0="; check_hex(val, 2); print ", ";
testglobal = $C0000000; @ftonumz testglobal val; ! -2.0
print "ftonumz -2.0="; check_hex(val, -2); print ", ";
testglobal = $4121999A; @ftonumz testglobal val; ! 10.1
print "ftonumz 10.1="; check_hex(val, 10); print ", ";
testglobal = $C121999A; @ftonumz testglobal val; ! -10.1
print "ftonumz -10.1="; check_hex(val, -10); print ", ";
testglobal = $4479FFFF; @ftonumz testglobal val; ! 999.99995
print "ftonumz 999.99995="; check_hex(val, 999); print ", ";
testglobal = $C479FFFF; @ftonumz testglobal val; ! -999.99995
print "ftonumz -999.99995="; check_hex(val, -999); print ", ";
testglobal = $4B800000; @ftonumz testglobal val; ! $1000000
print "ftonumz $1000000="; check_hex(val, $1000000); print ", ";
testglobal = $CB800000; @ftonumz testglobal val; ! -$1000000
print "ftonumz -$1000000="; check_hex(val, -$1000000); print ", ";
testglobal = $4EFFFFFE; @ftonumz testglobal val; ! $7FFFFF00
print "ftonumz $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
testglobal = $CEFFFFFE; @ftonumz testglobal val; ! -$7FFFFF00
print "ftonumz -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
testglobal = $4F000000; @ftonumz testglobal val; ! $80000000
print "ftonumz $80000000="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF000000; @ftonumz testglobal val; ! -$80000000
print "ftonumz -$80000000="; check_hex(val, $80000000); print ", ";
testglobal = $4F100000; @ftonumz testglobal val; ! $90000000
print "ftonumz $90000000="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF100000; @ftonumz testglobal val; ! -$90000000
print "ftonumz -$90000000="; check_hex(val, $80000000); print ", ";
testglobal = $4F412345; @ftonumz testglobal val; ! $C1234500
print "ftonumz $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF412345; @ftonumz testglobal val; ! -$C1234500
print "ftonumz -$C1234500="; check_hex(val, $80000000); print ", ";
testglobal = $4F800000; @ftonumz testglobal val; ! $100000000
print "ftonumz $100000000="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF800000; @ftonumz testglobal val; ! -$100000000
print "ftonumz -$100000000="; check_hex(val, $80000000); print ", ";
testglobal = $78D18A8B; @ftonumz testglobal val; ! 3.4e+34
print "ftonumz 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $F8D18A8B; @ftonumz testglobal val; ! -3.4e+34
print "ftonumz -3.4e+34="; check_hex(val, $80000000); print ", ";
testglobal = M_INF; @ftonumz testglobal val;
print "ftonumz +Inf="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = M_NINF; @ftonumz testglobal val;
print "ftonumz -Inf="; check_hex(val, $80000000); print ", ";
testglobal = M_NAN; @ftonumz testglobal val;
print "ftonumz +NaN="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = M_NNAN; @ftonumz testglobal val;
print "ftonumz -NaN="; check_hex(val, $80000000); print "^";
val2 = M_0; @ftonumz val2 val; ! 0.0
print "ftonumz 0.0="; check_hex(val, 0); print ", ";
val2 = M_N0; @ftonumz val2 val; ! -0.0
print "ftonumz -0.0="; check_hex(val, 0); print ", ";
val2 = $3F666666; @ftonumz val2 val; ! 0.9
print "ftonumz 0.9="; check_hex(val, 0); print ", ";
val2 = $BF666666; @ftonumz val2 val; ! -0.9
print "ftonumz -0.9="; check_hex(val, 0); print ", ";
val2 = $3F800000; @ftonumz val2 val; ! 1.0
print "ftonumz 1.0="; check_hex(val, 1); print ", ";
val2 = $BF800000; @ftonumz val2 val; ! -1.0
print "ftonumz -1.0="; check_hex(val, -1); print ", ";
val2 = $3FE00000; @ftonumz val2 val; ! 1.75
print "ftonumz 1.75="; check_hex(val, 1); print ", ";
val2 = $BFE00000; @ftonumz val2 val; ! -1.75
print "ftonumz -1.75="; check_hex(val, -1); print ", ";
val2 = $40000000; @ftonumz val2 val; ! 2.0
print "ftonumz 2.0="; check_hex(val, 2); print ", ";
val2 = $C0000000; @ftonumz val2 val; ! -2.0
print "ftonumz -2.0="; check_hex(val, -2); print ", ";
val2 = $4121999A; @ftonumz val2 val; ! 10.1
print "ftonumz 10.1="; check_hex(val, 10); print ", ";
val2 = $C121999A; @ftonumz val2 val; ! -10.1
print "ftonumz -10.1="; check_hex(val, -10); print ", ";
val2 = $4479FFFF; @ftonumz val2 val; ! 999.99995
print "ftonumz 999.99995="; check_hex(val, 999); print ", ";
val2 = $C479FFFF; @ftonumz val2 val; ! -999.99995
print "ftonumz -999.99995="; check_hex(val, -999); print ", ";
val2 = $4B800000; @ftonumz val2 val; ! $1000000
print "ftonumz $1000000="; check_hex(val, $1000000); print ", ";
val2 = $CB800000; @ftonumz val2 val; ! -$1000000
print "ftonumz -$1000000="; check_hex(val, -$1000000); print ", ";
val2 = $4EFFFFFE; @ftonumz val2 val; ! $7FFFFF00
print "ftonumz $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
val2 = $CEFFFFFE; @ftonumz val2 val; ! -$7FFFFF00
print "ftonumz -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
val2 = $4F000000; @ftonumz val2 val; ! $80000000
print "ftonumz $80000000="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $CF000000; @ftonumz val2 val; ! -$80000000
print "ftonumz -$80000000="; check_hex(val, $80000000); print ", ";
val2 = $4F100000; @ftonumz val2 val; ! $90000000
print "ftonumz $90000000="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $CF100000; @ftonumz val2 val; ! -$90000000
print "ftonumz -$90000000="; check_hex(val, $80000000); print ", ";
val2 = $4F412345; @ftonumz val2 val; ! $C1234500
print "ftonumz $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $CF412345; @ftonumz val2 val; ! -$C1234500
print "ftonumz -$C1234500="; check_hex(val, $80000000); print ", ";
val2 = $4F800000; @ftonumz val2 val; ! $100000000
print "ftonumz $100000000="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $CF800000; @ftonumz val2 val; ! -$100000000
print "ftonumz -$100000000="; check_hex(val, $80000000); print ", ";
val2 = $78D18A8B; @ftonumz val2 val; ! 3.4e+34
print "ftonumz 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $F8D18A8B; @ftonumz val2 val; ! -3.4e+34
print "ftonumz -3.4e+34="; check_hex(val, $80000000); print ", ";
val2 = M_INF; @ftonumz val2 val;
print "ftonumz +Inf="; check_hex(val, $7FFFFFFF); print ", ";
val2 = M_NINF; @ftonumz val2 val;
print "ftonumz -Inf="; check_hex(val, $80000000); print ", ";
val2 = M_NAN; @ftonumz val2 val;
print "ftonumz +NaN="; check_hex(val, $7FFFFFFF); print ", ";
val2 = M_NNAN; @ftonumz val2 val;
print "ftonumz -NaN="; check_hex(val, $80000000); print "^";
@push M_0; noop(); @ftonumz sp val; ! 0.0
print "ftonumz 0.0="; check_hex(val, 0); print ", ";
@push M_N0; noop(); @ftonumz sp val; ! -0.0
print "ftonumz -0.0="; check_hex(val, 0); print ", ";
@push $3F666666; @ftonumz sp val; ! 0.9
print "ftonumz 0.9="; check_hex(val, 0); print ", ";
@push $BF666666; @ftonumz sp val; ! -0.9
print "ftonumz -0.9="; check_hex(val, 0); print ", ";
@push $3F800000; noop(); @ftonumz sp val; ! 1.0
print "ftonumz 1.0="; check_hex(val, 1); print ", ";
@push $BF800000; noop(); @ftonumz sp val; ! -1.0
print "ftonumz -1.0="; check_hex(val, -1); print ", ";
@push $3FE00000; @ftonumz sp val; ! 1.75
print "ftonumz 1.75="; check_hex(val, 1); print ", ";
@push $BFE00000; @ftonumz sp val; ! -1.75
print "ftonumz -1.75="; check_hex(val, -1); print ", ";
@push $40000000; noop(); @ftonumz sp val; ! 2.0
print "ftonumz 2.0="; check_hex(val, 2); print ", ";
@push $C0000000; noop(); @ftonumz sp val; ! -2.0
print "ftonumz -2.0="; check_hex(val, -2); print ", ";
@push $4121999A; @ftonumz sp val; ! 10.1
print "ftonumz 10.1="; check_hex(val, 10); print ", ";
@push $C121999A; @ftonumz sp val; ! -10.1
print "ftonumz -10.1="; check_hex(val, -10); print ", ";
@push $4479FFFF; noop(); @ftonumz sp val; ! 999.99995
print "ftonumz 999.99995="; check_hex(val, 999); print ", ";
@push $C479FFFF; noop(); @ftonumz sp val; ! -999.99995
print "ftonumz -999.99995="; check_hex(val, -999); print ", ";
@push $4B800000; @ftonumz sp val; ! $1000000
print "ftonumz $1000000="; check_hex(val, $1000000); print ", ";
@push $CB800000; @ftonumz sp val; ! -$1000000
print "ftonumz -$1000000="; check_hex(val, -$1000000); print ", ";
@push $4EFFFFFE; noop(); @ftonumz sp val; ! $7FFFFF00
print "ftonumz $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
@push $CEFFFFFE; noop(); @ftonumz sp val; ! -$7FFFFF00
print "ftonumz -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
@push $4F000000; @ftonumz sp val; ! $80000000
print "ftonumz $80000000="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF000000; @ftonumz sp val; ! -$80000000
print "ftonumz -$80000000="; check_hex(val, $80000000); print ", ";
@push $4F100000; @ftonumz sp val; ! $90000000
print "ftonumz $90000000="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF100000; @ftonumz sp val; ! -$90000000
print "ftonumz -$90000000="; check_hex(val, $80000000); print ", ";
@push $4F412345; @ftonumz sp val; ! $C1234500
print "ftonumz $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF412345; @ftonumz sp val; ! -$C1234500
print "ftonumz -$C1234500="; check_hex(val, $80000000); print ", ";
@push $4F800000; @ftonumz sp val; ! $100000000
print "ftonumz $100000000="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF800000; @ftonumz sp val; ! -$100000000
print "ftonumz -$100000000="; check_hex(val, $80000000); print ", ";
@push $78D18A8B; @ftonumz sp val; ! 3.4e+34
print "ftonumz 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
@push $F8D18A8B; @ftonumz sp val; ! -3.4e+34
print "ftonumz -3.4e+34="; check_hex(val, $80000000); print ", ";
@push M_INF; noop(); @ftonumz sp val;
print "ftonumz +Inf="; check_hex(val, $7FFFFFFF); print ", ";
@push M_NINF; noop(); @ftonumz sp val;
print "ftonumz -Inf="; check_hex(val, $80000000); print ", ";
@push M_NAN; @ftonumz sp val;
print "ftonumz +NaN="; check_hex(val, $7FFFFFFF); print ", ";
@push M_NNAN; @ftonumz sp val;
print "ftonumz -NaN="; check_hex(val, $80000000); print "^";
new_line;
@ftonumn M_0 val; ! 0.0
print "ftonumn 0.0="; check_hex(val, 0); print ", ";
@ftonumn M_N0 val; ! -0.0
print "ftonumn -0.0="; check_hex(val, 0); print ", ";
@ftonumn $3F666666 val; ! 0.9
print "ftonumn 0.9="; check_hex(val, 1); print ", ";
@ftonumn $BF666666 val; ! -0.9
print "ftonumn -0.9="; check_hex(val, -1); print ", ";
@ftonumn $3F800000 val; ! 1.0
print "ftonumn 1.0="; check_hex(val, 1); print ", ";
@ftonumn $BF800000 val; ! -1.0
print "ftonumn -1.0="; check_hex(val, -1); print ", ";
@ftonumn $3FE00000 val; ! 1.75
print "ftonumn 1.75="; check_hex(val, 2); print ", ";
@ftonumn $BFE00000 val; ! -1.75
print "ftonumn -1.75="; check_hex(val, -2); print ", ";
@ftonumn $40000000 val; ! 2.0
print "ftonumn 2.0="; check_hex(val, 2); print ", ";
@ftonumn $C0000000 val; ! -2.0
print "ftonumn -2.0="; check_hex(val, -2); print ", ";
@ftonumn $4121999A val; ! 10.1
print "ftonumn 10.1="; check_hex(val, 10); print ", ";
@ftonumn $C121999A val; ! -10.1
print "ftonumn -10.1="; check_hex(val, -10); print ", ";
@ftonumn $4479FFFF val; ! 999.99995
print "ftonumn 999.99995="; check_hex(val, 1000); print ", ";
@ftonumn $C479FFFF val; ! -999.99995
print "ftonumn -999.99995="; check_hex(val, -1000); print ", ";
@ftonumn $4B800000 val; ! $1000000
print "ftonumn $1000000="; check_hex(val, $1000000); print ", ";
@ftonumn $CB800000 val; ! -$1000000
print "ftonumn -$1000000="; check_hex(val, -$1000000); print ", ";
@ftonumn $4EFFFFFE val; ! $7FFFFF00
print "ftonumn $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
@ftonumn $CEFFFFFE val; ! -$7FFFFF00
print "ftonumn -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
@ftonumn $4F000000 val; ! $80000000
print "ftonumn $80000000="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumn $CF000000 val; ! -$80000000
print "ftonumn -$80000000="; check_hex(val, $80000000); print ", ";
@ftonumn $4F100000 val; ! $90000000
print "ftonumn $90000000="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumn $CF100000 val; ! -$90000000
print "ftonumn -$90000000="; check_hex(val, $80000000); print ", ";
@ftonumn $4F412345 val; ! $C1234500
print "ftonumn $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumn $CF412345 val; ! -$C1234500
print "ftonumn -$C1234500="; check_hex(val, $80000000); print ", ";
@ftonumn $4F800000 val; ! $100000000
print "ftonumn $100000000="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumn $CF800000 val; ! -$100000000
print "ftonumn -$100000000="; check_hex(val, $80000000); print ", ";
@ftonumn $78D18A8B val; ! 3.4e+34
print "ftonumn 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumn $F8D18A8B val; ! -3.4e+34
print "ftonumn -3.4e+34="; check_hex(val, $80000000); print ", ";
@ftonumn M_INF val;
print "ftonumn +Inf="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumn M_NINF val;
print "ftonumn -Inf="; check_hex(val, $80000000); print ", ";
@ftonumn M_NAN val;
print "ftonumn +NaN="; check_hex(val, $7FFFFFFF); print ", ";
@ftonumn M_NNAN val;
print "ftonumn -NaN="; check_hex(val, $80000000); print "^";
val2 = M_0; @ftonumn val2 val; ! 0.0
print "ftonumn 0.0="; check_hex(val, 0); print ", ";
val2 = M_N0; @ftonumn val2 val; ! -0.0
print "ftonumn -0.0="; check_hex(val, 0); print ", ";
val2 = $3F666666; @ftonumn val2 val; ! 0.9
print "ftonumn 0.9="; check_hex(val, 1); print ", ";
val2 = $BF666666; @ftonumn val2 val; ! -0.9
print "ftonumn -0.9="; check_hex(val, -1); print ", ";
val2 = $3F800000; @ftonumn val2 val; ! 1.0
print "ftonumn 1.0="; check_hex(val, 1); print ", ";
val2 = $BF800000; @ftonumn val2 val; ! -1.0
print "ftonumn -1.0="; check_hex(val, -1); print ", ";
val2 = $3FE00000; @ftonumn val2 val; ! 1.75
print "ftonumn 1.75="; check_hex(val, 2); print ", ";
val2 = $BFE00000; @ftonumn val2 val; ! -1.75
print "ftonumn -1.75="; check_hex(val, -2); print ", ";
val2 = $40000000; @ftonumn val2 val; ! 2.0
print "ftonumn 2.0="; check_hex(val, 2); print ", ";
val2 = $C0000000; @ftonumn val2 val; ! -2.0
print "ftonumn -2.0="; check_hex(val, -2); print ", ";
val2 = $4121999A; @ftonumn val2 val; ! 10.1
print "ftonumn 10.1="; check_hex(val, 10); print ", ";
val2 = $C121999A; @ftonumn val2 val; ! -10.1
print "ftonumn -10.1="; check_hex(val, -10); print ", ";
val2 = $4479FFFF; @ftonumn val2 val; ! 999.99995
print "ftonumn 999.99995="; check_hex(val, 1000); print ", ";
val2 = $C479FFFF; @ftonumn val2 val; ! -999.99995
print "ftonumn -999.99995="; check_hex(val, -1000); print ", ";
val2 = $4B800000; @ftonumn val2 val; ! $1000000
print "ftonumn $1000000="; check_hex(val, $1000000); print ", ";
val2 = $CB800000; @ftonumn val2 val; ! -$1000000
print "ftonumn -$1000000="; check_hex(val, -$1000000); print ", ";
val2 = $4EFFFFFE; @ftonumn val2 val; ! $7FFFFF00
print "ftonumn $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
val2 = $CEFFFFFE; @ftonumn val2 val; ! -$7FFFFF00
print "ftonumn -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
val2 = $4F000000; @ftonumn val2 val; ! $80000000
print "ftonumn $80000000="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $CF000000; @ftonumn val2 val; ! -$80000000
print "ftonumn -$80000000="; check_hex(val, $80000000); print ", ";
val2 = $CF100000; @ftonumn val2 val; ! -$90000000
print "ftonumn -$90000000="; check_hex(val, $80000000); print ", ";
val2 = $4F412345; @ftonumn val2 val; ! $C1234500
print "ftonumn $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $CF412345; @ftonumn val2 val; ! -$C1234500
print "ftonumn -$C1234500="; check_hex(val, $80000000); print ", ";
val2 = $4F800000; @ftonumn val2 val; ! $100000000
print "ftonumn $100000000="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $CF800000; @ftonumn val2 val; ! -$100000000
print "ftonumn -$100000000="; check_hex(val, $80000000); print ", ";
val2 = $78D18A8B; @ftonumn val2 val; ! 3.4e+34
print "ftonumn 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
val2 = $F8D18A8B; @ftonumn val2 val; ! -3.4e+34
print "ftonumn -3.4e+34="; check_hex(val, $80000000); print ", ";
val2 = M_INF; @ftonumn val2 val;
print "ftonumn +Inf="; check_hex(val, $7FFFFFFF); print ", ";
val2 = M_NINF; @ftonumn val2 val;
print "ftonumn -Inf="; check_hex(val, $80000000); print ", ";
val2 = M_NAN; @ftonumn val2 val;
print "ftonumn +NaN="; check_hex(val, $7FFFFFFF); print ", ";
val2 = M_NNAN; @ftonumn val2 val;
print "ftonumn -NaN="; check_hex(val, $80000000); print "^";
testglobal = M_0; @ftonumn testglobal val; ! 0.0
print "ftonumn 0.0="; check_hex(val, 0); print ", ";
testglobal = M_N0; @ftonumn testglobal val; ! -0.0
print "ftonumn -0.0="; check_hex(val, 0); print ", ";
testglobal = $3F666666; @ftonumn testglobal val; ! 0.9
print "ftonumn 0.9="; check_hex(val, 1); print ", ";
testglobal = $BF666666; @ftonumn testglobal val; ! -0.9
print "ftonumn -0.9="; check_hex(val, -1); print ", ";
testglobal = $3F800000; @ftonumn testglobal val; ! 1.0
print "ftonumn 1.0="; check_hex(val, 1); print ", ";
testglobal = $BF800000; @ftonumn testglobal val; ! -1.0
print "ftonumn -1.0="; check_hex(val, -1); print ", ";
testglobal = $3FE00000; @ftonumn testglobal val; ! 1.75
print "ftonumn 1.75="; check_hex(val, 2); print ", ";
testglobal = $BFE00000; @ftonumn testglobal val; ! -1.75
print "ftonumn -1.75="; check_hex(val, -2); print ", ";
testglobal = $40000000; @ftonumn testglobal val; ! 2.0
print "ftonumn 2.0="; check_hex(val, 2); print ", ";
testglobal = $C0000000; @ftonumn testglobal val; ! -2.0
print "ftonumn -2.0="; check_hex(val, -2); print ", ";
testglobal = $4121999A; @ftonumn testglobal val; ! 10.1
print "ftonumn 10.1="; check_hex(val, 10); print ", ";
testglobal = $C121999A; @ftonumn testglobal val; ! -10.1
print "ftonumn -10.1="; check_hex(val, -10); print ", ";
testglobal = $4479FFFF; @ftonumn testglobal val; ! 999.99995
print "ftonumn 999.99995="; check_hex(val, 1000); print ", ";
testglobal = $C479FFFF; @ftonumn testglobal val; ! -999.99995
print "ftonumn -999.99995="; check_hex(val, -1000); print ", ";
testglobal = $4B800000; @ftonumn testglobal val; ! $1000000
print "ftonumn $1000000="; check_hex(val, $1000000); print ", ";
testglobal = $CB800000; @ftonumn testglobal val; ! -$1000000
print "ftonumn -$1000000="; check_hex(val, -$1000000); print ", ";
testglobal = $4EFFFFFE; @ftonumn testglobal val; ! $7FFFFF00
print "ftonumn $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
testglobal = $CEFFFFFE; @ftonumn testglobal val; ! -$7FFFFF00
print "ftonumn -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
testglobal = $4F000000; @ftonumn testglobal val; ! $80000000
print "ftonumn $80000000="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF000000; @ftonumn testglobal val; ! -$80000000
print "ftonumn -$80000000="; check_hex(val, $80000000); print ", ";
testglobal = $4F100000; @ftonumn testglobal val; ! $90000000
print "ftonumn $90000000="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF100000; @ftonumn testglobal val; ! -$90000000
print "ftonumn -$90000000="; check_hex(val, $80000000); print ", ";
testglobal = $4F412345; @ftonumn testglobal val; ! $C1234500
print "ftonumn $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF412345; @ftonumn testglobal val; ! -$C1234500
print "ftonumn -$C1234500="; check_hex(val, $80000000); print ", ";
testglobal = $4F800000; @ftonumn testglobal val; ! $100000000
print "ftonumn $100000000="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $CF800000; @ftonumn testglobal val; ! -$100000000
print "ftonumn -$100000000="; check_hex(val, $80000000); print ", ";
testglobal = $78D18A8B; @ftonumn testglobal val; ! 3.4e+34
print "ftonumn 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = $F8D18A8B; @ftonumn testglobal val; ! -3.4e+34
print "ftonumn -3.4e+34="; check_hex(val, $80000000); print ", ";
testglobal = M_INF; @ftonumn testglobal val;
print "ftonumn +Inf="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = M_NINF; @ftonumn testglobal val;
print "ftonumn -Inf="; check_hex(val, $80000000); print ", ";
testglobal = M_NAN; @ftonumn testglobal val;
print "ftonumn +NaN="; check_hex(val, $7FFFFFFF); print ", ";
testglobal = M_NNAN; @ftonumn testglobal val;
print "ftonumn -NaN="; check_hex(val, $80000000); print "^";
@push M_0; noop(); @ftonumn sp val; ! 0.0
print "ftonumn 0.0="; check_hex(val, 0); print ", ";
@push M_N0; noop(); @ftonumn sp val; ! -0.0
print "ftonumn -0.0="; check_hex(val, 0); print ", ";
@push $3F666666; @ftonumn sp val; ! 0.9
print "ftonumn 0.9="; check_hex(val, 1); print ", ";
@push $BF666666; @ftonumn sp val; ! -0.9
print "ftonumn -0.9="; check_hex(val, -1); print ", ";
@push $3F800000; noop(); @ftonumn sp val; ! 1.0
print "ftonumn 1.0="; check_hex(val, 1); print ", ";
@push $BF800000; noop(); @ftonumn sp val; ! -1.0
print "ftonumn -1.0="; check_hex(val, -1); print ", ";
@push $3FE00000; @ftonumn sp val; ! 1.75
print "ftonumn 1.75="; check_hex(val, 2); print ", ";
@push $BFE00000; @ftonumn sp val; ! -1.75
print "ftonumn -1.75="; check_hex(val, -2); print ", ";
@push $40000000; noop(); @ftonumn sp val; ! 2.0
print "ftonumn 2.0="; check_hex(val, 2); print ", ";
@push $C0000000; noop(); @ftonumn sp val; ! -2.0
print "ftonumn -2.0="; check_hex(val, -2); print ", ";
@push $4121999A; @ftonumn sp val; ! 10.1
print "ftonumn 10.1="; check_hex(val, 10); print ", ";
@push $C121999A; @ftonumn sp val; ! -10.1
print "ftonumn -10.1="; check_hex(val, -10); print ", ";
@push $4479FFFF; noop(); @ftonumn sp val; ! 999.99995
print "ftonumn 999.99995="; check_hex(val, 1000); print ", ";
@push $C479FFFF; noop(); @ftonumn sp val; ! -999.99995
print "ftonumn -999.99995="; check_hex(val, -1000); print ", ";
@push $4B800000; @ftonumn sp val; ! $1000000
print "ftonumn $1000000="; check_hex(val, $1000000); print ", ";
@push $CB800000; @ftonumn sp val; ! -$1000000
print "ftonumn -$1000000="; check_hex(val, -$1000000); print ", ";
@push $4EFFFFFE; noop(); @ftonumn sp val; ! $7FFFFF00
print "ftonumn $7FFFFF00="; check_hex(val, $7FFFFF00); print ", ";
@push $CEFFFFFE; noop(); @ftonumn sp val; ! -$7FFFFF00
print "ftonumn -$7FFFFF00="; check_hex(val, -$7FFFFF00); print ", ";
@push $4F000000; @ftonumn sp val; ! $80000000
print "ftonumn $80000000="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF000000; @ftonumn sp val; ! -$80000000
print "ftonumn -$80000000="; check_hex(val, $80000000); print ", ";
@push $4F100000; @ftonumn sp val; ! $90000000
print "ftonumn $90000000="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF100000; @ftonumn sp val; ! -$90000000
print "ftonumn -$90000000="; check_hex(val, $80000000); print ", ";
@push $4F412345; @ftonumn sp val; ! $C1234500
print "ftonumn $C1234500="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF412345; @ftonumn sp val; ! -$C1234500
print "ftonumn -$C1234500="; check_hex(val, $80000000); print ", ";
@push $4F800000; @ftonumn sp val; ! $100000000
print "ftonumn $100000000="; check_hex(val, $7FFFFFFF); print ", ";
@push $CF800000; @ftonumn sp val; ! -$100000000
print "ftonumn -$100000000="; check_hex(val, $80000000); print ", ";
@push $78D18A8B; @ftonumn sp val; ! 3.4e+34
print "ftonumn 3.4e+34="; check_hex(val, $7FFFFFFF); print ", ";
@push $F8D18A8B; @ftonumn sp val; ! -3.4e+34
print "ftonumn -3.4e+34="; check_hex(val, $80000000); print ", ";
@push M_INF; noop(); @ftonumn sp val;
print "ftonumn +Inf="; check_hex(val, $7FFFFFFF); print ", ";
@push M_NINF; noop(); @ftonumn sp val;
print "ftonumn -Inf="; check_hex(val, $80000000); print ", ";
@push M_NAN; @ftonumn sp val;
print "ftonumn +NaN="; check_hex(val, $7FFFFFFF); print ", ";
@push M_NNAN; @ftonumn sp val;
print "ftonumn -NaN="; check_hex(val, $80000000); print "^";
count_failures();
];
TestFloatClass FloatArithTest
with name 'floatarith',
short_name "floatarith",
testfunc [ val val1 val2;
print "Floating-point arithmetic:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
@fadd M_1 $3FC00000 val;
print "add(1,1.5)="; check_float(val, $40200000); print ", ";
@fadd $3F000000 $BFC00000 val;
print "add(0.5,-1.5)="; check_float(val, $BF800000); print ", ";
val1 = $BF000000;
val2 = $BFC00000;
@fadd val1 val2 val;
print "add(-0.5,-1.5)="; check_float(val, $C0000000); print ", ";
testglobal = $BF000000;
testglobal2 = $3FC00000;
@fadd testglobal testglobal2 val;
print "add(-0.5,1.5)="; check_float(val, $3F800000); print ", ";
@push $40200000;
@push $0;
noop();
@fadd sp sp sp;
@pull val;
print "add(0,2.5)="; check_float(val, $40200000); print "^";
@fsub M_1 $3FC00000 val;
print "sub(1,1.5)="; check_float(val, $BF000000); print ", ";
@fsub $3F000000 $BFC00000 val;
print "sub(0.5,-1.5)="; check_float(val, $40000000); print ", ";
val1 = $BF000000;
val2 = $BFC00000;
@fsub val1 val2 val;
print "sub(-0.5,-1.5)="; check_float(val, $3F800000); print ", ";
testglobal = $BF000000;
testglobal2 = $3FC00000;
@fsub testglobal testglobal2 val;
print "sub(-0.5,1.5)="; check_float(val, $C0000000); print ", ";
@push $40200000;
@push $0;
noop();
@fsub sp sp sp;
@pull val;
print "sub(0,2.5)="; check_float(val, $C0200000); print "^";
@fmul $3FA00000 $3FC00000 val;
print "mul(1.25,1.5)="; check_float(val, $3FF00000); print ", ";
@fmul $3F000000 $BFC00000 val;
print "mul(0.5,-1.5)="; check_float(val, $BF400000); print ", ";
val1 = $BF400000;
val2 = $BFC00000;
@fmul val1 val2 val;
print "mul(-0.75,-1.5)="; check_float(val, $3F900000); print ", ";
testglobal = $BF000000;
testglobal2 = $40000000;
@fmul testglobal testglobal2 val;
print "mul(-0.5,2)="; check_float(val, $BF800000); print ", ";
@push $40200000;
@push $40800000;
noop();
@fmul sp sp sp;
@pull val;
print "mul(4,2.5)="; check_float(val, $41200000); print "^";
@fdiv $3FA00000 $3FC00000 val;
print "div(1.25,1.5)="; check_float(val, $3F555555); print ", ";
@fdiv $3F000000 $BFC00000 val;
print "div(0.5,-1.5)="; check_float(val, $BEAAAAAB); print ", ";
val1 = $BF400000;
val2 = $BFC00000;
@fdiv val1 val2 val;
print "div(-0.75,-1.5)="; check_float(val, $3F000000); print ", ";
testglobal = $BF000000;
testglobal2 = $40000000;
@fdiv testglobal testglobal2 val;
print "div(-0.5,2)="; check_float(val, $BE800000); print ", ";
@push $40200000;
@push $40800000;
noop();
@fdiv sp sp sp;
@pull val;
print "div(4,2.5)="; check_float(val, $3FCCCCCD); print "^";
new_line;
@fadd M_1 M_1 val;
print "add(1,1)="; check_float(val, $40000000); print ", ";
@fadd M_N1 M_1 val;
print "add(-1,1)="; check_float(val, M_0); print ", ";
@fadd M_N1 M_N1 val;
print "add(-1,-1)="; check_float(val, $C0000000); print ", ";
@fadd M_1 M_0 val;
print "add(1,0)="; check_float(val, M_1); print ", ";
@fadd M_N0 M_1 val;
print "add(-0,1)="; check_float(val, M_1); print ", ";
@fadd M_N0 M_0 val;
print "add(-0,0)="; check_float(val, M_0); print ", ";
@fadd $42F60000 M_N0 val;
print "add(123,-0)="; check_float(val, $42F60000); print ", ";
@fadd M_0 $42F60000 val;
print "add(0,123)="; check_float(val, $42F60000); print ", ";
@fadd $3F800001 M_N1 val;
print "add(1.0000001,-1)="; check_float(val, $34000000); print ", ";
@fadd $7F7FFFFF $7F7FFFFF val;
print "add(3.4e38,3.4e38)="; check_float(val, M_INF); print ", ";
@fadd $FF7FFFFF $FF7FFFFF val;
print "add(-3.4e38,-3.4e38)="; check_float(val, M_NINF); print ", ";
@fadd $7F7FFFFF $FF7FFFFF val;
print "add(3.4e38,-3.4e38)="; check_float(val, M_0); print ", ";
@fadd M_INF $42F60000 val;
print "add(Inf,123)="; check_float(val, M_INF); print ", ";
@fadd M_NINF $42F60000 val;
print "add(-Inf,123)="; check_float(val, M_NINF); print ", ";
@fadd M_INF M_INF val;
print "add(Inf,Inf)="; check_float(val, M_INF); print ", ";
@fadd M_NINF M_INF val;
print "add(-Inf,Inf)="; check_isnan(val); print "^";
@fadd M_1 M_NAN val;
print "add(1,NaN)="; check_isnan(val); print ", ";
@fadd M_NAN M_N0 val;
print "add(NaN,-0)="; check_isnan(val); print ", ";
@fadd M_INF M_NAN val;
print "add(Inf,NaN)="; check_isnan(val); print ", ";
@fadd M_NINF M_NAN val;
print "add(-Inf,NaN)="; check_isnan(val); print ", ";
@fadd M_NAN M_NAN val;
print "add(NaN,NaN)="; check_isnan(val); print "^";
new_line;
@fsub M_1 M_1 val;
print "sub(1,1)="; check_float(val, M_0); print ", ";
@fsub M_N1 M_1 val;
print "sub(-1,1)="; check_float(val, $C0000000); print ", ";
@fsub M_N1 M_N1 val;
print "sub(-1,-1)="; check_float(val, M_0); print ", ";
@fsub M_1 M_0 val;
print "sub(1,0)="; check_float(val, M_1); print ", ";
@fsub M_N0 M_1 val;
print "sub(-0,1)="; check_float(val, M_N1); print ", ";
@fsub $42F60000 M_N0 val;
print "sub(123,-0)="; check_float(val, $42F60000); print ", ";
@fsub M_0 $42F60000 val;
print "sub(0,123)="; check_float(val, $C2F60000); print ", ";
@fsub $3F800001 M_1 val;
print "sub(1.0000001,1)="; check_float(val, $34000000); print ", ";
@fsub $7F7FFFFF $7F7FFFFF val;
print "sub(3.4e38,3.4e38)="; check_float(val, M_0); print ", ";
@fsub $FF7FFFFF $FF7FFFFF val;
print "sub(-3.4e38,-3.4e38)="; check_float(val, M_0); print ", ";
@fsub $7F7FFFFF $FF7FFFFF val;
print "sub(3.4e38,-3.4e38)="; check_float(val, M_INF); print ", ";
@fsub $FF7FFFFF $7F7FFFFF val;
print "sub(-3.4e38,3.4e38)="; check_float(val, M_NINF); print ", ";
@fsub M_INF $42F60000 val;
print "sub(Inf,123)="; check_float(val, M_INF); print ", ";
@fsub M_NINF $42F60000 val;
print "sub(-Inf,123)="; check_float(val, M_NINF); print ", ";
@fsub $42F60000 M_INF val;
print "sub(123,Inf)="; check_float(val, M_NINF); print ", ";
@fsub $42F60000 M_NINF val;
print "sub(123,-Inf)="; check_float(val, M_INF); print ", ";
@fsub M_INF M_NINF val;
print "sub(Inf,-Inf)="; check_float(val, M_INF); print ", ";
@fsub M_NINF M_INF val;
print "sub(-Inf,Inf)="; check_float(val, M_NINF); print ", ";
@fsub M_NINF M_NINF val;
print "sub(-Inf,-Inf)="; check_isnan(val); print ", ";
@fsub M_INF M_INF val;
print "sub(Inf,Inf)="; check_isnan(val); print "^";
@fsub M_1 M_NAN val;
print "sub(1,NaN)="; check_isnan(val); print ", ";
@fsub M_NAN M_N0 val;
print "sub(NaN,-0)="; check_isnan(val); print ", ";
@fsub M_INF M_NAN val;
print "sub(Inf,NaN)="; check_isnan(val); print ", ";
@fsub M_NINF M_NAN val;
print "sub(-Inf,NaN)="; check_isnan(val); print ", ";
@fsub M_NAN M_NAN val;
print "sub(NaN,NaN)="; check_isnan(val); print "^";
new_line;
@fmul M_1 M_1 val;
print "mul(1,1)="; check_float(val, M_1); print ", ";
@fmul M_N1 M_1 val;
print "mul(-1,1)="; check_float(val, M_N1); print ", ";
@fmul M_N1 M_N1 val;
print "mul(-1,-1)="; check_float(val, M_1); print ", ";
@fmul M_1 M_0 val;
print "mul(1,0)="; check_float(val, M_0); print ", ";
@fmul M_N0 M_1 val;
print "mul(-0,1)="; check_float(val, M_N0); print ", ";
@fmul M_N0 M_N1 val;
print "mul(-0,-1)="; check_float(val, M_0); print ", ";
@fmul $42F60000 M_N1 val;
print "mul(123,-1)="; check_float(val, $C2F60000); print ", ";
@fmul M_1 $42F60000 val;
print "mul(1,123)="; check_float(val, $42F60000); print ", ";
@fmul $7F7FFFFF $00200001 val;
print "mul(3.4e38,2.9e-39)="; check_float(val, $3F800003); print ", ";
@fmul $00200000 $00200000 val;
print "mul(2.9e-39,2.9e-39)="; check_float(val, M_0); print ", ";
@fmul $80200000 $00200000 val;
print "mul(-2.9e-39,2.9e-39)="; check_float(val, M_N0); print ", ";
@fmul $60AD78EC $60AD78EC val;
print "mul(1e20,1e20)="; check_float(val, M_INF); print ", ";
@fmul $60AD78EC $E0AD78EC val;
print "mul(1e20,-1e20)="; check_float(val, M_NINF); print ", ";
@fmul $E0AD78EC $E0AD78EC val;
print "mul(-1e20,-1e20)="; check_float(val, M_INF); print ", ";
@fmul M_INF $38D1B717 val;
print "mul(Inf,0.0001)="; check_float(val, M_INF); print ", ";
@fmul M_NINF $38D1B717 val;
print "mul(-Inf,0.0001)="; check_float(val, M_NINF); print ", ";
@fmul M_INF M_INF val;
print "mul(Inf,Inf)="; check_float(val, M_INF); print ", ";
@fmul M_NINF M_INF val;
print "mul(-Inf,Inf)="; check_float(val, M_NINF); print ", ";
@fmul M_NINF M_NINF val;
print "mul(-Inf,-Inf)="; check_float(val, M_INF); print ", ";
@fmul M_INF M_0 val;
print "mul(Inf,0)="; check_isnan(val); print ", ";
@fmul M_N0 M_INF val;
print "mul(-0,Inf)="; check_isnan(val); print "^";
@fmul M_1 M_NAN val;
print "mul(1,NaN)="; check_isnan(val); print ", ";
@fmul M_NAN M_N0 val;
print "mul(NaN,-0)="; check_isnan(val); print ", ";
@fmul M_INF M_NAN val;
print "mul(Inf,NaN)="; check_isnan(val); print ", ";
@fmul M_NINF M_NAN val;
print "mul(-Inf,NaN)="; check_isnan(val); print ", ";
@fmul M_NAN M_NAN val;
print "mul(NaN,NaN)="; check_isnan(val); print "^";
new_line;
@fdiv M_1 M_1 val;
print "div(1,1)="; check_float(val, M_1); print ", ";
@fdiv M_N1 M_1 val;
print "div(-1,1)="; check_float(val, M_N1); print ", ";
@fdiv M_N1 M_N1 val;
print "div(-1,-1)="; check_float(val, M_1); print ", ";
@fdiv M_1 M_0 val;
print "div(1,0)="; check_float(val, M_INF); print ", ";
@fdiv M_1 M_N0 val;
print "div(1,-0)="; check_float(val, M_NINF); print ", ";
@fdiv M_N0 M_1 val;
print "div(-0,1)="; check_float(val, M_N0); print ", ";
@fdiv M_N0 M_N1 val;
print "div(-0,-1)="; check_float(val, M_0); print ", ";
@fdiv $42F60000 M_N1 val;
print "div(123,-1)="; check_float(val, $C2F60000); print ", ";
@fdiv $42F60000 M_1 val;
print "div(123,1)="; check_float(val, $42F60000); print ", ";
@fdiv $7F7FFFFF $00200000 val;
print "div(3.4e38,2.9e-39)="; check_float(val, M_INF); print ", ";
@fdiv $00200000 $00200000 val;
print "div(2.9e-39,2.9e-39)="; check_float(val, M_1); print ", ";
@fdiv $80200000 $00200000 val;
print "div(-2.9e-39,2.9e-39)="; check_float(val, M_N1); print ", ";
@fdiv $60AD78EC $60AD78EC val;
print "div(1e20,1e20)="; check_float(val, M_1); print ", ";
@fdiv $60AD78EC $E0AD78EC val;
print "div(1e20,-1e20)="; check_float(val, M_N1); print ", ";
@fdiv M_INF $461C4000 val;
print "div(Inf,10000)="; check_float(val, M_INF); print ", ";
@fdiv M_NINF $461C4000 val;
print "div(-Inf,10000)="; check_float(val, M_NINF); print ", ";
@fdiv M_INF M_0 val;
print "div(Inf,0)="; check_float(val, M_INF); print ", ";
@fdiv M_INF M_N0 val;
print "div(Inf,-0)="; check_float(val, M_NINF); print ", ";
@fdiv M_INF M_INF val;
print "div(Inf,Inf)="; check_isnan(val); print ", ";
@fdiv M_NINF M_INF val;
print "div(-Inf,Inf)="; check_isnan(val); print ", ";
@fdiv M_0 M_0 val;
print "div(0,0)="; check_isnan(val); print ", ";
@fdiv M_N0 M_0 val;
print "div(-0,0)="; check_isnan(val); print "^";
@fdiv M_1 M_NAN val;
print "div(1,NaN)="; check_isnan(val); print ", ";
@fdiv M_NAN M_N0 val;
print "div(NaN,-0)="; check_isnan(val); print ", ";
@fdiv M_INF M_NAN val;
print "div(Inf,NaN)="; check_isnan(val); print ", ";
@fdiv M_NINF M_NAN val;
print "div(-Inf,NaN)="; check_isnan(val); print ", ";
@fdiv M_NAN M_NAN val;
print "div(NaN,NaN)="; check_isnan(val); print "^";
count_failures();
];
TestFloatClass FloatModTest
with name 'floatmod',
testfunc [ val rem quo val1 val2;
print "Floating-point modulo:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
@fmod $40840000 $40000000 rem quo;
print "mod(4.125,2)=rem "; check_float(rem, $3E000000);
print " quo "; check_float(quo, $40000000); print ", ";
val1 = $40A00000;
val2 = $3FC00000;
@fmod val1 val2 rem quo;
print "mod(5,1.5)=rem "; check_float(rem, $3F000000);
print " quo "; check_float(quo, $40400000); print ", ";
testglobal = $40E40000;
testglobal2 = $3F800000;
@fmod testglobal testglobal2 rem quo;
print "mod(7.125,1)=rem "; check_float(rem, $3E000000);
print " quo "; check_float(quo, $40E00000); print ", ";
@push $3FE00000;
@push $40C00000;
noop();
@fmod sp sp sp sp;
@pull quo;
@pull rem;
print "mod(6,1.75)=rem "; check_float(rem, $3F400000);
print " quo "; check_float(quo, $40400000); print ", ";
val1 = $40A40000;
noop();
@fmod val1 $3F000000 testglobal sp;
@pull quo;
print "mod(5.125,0.5)=rem "; check_float(testglobal, $3E000000);
print " quo "; check_float(quo, $41200000); print ", ";
@push $40800000;
testglobal = $3F400000;
noop();
@fmod sp testglobal rem testglobal2;
print "mod(4,0.75)=rem "; check_float(rem, $3E800000);
print " quo "; check_float(testglobal2, $40A00000); print "^";
new_line;
val1 = $40200000;
val2 = M_1;
@fmod val1 val2 rem quo;
print "mod(2.5,1)=rem "; check_float(rem, $3F000000);
print " quo "; check_float(quo, $40000000); print ", ";
val1 = $40200000;
val2 = M_N1;
@fmod val1 val2 rem quo;
print "mod(2.5,-1)=rem "; check_float(rem, $3F000000);
print " quo "; check_float(quo, $C0000000); print ", ";
val1 = $C0200000;
val2 = M_1;
@fmod val1 val2 rem quo;
print "mod(-2.5,1)=rem "; check_float(rem, $BF000000);
print " quo "; check_float(quo, $C0000000); print ", ";
val1 = $C0200000;
val2 = M_N1;
@fmod val1 val2 rem quo;
print "mod(-2.5,-1)=rem "; check_float(rem, $BF000000);
print " quo "; check_float(quo, $40000000); print ", ";
val1 = M_0;
val2 = M_1;
@fmod val1 val2 rem quo;
print "mod(0,1)=rem "; check_float(rem, M_0);
print " quo "; check_float(quo, M_0); print ", ";
val1 = M_0;
val2 = M_N1;
@fmod val1 val2 rem quo;
print "mod(0,-1)=rem "; check_float(rem, M_0);
print " quo "; check_float(quo, M_N0); print ", ";
val1 = M_N0;
val2 = M_1;
@fmod val1 val2 rem quo;
print "mod(-0,1)=rem "; check_float(rem, M_N0);
print " quo "; check_float(quo, M_N0); print ", ";
val1 = M_N0;
val2 = M_N1;
@fmod val1 val2 rem quo;
print "mod(-0,-1)=rem "; check_float(rem, M_N0);
print " quo "; check_float(quo, M_0); print "^";
new_line;
@fmod $40A40000 $40000000 rem quo;
print "mod(5.125,2)=rem "; check_float(rem, $3F900000);
print " quo "; check_float(quo, $40000000); print ", ";
@fmod $40A40000 $C0000000 rem quo;
print "mod(5.125,-2)=rem "; check_float(rem, $3F900000);
print " quo "; check_float(quo, $C0000000); print ", ";
@fmod $C0A40000 $40000000 rem quo;
print "mod(-5.125,2)=rem "; check_float(rem, $BF900000);
print " quo "; check_float(quo, $C0000000); print ", ";
@fmod $C0A40000 $C0000000 rem quo;
print "mod(-5.125,-2)=rem "; check_float(rem, $BF900000);
print " quo "; check_float(quo, $40000000); print "^";
@fmod $40A40000 M_1 rem quo;
print "mod(5.125,1)=rem "; check_float(rem, $3E000000);
print " quo "; check_float(quo, $40A00000); print ", ";
@fmod $40A40000 M_N1 rem quo;
print "mod(5.125,-1)=rem "; check_float(rem, $3E000000);
print " quo "; check_float(quo, $C0A00000); print ", ";
@fmod $C0A40000 M_1 rem quo;
print "mod(-5.125,1)=rem "; check_float(rem, $BE000000);
print " quo "; check_float(quo, $C0A00000); print ", ";
@fmod $C0A40000 M_N1 rem quo;
print "mod(-5.125,-1)=rem "; check_float(rem, $BE000000);
print " quo "; check_float(quo, $40A00000); print "^";
@fmod $3FC00000 $3F400000 rem quo;
print "mod(1.5,0.75)=rem "; check_float(rem, M_0);
print " quo "; check_float(quo, $40000000); print ", ";
@fmod $3FC00000 $BF400000 rem quo;
print "mod(1.5,-0.75)=rem "; check_float(rem, M_0);
print " quo "; check_float(quo, $C0000000); print ", ";
@fmod $BFC00000 $3F400000 rem quo;
print "mod(-1.5,0.75)=rem "; check_float(rem, M_N0);
print " quo "; check_float(quo, $C0000000); print ", ";
@fmod $BFC00000 $BF400000 rem quo;
print "mod(-1.5,-0.75)=rem "; check_float(rem, M_N0);
print " quo "; check_float(quo, $40000000); print "^";
new_line;
@fmod $1E3CE508 M_1 rem quo;
print "mod(1e-20,1)=rem "; check_float(rem, $1E3CE508);
print " quo "; check_float(quo, M_0); print ", ";
@fmod $60AD78EC M_1 rem quo;
print "mod(1e20,1)=rem "; check_float(rem, M_0);
print " quo "; check_float(quo, $60AD78EC); print ", ";
@fmod $4AFFFFFF M_1 rem quo;
print "mod(8388607.5,1)=rem "; check_float(rem, $3F000000);
print " quo "; check_float(quo, $4AFFFFFE); print ", ";
@fmod $CAFFFFFF M_1 rem quo;
print "mod(-8388607.5,1)=rem "; check_float(rem, $BF000000);
print " quo "; check_float(quo, $CAFFFFFE); print "^";
@fmod $5268D4A6 $501502F9 rem quo;
print "mod(2.5e11,1e10)=rem "; check_float(rem, $46700000);
print " quo "; check_float(quo, $41C80000); print ", ";
@fmod $50BA43B8 $501502F9 rem quo;
print "mod(2.5e10,1e10)=rem "; check_float(rem, $4F9502FC);
print " quo "; check_float(quo, $40000000); print ", ";
@fmod $50BA43B8 $3C4985F0 rem quo;
print "mod(2.5e10,0.0123)=rem "; check_float(rem, $3B455840);
print " quo "; check_float(quo, $53EC9DD5); print "^";
new_line;
@fmod M_0 M_0 rem quo;
print "mod(0,0)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_N0 M_0 rem quo;
print "mod(-0,0)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_1 M_0 rem quo;
print "mod(1,0)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_INF M_1 rem quo;
print "mod(Inf,1)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_NINF M_1 rem quo;
print "mod(-Inf,1)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_INF M_INF rem quo;
print "mod(Inf,Inf)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_INF M_NINF rem quo;
print "mod(Inf,-Inf)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_NINF M_INF rem quo;
print "mod(-Inf,Inf)=rem "; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_0 M_1 rem quo;
print "mod(0,1)=rem "; check_float(rem, M_0);
print " quo "; check_float(quo, M_0); print ", ";
@fmod M_N0 M_1 rem quo;
print "mod(-0,1)=rem "; check_float(rem, M_N0);
print " quo "; check_float(quo, M_N0); print ", ";
@fmod M_0 M_N1 rem quo;
print "mod(0,-1)=rem "; check_float(rem, M_0);
print " quo "; check_float(quo, M_N0); print ", ";
@fmod M_N0 M_N1 rem quo;
print "mod(-0,-1)=rem "; check_float(rem, M_N0);
print " quo "; check_float(quo, M_0); print ", ";
@fmod M_1 M_INF rem quo;
print "mod(1,Inf)=rem "; check_float(rem, M_1);
print " quo "; check_float(quo, M_0); print ", ";
@fmod M_1 M_NINF rem quo;
print "mod(1,-Inf)=rem "; check_float(rem, M_1);
print " quo "; check_float(quo, M_N0); print ", ";
@fmod $C0000000 M_Inf rem quo;
print "mod(-2,Inf)=rem "; check_float(rem, $C0000000);
print " quo "; check_float(quo, M_N0); print ", ";
@fmod $BE000000 M_Inf rem quo;
print "mod(-0.125,Inf)=rem "; check_float(rem, $BE000000);
print " quo "; check_float(quo, M_N0); print "^";
new_line;
@fmod M_1 M_NAN rem quo;
print "mod(1,NaN)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_NAN M_N1 rem quo;
print "mod(NaN,-1)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_0 M_NAN rem quo;
print "mod(0,NaN)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_N0 M_NAN rem quo;
print "mod(N0,NaN)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_INF M_NAN rem quo;
print "mod(Inf,NaN)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_NAN M_INF rem quo;
print "mod(NaN,Inf)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_NAN M_NINF rem quo;
print "mod(NaN,-Inf)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_NINF M_NAN rem quo;
print "mod(-Inf,NaN)="; check_isnan(rem);
print " quo "; check_isnan(quo); print ", ";
@fmod M_NAN M_NAN rem quo;
print "mod(NaN,NaN)="; check_isnan(rem);
print " quo "; check_isnan(quo); print "^";
count_failures();
];
TestFloatClass FloatRoundTest
with name 'floatround',
short_name "floatround",
testfunc [ val val2;
print "Floating-point rounding:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
@floor $40600000 val; ! 3.5
print "floor 3.5="; check_float(val, $40400000); print ", ";
@floor $C0600000 val; ! -3.5
print "floor -3.5="; check_float(val, $C0800000); print ", ";
testglobal = $40600000; ! 3.5
@floor testglobal testglobal2;
print "floor 3.5="; check_float(testglobal2, $40400000); print ", ";
testglobal = $C0600000; ! -3.5
@floor testglobal testglobal2;
print "floor -3.5="; check_float(testglobal2, $C0800000); print ", ";
val = $40600000; ! 3.5
@floor val val2;
print "floor 3.5="; check_float(val2, $40400000); print ", ";
val = $C0600000; ! -3.5
@floor val val2;
print "floor -3.5="; check_float(val2, $C0800000); print ", ";
val = 0;
@push $40600000; ! 3.5
@floor sp sp;
@pull val;
print "floor 3.5="; check_float(val, $40400000); print ", ";
@push $C0600000; ! -3.5
@floor sp val;
print "floor -3.5="; check_float(val, $C0800000); print ", ";
val = 0;
@push $40600000; ! 3.5
noop();
@floor sp sp;
@pull val;
print "floor 3.5="; check_float(val, $40400000); print ", ";
@push $C0600000; ! -3.5
noop();
@floor sp val;
print "floor -3.5="; check_float(val, $C0800000); print "^";
new_line;
@ceil $40600000 val; ! 3.5
print "ceil 3.5="; check_float(val, $40800000); print ", ";
@ceil $C0600000 val; ! -3.5
print "ceil -3.5="; check_float(val, $C0400000); print ", ";
testglobal = $40600000; ! 3.5
@ceil testglobal testglobal2;
print "ceil 3.5="; check_float(testglobal2, $40800000); print ", ";
testglobal = $C0600000; ! -3.5
@ceil testglobal testglobal2;
print "ceil -3.5="; check_float(testglobal2, $C0400000); print ", ";
val = $40600000; ! 3.5
@ceil val val2;
print "ceil 3.5="; check_float(val2, $40800000); print ", ";
val = $C0600000; ! -3.5
@ceil val val2;
print "ceil -3.5="; check_float(val2, $C0400000); print ", ";
val = 0;
@push $40600000; ! 3.5
@ceil sp sp;
@pull val;
print "ceil 3.5="; check_float(val, $40800000); print ", ";
@push $C0600000; ! -3.5
@ceil sp val;
print "ceil -3.5="; check_float(val, $C0400000); print ", ";
val = 0;
@push $40600000; ! 3.5
noop();
@ceil sp sp;
@pull val;
print "ceil 3.5="; check_float(val, $40800000); print ", ";
@push $C0600000; ! -3.5
noop();
@ceil sp val;
print "ceil -3.5="; check_float(val, $C0400000); print "^";
new_line;
@floor M_0 val; ! 0.0
print "floor 0.0="; check_float(val, M_0); print ", ";
@floor M_N0 val; ! -0.0
print "floor -0.0="; check_float(val, M_N0); print ", ";
@floor $3F666666 val; ! 0.9
print "floor 0.9="; check_float(val, M_0); print ", ";
@floor $BF666666 val; ! -0.9
print "floor -0.9="; check_float(val, $BF800000); print ", ";
@floor $3F800000 val; ! 1.0
print "floor 1.0="; check_float(val, $3F800000); print ", ";
@floor $BF800000 val; ! -1.0
print "floor -1.0="; check_float(val, $BF800000); print ", ";
@floor $3FE00000 val; ! 1.75
print "floor 1.75="; check_float(val, $3F800000); print ", ";
@floor $BFE00000 val; ! -1.75
print "floor -1.75="; check_float(val, $C0000000); print ", ";
@floor $40000000 val; ! 2.0
print "floor 2.0="; check_float(val, $40000000); print ", ";
@floor $C0000000 val; ! -2.0
print "floor -2.0="; check_float(val, $C0000000); print ", ";
@floor $4121999A val; ! 10.1
print "floor 10.1="; check_float(val, $41200000); print ", ";
@floor $C121999A val; ! -10.1
print "floor -10.1="; check_float(val, $C1300000); print ", ";
@floor $4479FFFF val; ! 999.99995
print "floor 999.99995="; check_float(val, $4479C000); print ", ";
@floor $C479FFFF val; ! -999.99995
print "floor -999.99995="; check_float(val, $C47A0000); print ", ";
@floor $4B800000 val; ! $1000000
print "floor $1000000="; check_float(val, $4B800000); print ", ";
@floor $CB800000 val; ! -$1000000
print "floor -$1000000="; check_float(val, $CB800000); print ", ";
@floor $4EFFFFFE val; ! $7FFFFF00
print "floor $7FFFFF00="; check_float(val, $4EFFFFFE); print ", ";
@floor $CEFFFFFE val; ! -$7FFFFF00
print "floor -$7FFFFF00="; check_float(val, $CEFFFFFE); print ", ";
@floor $4F000000 val; ! $80000000
print "floor $80000000="; check_float(val, $4F000000); print ", ";
@floor $CF000000 val; ! -$80000000
print "floor -$80000000="; check_float(val, $CF000000); print ", ";
@floor M_INF val;
print "floor +Inf="; check_float(val, M_INF); print ", ";
@floor M_NINF val;
print "floor -Inf="; check_float(val, M_NINF); print ", ";
@floor M_NAN val;
print "floor +NaN="; check_isnan(val); print ", ";
@floor M_NNAN val;
print "floor -NaN="; check_isnan(val); print "^";
new_line;
@ceil M_0 val; ! 0.0
print "ceil 0.0="; check_float(val, M_0); print ", ";
@ceil M_N0 val; ! -0.0
print "ceil -0.0="; check_float(val, M_N0); print ", ";
@ceil $3F666666 val; ! 0.9
print "ceil 0.9="; check_float(val, $3F800000); print ", ";
@ceil $BF666666 val; ! -0.9
print "ceil -0.9="; check_float(val, M_N0); print ", ";
@ceil $3F800000 val; ! 1.0
print "ceil 1.0="; check_float(val, $3F800000); print ", ";
@ceil $BF800000 val; ! -1.0
print "ceil -1.0="; check_float(val, $BF800000); print ", ";
@ceil $3FE00000 val; ! 1.75
print "ceil 1.75="; check_float(val, $40000000); print ", ";
@ceil $BFE00000 val; ! -1.75
print "ceil -1.75="; check_float(val, $BF800000); print ", ";
@ceil $40000000 val; ! 2.0
print "ceil 2.0="; check_float(val, $40000000); print ", ";
@ceil $C0000000 val; ! -2.0
print "ceil -2.0="; check_float(val, $C0000000); print ", ";
@ceil $4121999A val; ! 10.1
print "ceil 10.1="; check_float(val, $41300000); print ", ";
@ceil $C121999A val; ! -10.1
print "ceil -10.1="; check_float(val, $C1200000); print ", ";
@ceil $4479FFFF val; ! 999.99995
print "ceil 999.99995="; check_float(val, $447A0000); print ", ";
@ceil $C479FFFF val; ! -999.99995
print "ceil -999.99995="; check_float(val, $C479C000); print ", ";
@ceil $4B800000 val; ! $1000000
print "ceil $1000000="; check_float(val, $4B800000); print ", ";
@ceil $CB800000 val; ! -$1000000
print "ceil -$1000000="; check_float(val, $CB800000); print ", ";
@ceil $4EFFFFFE val; ! $7FFFFF00
print "ceil $7FFFFF00="; check_float(val, $4EFFFFFE); print ", ";
@ceil $CEFFFFFE val; ! -$7FFFFF00
print "ceil -$7FFFFF00="; check_float(val, $CEFFFFFE); print ", ";
@ceil $4F000000 val; ! $80000000
print "ceil $80000000="; check_float(val, $4F000000); print ", ";
@ceil $CF000000 val; ! -$80000000
print "ceil -$80000000="; check_float(val, $CF000000); print ", ";
@ceil M_INF val;
print "ceil +Inf="; check_float(val, M_INF); print ", ";
@ceil M_NINF val;
print "ceil -Inf="; check_float(val, M_NINF); print ", ";
@ceil M_NAN val;
print "ceil +NaN="; check_isnan(val); print ", ";
@ceil M_NNAN val;
print "ceil -NaN="; check_isnan(val); print "^";
count_failures();
];
TestFloatClass FloatExpTest
with name 'floatexp' 'floatsqrt' 'floatpow' 'floatlog',
testfunc [ val val1 val2;
print "Floating-point exponent functions:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
@sqrt $40100000 val; ! 2.25
print "sqrt 2.25="; check_float(val, $3FC00000); print ", ";
@sqrt $C0100000 val; ! -2.25
print "sqrt -2.25="; check_isnan(val); print ", ";
testglobal = $40100000; ! 2.25
@sqrt testglobal testglobal2;
print "sqrt 2.25="; check_float(testglobal2, $3FC00000); print ", ";
testglobal = $C0100000; ! -2.25
@sqrt testglobal testglobal2;
print "sqrt -2.25="; check_isnan(testglobal2); print ", ";
val = 0;
@push $40100000; ! 2.25
@sqrt sp sp;
@pull val;
print "sqrt 2.25="; check_float(val, $3FC00000); print ", ";
@push $C0100000; ! -2.25
@sqrt sp val;
print "sqrt -2.25="; check_isnan(val); print ", ";
val = 0;
@push $40100000; ! 2.25
noop();
@sqrt sp sp;
@pull val;
print "sqrt 2.25="; check_float(val, $3FC00000); print ", ";
@push $C0100000; ! -2.25
noop();
@sqrt sp val;
print "sqrt -2.25="; check_isnan(val); print "^";
new_line;
@log M_E2 val; ! e^2
print "log e",(char)'^',"2="; check_float(val, $40000000); print ", ";
@log $BF800000 val; ! -1.0
print "log -1.0="; check_isnan(val); print ", ";
testglobal = M_E2; ! e^2
@log testglobal testglobal2;
print "log e",(char)'^',"2="; check_float(testglobal2, $40000000); print ", ";
testglobal = $BF800000; ! -1.0
@log testglobal testglobal2;
print "log -1.0="; check_isnan(testglobal2); print ", ";
val = 0;
@push M_E2; ! e^2
@log sp sp;
@pull val;
print "log e",(char)'^',"2="; check_float(val, $40000000); print ", ";
@push $BF800000; ! -1.0
@log sp val;
print "log -1.0="; check_isnan(val); print ", ";
val = 0;
@push M_E2; ! e^2
noop();
@log sp sp;
@pull val;
print "log e",(char)'^',"2="; check_float(val, $40000000); print ", ";
@push $BF800000; ! -1.0
noop();
@log sp val;
print "log -1.0="; check_isnan(val); print "^";
new_line;
@exp $40000000 val; ! 2.0
print "exp 2.0="; check_float(val, M_E2); print ", ";
@exp $C0000000 val; ! -2.0
print "exp -2.0="; check_float(val, $3E0A9555); print ", ";
testglobal = $40000000; ! 2.0
@exp testglobal testglobal2;
print "exp 2.0="; check_float(testglobal2, M_E2); print ", ";
testglobal = $C0000000; ! -2.0
@exp testglobal testglobal2;
print "exp -2.0="; check_float(testglobal2, $3E0A9555); print ", ";
val = 0;
@push $40000000; ! 2.0
@exp sp sp;
@pull val;
print "exp 2.0="; check_float(val, M_E2); print ", ";
@push $C0000000; ! -2.0
@exp sp val;
print "exp -2.0="; check_float(val, $3E0A9555); print ", ";
val = 0;
@push $40000000; ! 2.0
noop();
@exp sp sp;
@pull val;
print "exp 2.0="; check_float(val, M_E2); print ", ";
@push $C0000000; ! -2.0
noop();
@exp sp val;
print "exp -2.0="; check_float(val, $3E0A9555); print "^";
new_line;
@pow $3FE00000 $3FC00000 val; ! 1.75, 1.5
print "pow(1.75,1.5)="; check_float(val, $4014297E); print ", ";
val1 = $BFC00000;
@pow $3FE00000 val1 val; ! 1.75, -1.5
print "pow(1.75,-1.5)="; check_float(val, $3EDD29C8); print ", ";
val1 = $BFE00000;
@pow val1 $40000000 val; ! -1.75, 2
print "pow(-1.75,2)="; check_float(val, $40440000); print ", ";
val2 = $3FC00000;
@pow val1 val2 val; ! -1.75, 1.5
print "pow(-1.75,1.5)="; check_isnan(val); print "^";
@pow $40100000 $40000000 testglobal; ! 2.25, 2.0
print "pow(2.25,2.0)="; check_float(testglobal, $40A20000); print ", ";
testglobal = $40100000; ! 2.25
testglobal2 = $C0000000; ! -2.0
@pow testglobal testglobal2 val;
print "pow(2.25,-2.0)="; check_float(val, $3E4A4588); print ", ";
val1 = $C0100000; ! -2.25
val2 = $40400000; ! 3.0
@pow val1 val2 val;
print "pow(-2.25,3.0)="; check_float(val, $C1364000); print ", ";
@push $C0400000; ! -3.0
@push $C0100000; ! -2.25
noop();
@pow sp sp sp;
@pull val;
print "pow(-2.25,-3.0)="; check_float(val, $BDB3CC07); print "^";
new_line;
@sqrt M_0 val;
print "sqrt 0="; check_float(val, M_0); print ", ";
@sqrt M_N0 val;
print "sqrt -0="; check_float(val, M_N0); print ", ";
@sqrt M_1 val;
print "sqrt 1="; check_float(val, M_1); print ", ";
@sqrt M_N1 val;
print "sqrt -1="; check_isnan(val); print ", ";
@sqrt $3F19999A val;
print "sqrt 0.6="; check_float(val, $3F464BF8); print ", ";
@sqrt $42C80001 val;
print "sqrt 100.0000076="; check_float(val, $41200000); print ", ";
@sqrt $4CEB79A3 val;
print "sqrt 123456789.0="; check_float(val, $462D9C72); print ", ";
@sqrt $7B3E36E8 val;
print "sqrt 9.8765e+35="; check_float(val, $5D5CAB52); print ", ";
@sqrt M_INF val;
print "sqrt Inf="; check_float(val, M_INF); print ", ";
@sqrt M_NINF val;
print "sqrt -Inf="; check_isnan(val); print ", ";
@sqrt M_NAN val;
print "sqrt +NaN="; check_isnan(val); print ", ";
@sqrt M_NNAN val;
print "sqrt -NaN="; check_isnan(val); print "^";
new_line;
@exp M_0 val;
print "exp 0="; check_float(val, M_1); print ", ";
@exp M_N0 val;
print "exp -0="; check_float(val, M_1); print ", ";
@exp M_1 val;
print "exp 1="; check_float(val, M_E); print ", ";
@exp M_N1 val;
print "exp -1="; check_float(val, $3EBC5AB2); print ", ";
@exp $3F19999A val;
print "exp 0.6="; check_float(val, $3FE93B31); print ", ";
@exp $BF19999A val;
print "exp -0.6="; check_float(val, $3F0C7EEB); print ", ";
@exp $42B00000 val;
print "exp 88.0="; check_float(val, $7EF882B7); print ", ";
@exp $42C80000 val;
print "exp 100.0="; check_float(val, M_INF); print ", ";
@exp $C2C80000 val;
print "exp -100.0="; check_float(val, $0000001B); print ", ";
@exp $C2D00000 val;
print "exp -104.0="; check_float(val, M_0); print ", ";
@exp M_INF val;
print "exp Inf="; check_float(val, M_INF); print ", ";
@exp M_NINF val;
print "exp -Inf="; check_float(val, M_0); print ", ";
@exp M_NAN val;
print "exp +NaN="; check_isnan(val); print ", ";
@exp M_NNAN val;
print "exp -NaN="; check_isnan(val); print "^";
new_line;
@log M_0 val;
print "log 0="; check_float(val, M_NINF); print ", ";
@log M_N0 val;
print "log -0="; check_float(val, M_NINF); print ", ";
@log M_1 val;
print "log 1="; check_float(val, M_0); print ", ";
@log M_N1 val;
print "log -1="; check_isnan(val); print ", ";
@log M_E val;
print "log e="; check_float_e(val, $3F800000, $34800000); print ", ";
@log $3F19999A val;
print "log 0.6="; check_float_e(val, $BF02C577, $34000000); print ", ";
@log $47800000 val;
print "log 65536="; check_float_e(val, $41317218, $36000000); print ", ";
@log $4CEB79A3 val;
print "log 123456789.0="; check_float_e(val, $41950D1C, $36800000); print ", ";
@log $7E949AE5 val;
print "log 9.8765e+37="; check_float_e(val, $42AEF8BC, $37800000); print ", ";
@log M_INF val;
print "log Inf="; check_float(val, M_INF); print ", ";
@log M_NINF val;
print "log -Inf="; check_isnan(val); print ", ";
@log M_NAN val;
print "log +NaN="; check_isnan(val); print ", ";
@log M_NNAN val;
print "log -NaN="; check_isnan(val); print "^";
new_line;
@pow M_N1 M_1 val;
print "pow(-1,1)="; check_float(val, M_N1); print ", ";
@pow M_N1 M_N1 val;
print "pow(-1,-1)="; check_float(val, M_N1); print ", ";
@pow M_N1 $3FC00000 val;
print "pow(-1,1.5)="; check_isnan(val); print ", ";
@pow M_0 M_1 val;
print "pow(0,1)="; check_float(val, M_0); print ", ";
@pow M_N0 M_1 val;
print "pow(-0,1)="; check_float(val, M_N0); print ", ";
@pow $40000000 $42FE0000 val;
print "pow(2,127)="; check_float(val, $7F000000); print ", ";
@pow $40000000 $43000000 val;
print "pow(2,128)="; check_float(val, M_INF); print ", ";
@pow $40000000 $C3150000 val;
print "pow(2,-149)="; check_float(val, $00000001); print ", ";
@pow $40000000 $C3160000 val;
print "pow(2,-150)="; check_float(val, M_0); print ", ";
@pow $40000000 M_NAN val;
print "pow(2,NaN)="; check_isnan(val); print ", ";
@pow M_NAN $40000000 val;
print "pow(NaN,2)="; check_isnan(val); print ", ";
@pow M_NAN M_NAN val;
print "pow(NaN,NaN)="; check_isnan(val); print "^";
@pow M_0 M_N1 val;
print "pow(0,-1)="; check_float(val, M_INF); print ", ";
@pow M_N0 M_N1 val;
print "pow(-0,-1)="; check_float(val, M_NINF); print ", ";
@pow M_0 $C0000000 val;
print "pow(0,-2)="; check_float(val, M_INF); print ", ";
@pow M_N0 $C0000000 val;
print "pow(-0,-2)="; check_float(val, M_INF); print ", ";
@pow M_0 $BFC00000 val;
print "pow(0,-1.5)="; check_float(val, M_INF); print ", ";
@pow M_N0 $BFC00000 val;
print "pow(-0,-1.5)="; check_float(val, M_INF); print ", ";
@pow M_0 M_1 val;
print "pow(0,1)="; check_float(val, M_0); print ", ";
@pow M_N0 M_1 val;
print "pow(-0,1)="; check_float(val, M_N0); print ", ";
@pow M_0 $40000000 val;
print "pow(0,2)="; check_float(val, M_0); print ", ";
@pow M_N0 $40000000 val;
print "pow(-0,2)="; check_float(val, M_0); print ", ";
@pow M_0 $3FC00000 val;
print "pow(0,1.5)="; check_float(val, M_0); print ", ";
@pow M_N0 $3FC00000 val;
print "pow(-0,1.5)="; check_float(val, M_0); print "^";
@pow M_N1 M_INF val;
print "pow(-1,Inf)="; check_float(val, M_1); print ", ";
@pow M_N1 M_NINF val;
print "pow(-1,-Inf)="; check_float(val, M_1); print ", ";
@pow M_1 M_1 val;
print "pow(1,1)="; check_float(val, M_1); print ", ";
@pow M_1 M_N1 val;
print "pow(1,-1)="; check_float(val, M_1); print ", ";
@pow M_1 M_0 val;
print "pow(1,0)="; check_float(val, M_1); print ", ";
@pow M_1 M_INF val;
print "pow(1,Inf)="; check_float(val, M_1); print ", ";
@pow M_1 M_NINF val;
print "pow(1,-Inf)="; check_float(val, M_1); print ", ";
@pow M_1 M_NAN val;
print "pow(1,NaN)="; check_float(val, M_1); print ", ";
@pow M_1 M_NNAN val;
print "pow(1,-NaN)="; check_float(val, M_1); print "^";
@pow $40800000 M_0 val;
print "pow(4,0)="; check_float(val, M_1); print ", ";
@pow $C0800000 M_0 val;
print "pow(-4,0)="; check_float(val, M_1); print ", ";
@pow M_0 M_0 val;
print "pow(0,0)="; check_float(val, M_1); print ", ";
@pow M_N0 M_0 val;
print "pow(-0,0)="; check_float(val, M_1); print ", ";
@pow M_INF M_0 val;
print "pow(Inf,0)="; check_float(val, M_1); print ", ";
@pow M_NINF M_0 val;
print "pow(-Inf,0)="; check_float(val, M_1); print ", ";
@pow M_NAN M_0 val;
print "pow(NaN,0)="; check_float(val, M_1); print ", ";
@pow M_NNAN M_0 val;
print "pow(-NaN,0)="; check_float(val, M_1); print "^";
@pow M_N1 $BFC00000 val;
print "pow(-1,1.5)="; check_isnan(val); print ", ";
@pow $3F000000 M_NINF val;
print "pow(0.5,-Inf)="; check_float(val, M_INF); print ", ";
@pow $BF000000 M_NINF val;
print "pow(-0.5,-Inf)="; check_float(val, M_INF); print ", ";
@pow $3FC00000 M_NINF val;
print "pow(1.5,-Inf)="; check_float(val, M_0); print ", ";
@pow $BFC00000 M_NINF val;
print "pow(-1.5,-Inf)="; check_float(val, M_0); print ", ";
@pow $3F000000 M_INF val;
print "pow(0.5,Inf)="; check_float(val, M_0); print ", ";
@pow $BF000000 M_INF val;
print "pow(-0.5,Inf)="; check_float(val, M_0); print ", ";
@pow $3FC00000 M_INF val;
print "pow(1.5,Inf)="; check_float(val, M_INF); print ", ";
@pow $BFC00000 M_INF val;
print "pow(-1.5,Inf)="; check_float(val, M_INF); print ", ";
@pow M_NINF M_N1 val;
print "pow(-Inf,-1)="; check_float(val, M_N0); print ", ";
@pow M_NINF $C0000000 val;
print "pow(-Inf,-2)="; check_float(val, M_0); print ", ";
@pow M_NINF $BFC00000 val;
print "pow(-Inf,-1.5)="; check_float(val, M_0); print ", ";
@pow M_NINF M_1 val;
print "pow(-Inf,1)="; check_float(val, M_NINF); print ", ";
@pow M_NINF $40000000 val;
print "pow(-Inf,2)="; check_float(val, M_INF); print ", ";
@pow M_NINF $3FC00000 val;
print "pow(-Inf,1.5)="; check_float(val, M_INF); print ", ";
@pow M_INF $40000000 val;
print "pow(Inf,2)="; check_float(val, M_INF); print ", ";
@pow M_INF $3FC00000 val;
print "pow(Inf,1.5)="; check_float(val, M_INF); print ", ";
@pow M_INF $C0000000 val;
print "pow(Inf,-2)="; check_float(val, M_0); print ", ";
@pow M_INF $BFC00000 val;
print "pow(Inf,-1.5)="; check_float(val, M_0); print "^";
count_failures();
];
TestFloatClass FloatTrigTest
with name 'floattrig' 'trig',
testfunc [ val val1;
print "Floating-point trig functions:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
val1 = $3F060A92;
@sin val1 val;
print "sin(pi/6)="; check_float_e(val, $3F000000, $33800000); print ", ";
testglobal = $BF860A92;
@sin testglobal testglobal2;
print "sin(-pi/3)="; check_float_e(testglobal2, $BF5DB3D8, $33800000); print ", ";
@push $3F490FDB;
noop();
@sin sp sp;
@pull val;
print "sin(pi/4)="; check_float_e(val, $3F3504F3, $33800000); print "^";
val1 = $3F060A92;
@cos val1 val;
print "cos(pi/6)="; check_float_e(val, $3F5DB3D7, $33800000); print ", ";
testglobal = $BF860A92;
@cos testglobal testglobal2;
print "cos(-pi/3)="; check_float_e(testglobal2, $3F000000, $33800000); print ", ";
@push $3F490FDB;
noop();
@cos sp sp;
@pull val;
print "cos(pi/4)="; check_float_e(val, $3F3504F3, $33800000); print "^";
val1 = $3F060A92;
@tan val1 val;
print "tan(pi/6)="; check_float_e(val, $3F13CD3A, $33800000); print ", ";
testglobal = $BF860A92;
@tan testglobal testglobal2;
print "tan(-pi/3)="; check_float_e(testglobal2, $BFDDB3D8, $33800000); print ", ";
@push $3F490FDB;
noop();
@tan sp sp;
@pull val;
print "tan(pi/4)="; check_float(val, M_1); print "^";
val1 = $3F000000;
@asin val1 val;
print "asin(1/2)="; check_float_e(val, $3F060A92, $34000000); print ", ";
testglobal = $BF5DB3D8;
@asin testglobal testglobal2;
print "asin(-sqrt(3)/2)="; check_float_e(testglobal2, $BF860A92, $34000000); print ", ";
@push $3F3504F3;
noop();
@asin sp sp;
@pull val;
print "asin(sqrt(2)/2)="; check_float_e(val, $3F490FDA, $34000000); print "^";
val1 = $3F5DB3D7;
@acos val1 val;
print "acos(sqrt(3)/2)="; check_float_e(val, $3F060A92, $34000000); print ", ";
testglobal = $BEFFFFFF;
@acos testglobal testglobal2;
print "acos(-0.5)="; check_float_e(testglobal2, $40060A92, $34000000); print ", ";
@push $3F3504F3;
noop();
@acos sp sp;
@pull val;
print "acos(sqrt(2)/2)="; check_float_e(val, $3F490FDB, $34000000); print "^";
val1 = $3F13CD3A;
@atan val1 val;
print "atan(sqrt(3)/3)="; check_float_e(val, $3F060A92, $34000000); print ", ";
testglobal = $BFDDB3D8;
@atan testglobal testglobal2;
print "atan(-sqrt(3))="; check_float_e(testglobal2, $BF860A92, $34000000); print ", ";
@push M_1;
noop();
@atan sp sp;
@pull val;
print "atan(1)="; check_float_e(val, $3F490FDB, $34000000); print "^";
new_line;
@sin M_0 val;
print "sin(0)="; check_float(val, M_0); print ", ";
@sin M_N0 val;
print "sin(-0)="; check_float(val, M_N0); print ", ";
@sin M_PI val;
print "sin(pi)="; check_float_e(val, M_0, $35000000); print ", ";
@sin M_2PI val;
print "sin(2pi)="; check_float_e(val, M_0, $35000000); print ", ";
@sin M_INF val;
print "sin(Inf)="; check_isnan(val); print ", ";
@sin M_NINF val;
print "sin(-Inf)="; check_isnan(val); print ", ";
@sin M_NAN val;
print "sin(NaN)="; check_isnan(val); print "^";
@cos M_0 val;
print "cos(0)="; check_float(val, M_1); print ", ";
@cos M_N0 val;
print "cos(-0)="; check_float(val, M_1); print ", ";
@cos M_PI val;
print "cos(pi)="; check_float_e(val, M_N1, $35000000); print ", ";
@cos M_2PI val;
print "cos(2pi)="; check_float_e(val, M_1, $35000000); print ", ";
@cos M_INF val;
print "cos(Inf)="; check_isnan(val); print ", ";
@cos M_NINF val;
print "cos(-Inf)="; check_isnan(val); print ", ";
@cos M_NAN val;
print "cos(NaN)="; check_isnan(val); print "^";
@tan M_0 val;
print "tan(0)="; check_float(val, M_0); print ", ";
@tan M_N0 val;
print "tan(-0)="; check_float(val, M_N0); print ", ";
@tan M_PI val;
print "tan(pi)="; check_float_e(val, M_0, $35000000); print ", ";
@tan M_2PI val;
print "tan(2pi)="; check_float_e(val, M_0, $35000000); print ", ";
@tan M_INF val;
print "tan(Inf)="; check_isnan(val); print ", ";
@tan M_NINF val;
print "tan(-Inf)="; check_isnan(val); print ", ";
@tan M_NAN val;
print "tan(NaN)="; check_isnan(val); print "^";
@asin M_0 val;
print "asin(0)="; check_float(val, M_0); print ", ";
@asin M_N0 val;
print "asin(-0)="; check_float(val, M_N0); print ", ";
@asin M_1 val;
print "asin(1)="; check_float_e(val, $3FC90FDB, $34000000); print ", ";
@asin M_N1 val;
print "asin(-1)="; check_float_e(val, $BFC90FDB, $34000000); print ", ";
@asin $40000000 val;
print "asin(2)="; check_isnan(val); print ", ";
@asin $C0000000 val;
print "asin(-2)="; check_isnan(val); print ", ";
@asin M_INF val;
print "asin(Inf)="; check_isnan(val); print ", ";
@asin M_NINF val;
print "asin(-Inf)="; check_isnan(val); print ", ";
@asin M_NAN val;
print "asin(NaN)="; check_isnan(val); print "^";
@acos M_1 val;
print "acos(1)="; check_float(val, M_0); print ", ";
@acos M_N1 val;
print "acos(-1)="; check_float_e(val, M_PI, $35000000); print ", ";
@acos M_0 val;
print "acos(0)="; check_float_e(val, $3FC90FDB, $34000000); print ", ";
@acos M_N0 val;
print "acos(-0)="; check_float_e(val, $3FC90FDB, $34000000); print ", ";
@acos $40000000 val;
print "acos(2)="; check_isnan(val); print ", ";
@acos $C0000000 val;
print "acos(-2)="; check_isnan(val); print ", ";
@acos M_INF val;
print "acos(Inf)="; check_isnan(val); print ", ";
@acos M_NINF val;
print "acos(-Inf)="; check_isnan(val); print ", ";
@acos M_NAN val;
print "acos(NaN)="; check_isnan(val); print "^";
@atan M_0 val;
print "atan(0)="; check_float(val, M_0); print ", ";
@atan M_N0 val;
print "atan(-0)="; check_float(val, M_N0); print ", ";
@atan M_1 val;
print "atan(1)="; check_float_e(val, $3F490FDB, $34000000); print ", ";
@atan M_N1 val;
print "atan(-1)="; check_float_e(val, $BF490FDB, $34000000); print ", ";
@atan M_INF val;
print "atan(Inf)="; check_float_e(val, $3FC90FDB, $34000000); print ", ";
@atan M_NINF val;
print "atan(-Inf)="; check_float_e(val, $BFC90FDB, $34000000); print ", ";
@atan M_NAN val;
print "atan(NaN)="; check_isnan(val); print "^";
count_failures();
];
TestFloatClass FloatAtan2Test
with name 'floatatan2' 'atan2',
short_name "floatatan2",
testfunc [ val val1 val2;
print "Floating-point atan2 function:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
@atan2 M_1 M_1 val;
print "atan2(1,1)="; check_float_e(val, $3F490FDB, $34000000); print ", ";
val1 = M_1;
@atan2 val1 M_N1 val;
print "atan2(1,-1)="; check_float_e(val, $4016CBE4, $35000000); print ", ";
val2 = M_N1;
@atan2 M_N1 val2 val;
print "atan2(-1,-1)="; check_float_e(val, $C016CBE4, $35000000); print ", ";
val1 = M_N1;
val2 = M_1;
@atan2 val1 val2 val;
print "atan2(-1,1)="; check_float_e(val, $BF490FDB, $34000000); print "^";
new_line;
@atan2 $3F800000 $40000000 testglobal;
print "atan2(1,2)="; check_float_e(testglobal, $3EED6338, $33800000); print ", ";
testglobal = $40000000;
testglobal2 = $BF000000;
@atan2 testglobal testglobal2 val;
print "atan2(2,-0.5)="; check_float_e(val, $3FE86B51, $34800000); print ", ";
val1 = $BE000000;
val2 = $C1000000;
@atan2 val1 val2 sp;
@pull val;
print "atan2(-0.125,-8)="; check_float_e(val, $C0480FE0, $35000000); print ", ";
@push $40400000;
@push $C0000000;
noop();
@atan2 sp sp sp;
@pull val;
print "atan2(-2,3)="; check_float_e(val, $BF168757, $34000000); print "^";
new_line;
@atan2 M_0 M_0 val;
print "atan2(0,0)="; check_float(val, M_0); print ", ";
@atan2 M_N0 M_0 val;
print "atan2(-0,0)="; check_float(val, M_N0); print ", ";
@atan2 M_0 M_N0 val;
print "atan2(0,-0)="; check_float_e(val, M_PI, $35000000); print ", ";
@atan2 M_N0 M_N0 val;
print "atan2(-0,-0)="; check_float_e(val, M_NPI, $35000000); print ", ";
@atan2 M_0 M_1 val;
print "atan2(0,1)="; check_float(val, M_0); print ", ";
@atan2 M_N0 M_1 val;
print "atan2(-0,1)="; check_float(val, M_N0); print ", ";
@atan2 M_0 M_N1 val;
print "atan2(0,-1)="; check_float_e(val, M_PI, $35000000); print ", ";
@atan2 M_N0 M_N1 val;
print "atan2(-0,-1)="; check_float_e(val, M_NPI, $35000000); print ", ";
@atan2 M_1 M_0 val;
print "atan2(1,0)="; check_float_e(val, M_PI2, $34000000); print ", ";
@atan2 M_1 M_N0 val;
print "atan2(1,-0)="; check_float_e(val, M_PI2, $34000000); print ", ";
@atan2 M_N1 M_0 val;
print "atan2(-1,0)="; check_float_e(val, M_NPI2, $34000000); print ", ";
@atan2 M_N1 M_N0 val;
print "atan2(-1,-0)="; check_float_e(val, M_NPI2, $34000000); print "^";
@atan2 M_1 M_INF val;
print "atan2(1,Inf)="; check_float(val, M_0); print ", ";
@atan2 M_N1 M_INF val;
print "atan2(-1,Inf)="; check_float(val, M_N0); print ", ";
@atan2 M_1 M_NINF val;
print "atan2(1,-Inf)="; check_float_e(val, M_PI, $35000000); print ", ";
@atan2 M_N1 M_NINF val;
print "atan2(-1,-Inf)="; check_float_e(val, M_NPI, $35000000); print ", ";
@atan2 M_INF M_INF val;
print "atan2(Inf,Inf)="; check_float_e(val, $3F490FDB, $34000000); print ", ";
@atan2 M_NINF M_INF val;
print "atan2(-Inf,Inf)="; check_float_e(val, $BF490FDB, $34000000); print ", ";
@atan2 M_INF M_NINF val;
print "atan2(Inf,-Inf)="; check_float_e(val, $4016CBE4, $35000000); print ", ";
@atan2 M_NINF M_NINF val;
print "atan2(-Inf,-Inf)="; check_float_e(val, $C016CBE4, $35000000); print "^";
@atan2 M_1 M_NAN val;
print "atan2(1,NaN)="; check_isnan(val); print ", ";
@atan2 M_NAN M_N0 val;
print "atan2(NaN,-0)="; check_isnan(val); print ", ";
@atan2 M_INF M_NAN val;
print "atan2(Inf,NaN)="; check_isnan(val); print ", ";
@atan2 M_NINF M_NAN val;
print "atan2(-Inf,NaN)="; check_isnan(val); print ", ";
@atan2 M_NAN M_NAN val;
print "atan2(NaN,NaN)="; check_isnan(val); print "^";
count_failures();
];
TestFloatClass FloatJumpFormTest
with name 'fjumpform',
testfunc [ val;
print "Floating-point jump with various operand forms:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
val = 33;
@jisinf M_INF ?A0;
val = 44;
.A0;
print "Test A0="; check(val, 33); print ", ";
val = 33;
@jisinf M_1 ?A1;
val = 44;
.A1;
print "Test A1="; check(val, 44); print ", ";
testglobal = M_NINF;
val = 33;
@jisinf testglobal ?A2;
val = 44;
.A2;
print "Test A2="; check(val, 33); print ", ";
testglobal = M_N1;
val = 33;
@jisinf testglobal ?A3;
val = 44;
.A3;
print "Test A3="; check(val, 44); print ", ";
@push M_INF;
val = 33;
@jisinf sp ?A4;
val = 44;
.A4;
print "Test A4="; check(val, 33); print ", ";
@push M_0;
val = 33;
@jisinf sp ?A5;
val = 44;
.A5;
print "Test A5="; check(val, 44); print "^";
val = 11;
@jflt $40000000 $40400000 ?B0;
val = 22;
.B0;
print "Test B0="; check(val, 11); print ", ";
val = 11;
@jflt $40400000 $40000000 ?B1;
val = 22;
.B1;
print "Test B1="; check(val, 22); print ", ";
testglobal = $C0400000;
val = 11;
@jflt testglobal $C0000000 ?B2;
val = 22;
.B2;
print "Test B2="; check(val, 11); print ", ";
val = 11;
@jflt $C0000000 testglobal ?B3;
val = 22;
.B3;
print "Test B3="; check(val, 22); print ", ";
@push $40400000;
@push $40000000;
val = 11;
@jflt sp sp ?B4;
val = 22;
.B4;
print "Test B4="; check(val, 11); print ", ";
@push $40000000;
@push $40400000;
val = 11;
@jflt sp sp ?B5;
val = 22;
.B5;
print "Test B5="; check(val, 22); print "^";
val = 55;
@jfeq M_0 M_0 M_0 ?C0;
val = 66;
.C0;
print "Test C0="; check(val, 55); print ", ";
val = 55;
@jfeq M_1 M_0 M_0 ?C1;
val = 66;
.C1;
print "Test C1="; check(val, 66); print ", ";
testglobal = M_0;
val = 55;
@jfeq testglobal M_0 M_0 ?C2;
val = 66;
.C2;
print "Test C2="; check(val, 55); print ", ";
val = 55;
@jfeq testglobal M_1 M_0 ?C3;
val = 66;
.C3;
print "Test C3="; check(val, 66); print ", ";
@push M_0;
@push M_0;
@push M_0;
val = 55;
@jfeq sp sp sp ?C4;
val = 66;
.C4;
print "Test C4="; check(val, 55); print ", ";
@push M_0;
@push M_0;
@push M_1;
val = 55;
@jfeq sp sp sp ?C5;
val = 66;
.C5;
print "Test C5="; check(val, 66); print "^";
val = test_jfeq0($C0000000, $C0000000, M_0);
print "Test E0="; check(val, 0); print ", ";
val = test_jfeq1($C0400000, $C0400000, M_0);
print "E1="; check(val, 1); print ", ";
val = test_jfeq1($C0400000, M_0);
print "E2="; check(val, 99); print "^";
val = test_push_computed_jfeq($40E00000, $40E00000, M_0, 2);
print "Test F0="; check(val, 2); print ", ";
val = test_push_computed_jfeq($40E00000, $40E00000, M_0, 5);
print "F1="; check(val, 3); print ", ";
val = test_push_computed_jfeq($40E00000, $40E00000, M_0, 8);
print "F2="; check(val, 9); print ", ";
val = test_push_computed_jfeq($40E00000, $40E00000, M_0, 10);
print "F3="; check(val, 5); print ", ";
val = test_push_computed_jfeq($40E00000, $40C00000, M_0, 10);
print "F4="; check(val, 2); print ", ";
val = test_push_computed_jfeq(M_N1, M_N1, M_0, 1);
print "F5="; check(val, 1); print ", ";
val = test_push_computed_jfeq(M_0, M_0, M_0, 0);
print "F6="; check(val, 0); print "^";
count_failures();
];
[ test_jfeq0 val1 val2 val3;
@"4:448" val1 val2 val3 0;
return 99;
];
[ test_jfeq1 val1 val2 val3;
@"4:448" val1 val2 val3 1;
return 99;
];
[ test_push_computed_jfeq val1 val2 val3 loc;
@copy 9 sp;
@"4:448" val1 val2 val3 loc;
@"1:49" 2;
@"1:49" 3;
@"1:49" sp;
@"1:49" 5;
@"1:49" 6;
];
TestFloatClass FloatJumpTest
with name 'fjump',
testfunc [ val;
print "Floating-point equality comparisons:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
val = test_jisnan(M_0);
print "jisnan(0)="; check(val, 0); print ", ";
val = test_jisnan(M_N0);
print "jisnan(-0)="; check(val, 0); print ", ";
val = test_jisnan(M_1);
print "jisnan(1)="; check(val, 0); print ", ";
val = test_jisnan($7F7FFFFF);
print "jisnan(3.4e38)="; check(val, 0); print ", ";
val = test_jisnan(M_INF);
print "jisnan(Inf)="; check(val, 0); print ", ";
val = test_jisnan(M_NINF);
print "jisnan(-Inf)="; check(val, 0); print ", ";
val = test_jisnan(M_NAN);
print "jisnan(NaN)="; check(val, 1); print ", ";
val = test_jisnan(M_NNAN);
print "jisnan(-NaN)="; check(val, 1); print ", ";
val = test_jisnan($7FFFFFFF);
print "jisnan(other NaN)="; check(val, 1); print ", ";
val = test_jisnan($FFFFFFFF);
print "jisnan(other -NaN)="; check(val, 1); print "^";
val = test_jisinf(M_0);
print "jisinf(0)="; check(val, 0); print ", ";
val = test_jisinf(M_N0);
print "jisinf(-0)="; check(val, 0); print ", ";
val = test_jisinf(M_1);
print "jisinf(1)="; check(val, 0); print ", ";
val = test_jisinf($7F7FFFFF);
print "jisinf(3.4e+38)="; check(val, 0); print ", ";
val = test_jisinf(M_INF);
print "jisinf(Inf)="; check(val, 1); print ", ";
val = test_jisinf(M_NINF);
print "jisinf(-Inf)="; check(val, 1); print ", ";
val = test_jisinf(M_NAN);
print "jisinf(NaN)="; check(val, 0); print ", ";
val = test_jisinf(M_NNAN);
print "jisinf(-NaN)="; check(val, 0); print ", ";
val = test_jisinf($7FFFFFFF);
print "jisinf(other NaN)="; check(val, 0); print ", ";
val = test_jisinf($FFFFFFFF);
print "jisinf(other -NaN)="; check(val, 0); print "^";
val = test_jfeq(M_0, M_0, M_0);
print "jfeq(0,0,0)="; check(val, 1); print ", ";
val = test_jfeq(M_0, M_N0, M_0);
print "jfeq(0,-0,0)="; check(val, 1); print ", ";
val = test_jfeq(M_0, M_0, M_N0);
print "jfeq(0,0,-0)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $00000001, M_0);
print "jfeq(0,1.4e-45,0)="; check(val, 0); print ", ";
val = test_jfeq(M_0, $80000001, M_0);
print "jfeq(0,-1.4e-45,0)="; check(val, 0); print ", ";
val = test_jfeq($7F7FFFFF, $7F7FFFFF, M_0);
print "jfeq(3.4e+38,3.4e+38,0)="; check(val, 1); print ", ";
val = test_jfeq($7F7FFFFF, $7F7FFFFE, M_0);
print "jfeq(3.4e+38,3.4e+38,0)="; check(val, 0); print ", ";
val = test_jfeq(M_INF, M_INF, M_0);
print "jfeq(Inf,Inf,0)="; check(val, 1); print ", ";
val = test_jfeq(M_NINF, M_NINF, M_0);
print "jfeq(-Inf,-Inf,0)="; check(val, 1); print ", ";
val = test_jfeq(M_INF, M_NINF, M_0);
print "jfeq(Inf,-Inf,0)="; check(val, 0); print "^";
val = test_jfeq(M_0, M_0, $00000001);
print "jfeq(0,0,1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_0, M_N0, $00000001);
print "jfeq(0,-0,1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_0, M_0, $80000001);
print "jfeq(0,0,-1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $00000001, $00000001);
print "jfeq(0,1.4e-45,1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $80000001, $00000001);
print "jfeq(0,-1.4e-45,1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $00000001, $80000001);
print "jfeq(0,1.4e-45,-1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $00000002, $00000001);
print "jfeq(0,2.8e-45,1.4e-45)="; check(val, 0); print ", ";
val = test_jfeq($7F7FFFFF, $7F7FFFFF, $00000001);
print "jfeq(3.4e+38,3.4e+38,1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq($7F7FFFFF, $7F7FFFFE, $00000001);
print "jfeq(3.4e+38,3.4e+38,1.4e-45)="; check(val, 0); print ", ";
val = test_jfeq(M_INF, M_INF, $00000001);
print "jfeq(Inf,Inf,1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_NINF, M_NINF, $00000001);
print "jfeq(-Inf,-Inf,1.4e-45)="; check(val, 1); print ", ";
val = test_jfeq(M_INF, M_NINF, $00000001);
print "jfeq(Inf,-Inf,1.4e-45)="; check(val, 0); print "^";
val = test_jfeq(M_0, M_1, M_1);
print "jfeq(0,0,1)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $C0000000, M_1);
print "jfeq(0,-2,1)="; check(val, 0); print ", ";
val = test_jfeq(M_0, $C0000000, $3FC00000);
print "jfeq(0,-2,1.5)="; check(val, 0); print ", ";
val = test_jfeq(M_0, $C0000000, $40000000);
print "jfeq(0,-2,2)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $C0000000, $C0000000);
print "jfeq(0,-2,-2)="; check(val, 1); print ", ";
val = test_jfeq($3FC00000, $40000000, $3FC00000);
print "jfeq(1.5,2,1.5)="; check(val, 1); print ", ";
val = test_jfeq($3FC00000, $40400000, $3FC00000);
print "jfeq(1.5,3,1.5)="; check(val, 1); print ", ";
val = test_jfeq($3FC00000, $40400001, $3FC00000);
print "jfeq(1.5,3+,1.5)="; check(val, 0); print "^";
val = test_jfeq(M_0, $7F7FFFFF, $7F7FFFFE);
print "jfeq(0,3.4e+38,3.4e+38-)="; check(val, 0); print ", ";
val = test_jfeq(M_0, $7F7FFFFF, $7F7FFFFF);
print "jfeq(0,3.4e+38,3.4e+38)="; check(val, 1); print ", ";
val = test_jfeq(M_N1, $7F7FFFFF, $7F7FFFFF);
print "jfeq(-1,3.4e+38,3.4e+38)="; check(val, 1); print ", ";
val = test_jfeq($FF7FFFFF, $7F7FFFFF, $7F7FFFFF);
print "jfeq(-3.4e+38,3.4e+38,3.4e+38)="; check(val, 0); print ",";
val = test_jfeq(M_INF, $7F7FFFFF, $7F7FFFFF);
print "jfeq(Inf,3.4e+38,3.4e+38)="; check(val, 0); print ", ";
val = test_jfeq(M_NINF, $FF7FFFFF, $7F7FFFFF);
print "jfeq(-Inf,-3.4e+38,3.4e+38)="; check(val, 0); print ", ";
val = test_jfeq(M_INF, M_INF, $7F7FFFFF);
print "jfeq(Inf,Inf,3.4e+38)="; check(val, 1); print ", ";
val = test_jfeq(M_NINF, M_INF, $7F7FFFFF);
print "jfeq(-Inf,Inf,3.4e+38)="; check(val, 0); print "^";
val = test_jfeq(M_0, M_0, M_INF);
print "jfeq(0,0,Inf)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $7F7FFFFF, M_INF);
print "jfeq(0,3.4e+38,Inf)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $7F7FFFFF, M_NINF);
print "jfeq(0,3.4e+38,-Inf)="; check(val, 1); print ", ";
val = test_jfeq(M_0, $FF7FFFFF, M_NINF);
print "jfeq(0,-3.4e+38,-Inf)="; check(val, 1); print ", ";
val = test_jfeq($FF7FFFFF, $7F7FFFFF, M_INF);
print "jfeq(-3.4e+38,3.4e+38,Inf)="; check(val, 1); print ", ";
val = test_jfeq($FF7FFFFF, $7F7FFFFF, M_NINF);
print "jfeq(-3.4e+38,3.4e+38,-Inf)="; check(val, 1); print ", ";
val = test_jfeq(M_0, M_INF, M_INF);
print "jfeq(0,Inf,Inf)="; check(val, 1); print ", ";
val = test_jfeq($FF7FFFFF, M_NINF, M_INF);
print "jfeq(-3.4e+38,-Inf,Inf)="; check(val, 1); print ", ";
val = test_jfeq(M_0, M_NINF, M_INF);
print "jfeq(0,-Inf,Inf)="; check(val, 1); print ", ";
val = test_jfeq(M_NINF, M_NINF, M_INF);
print "jfeq(-Inf,-Inf,Inf)="; check(val, 1); print ", ";
val = test_jfeq(M_INF, M_NINF, M_INF);
print "jfeq(Inf,-Inf,Inf)="; check(val, 0); print "^";
val = test_jfeq(M_NAN, M_0, M_0);
print "jfeq(NaN,0,0)="; check(val, 0); print ", ";
val = test_jfeq(M_0, M_NAN, M_0);
print "jfeq(0,NaN,0)="; check(val, 0); print ", ";
val = test_jfeq(M_0, M_0, M_NAN);
print "jfeq(0,0,NaN)="; check(val, 0); print ", ";
val = test_jfeq(M_0, M_NAN, M_NAN);
print "jfeq(0,NaN,NAN)="; check(val, 0); print ", ";
val = test_jfeq(M_NAN, M_0, M_NAN);
print "jfeq(NaN,0,NaN)="; check(val, 0); print ", ";
val = test_jfeq(M_NAN, M_NAN, M_0);
print "jfeq(NaN,NaN,0)="; check(val, 0); print ", ";
val = test_jfeq(M_NAN, M_NAN, M_NAN);
print "jfeq(NaN,NaN,NaN)="; check(val, 0); print ", ";
val = test_jfeq(M_INF, M_INF, M_NAN);
print "jfeq(Inf,Inf,NaN)="; check(val, 0); print ", ";
val = test_jfeq(M_INF, M_NINF, M_NAN);
print "jfeq(Inf,-Inf,NaN)="; check(val, 0); print ", ";
val = test_jfeq(M_INF, M_0, M_NAN);
print "jfeq(Inf,0,NaN)="; check(val, 0); print ", ";
val = test_jfeq(M_0, M_NAN, M_INF);
print "jfeq(0,NaN,Inf)="; check(val, 0); print ", ";
val = test_jfeq(M_NAN, M_NAN, M_INF);
print "jfeq(NaN,NaN,Inf)="; check(val, 0); print "^";
val = test_jfne(M_0, M_0, M_0);
print "jfne(0,0,0)="; check(val, 0); print ", ";
val = test_jfne(M_0, M_N0, M_0);
print "jfne(0,-0,0)="; check(val, 0); print ", ";
val = test_jfne(M_0, M_0, M_N0);
print "jfne(0,0,-0)="; check(val, 0); print ", ";
val = test_jfne(M_0, $00000001, M_0);
print "jfne(0,1.4e-45,0)="; check(val, 1); print ", ";
val = test_jfne(M_0, $80000001, M_0);
print "jfne(0,-1.4e-45,0)="; check(val, 1); print ", ";
val = test_jfne($7F7FFFFF, $7F7FFFFF, M_0);
print "jfne(3.4e+38,3.4e+38,0)="; check(val, 0); print ", ";
val = test_jfne($7F7FFFFF, $7F7FFFFE, M_0);
print "jfne(3.4e+38,3.4e+38,0)="; check(val, 1); print ", ";
val = test_jfne(M_INF, M_INF, M_0);
print "jfne(Inf,Inf,0)="; check(val, 0); print ", ";
val = test_jfne(M_NINF, M_NINF, M_0);
print "jfne(-Inf,-Inf,0)="; check(val, 0); print ", ";
val = test_jfne(M_INF, M_NINF, M_0);
print "jfne(Inf,-Inf,0)="; check(val, 1); print "^";
val = test_jfne(M_0, M_0, $00000001);
print "jfne(0,0,1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_0, M_N0, $00000001);
print "jfne(0,-0,1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_0, M_0, $80000001);
print "jfne(0,0,-1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_0, $00000001, $00000001);
print "jfne(0,1.4e-45,1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_0, $80000001, $00000001);
print "jfne(0,-1.4e-45,1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_0, $00000001, $80000001);
print "jfne(0,1.4e-45,-1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_0, $00000002, $00000001);
print "jfne(0,2.8e-45,1.4e-45)="; check(val, 1); print ", ";
val = test_jfne($7F7FFFFF, $7F7FFFFF, $00000001);
print "jfne(3.4e+38,3.4e+38,1.4e-45)="; check(val, 0); print ", ";
val = test_jfne($7F7FFFFF, $7F7FFFFE, $00000001);
print "jfne(3.4e+38,3.4e+38,1.4e-45)="; check(val, 1); print ", ";
val = test_jfne(M_INF, M_INF, $00000001);
print "jfne(Inf,Inf,1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_NINF, M_NINF, $00000001);
print "jfne(-Inf,-Inf,1.4e-45)="; check(val, 0); print ", ";
val = test_jfne(M_INF, M_NINF, $00000001);
print "jfne(Inf,-Inf,1.4e-45)="; check(val, 1); print "^";
val = test_jfne(M_0, M_1, M_1);
print "jfne(0,0,1)="; check(val, 0); print ", ";
val = test_jfne(M_0, $C0000000, M_1);
print "jfne(0,-2,1)="; check(val, 1); print ", ";
val = test_jfne(M_0, $C0000000, $3FC00000);
print "jfne(0,-2,1.5)="; check(val, 1); print ", ";
val = test_jfne(M_0, $C0000000, $40000000);
print "jfne(0,-2,2)="; check(val, 0); print ", ";
val = test_jfne(M_0, $C0000000, $C0000000);
print "jfne(0,-2,-2)="; check(val, 0); print ", ";
val = test_jfne($3FC00000, $40000000, $3FC00000);
print "jfne(1.5,2,1.5)="; check(val, 0); print ", ";
val = test_jfne($3FC00000, $40400000, $3FC00000);
print "jfne(1.5,3,1.5)="; check(val, 0); print ", ";
val = test_jfne($3FC00000, $40400001, $3FC00000);
print "jfne(1.5,3+,1.5)="; check(val, 1); print "^";
val = test_jfne(M_0, $7F7FFFFF, $7F7FFFFE);
print "jfne(0,3.4e+38,3.4e+38-)="; check(val, 1); print ", ";
val = test_jfne(M_0, $7F7FFFFF, $7F7FFFFF);
print "jfne(0,3.4e+38,3.4e+38)="; check(val, 0); print ", ";
val = test_jfne(M_N1, $7F7FFFFF, $7F7FFFFF);
print "jfne(-1,3.4e+38,3.4e+38)="; check(val, 0); print ", ";
val = test_jfne($FF7FFFFF, $7F7FFFFF, $7F7FFFFF);
print "jfne(-3.4e+38,3.4e+38,3.4e+38)="; check(val, 1); print ",";
val = test_jfne(M_INF, $7F7FFFFF, $7F7FFFFF);
print "jfne(Inf,3.4e+38,3.4e+38)="; check(val, 1); print ", ";
val = test_jfne(M_NINF, $FF7FFFFF, $7F7FFFFF);
print "jfne(-Inf,-3.4e+38,3.4e+38)="; check(val, 1); print ", ";
val = test_jfne(M_INF, M_INF, $7F7FFFFF);
print "jfne(Inf,Inf,3.4e+38)="; check(val, 0); print ", ";
val = test_jfne(M_NINF, M_INF, $7F7FFFFF);
print "jfne(-Inf,Inf,3.4e+38)="; check(val, 1); print "^";
val = test_jfne(M_0, M_0, M_INF);
print "jfne(0,0,Inf)="; check(val, 0); print ", ";
val = test_jfne(M_0, $7F7FFFFF, M_INF);
print "jfne(0,3.4e+38,Inf)="; check(val, 0); print ", ";
val = test_jfne(M_0, $7F7FFFFF, M_NINF);
print "jfne(0,3.4e+38,-Inf)="; check(val, 0); print ", ";
val = test_jfne(M_0, $FF7FFFFF, M_NINF);
print "jfne(0,-3.4e+38,-Inf)="; check(val, 0); print ", ";
val = test_jfne($FF7FFFFF, $7F7FFFFF, M_INF);
print "jfne(-3.4e+38,3.4e+38,Inf)="; check(val, 0); print ", ";
val = test_jfne($FF7FFFFF, $7F7FFFFF, M_NINF);
print "jfne(-3.4e+38,3.4e+38,-Inf)="; check(val, 0); print ", ";
val = test_jfne(M_0, M_INF, M_INF);
print "jfne(0,Inf,Inf)="; check(val, 0); print ", ";
val = test_jfne($FF7FFFFF, M_NINF, M_INF);
print "jfne(-3.4e+38,-Inf,Inf)="; check(val, 0); print ", ";
val = test_jfne(M_0, M_NINF, M_INF);
print "jfne(0,-Inf,Inf)="; check(val, 0); print ", ";
val = test_jfne(M_NINF, M_NINF, M_INF);
print "jfne(-Inf,-Inf,Inf)="; check(val, 0); print ", ";
val = test_jfne(M_INF, M_NINF, M_INF);
print "jfne(Inf,-Inf,Inf)="; check(val, 1); print "^";
val = test_jfne(M_NAN, M_0, M_0);
print "jfne(NaN,0,0)="; check(val, 1); print ", ";
val = test_jfne(M_0, M_NAN, M_0);
print "jfne(0,NaN,0)="; check(val, 1); print ", ";
val = test_jfne(M_0, M_0, M_NAN);
print "jfne(0,0,NaN)="; check(val, 1); print ", ";
val = test_jfne(M_0, M_NAN, M_NAN);
print "jfne(0,NaN,NAN)="; check(val, 1); print ", ";
val = test_jfne(M_NAN, M_0, M_NAN);
print "jfne(NaN,0,NaN)="; check(val, 1); print ", ";
val = test_jfne(M_NAN, M_NAN, M_0);
print "jfne(NaN,NaN,0)="; check(val, 1); print ", ";
val = test_jfne(M_NAN, M_NAN, M_NAN);
print "jfne(NaN,NaN,NaN)="; check(val, 1); print ", ";
val = test_jfne(M_INF, M_INF, M_NAN);
print "jfne(Inf,Inf,NaN)="; check(val, 1); print ", ";
val = test_jfne(M_INF, M_NINF, M_NAN);
print "jfne(Inf,-Inf,NaN)="; check(val, 1); print ", ";
val = test_jfne(M_INF, M_0, M_NAN);
print "jfne(Inf,0,NaN)="; check(val, 1); print ", ";
val = test_jfne(M_0, M_NAN, M_INF);
print "jfne(0,NaN,Inf)="; check(val, 1); print ", ";
val = test_jfne(M_NAN, M_NAN, M_INF);
print "jfne(NaN,NaN,Inf)="; check(val, 1); print "^";
count_failures();
];
TestFloatClass FloatCompareTest
with name 'fcompare',
testfunc [ val;
print "Floating-point inequality comparisons:^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
val = test_jflt(M_0, M_0);
print "jflt(0,0)="; check(val, 0); print ", ";
val = test_jflt(M_0, M_1);
print "jflt(0,1)="; check(val, 1); print ", ";
val = test_jflt(M_0, M_N1);
print "jflt(0,-1)="; check(val, 0); print ", ";
val = test_jflt(M_N0, M_0);
print "jflt(-0,0)="; check(val, 0); print ", ";
val = test_jflt(M_N0, M_1);
print "jflt(-0,1)="; check(val, 1); print ", ";
val = test_jflt(M_N0, M_N1);
print "jflt(-0,-1)="; check(val, 0); print ", ";
val = test_jflt(M_N0, M_N0);
print "jflt(-0,-0)="; check(val, 0); print ", ";
val = test_jflt(M_1, M_1);
print "jflt(1,1)="; check(val, 0); print ", ";
val = test_jflt(M_PI, M_PI);
print "jflt(pi,pi)="; check(val, 0); print ", ";
val = test_jflt(M_0, $00000001);
print "jflt(0,1.4e-45)="; check(val, 1); print ", ";
val = test_jflt(M_0, $80000001);
print "jflt(0,-1.4e-45)="; check(val, 0); print ", ";
val = test_jflt($80000001, M_N0);
print "jflt(-1.4e-45,-0)="; check(val, 1); print ", ";
val = test_jflt($00000001, $7F7FFFFF);
print "jflt(1.4e-45,3.4e+38)="; check(val, 1); print ", ";
val = test_jflt($00000001, $FF7FFFFF);
print "jflt(1.4e-45,-3.4e+38)="; check(val, 0); print "^";
val = test_jflt(M_0, M_INF);
print "jflt(0,Inf)="; check(val, 1); print ", ";
val = test_jflt(M_0, M_NINF);
print "jflt(0,-Inf)="; check(val, 0); print ", ";
val = test_jflt($7F7FFFFF, M_INF);
print "jflt(3.4e+38,Inf)="; check(val, 1); print ", ";
val = test_jflt($7F7FFFFF, M_NINF);
print "jflt(3.4e+38,-Inf)="; check(val, 0); print ", ";
val = test_jflt(M_NINF, $FF7FFFFF);
print "jflt(-Inf,-3.4e+38)="; check(val, 1); print ", ";
val = test_jflt(M_NINF, M_INF);
print "jflt(-Inf,Inf)="; check(val, 1); print ", ";
val = test_jflt(M_INF, M_NINF);
print "jflt(Inf,-Inf)="; check(val, 0); print ", ";
val = test_jflt(M_INF, M_INF);
print "jflt(Inf,Inf)="; check(val, 0); print ", ";
val = test_jflt(M_NINF, M_NINF);
print "jflt(-Inf,-Inf)="; check(val, 0); print "^";
val = test_jflt(M_0, M_NAN);
print "jflt(0,NaN)="; check(val, 0); print ", ";
val = test_jflt(M_NAN, M_0);
print "jflt(NaN,0)="; check(val, 0); print ", ";
val = test_jflt(M_INF, M_NAN);
print "jflt(Inf,NaN)="; check(val, 0); print ", ";
val = test_jflt(M_NINF, M_NAN);
print "jflt(-Inf,NaN)="; check(val, 0); print ", ";
val = test_jflt(M_NAN, M_INF);
print "jflt(NaN,Inf)="; check(val, 0); print ", ";
val = test_jflt(M_NAN, M_NINF);
print "jflt(NaN,-Inf)="; check(val, 0); print ", ";
val = test_jflt(M_NAN, M_NAN);
print "jflt(NaN,NaN)="; check(val, 0); print ", ";
val = test_jflt(M_NNAN, M_NAN);
print "jflt(-NaN,NaN)="; check(val, 0); print "^";
val = test_jfle(M_0, M_0);
print "jfle(0,0)="; check(val, 1); print ", ";
val = test_jfle(M_0, M_1);
print "jfle(0,1)="; check(val, 1); print ", ";
val = test_jfle(M_0, M_N1);
print "jfle(0,-1)="; check(val, 0); print ", ";
val = test_jfle(M_N0, M_0);
print "jfle(-0,0)="; check(val, 1); print ", ";
val = test_jfle(M_N0, M_1);
print "jfle(-0,1)="; check(val, 1); print ", ";
val = test_jfle(M_N0, M_N1);
print "jfle(-0,-1)="; check(val, 0); print ", ";
val = test_jfle(M_N0, M_N0);
print "jfle(-0,-0)="; check(val, 1); print ", ";
val = test_jfle(M_1, M_1);
print "jfle(1,1)="; check(val, 1); print ", ";
val = test_jfle(M_PI, M_PI);
print "jfle(pi,pi)="; check(val, 1); print ", ";
val = test_jfle(M_0, $00000001);
print "jfle(0,1.4e-45)="; check(val, 1); print ", ";
val = test_jfle(M_0, $80000001);
print "jfle(0,-1.4e-45)="; check(val, 0); print ", ";
val = test_jfle($80000001, M_N0);
print "jfle(-1.4e-45,-0)="; check(val, 1); print ", ";
val = test_jfle($00000001, $7F7FFFFF);
print "jfle(1.4e-45,3.4e+38)="; check(val, 1); print ", ";
val = test_jfle($00000001, $FF7FFFFF);
print "jfle(1.4e-45,-3.4e+38)="; check(val, 0); print "^";
val = test_jfle(M_0, M_INF);
print "jfle(0,Inf)="; check(val, 1); print ", ";
val = test_jfle(M_0, M_NINF);
print "jfle(0,-Inf)="; check(val, 0); print ", ";
val = test_jfle($7F7FFFFF, M_INF);
print "jfle(3.4e+38,Inf)="; check(val, 1); print ", ";
val = test_jfle($7F7FFFFF, M_NINF);
print "jfle(3.4e+38,-Inf)="; check(val, 0); print ", ";
val = test_jfle(M_NINF, $FF7FFFFF);
print "jfle(-Inf,-3.4e+38)="; check(val, 1); print ", ";
val = test_jfle(M_NINF, M_INF);
print "jfle(-Inf,Inf)="; check(val, 1); print ", ";
val = test_jfle(M_INF, M_NINF);
print "jfle(Inf,-Inf)="; check(val, 0); print ", ";
val = test_jfle(M_INF, M_INF);
print "jfle(Inf,Inf)="; check(val, 1); print ", ";
val = test_jfle(M_NINF, M_NINF);
print "jfle(-Inf,-Inf)="; check(val, 1); print "^";
val = test_jfle(M_0, M_NAN);
print "jfle(0,NaN)="; check(val, 0); print ", ";
val = test_jfle(M_NAN, M_0);
print "jfle(NaN,0)="; check(val, 0); print ", ";
val = test_jfle(M_INF, M_NAN);
print "jfle(Inf,NaN)="; check(val, 0); print ", ";
val = test_jfle(M_NINF, M_NAN);
print "jfle(-Inf,NaN)="; check(val, 0); print ", ";
val = test_jfle(M_NAN, M_INF);
print "jfle(NaN,Inf)="; check(val, 0); print ", ";
val = test_jfle(M_NAN, M_NINF);
print "jfle(NaN,-Inf)="; check(val, 0); print ", ";
val = test_jfle(M_NAN, M_NAN);
print "jfle(NaN,NaN)="; check(val, 0); print ", ";
val = test_jfle(M_NNAN, M_NAN);
print "jfle(-NaN,NaN)="; check(val, 0); print "^";
val = test_jfgt(M_0, M_0);
print "jfgt(0,0)="; check(val, 0); print ", ";
val = test_jfgt(M_0, M_1);
print "jfgt(0,1)="; check(val, 0); print ", ";
val = test_jfgt(M_0, M_N1);
print "jfgt(0,-1)="; check(val, 1); print ", ";
val = test_jfgt(M_N0, M_0);
print "jfgt(-0,0)="; check(val, 0); print ", ";
val = test_jfgt(M_N0, M_1);
print "jfgt(-0,1)="; check(val, 0); print ", ";
val = test_jfgt(M_N0, M_N1);
print "jfgt(-0,-1)="; check(val, 1); print ", ";
val = test_jfgt(M_N0, M_N0);
print "jfgt(-0,-0)="; check(val, 0); print ", ";
val = test_jfgt(M_1, M_1);
print "jfgt(1,1)="; check(val, 0); print ", ";
val = test_jfgt(M_PI, M_PI);
print "jfgt(pi,pi)="; check(val, 0); print ", ";
val = test_jfgt(M_0, $00000001);
print "jfgt(0,1.4e-45)="; check(val, 0); print ", ";
val = test_jfgt(M_0, $80000001);
print "jfgt(0,-1.4e-45)="; check(val, 1); print ", ";
val = test_jfgt($80000001, M_N0);
print "jfgt(-1.4e-45,-0)="; check(val, 0); print ", ";
val = test_jfgt($00000001, $7F7FFFFF);
print "jfgt(1.4e-45,3.4e+38)="; check(val, 0); print ", ";
val = test_jfgt($00000001, $FF7FFFFF);
print "jfgt(1.4e-45,-3.4e+38)="; check(val, 1); print "^";
val = test_jfgt(M_0, M_INF);
print "jfgt(0,Inf)="; check(val, 0); print ", ";
val = test_jfgt(M_0, M_NINF);
print "jfgt(0,-Inf)="; check(val, 1); print ", ";
val = test_jfgt($7F7FFFFF, M_INF);
print "jfgt(3.4e+38,Inf)="; check(val, 0); print ", ";
val = test_jfgt($7F7FFFFF, M_NINF);
print "jfgt(3.4e+38,-Inf)="; check(val, 1); print ", ";
val = test_jfgt(M_NINF, $FF7FFFFF);
print "jfgt(-Inf,-3.4e+38)="; check(val, 0); print ", ";
val = test_jfgt(M_NINF, M_INF);
print "jfgt(-Inf,Inf)="; check(val, 0); print ", ";
val = test_jfgt(M_INF, M_NINF);
print "jfgt(Inf,-Inf)="; check(val, 1); print ", ";
val = test_jfgt(M_INF, M_INF);
print "jfgt(Inf,Inf)="; check(val, 0); print ", ";
val = test_jfgt(M_NINF, M_NINF);
print "jfgt(-Inf,-Inf)="; check(val, 0); print "^";
val = test_jfgt(M_0, M_NAN);
print "jfgt(0,NaN)="; check(val, 0); print ", ";
val = test_jfgt(M_NAN, M_0);
print "jfgt(NaN,0)="; check(val, 0); print ", ";
val = test_jfgt(M_INF, M_NAN);
print "jfgt(Inf,NaN)="; check(val, 0); print ", ";
val = test_jfgt(M_NINF, M_NAN);
print "jfgt(-Inf,NaN)="; check(val, 0); print ", ";
val = test_jfgt(M_NAN, M_INF);
print "jfgt(NaN,Inf)="; check(val, 0); print ", ";
val = test_jfgt(M_NAN, M_NINF);
print "jfgt(NaN,-Inf)="; check(val, 0); print ", ";
val = test_jfgt(M_NAN, M_NAN);
print "jfgt(NaN,NaN)="; check(val, 0); print ", ";
val = test_jfgt(M_NNAN, M_NAN);
print "jfgt(-NaN,NaN)="; check(val, 0); print "^";
val = test_jfge(M_0, M_0);
print "jfge(0,0)="; check(val, 1); print ", ";
val = test_jfge(M_0, M_1);
print "jfge(0,1)="; check(val, 0); print ", ";
val = test_jfge(M_0, M_N1);
print "jfge(0,-1)="; check(val, 1); print ", ";
val = test_jfge(M_N0, M_0);
print "jfge(-0,0)="; check(val, 1); print ", ";
val = test_jfge(M_N0, M_1);
print "jfge(-0,1)="; check(val, 0); print ", ";
val = test_jfge(M_N0, M_N1);
print "jfge(-0,-1)="; check(val, 1); print ", ";
val = test_jfge(M_N0, M_N0);
print "jfge(-0,-0)="; check(val, 1); print ", ";
val = test_jfge(M_1, M_1);
print "jfge(1,1)="; check(val, 1); print ", ";
val = test_jfge(M_PI, M_PI);
print "jfge(pi,pi)="; check(val, 1); print ", ";
val = test_jfge(M_0, $00000001);
print "jfge(0,1.4e-45)="; check(val, 0); print ", ";
val = test_jfge(M_0, $80000001);
print "jfge(0,-1.4e-45)="; check(val, 1); print ", ";
val = test_jfge($80000001, M_N0);
print "jfge(-1.4e-45,-0)="; check(val, 0); print ", ";
val = test_jfge($00000001, $7F7FFFFF);
print "jfge(1.4e-45,3.4e+38)="; check(val, 0); print ", ";
val = test_jfge($00000001, $FF7FFFFF);
print "jfge(1.4e-45,-3.4e+38)="; check(val, 1); print "^";
val = test_jfge(M_0, M_INF);
print "jfge(0,Inf)="; check(val, 0); print ", ";
val = test_jfge(M_0, M_NINF);
print "jfge(0,-Inf)="; check(val, 1); print ", ";
val = test_jfge($7F7FFFFF, M_INF);
print "jfge(3.4e+38,Inf)="; check(val, 0); print ", ";
val = test_jfge($7F7FFFFF, M_NINF);
print "jfge(3.4e+38,-Inf)="; check(val, 1); print ", ";
val = test_jfge(M_NINF, $FF7FFFFF);
print "jfge(-Inf,-3.4e+38)="; check(val, 0); print ", ";
val = test_jfge(M_NINF, M_INF);
print "jfge(-Inf,Inf)="; check(val, 0); print ", ";
val = test_jfge(M_INF, M_NINF);
print "jfge(Inf,-Inf)="; check(val, 1); print ", ";
val = test_jfge(M_INF, M_INF);
print "jfge(Inf,Inf)="; check(val, 1); print ", ";
val = test_jfge(M_NINF, M_NINF);
print "jfge(-Inf,-Inf)="; check(val, 1); print "^";
val = test_jfge(M_0, M_NAN);
print "jfge(0,NaN)="; check(val, 0); print ", ";
val = test_jfge(M_NAN, M_0);
print "jfge(NaN,0)="; check(val, 0); print ", ";
val = test_jfge(M_INF, M_NAN);
print "jfge(Inf,NaN)="; check(val, 0); print ", ";
val = test_jfge(M_NINF, M_NAN);
print "jfge(-Inf,NaN)="; check(val, 0); print ", ";
val = test_jfge(M_NAN, M_INF);
print "jfge(NaN,Inf)="; check(val, 0); print ", ";
val = test_jfge(M_NAN, M_NINF);
print "jfge(NaN,-Inf)="; check(val, 0); print ", ";
val = test_jfge(M_NAN, M_NAN);
print "jfge(NaN,NaN)="; check(val, 0); print ", ";
val = test_jfge(M_NNAN, M_NAN);
print "jfge(-NaN,NaN)="; check(val, 0); print "^";
count_failures();
];
[ test_jisinf val;
@jisinf val ?Yes;
rfalse;
.Yes;
rtrue;
];
[ test_jisnan val;
@jisnan val ?Yes;
rfalse;
.Yes;
rtrue;
];
[ test_jflt val1 val2;
@jflt val1 val2 ?Yes;
rfalse;
.Yes;
rtrue;
];
[ test_jfle val1 val2;
@jfle val1 val2 ?Yes;
rfalse;
.Yes;
rtrue;
];
[ test_jfgt val1 val2;
@jfgt val1 val2 ?Yes;
rfalse;
.Yes;
rtrue;
];
[ test_jfge val1 val2;
@jfge val1 val2 ?Yes;
rfalse;
.Yes;
rtrue;
];
[ test_jfeq val1 val2 val3;
@jfeq val1 val2 val3 ?Yes;
rfalse;
.Yes;
rtrue;
];
[ test_jfne val1 val2 val3;
@jfne val1 val2 val3 ?Yes;
rfalse;
.Yes;
rtrue;
];
TestFloatClass FloatprintTest
with name 'fprint' 'floatprint',
testfunc [ val;
print "Print floating-point numbers:^";
print "Note: this does not test an opcode. It tests the
FloatExp function, which is included in this test suite.
You are welcome to use that function in your Glulx program
or library.^^";
@gestalt 11 0 val; ! Float
if (~~val) {
print "Interpreter claims to not support floating-point. Skipping test.^^";
count_failures();
return;
}
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_0);
check_str("0.00000e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_N0);
check_str("-0.00000e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_1);
check_str("1.00000e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_N1);
check_str("-1.00000e+00", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $3DCCCCCD);
check_str("1.00000e-01", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $3D088889);
check_str("3.33333e-02", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $40000000);
check_str("2.00000e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $42C80000);
check_str("1.00000e+02", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $42C7FFFE);
check_str("1.00000e+02", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $42C7FFFD);
check_str("1.00000e+02", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $42C7FFF0);
check_str("9.99999e+01", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $42FA0000);
check_str("1.25000e+02", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $0E736390);
check_str("3.00000e-30", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $72B0B471);
check_str("6.99998e+30", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $0003444A);
check_str("3.00004e-40", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $7957B443);
check_str("6.99998e+34", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_1, 1);
check_str("1.0e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_1, 4);
check_str("1.0000e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_1, 8);
check_str("1.00000024e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $40D945F4, 1);
check_str("6.8e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $40D945F4, 4);
check_str("6.7898e+00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $40D945F4, 8);
check_str("6.78979520e+00", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_INF);
check_str("Inf", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_NINF);
check_str("-Inf", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, M_NAN);
check_str("NaN", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatExp, $FFFFFFFF);
check_str("-NaN", val); print "^";
new_line;
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_0);
check_str("0.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_N0);
check_str("-0.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_1);
check_str("1.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_N1);
check_str("-1.00000", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $3DCCCCCD);
check_str("0.10000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $3CA3D70A);
check_str("0.02000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $3D088889);
check_str("0.03333", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $414587E7);
check_str("12.34568", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $C2F0B0FD);
check_str("-120.34568", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $47C3502C);
check_str("100000.34375", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $49742406);
check_str("1000000.37500", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $4B189680);
check_str("10000000.00000", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $1E3CE508);
check_str("0.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $9E3CE508);
check_str("-0.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $4F800000);
check_str("4294965440.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $7149F2CA);
check_str("1000000240000000000000000000000.00000", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_1, 1);
check_str("1.0", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_1, 4);
check_str("1.0000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_1, 8);
check_str("1.00000000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $40D945F4, 1);
check_str("6.8", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $40D945F4, 4);
check_str("6.7898", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $40D945F4, 8);
check_str("6.78978832", val); print "^";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_INF);
check_str("Inf", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_NINF);
check_str("-Inf", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, M_NAN);
check_str("NaN", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, FloatDec, $FFFFFFFF);
check_str("-NaN", val); print "^";
new_line;
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, M_1, 2);
check_str("1.00", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, M_1);
check_str("1.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $497423F0);
check_str("999999.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $C97423F0);
check_str("-999999.00000", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $497424A0);
check_str("1.00001e+06", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $C97424A0);
check_str("-1.00001e+06", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $38D1B717);
check_str("0.00010", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $B8D1B717);
check_str("-0.00010", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $38BCBE62, 4);
check_str("9.0000e-05", val); print ", ";
val = func_to_array(bigbuffer, BIGBUFSIZE, Float, $B8BCBE62, 4);
check_str("-9.0000e-05", val); print "^";
count_failures();
];
#endif; ! FLOAT_OPCODES_AVAILABLE
TestClass Safari5Test
with name 'safari5',
testfunc [ val arr res;
print "Safari 5 bug:^";
print "This tests for a known Javascript bug in Safari 5,
MacOS 10.5.8, Intel (not PPC). You should only see
this fail on Quixe on that browser setup. This failure
does not represent a Glulx error. I just want to be
able to track it.^^";
@push $80000000;
@push $80FFFFFF;
@sub sp sp val;
print "Folded: "; check_hex(val, $FFFFFF); print "^";
@push $80000000;
@push $80FFFFFF;
noop();
@sub sp sp val;
print "Stack: "; check_hex(val, $FFFFFF); print "^";
arr = $80000000;
res = $80FFFFFF;
val = res - arr;
print "Locals: "; check_hex(val, $FFFFFF); print "^";
count_failures();
];
Reference in a new issue View git blame Copy permalink