mirror of
https://github.com/ganelson/inform.git
synced 2024-07-16 22:14:23 +03:00
10549 lines
325 KiB
INI
Executable file
10549 lines
325 KiB
INI
Executable file
!% $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();
|
|
];
|