interpreters/nitfol/test.inf

   1 !!
   2 !! Simple program to test various z-machine stuff.
   3 !! Placed in the public domain by Evin Robertson.
   4 !!
   5
   6 [ assert actual expected a op b;
   7    if(expected ~= actual) {
   8       print "^";
   9       @check_arg_count 5 ?binary;
  10
  11       print (string) op, a;
  12       jump e;
  13
  14       .binary;
  15       print a, (string) op, b;
  16
  17       .e;
  18       print "  expected ", expected, "; got ", actual, "^";
  19       @quit;
  20    }
  21 ];
  22
  23 Global count;
  24
  25 [ do_check_check_arg_count a b c d e f g n;
  26    for(n = 1: n <= count: n++) {
  27       @check_arg_count n ?~bad;
  28    }
  29    for(: n <= 7: n++) {
  30       @check_arg_count n ?bad;
  31    }
  32    return;
  33
  34    .bad;
  35
  36    print "^claimed argument ", n, " was ";
  37    if(n <= count)
  38       print "not given when it was.^";
  39    else
  40       print "given when it was not.^";
  41    @quit;
  42 ];
  43
  44 !Global mycount;
  45 !
  46 ![ list_arguments a b c d e f g h i j k l m n o;
  47 !   for(mycount = 1: mycount <= 15: mycount++) {
  48 !      @check_arg_count mycount ?~noarg;
  49 !
  50 !      print mycount, "=";
  51 !
  52 !      @load [mycount] -> sp;
  53 !      @print_num sp;
  54 !
  55 !      print "; ";
  56 !
  57 !      .noarg;
  58 !   }
  59 !   new_line;
  60 !];
  61
  62 [ do_add a b expect;
  63    @add a b -> sp;
  64    @call_vn2 assert sp expect a "+" b;
  65 ];
  66
  67 [ do_and a b expect;
  68    @and a b -> sp;
  69    @call_vn2 assert sp expect a "&" b;
  70 ];
  71
  72 [ do_art a b expect;
  73   @art_shift a b -> sp;
  74   @call_vn2 assert sp expect a "<<" b;
  75 ];
  76
  77 [ do_dec a expect;
  78   @dec a;
  79   @call_vn2 assert a expect a "--";
  80 ];
  81
  82 [ do_div a b expect;
  83   @div a b -> sp;
  84   @call_vn2 assert sp expect a "/" b;
  85 ];
  86
  87 [ do_inc a expect;
  88    @inc a;
  89    @call_vn2 assert a expect a "++";
  90 ];
  91
  92 [ do_log a b expect;
  93    @log_shift a b -> sp;
  94    @call_vn2 assert sp expect a "<<" b;
  95 ];
  96
  97 [ do_mod a b expect;
  98    @mod a b -> sp;
  99    @call_vn2 assert sp expect a "%" b;
 100 ];
 101
 102 [ do_mul a b expect;
 103    @mul a b -> sp;
 104    @call_vn2 assert sp expect a "*" b;
 105 ];
 106
 107 [ do_not a expect;
 108    @"VAR:56S" a -> sp;     !   @not a -> sp;   (bug in inform)
 109    @call_vn2 assert sp expect a "~";
 110 ];
 111
 112 [ do_or a b expect;
 113    @or a b -> sp;
 114    @call_vn2 assert sp expect a "|" b;
 115 ];
 116
 117 [ do_sub a b expect;
 118    @sub a b -> sp;
 119    @call_vn2 assert sp expect a "-" b;
 120 ];
 121
 122
 123
 124 ! I couldn't figure out how to do negative numbers in inform assembly, so
 125 ! here's constants for the numbers I use
 126 Constant n1 -1;
 127 Constant n2 -2;
 128 Constant n3 -3;
 129 Constant n4 -4;
 130 Constant n5 -5;
 131 Constant n500 -500;
 132 Constant n32768 -32768;
 133
 134 Constant Rand_Range 60;
 135
 136 Array mytable -> 256;
 137 Array mysecond -> 256;
 138
 139
 140 [ Main n g max;
 141 !   mytable->0 = 200;
 142 !   mytable->1 = 0;
 143 !   @aread mytable 0 -> n;
 144
 145    print "Testing... ";
 146
 147    print "check_arg_count ";
 148    count = 0; do_check_check_arg_count();
 149    count = 1; do_check_check_arg_count(1);
 150    count = 2; do_check_check_arg_count(2, 1);
 151    count = 3; do_check_check_arg_count(3, 2, 1);
 152    count = 4; do_check_check_arg_count(4, 3, 2, 1);
 153    count = 5; do_check_check_arg_count(5, 4, 3, 2, 1);
 154    count = 6; do_check_check_arg_count(6, 5, 4, 3, 2, 1);
 155    count = 7; do_check_check_arg_count(7, 6, 5, 4, 3, 2, 1);
 156
 157    print "je ";
 158    @je  5  5 ?~bad;
 159    @je  5 n5 ?bad;
 160    @je n5  5 ?bad;
 161    @je n5 n5 ?~bad;
 162    @je  32767 n32768 ?bad;
 163    @je n32768 n32768 ?~bad;
 164
 165    print "jg ";
 166    @jg  5  5 ?bad;
 167    @jg  1  0 ?~bad;
 168    @jg  0  1 ?bad;
 169    @jg n1 n2 ?~bad;
 170    @jg n2 n1 ?bad;
 171    @jg  1 n1 ?~bad;
 172    @jg n1  1 ?bad;
 173
 174    print "jl ";
 175    @jl  5  5 ?bad;
 176    @jl  1  0 ?bad;
 177    @jl  0  1 ?~bad;
 178    @jl n1 n2 ?bad;
 179    @jl n2 n1 ?~bad;
 180    @jl  1 n1 ?bad;
 181    @jl n1  1 ?~bad;
 182
 183    print "jz ";
 184    @jz 0 ?~bad;
 185    @jz 1 ?bad;
 186    print "je ";
 187    @je 42 42 ?~bad;
 188    @je 15 5 ?bad;
 189
 190    print "dec_chk ";
 191    n = 3;
 192    @dec_chk n 1000 ?~bad;  !  2
 193    @dec_chk n    1 ?bad;   !  1
 194    @dec_chk n    1 ?~bad;  !  0
 195    @dec_chk n    0 ?~bad;  ! -1
 196    @dec_chk n   n2 ?bad;   ! -2
 197    @dec_chk n   n2 ?~bad;  ! -3
 198    @dec_chk n 1000 ?~bad;  ! -4
 199    @dec_chk n n500 ?bad;   ! -5
 200
 201    print "inc_chk ";
 202    n = -6;
 203    @inc_chk n n500 ?~bad; ! -5
 204    @inc_chk n 1000 ?bad;  ! -4
 205    @inc_chk n   n3 ?bad;  ! -3
 206    @inc_chk n   n3 ?~bad; ! -2
 207    @inc_chk n    0 ?bad;  ! -1
 208    @inc_chk n    1 ?bad;  !  0
 209    @inc_chk n    1 ?bad;  !  1
 210    @inc_chk n    1 ?~bad; !  2
 211    @inc_chk n 1000 ?bad;  !  3
 212
 213    print "test ";
 214    @test $ffff $ffff ?~bad;
 215    @test $ffff     0 ?~bad;
 216    @test $1234 $4321 ?bad;
 217
 218    print "add ";
 219    do_add( 5,  3,  8);
 220    do_add( 3,  5,  8);
 221    do_add(-5,  3, -2);
 222    do_add(-5, -3, -8);
 223    do_add(-3, -5, -8);
 224    do_add(-3,  5,  2);
 225    do_add(32765, 6, -32765);
 226
 227    print "and ";
 228    do_and( 5,  3,  1);
 229    do_and( 3,  5,  1);
 230    do_and(-3, -3, -3);
 231    do_and(-3,  5,  5);
 232    do_and(-3, -5, -7);
 233
 234    print "art_shift ";
 235    do_art( 0,  1,  0);
 236    do_art( 0, -1,  0);
 237    do_art( 1,  5, 32);
 238    do_art( 1, -1,  0);
 239    do_art(85,  1, 170);
 240    do_art(85, -2, 21);
 241    do_art(-9,  5, -288);
 242    do_art(-9, -5, -1);
 243
 244    print "dec ";
 245    do_dec( 5,  4);
 246    do_dec( 0, -1);
 247    do_dec(-8, -9);
 248    do_dec(-32768, 32767);
 249
 250    print "div ";
 251    do_div(-11,  2, -5);
 252    do_div(-11, -2,  5);
 253    do_div( 11, -2, -5);
 254    do_div(  5,  1,  5);
 255    do_div(  5,  2,  2);
 256    do_div(  5,  3,  1);
 257    do_div(  5,  5,  1);
 258    do_div(  5,  6,  0);
 259    do_div(5, 32767, 0);
 260    do_div(32767, -32768, 0);
 261    do_div(-32768, 32767, -1);
 262    do_div(-32768, -1, -32768);
 263
 264
 265    print "inc ";
 266    do_inc( 5,  6);
 267    do_inc(-1,  0);
 268    do_inc(-8, -7);
 269    do_inc(32767, -32768);
 270
 271    print "loadx/storex ";
 272    @loadb  mytable 0 -> n;
 273    assert(n, 0);
 274    @storeb mytable 0 123;
 275    @loadb  mytable 0 -> n;
 276    assert(n, 123);
 277    @loadw  mytable 0 -> n;
 278    assert(n, $7b00);
 279    @storew mytable 0 $1234;
 280    @loadw  mytable 0 -> n;
 281    assert(n, $1234);
 282    @loadb  mytable 0 -> n;
 283    assert(n, $12);
 284    @loadb  mytable 1 -> n;
 285    assert(n, $34);
 286
 287    print "log_shift ";
 288    do_log( 0,  1,  0);
 289    do_log( 0, -1,  0);
 290    do_log( 1,  5, 32);
 291    do_log( 1, -1,  0);
 292    do_log(85,  1, 170);
 293    do_log(85, -2, 21);
 294    do_log(-9,  5, -288);
 295    do_log(-9, -5, 2047);
 296
 297    print "mod ";
 298    do_mod(-13,  5, -3);
 299    do_mod( 13, -5,  3);
 300    do_mod(-13, -5, -3);
 301    do_mod(  5,  1,  0);
 302    do_mod(  5,  2,  1);
 303    do_mod(  5,  3,  2);
 304    do_mod(  5,  5,  0);
 305    do_mod(  5,  6,  5);
 306    do_mod(5, 32767, 5);
 307    do_mod(32767, -32768, 32767);
 308    do_mod(-32768, 32767, -1);
 309    do_mod(-32768, -1, 0);
 310
 311    print "mul ";
 312    do_mul(  0, 123,   0);
 313    do_mul(123,   0,   0);
 314    do_mul(  8,   9,  72);
 315    do_mul(  9,   8,  72);
 316    do_mul( 11,  -5, -55);
 317    do_mul(-11,   5, -55);
 318    do_mul(-11,  -5,  55);
 319    do_mul(-32768, -1, -32768);
 320
 321    print "not ";
 322    do_not(0, ~0);
 323    do_not(123, ~123);
 324    do_not($5555, $aaaa);
 325    do_not($aaaa, $5555);
 326
 327    print "or ";
 328    do_or($1234, $4321, $5335);
 329    do_or($4321, $1234, $5335);
 330    do_or($1234,     0, $1234);
 331    do_or($1030, $ffff, $ffff);
 332    do_or($ffff, $0204, $ffff);
 333
 334    print "sub ";
 335    do_sub(8,   5,  3);
 336    do_sub(8,   3,  5);
 337    do_sub(-2, -5,  3);
 338    do_sub(-8, -5, -3);
 339    do_sub(-8, -3, -5);
 340    do_sub(2,  -3,  5);
 341    do_sub(-32765, 32765, 6);
 342
 343    print "output_stream ";
 344    @output_stream 3 mytable;
 345    print "...looks ";
 346    @output_stream 3 mysecond;
 347    print " to me...";
 348    @output_stream -3;
 349    print "good";
 350    @output_stream -3;
 351    for(n = 0: n < mytable-->0: n++)
 352       print (char) mytable->(n+2);
 353    for(n = 0: n < mysecond-->0: n++)
 354       print (char) mysecond->(n+2);
 355
 356    print " random ";
 357    for(n = 1: n <= Rand_Range: n++)
 358       mytable-->n = 0;
 359
 360    for(n = 0: n < 800: n++) {
 361       @random Rand_Range -> g;
 362       if(g <= 0 || g > Rand_Range) {
 363          print "illegal return from result (", g, ").^";
 364          @quit;
 365       }
 366       (mytable-->g)++;
 367    }
 368
 369    new_line;
 370    style fixed;
 371
 372    max = 0;
 373    for(n = 1: n <= Rand_Range: n++) {
 374       if(mytable-->n > max)
 375          max = mytable-->n;
 376    }
 377
 378    for(g = max: g > 0: g--) {
 379       for(n = 1: n < Rand_Range: n++) {
 380          if(mytable-->n >= g)
 381             print (char) '#';
 382          else
 383             print (char) ' ';
 384       }
 385       new_line;
 386    }
 387
 388    style roman;
 389
 390    "Yay!";
 391
 392 .bad;
 393    "bad!";
 394
 395 ];