!% $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(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 : ixix = glk($00A0, buf->(cx+ix)); for (: ixix = 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 : ixix == 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 : ixix ~= bigbuffer2->ix) good = false; } } print "~"; for (ix=0 : ixix; @streamchar ch; } print "~ len ", len; if (~~good) { failures++; print " (should be ~"; for (ix=0 : ixix; @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 : ixix ~= bigubuffer2-->ix) good = false; } } print "~"; for (ix=0 : ixix; @streamunichar ch; } print "~ len ", len; if (~~good) { failures++; print " (should be ~"; for (ix=0 : ixix; @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 : ixix = str->ix; val = string_to_array(ramstringbuf, bigbuffer, BIGBUFSIZE); check_str(str, val); print "^"; str = "Third test."; for (ix=0 : ixix = str->ix; val = string_to_array(ramstringbuf, bigbuffer, BIGBUFSIZE); check_str(str, val); print "^"; str = ""; for (ix=0 : ixix = 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("<,>< >< ><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("<,>< >< ><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("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("={<.><.><.><[><]><.><.><.><[><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= 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