Bug fixes
[rodin/chimara.git] / 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 ];