1TYPE int32 IS SIGNED (32); 2TYPE uns32 IS UNSIGNED (32); 3TYPE char8 IS UNSIGNED (8); 4 5TYPE enum8 IS ENUM {e8_0, e8_1, e8_2}; 6 7TYPE string8 IS ARRAY [uns32] OF char8; 8TYPE string_acc IS ACCESS string8; 9 10TYPE bool IS BOOLEAN {false, true}; 11 12TYPE float IS FLOAT; 13 14TYPE int64 IS SIGNED (64); 15TYPE uns64 IS UNSIGNED (64); 16 17TYPE int32_acc IS ACCESS int32; 18TYPE int64_acc IS ACCESS int64; 19 20-- Some constants. 21PRIVATE CONSTANT zero_i32 : int32 := 0; 22PRIVATE CONSTANT zero_u32 : uns32 := 0; 23PRIVATE CONSTANT zero_u8 : char8 := 0; 24PRIVATE CONSTANT zero_u64 : uns64 := 0; 25PRIVATE CONSTANT zero_i64 : int64 := 0; 26PRIVATE CONSTANT zero_fp : float := 0.0; 27PRIVATE CONSTANT zero_enum8 : enum8 := enum8'[e8_0]; 28 29PRIVATE CONSTANT true_bool : bool := bool'[true]; 30PRIVATE CONSTANT false_bool : bool := bool'[false]; 31 32-- Array of size 5 bytes 33TYPE arr5 IS SUBARRAY string8[5]; 34TYPE arr5_array IS ARRAY [uns32] OF arr5; 35 36PRIVATE VAR v_arr5_4: SUBARRAY arr5_array[4]; 37 38-- Record of 2 words. 39TYPE rec8 IS RECORD a : int32; b : int32; END RECORD; 40TYPE rec8_array IS ARRAY [uns32] OF rec8; 41-- Array of size 2 words and 8 words 42TYPE int32_array IS ARRAY [uns32] OF int32; 43TYPE arr32 IS SUBARRAY int32_array[8]; 44TYPE arr32_array IS ARRAY [uns32] OF arr32; 45 46PRIVATE VAR v_rec8_2: SUBARRAY rec8_array[2]; 47PRIVATE VAR v_arr32_3: SUBARRAY arr32_array[3]; 48 49-- Write a character on the standard output. 50EXTERNAL PROCEDURE putchar (v : int32); 51 52-- Exit status. 53PRIVATE VAR status : int32; 54 55PRIVATE CONSTANT banner1 : SUBARRAY string8[6]; 56CONSTANT banner1 := { 'h', 'e', 'l', 'l', 'o', 10 }; 57 58PRIVATE CONSTANT banner1_acc : string_acc := string_acc'address (banner1); 59PRIVATE CONSTANT null_acc : string_acc := string_acc'[NULL]; 60 61-- Disp the LEN first characters of S. 62PRIVATE PROCEDURE disp_lstr (s : string_acc; len : uns32) 63DECLARE 64 LOCAL VAR i : uns32; 65BEGIN 66 i := 0; 67 LOOP 1: 68 IF bool'(i = len) THEN 69 EXIT LOOP 1; 70 END IF; 71 putchar (int32'conv (s.ALL[i])); 72 i := i +# 1; 73 END LOOP; 74END; 75 76-- Disp a NUL terminated string. 77PRIVATE PROCEDURE puts (s : string_acc) 78DECLARE 79 LOCAL VAR i : uns32; 80 LOCAL VAR c : char8; 81BEGIN 82 i := 0; 83 LOOP 1: 84 c := s.ALL[i]; 85 IF bool'(c = 0) THEN 86 EXIT LOOP 1; 87 END IF; 88 putchar (int32'conv (c)); 89 i := i +# 1; 90 END LOOP; 91END; 92 93PRIVATE PROCEDURE putn (n : uns32) 94DECLARE 95 LOCAL VAR n1 : uns32; 96 LOCAL VAR d : uns32; 97BEGIN 98 d := '0' +# (n MOD# 10); 99 n1 := n /# 10; 100 IF bool'(n1 /= 0) THEN 101 putn (n1); 102 END IF; 103 putchar (int32'conv (d)); 104END; 105 106PRIVATE PROCEDURE putn_nl (n : uns32) 107DECLARE 108BEGIN 109 putn (n); 110 putchar (10); 111END; 112 113PRIVATE CONSTANT str_test : SUBARRAY string8[7]; 114CONSTANT str_test := { 'T', 'e', 's', 't', ' ', '#', 0 }; 115 116PRIVATE VAR test_num : uns32; 117 118PRIVATE PROCEDURE disp_test () 119DECLARE 120BEGIN 121 puts (string_acc'address(str_test)); 122 putn (test_num); 123 putchar (10); 124 test_num := test_num +# 1; 125END; 126 127PRIVATE FUNCTION add2 (a : int32; b : int32) RETURN int32 128DECLARE 129BEGIN 130 RETURN a +# b; 131END; 132 133PRIVATE FUNCTION add8 (a : uns32; b : uns32; c : uns32; d : uns32; 134 e : uns32; f : uns32; g : uns32; h : uns32) 135 RETURN uns32 136DECLARE 137BEGIN 138 RETURN a +# (b +# (c +# (d +# (e +# (f +# (g +# h)))))); 139END; 140 141PRIVATE PROCEDURE puti32 (n : int32) 142DECLARE 143 TYPE str8x11 IS SUBARRAY string8[11]; 144 LOCAL VAR s : str8x11; 145 LOCAL VAR is_neg : bool; 146 LOCAL VAR i : uns32; 147 LOCAL VAR n1 : int32; 148 LOCAL VAR d : int32; 149BEGIN 150 IF bool'(n < 0) THEN 151 is_neg := bool'[true]; 152 n1 := -n; 153 ELSE 154 is_neg := bool'[false]; 155 n1 := n; 156 END IF; 157 i := 9; 158 s[10] := 0; 159 LOOP 1: 160 d := '0' +# (n1 MOD# 10); 161 s[i] := char8'conv (d); 162 n1 := n1 /# 10; 163 IF bool'(n1 = 0) THEN 164 EXIT LOOP 1; 165 END IF; 166 i := i -# 1; 167 END LOOP; 168 IF is_neg THEN 169 i := i -# 1; 170 s[i] := '-'; 171 END IF; 172 puts(string_acc'address(s[i...])); 173END; 174 175 176PRIVATE PROCEDURE error () 177DECLARE 178 PRIVATE CONSTANT str_error : SUBARRAY string8[8]; 179 CONSTANT str_error := { 'E', 'R', 'R', 'O', 'R', '!', 10, 0 }; 180BEGIN 181 status := 1; 182 puts (string_acc'address(str_error)); 183END; 184 185PRIVATE PROCEDURE check_i32 (a : int32; ref : int32) 186DECLARE 187BEGIN 188 puti32 (a); 189 putchar (10); 190 IF bool'(a /= ref) THEN 191 error (); 192 END IF; 193END; 194 195PRIVATE CONSTANT str_true : SUBARRAY string8[5]; 196CONSTANT str_true := { 'T', 'r', 'u', 'e', 0 }; 197 198PRIVATE CONSTANT str_false : SUBARRAY string8[6]; 199CONSTANT str_false := { 'F', 'a', 'l', 's', 'e', 0 }; 200 201PRIVATE PROCEDURE check_bool (a : bool; ref : bool) 202DECLARE 203BEGIN 204 IF a THEN 205 puts(string_acc'address(str_true)); 206 ELSE 207 puts(string_acc'address(str_false)); 208 END IF; 209 putchar (10); 210 IF bool'(a /= ref) THEN 211 error (); 212 END IF; 213END; 214 215PRIVATE CONSTANT str_float : SUBARRAY string8[13]; 216CONSTANT str_float := 217 { 'F', 'l', 'o', 'a', 't', ' ', 't', 'e', 's', 't', 's', 10, 0 }; 218 219PRIVATE PROCEDURE check_float (a : float; ref : float) 220DECLARE 221BEGIN 222 IF bool'(a /= ref) THEN 223 error (); 224 END IF; 225END; 226 227PRIVATE FUNCTION add_float (a : float; b : float) RETURN float 228DECLARE 229BEGIN 230 RETURN a +# b; 231END; 232 233PRIVATE FUNCTION add3_float (a : float; b : float; c : float) RETURN float 234DECLARE 235BEGIN 236 RETURN add_float (a, add_float (b, c)); 237END; 238 239PRIVATE PROCEDURE check_i64 (a : int64; ref : int64) 240DECLARE 241BEGIN 242-- puti32 (a); 243-- putchar (10); 244 IF bool'(a /= ref) THEN 245 error (); 246 END IF; 247END; 248 249PRIVATE FUNCTION add2_i64 (a : int64; b : int64) RETURN int64 250DECLARE 251BEGIN 252 RETURN a +# b; 253END; 254 255PRIVATE FUNCTION andn (a : bool; b : bool) RETURN bool 256DECLARE 257BEGIN 258 RETURN a AND (NOT b); 259END; 260 261PRIVATE FUNCTION cmpi32 (a : int32) RETURN bool 262DECLARE 263BEGIN 264 RETURN a >= 0; 265END; 266 267PRIVATE PROCEDURE check_u32 (a : uns32; ref : uns32) 268DECLARE 269BEGIN 270 IF bool'(a /= ref) THEN 271 error (); 272 END IF; 273END; 274 275PRIVATE PROCEDURE check_u64 (a : uns64; ref : uns64) 276DECLARE 277BEGIN 278 IF bool'(a /= ref) THEN 279 error (); 280 END IF; 281END; 282 283PRIVATE PROCEDURE check_enum8 (a : enum8; ref : enum8) 284DECLARE 285BEGIN 286 IF bool'(a /= ref) THEN 287 error (); 288 END IF; 289END; 290 291-- To test alloca 292PRIVATE PROCEDURE disp_indent (n : uns32) 293DECLARE 294 LOCAL VAR i : uns32; 295 LOCAL VAR ptr : string_acc; 296BEGIN 297 ptr := string_acc'alloca (n +# 1); 298 ptr.ALL[n] := 0; 299 LOOP 1: 300 IF bool'(n = 0) THEN 301 EXIT LOOP 1; 302 END IF; 303 n := n -# 1; 304 ptr.ALL[n] := 32; 305 END LOOP; 306 puts (ptr); 307END; 308 309PRIVATE PROCEDURE test_case () 310DECLARE 311 LOCAL VAR i : int32; 312 PRIVATE CONSTANT str_zero : SUBARRAY string8[5]; 313 CONSTANT str_zero := { 'z', 'e', 'r', 'o', 0 }; 314 PRIVATE CONSTANT str_one : SUBARRAY string8[4]; 315 CONSTANT str_one := { 'o', 'n', 'e', 0 }; 316 PRIVATE CONSTANT str_two_four : SUBARRAY string8[9]; 317 CONSTANT str_two_four := { 't', 'w', 'o', '-', 'f', 'o', 'u', 'r', 0 }; 318 PRIVATE CONSTANT str_five_plus : SUBARRAY string8[6]; 319 CONSTANT str_five_plus := { 'f', 'i', 'v', 'e', '+', 0 }; 320BEGIN 321 i := 0; 322 LOOP 1: 323 IF bool'(i = 6) THEN 324 EXIT LOOP 1; 325 END IF; 326 CASE i IS 327 WHEN 0 => puts (string_acc'address (str_zero)); 328 WHEN 1 => puts (string_acc'address (str_one)); 329 WHEN 2 ... 4 => puts (string_acc'address (str_two_four)); 330 WHEN DEFAULT => puts (string_acc'address (str_five_plus)); 331 END CASE; 332 putchar (10); 333 i := i +# 1; 334 END LOOP; 335END; 336 337PRIVATE PROCEDURE call_9iargs (i1 : int64; i2 : int64; i3 : int64; i4 : int64; 338 i5 : int64; i6 : int64; i7 : int64; i8 : int64; 339 i9 : int64) 340DECLARE 341BEGIN 342 IF bool'((i1 +# (i2 +# (i3 +# (i4 +# (i5 +# (i6 +# (i7 +# (i8 +# i9)))))))) 343 /= 45) 344 THEN 345 error (); 346 END IF; 347END; 348 349PRIVATE PROCEDURE call_9fargs (i1 : float; i2 : float; i3 : float; i4 : float; 350 i5 : float; i6 : float; i7 : float; i8 : float; 351 i9 : float) 352DECLARE 353BEGIN 354 IF bool'((i1 +# (i2 +# (i3 +# (i4 +# (i5 +# (i6 +# (i7 +# (i8 +# i9)))))))) 355 /= 45.0) 356 THEN 357 error (); 358 END IF; 359END; 360 361PRIVATE PROCEDURE call_nested (a : int32; b : int32; c : int32) 362DECLARE 363 PRIVATE PROCEDURE nested (d : int32) 364 DECLARE 365 BEGIN 366 puti32 (d); 367 putchar (10); 368 puti32 (a); 369 putchar (10); 370 IF bool'((a +# (b +# d)) /= 7) THEN 371 error (); 372 END IF; 373 END; 374BEGIN 375 nested (c +# 1); 376END; 377 378PRIVATE VAR g_int32_ptr : int32_acc; 379 380PRIVATE PROCEDURE call_arg_addr (a : int32; b : int64; c : float) 381DECLARE 382 LOCAL VAR ap : int32_acc; 383 LOCAL VAR bp : int64_acc; 384BEGIN 385 ap := int32_acc'address (zero_i32); 386 387 ap := int32_acc'address (a); 388 bp := int64_acc'address (b); 389 390 g_int32_ptr := int32_acc'address (a); 391 392 IF bool'(ap.ALL /= 1) THEN 393 error (); 394 END IF; 395 IF bool'(bp.ALL /= 2) THEN 396 error (); 397 END IF; 398END; 399 400PUBLIC FUNCTION main () RETURN int32 401DECLARE 402BEGIN 403 -- Start with a simple banner. 404 putchar ('h'); 405 putchar (10); 406 407 -- Real banner. 408 disp_lstr (string_acc'address(banner1), 6); 409 410 -- Test assignment to a global and putn. 411 test_num := 3; 412 putn (test_num); 413 putchar (10); 414 415 status := 0; 416 417 -- Start of tests. 418 test_num := 4; 419 disp_test (); 420 -- Test putn with more than 1 digit. 421 putn_nl (125); 422 423 -- Nested calls. 424 disp_test (); 425 putn_nl (uns32'conv (add2 (7, add2 (5, 3)))); -- 15 426 427 -- Many parameters 428 disp_test (); 429 putn_nl (add8 (1, 2, 3, 4, 5, 6, 7, 8)); -- 36 430 431 -- Nested with many parameters 432 disp_test (); 433 putn_nl (add8 (1, 2, 3, 4, 5, 6, 434 add8 (10, 11, 12, 13, 14, 15, 16, 17), 8)); -- 137 435 436 -- Test puti32 437 disp_test (); 438 puti32 (15679); 439 putchar (10); 440 441 -- Test puti32 442 disp_test (); 443 puti32 (-45678); 444 putchar (10); 445 446 DECLARE 447 LOCAL VAR v1 : int32; 448 LOCAL VAR v2 : int32; 449 BEGIN 450 v1 := 12; 451 v2 := -15; 452 453 -- Arith i32: add 454 disp_test (); 455 check_i32 (v1 +# 5, 17); 456 457 -- Arith i32: sub 458 disp_test (); 459 check_i32 (v1 -# 5, 7); 460 461 -- Arith i32: mul 462 disp_test (); 463 check_i32 (v1 *# 9, 108); 464 465 -- Arith i32: div 466 disp_test (); 467 check_i32 (v1 /# 4, 3); 468 check_i32 (v2 /# 6, -2); 469 470 -- Arith i32: abs 471 disp_test (); 472 check_i32 (ABS v1, 12); 473 check_i32 (ABS v2, 15); 474 475 -- Arith i32: neg 476 disp_test (); 477 check_i32 (-v1, -12); 478 check_i32 (-v2, 15); 479 480 -- Arith i32: rem (sign of the dividend) 481 disp_test (); 482 check_i32 (v1 REM# 5, 2); 483 check_i32 (v1 REM# (-5), 2); 484 check_i32 (v2 REM# 4, -3); 485 check_i32 (v2 REM# (-4), -3); 486 487 -- Arith i32: mod (sign of the divisor) 488 disp_test (); 489 check_i32 (v1 MOD# 5, 2); 490 check_i32 (v1 MOD# (-5), -3); 491 check_i32 (v2 MOD# 4, 1); 492 check_i32 (v2 MOD# (-4), -3); 493 494 -- Comparaisons 495 disp_test (); 496 check_bool (bool'(v1 > 11), bool'[true]); 497 check_bool (bool'(v1 < 16), bool'[true]); 498 check_bool (bool'(v1 <= 9), bool'[false]); 499 check_bool (bool'(v1 >= 22), bool'[false]); 500 check_bool (bool'(v1 /= 21), bool'[true]); 501 check_bool (bool'(v1 = 17), bool'[false]); 502 503 -- Conversions. 504 disp_test (); 505 check_i32 (int32'conv (zero_i32), 0); 506 check_i32 (int32'conv (zero_u32), 0); 507 check_i32 (int32'conv (zero_u8), 0); 508-- check_i32 (int32'conv (zero_u64), 0); -- Never supported. 509 check_i32 (int32'conv (zero_i64), 0); 510 check_i32 (int32'conv (zero_fp), 0); 511 check_i32 (int32'conv (true_bool), 1); 512 check_i32 (int32'conv (false_bool), 0); 513 check_i32 (int32'conv (zero_enum8), 0); 514 END; 515 516 DECLARE 517 LOCAL VAR v1 : float; 518 LOCAL VAR v2 : float; 519 BEGIN 520 v1 := 3.5; 521 v2 := -2.25; 522 523 puts(string_acc'address (str_float)); 524 525 -- function call 526 disp_test (); 527 check_float (add_float (v1, v2), 1.25); 528 529 -- function call 530 disp_test (); 531 check_float (add3_float (v1, v2, v1), 4.75); 532 533 -- Arith fp: add 534 disp_test (); 535 check_float (v1 +# 5.5, 9.0); 536 537 -- Arith fp: sub 538 disp_test (); 539 check_float (v1 -# 5.25, -1.75); 540 541 -- Arith fp: mul 542 disp_test (); 543 check_float (v1 *# 4.0, 14.0); 544 545 -- Arith fp: div 546 disp_test (); 547 check_float (v1 /# 0.5, 7.0); 548 check_float (v2 /# 2.0, -1.125); 549 550 -- Arith fp: abs 551 disp_test (); 552 check_float (ABS v1, 3.5); 553 check_float (ABS v2, 2.25); 554 555 -- Arith fp: neg 556 disp_test (); 557 check_float (-v1, -3.5); 558 check_float (-v2, 2.25); 559 560 -- Comparaisons 561 disp_test (); 562 check_bool (bool'(v1 > 3.0), bool'[true]); 563 check_bool (bool'(v1 < 3.75), bool'[true]); 564 check_bool (bool'(v1 <= 2.5), bool'[false]); 565 check_bool (bool'(v1 >= 4.0), bool'[false]); 566 check_bool (bool'(v1 /= 1.25), bool'[true]); 567 check_bool (bool'(v1 = 0.25), bool'[false]); 568 569 -- Conversions. 570 disp_test (); 571 check_float (float'conv (zero_i32), 0.0); 572-- Others were never supported. 573-- check_float (float'conv (zero_u32), 0.0); 574-- check_float (float'conv (zero_u8), 0.0); 575-- check_float (float'conv (zero_u64), 0.0); 576 check_float (float'conv (zero_i64), 0.0); 577 check_float (float'conv (zero_fp), 0.0); 578-- check_float (float'conv (true_bool), 1.0); 579-- check_float (float'conv (false_bool), 0.0); 580 END; 581 582 DECLARE 583 LOCAL VAR v1 : int64; 584 LOCAL VAR v2 : int64; 585 BEGIN 586 v1 := 14; 587 v2 := -11; 588 589 -- i64 call 590 disp_test (); 591 check_i64 (add2_i64 (v1, 5), 19); 592 593 -- Arith i64: add 594 disp_test (); 595 check_i64 (v1 +# 5, 19); 596 597 -- Arith i64: sub 598 disp_test (); 599 check_i64 (v1 -# 4, 10); 600 601 -- Arith i64: mul 602 disp_test (); 603 check_i64 (v1 *# 3, 42); 604 check_i64 (v2 *# 6, -66); 605 606 -- Arith i64: div 607 disp_test (); 608 check_i64 (v1 /# 3, 4); 609 check_i64 (v2 /# -5, 2); 610 611 -- Arith i64: abs 612 disp_test (); 613 check_i64 (ABS v1, 14); 614 check_i64 (ABS v2, 11); 615 616 -- Arith i64: neg 617 disp_test (); 618 check_i64 (-v1, -14); 619 check_i64 (-v2, 11); 620 621 -- Arith i64: rem (sign of the dividend) 622 disp_test (); 623 check_i64 (v1 REM# 5, 4); 624 check_i64 (v1 REM# (-5), 4); 625 check_i64 (v2 REM# 4, -3); 626 check_i64 (v2 REM# (-4), -3); 627 628 -- Arith i64: mod (sign of the divisor) 629 disp_test (); 630 check_i64 (v1 MOD# 5, 4); 631 check_i64 (v1 MOD# (-5), -1); 632 check_i64 (v2 MOD# 4, 1); 633 check_i64 (v2 MOD# (-4), -3); 634 635 -- Arith i64: large constants 636 disp_test (); 637 check_i64 (v1 +# 16#01234567_89abcdef#, 16#01234567_89abcdfd#); 638 639 -- Comparaisons 640 disp_test (); 641 check_bool (bool'(v1 > 11), bool'[true]); 642 check_bool (bool'(v1 < 16), bool'[true]); 643 check_bool (bool'(v1 <= 9), bool'[false]); 644 check_bool (bool'(v1 >= 22), bool'[false]); 645 check_bool (bool'(v1 /= 21), bool'[true]); 646 check_bool (bool'(v1 = 17), bool'[false]); 647 648 -- Conversions. 649 disp_test (); 650 check_i64 (int64'conv (zero_i32), 0); 651 check_i64 (int64'conv (zero_u32), 0); 652 check_i64 (int64'conv (zero_u8), 0); 653-- check_i64 (int64'conv (zero_u64), 0); -- Never supported. 654 check_i64 (int64'conv (zero_i64), 0); 655 check_i64 (int64'conv (zero_fp), 0); 656 check_i64 (int64'conv (true_bool), 1); 657 check_i64 (int64'conv (false_bool), 0); 658 END; 659 660 DECLARE 661 LOCAL VAR t : bool; 662 LOCAL VAR f : bool; 663 BEGIN 664 t := bool'[true]; 665 f := bool'[false]; 666 667 -- Test function call 668 disp_test (); 669 check_bool (andn (t, f), bool'[true]); 670 check_bool (cmpi32 (12), bool'[true]); 671 IF cmpi32 (-5) THEN 672 error (); 673 END IF; 674 675 -- Test or 676 disp_test (); 677 check_bool (t OR f, bool'[true]); 678 check_bool (t OR t, bool'[true]); 679 check_bool (f OR t, bool'[true]); 680 check_bool (f OR f, bool'[false]); 681 682 -- Test and 683 disp_test (); 684 check_bool (t AND f, bool'[false]); 685 check_bool (t AND t, bool'[true]); 686 check_bool (f AND t, bool'[false]); 687 check_bool (f AND f, bool'[false]); 688 689 -- Test xor 690 disp_test (); 691 check_bool (t XOR f, bool'[true]); 692 check_bool (t XOR t, bool'[false]); 693 check_bool (f XOR t, bool'[true]); 694 check_bool (f XOR f, bool'[false]); 695 696 -- Test not 697 disp_test (); 698 check_bool (NOT t, bool'[false]); 699 check_bool (NOT f, bool'[true]); 700 701 -- Test operators in if. 702 disp_test (); 703 IF bool'(t < f) THEN 704 error (); 705 END IF; 706 IF NOT bool'(t > f) THEN 707 error (); 708 END IF; 709 IF bool'(t = f) OR bool'(f >= t) THEN 710 error (); 711 END IF; 712 IF f THEN 713 error (); 714 END IF; 715 IF bool'[false] THEN 716 error (); 717 END IF; 718 719 -- Comparaisons 720 disp_test (); 721 check_bool (bool'(t > f), bool'[true]); 722 check_bool (bool'(t < f), bool'[false]); 723 check_bool (bool'(t <= f), bool'[false]); 724 check_bool (bool'(f >= t), bool'[false]); 725 check_bool (bool'(f /= t), bool'[true]); 726 check_bool (bool'(t = f), bool'[false]); 727 728 -- Conversions. 729 disp_test (); 730 check_bool (bool'conv (zero_i32), bool'[false]); 731 check_bool (bool'conv (zero_u32), bool'[false]); 732-- check_bool (bool'conv (zero_u8), bool'[false]); 733-- check_bool (int64'conv (zero_u64), bool'[false]); -- Never supported. 734 check_bool (bool'conv (zero_i64), bool'[false]); 735-- check_bool (bool'conv (zero_fp), bool'[false]); 736 check_bool (bool'conv (true_bool), bool'[true]); 737 check_bool (bool'conv (false_bool), bool'[false]); 738 END; 739 740 DECLARE 741 LOCAL VAR v1 : uns32; 742 LOCAL VAR v2 : uns32; 743 BEGIN 744 v1 := 120; 745 v2 := 7; 746 747 -- Arith u32: add 748 disp_test (); 749 check_u32 (v1 +# 5, 125); 750 751 -- Arith u32: sub 752 disp_test (); 753 check_u32 (v1 -# 4, 116); 754 755 -- Arith u32: mul 756 disp_test (); 757 check_u32 (v1 *# 3, 360); 758 759 -- Arith u32: div 760 disp_test (); 761 check_u32 (v1 /# 6, 20); 762 763 -- Arith u32: rem (sign of the dividend) 764 disp_test (); 765 check_u32 (v2 REM# 3, 1); 766 767 -- Comparaisons 768 disp_test (); 769 check_bool (bool'(v1 > 10), bool'[true]); 770 check_bool (bool'(v1 < 16), bool'[false]); 771 check_bool (bool'(v1 <= 9), bool'[false]); 772 check_bool (bool'(v1 >= 22), bool'[true]); 773 check_bool (bool'(v1 /= 21), bool'[true]); 774 check_bool (bool'(v1 = 17), bool'[false]); 775 776 -- Conversions. 777 disp_test (); 778 check_u32 (uns32'conv (zero_i32), 0); 779 check_u32 (uns32'conv (zero_u32), 0); 780 check_u32 (uns32'conv (zero_u8), 0); 781-- check_u32 (uns32'conv (zero_u64), 0); -- Never supported. 782-- check_u32 (uns32'conv (zero_i64), 0); 783-- check_u32 (uns32'conv (zero_fp), 0); 784 check_u32 (uns32'conv (true_bool), 1); 785 check_u32 (uns32'conv (false_bool), 0); 786 787 -- bitwise operators 788 disp_test (); 789 check_u32 (v2 AND 3, 3); 790 check_u32 (v2 OR 8, 15); 791 check_u32 (NOT v2, 16#ffff_fff8#); 792 END; 793 794 DECLARE 795 LOCAL VAR v1 : uns64; 796 LOCAL VAR v2 : uns64; 797 BEGIN 798 v1 := 120; 799 v2 := 7; 800 801 -- Arith u64: add 802 disp_test (); 803 check_u64 (v1 +# 5, 125); 804 805 -- Arith u64: sub 806 disp_test (); 807 check_u64 (v1 -# 4, 116); 808 809 -- Arith u64: mul 810 disp_test (); 811 check_u64 (v1 *# 3, 360); 812 813 -- Arith u64: div 814 disp_test (); 815 check_u64 (v1 /# 6, 20); 816 817 -- Arith u64: rem (sign of the dividend) 818 disp_test (); 819 check_u64 (v2 REM# 3, 1); 820 821 -- Comparaisons 822 disp_test (); 823 check_bool (bool'(v1 > 10), bool'[true]); 824 check_bool (bool'(v1 < 16), bool'[false]); 825 check_bool (bool'(v1 <= 9), bool'[false]); 826 check_bool (bool'(v1 >= 22), bool'[true]); 827 check_bool (bool'(v1 /= 21), bool'[true]); 828 check_bool (bool'(v1 = 17), bool'[false]); 829 830 -- Conversions. 831 disp_test (); 832-- check_u64 (uns64'conv (zero_i32), 0); 833-- check_u64 (uns64'conv (zero_u32), 0); 834-- check_u64 (uns64'conv (zero_u8), 0); 835 check_u64 (uns64'conv (zero_u64), 0); -- Never supported. 836-- check_u64 (uns64'conv (zero_i64), 0); 837-- check_u64 (uns64'conv (zero_fp), 0); 838-- check_u64 (uns64'conv (true_bool), 1); 839-- check_u64 (uns64'conv (false_bool), 0); 840 841 -- bitwise operators 842 disp_test (); 843 check_u64 (v2 AND 3, 3); 844 check_u64 (v2 OR 8, 15); 845 check_u64 ((NOT v2) AND 255, 16#f8#); 846 END; 847 848 DECLARE 849 LOCAL VAR v1 : enum8; 850 LOCAL VAR v2 : enum8; 851 BEGIN 852 v1 := enum8'[e8_1]; 853 v2 := enum8'[e8_0]; 854 855 -- Comparaisons 856 disp_test (); 857 check_bool (bool'(v1 > enum8'[e8_0]), bool'[true]); 858 check_bool (bool'(v1 < enum8'[e8_1]), bool'[false]); 859 check_bool (bool'(v1 <= enum8'[e8_1]), bool'[true]); 860 check_bool (bool'(v1 >= enum8'[e8_2]), bool'[false]); 861 check_bool (bool'(v1 /= enum8'[e8_0]), bool'[true]); 862 check_bool (bool'(v1 = enum8'[e8_0]), bool'[false]); 863 864 -- Conversions. 865 disp_test (); 866 check_enum8 (enum8'conv (zero_i32), enum8'[e8_0]); 867-- check_u64 (uns64'conv (zero_u32), 0); 868-- check_u64 (uns64'conv (zero_u8), 0); 869-- check_u64 (uns64'conv (zero_u64), 0); -- Never supported. 870-- check_u64 (uns64'conv (zero_i64), 0); 871-- check_u64 (uns64'conv (zero_fp), 0); 872-- check_u64 (uns64'conv (true_bool), 1); 873-- check_u64 (uns64'conv (false_bool), 0); 874 END; 875 876 -- Test alloca 877 disp_test (); 878 disp_indent (5); 879 putchar ('|'); 880 putchar (10); 881 disp_indent (17); 882 putchar ('|'); 883 putchar (10); 884 885 -- Test case 886 disp_test (); 887 test_case (); 888 889 -- Test indexes 890 DECLARE 891 LOCAL VAR i: uns32; 892 LOCAL VAR l_arr5_4 : SUBARRAY arr5_array[4]; 893 BEGIN 894 disp_test (); 895 -- Write 896 i := 0; 897 LOOP 1: 898 IF bool'(i = 4) THEN 899 EXIT LOOP 1; 900 END IF; 901 v_arr5_4[i][0] := 2; 902 l_arr5_4[i][1] := v_arr5_4[i][0] +# 1; 903 v_arr5_4[i][2] := l_arr5_4[i][1] +# 1; 904 i := i +# 1; 905 END LOOP; 906 -- Check 907 i := 0; 908 LOOP 1: 909 IF bool'(i = 4) THEN 910 EXIT LOOP 1; 911 END IF; 912 IF bool'(v_arr5_4[i][2] /= 4) THEN 913 error (); 914 END IF; 915 IF bool'(l_arr5_4[i][1] /= 3) THEN 916 error (); 917 END IF; 918 i := i +# 1; 919 END LOOP; 920 END; 921 922 DECLARE 923 LOCAL VAR i: uns32; 924 LOCAL VAR l_rec8_2 : SUBARRAY rec8_array[2]; 925 BEGIN 926 disp_test (); 927 -- Write 928 i := 0; 929 LOOP 1: 930 IF bool'(i = 2) THEN 931 EXIT LOOP 1; 932 END IF; 933 v_rec8_2[i].a := 2; 934 l_rec8_2[i].a := v_rec8_2[i].a +# 1; 935 v_rec8_2[i].b := l_rec8_2[i].a +# 1; 936 i := i +# 1; 937 END LOOP; 938 -- Check 939 i := 0; 940 LOOP 1: 941 IF bool'(i = 2) THEN 942 EXIT LOOP 1; 943 END IF; 944 IF bool'(v_rec8_2[i].b /= 4) THEN 945 error (); 946 END IF; 947 IF bool'(l_rec8_2[i].a /= 3) THEN 948 error (); 949 END IF; 950 i := i +# 1; 951 END LOOP; 952 END; 953 954 DECLARE 955 LOCAL VAR i: uns32; 956 LOCAL VAR l_arr32_3 : SUBARRAY arr32_array[3]; 957 BEGIN 958 disp_test (); 959 -- Write 960 i := 0; 961 LOOP 1: 962 IF bool'(i = 3) THEN 963 EXIT LOOP 1; 964 END IF; 965 v_arr32_3[i][0] := 2; 966 l_arr32_3[i][1] := v_arr32_3[i][0] +# 1; 967 v_arr32_3[i][3] := l_arr32_3[i][1] +# 1; 968 l_arr32_3[i][5] := v_arr32_3[i][3] +# 1; 969 i := i +# 1; 970 END LOOP; 971 -- Check 972 i := 0; 973 LOOP 1: 974 IF bool'(i = 3) THEN 975 EXIT LOOP 1; 976 END IF; 977 IF bool'(l_arr32_3[i][5] /= 5) THEN 978 error (); 979 END IF; 980 IF bool'(v_arr32_3[i][3] /= 4) THEN 981 error (); 982 END IF; 983 i := i +# 1; 984 END LOOP; 985 END; 986 987 -- Call with more than 8 params. 988 disp_test(); 989 call_9iargs (1, 2, 3, 4, 5, 6, 7, 8, 9); 990 991 disp_test(); 992 call_9fargs (1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0); 993 994 -- nested subprograms 995 disp_test(); 996 call_nested (1, 2, 3); 997 998 -- Access in constant 999 disp_test (); 1000 puts (banner1_acc); 1001 1002 -- Address of argument 1003 disp_test (); 1004 call_arg_addr (1, 2, 3.0); 1005 1006 -- TODO: 1007 -- U8 1008 -- Spill (use div, mod). 1009 -- R12 and R13 in SIB. 1010 1011 RETURN status; 1012END; 1013