1{****************************************************************} 2{ CODE GENERATOR TEST PROGRAM } 3{****************************************************************} 4{ NODE TESTED : secondadd() } 5{****************************************************************} 6{ PRE-REQUISITES: secondload() } 7{ secondassign() } 8{ secondsetelement() } 9{****************************************************************} 10{ DEFINES: } 11{ FPC = Target is FreePascal compiler } 12{****************************************************************} 13{ REMARKS: } 14{ } 15{ } 16{ } 17{****************************************************************} 18 19Program taddsetint; 20 21{$modeswitch exceptions} 22 23{$macro on} 24{$define write:=jlsystem.fout.print} 25{$define writeln:=jlsystem.fout.println} 26 27uses 28 {$ifdef java}jdk15{$else}androidr14{$endif}; 29 30procedure halt(l: longint); 31begin 32 write('exit code: '); 33 writeln(l); 34 raise jlexception.create('error'); 35end; 36 37var 38 Err : boolean; 39 40type 41 { DO NOT CHANGE THE VALUES OF THESE ENUMERATIONS! } 42 tsmallenum = (dA,dB,dC,dd,de,df,dg,dh,di,dj,dk,dl,dm,dn,dop,dp,dq,dr); 43 tasmop = (A_ABCD, 44 A_ADD,A_ADDA,A_ADDI,A_ADDQ,A_ADDX,A_AND,A_ANDI, 45 A_ASL,A_ASR,A_BCC,A_BCS,A_BEQ,A_BGE,A_BGT,A_BHI, 46 A_BLE,A_BLS,A_BLT,A_BMI,A_BNE,A_BPL,A_BVC,A_BVS, 47 A_BCHG,A_BCLR,A_BRA,A_BSET,A_BSR,A_BTST,A_CHK, 48 A_CLR,A_CMP,A_CMPA,A_CMPI,A_CMPM,A_DBCC,A_DBCS,A_DBEQ,A_DBGE, 49 A_DBGT,A_DBHI,A_DBLE,A_DBLS,A_DBLT,A_DBMI,A_DBNE,A_DBRA, 50 A_DBPL,A_DBT,A_DBVC,A_DBVS,A_DBF,A_DIVS,A_DIVU, 51 A_EOR,A_EORI,A_EXG,A_ILLEGAL,A_EXT,A_JMP,A_JSR, 52 A_LEA,A_LINK,A_LSL,A_LSR,A_MOVE,A_MOVEA,A_MOVEI,A_MOVEQ, 53 A_MOVEM,A_MOVEP,A_MULS,A_MULU,A_NBCD,A_NEG,A_NEGX, 54 A_NOP,A_NOT,A_OR,A_ORI,A_PEA,A_ROL,A_ROR,A_ROXL, 55 A_ROXR,A_RTR,A_RTS,A_SBCD,A_SCC,A_SCS,A_SEQ,A_SGE, 56 A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,A_SNE, 57 A_SPL,A_ST,A_SVC,A_SVS,A_SF,A_SUB,A_SUBA,A_SUBI,A_SUBQ, 58 A_SUBX,A_SWAP,A_TAS,A_TRAP,A_TRAPV,A_TST,A_UNLK, 59 A_RTE,A_RESET,A_STOP, 60 { MC68010 instructions } 61 A_BKPT,A_MOVEC,A_MOVES,A_RTD, 62 { MC68020 instructions } 63 A_BFCHG,A_BFCLR,A_BFEXTS,A_BFEXTU,A_BFFFO, 64 A_BFINS,A_BFSET,A_BFTST,A_CALLM,A_CAS,A_CAS2, 65 A_CHK2,A_CMP2,A_DIVSL,A_DIVUL,A_EXTB,A_PACK,A_RTM, 66 A_TRAPCC,A_TRACS,A_TRAPEQ,A_TRAPF,A_TRAPGE,A_TRAPGT, 67 A_TRAPHI,A_TRAPLE,A_TRAPLS,A_TRAPLT,A_TRAPMI,A_TRAPNE, 68 A_TRAPPL,A_TRAPT,A_TRAPVC,A_TRAPVS,A_UNPK, 69 { FPU Processor instructions - directly supported only. } 70 { IEEE aware and misc. condition codes not supported } 71 A_FABS,A_FADD, 72 A_FBEQ,A_FBNE,A_FBNGT,A_FBGT,A_FBGE,A_FBNGE, 73 A_FBLT,A_FBNLT,A_FBLE,A_FBGL,A_FBNGL,A_FBGLE,A_FBNGLE, 74 A_FDBEQ,A_FDBNE,A_FDBGT,A_FDBNGT,A_FDBGE,A_FDBNGE, 75 A_FDBLT,A_FDBNLT,A_FDBLE,A_FDBGL,A_FDBNGL,A_FDBGLE,A_FBDNGLE, 76 A_FSEQ,A_FSNE,A_FSGT,A_FSNGT,A_FSGE,A_FSNGE, 77 A_FSLT,A_FSNLT,A_FSLE,A_FSGL,A_FSNGL,A_FSGLE,A_FSNGLE, 78 A_FCMP,A_FDIV,A_FMOVE,A_FMOVEM, 79 A_FMUL,A_FNEG,A_FNOP,A_FSQRT,A_FSUB,A_FSGLDIV, 80 A_FSFLMUL,A_FTST, 81 A_FTRAPEQ,A_FTRAPNE,A_FTRAPGT,A_FTRAPNGT,A_FTRAPGE,A_FTRAPNGE, 82 A_FTRAPLT,A_FTRAPNLT,A_FTRAPLE,A_FTRAPGL,A_FTRAPNGL,A_FTRAPGLE,A_FTRAPNGLE, 83 { Protected instructions } 84 A_CPRESTORE,A_CPSAVE, 85 { FPU Unit protected instructions } 86 { and 68030/68851 common MMU instructions } 87 { (this may include 68040 MMU instructions) } 88 A_FRESTORE,A_FSAVE,A_PFLUSH,A_PFLUSHA,A_PLOAD,A_PMOVE,A_PTEST, 89 { Useful for assembly langage output } 90 A_LABEL,A_NONE); 91 92 tsmallenumint = ord(low(tsmallenum))..ord(high(tsmallenum)); 93 tasmopint = ord(low(tasmop))..ord(high(tasmop)); 94 95 96 97type 98 topset = set of tasmopint; 99 tsmallset = set of tsmallenumint; 100 101const 102 103 { NORMAL SETS } 104 constset1 : array[1..3] of topset = 105 ( 106 { 66 } { 210 } { 225 } 107 ([ord(A_MOVE), { 66 : LONG 2 - BIT 2 } 108 ord(A_FTST), { 210 : LONG 6 - BIT 18 } 109 ord(A_CPSAVE)]),{ 225 : LONG 7 - BIT 1 } 110 { 1..8 } 111 ([ord(A_ADD)..ord(A_ASL)]), 112 { 134 } 113 ([ord(A_CHK2)]) 114 ); 115 116 constset2 : array[1..3] of topset = 117 ( 118 ([ord(A_MOVE),ord(A_FTST),ord(A_CPSAVE)]), 119 ([ord(A_ADD)..ord(A_ASL)]), 120 ([ord(A_CHK2)]) 121 ); 122 123 { SMALL SETS } 124 constset3 : array[1..3] of tsmallset = 125 ( 126 ([ord(DA), { 0 : LONG 0 : bit 0 } 127 ord(DD), { 3 : LONG 0 : bit 3 } 128 ord(DM)]), { 12 : LONG 0 : bit 12 } 129 ([ord(DB)..ord(DI)]), { 1..8 : LONG 0 : bits 1-8 } 130 ([ord(DR)]) { 17 : LONG 0 : bit 17 } 131 ); 132 133 constset4 : array[1..3] of tsmallset = 134 ( 135 ([ord(DA),ord(DD),ord(DM)]), 136 ([ord(DB)..ord(DI)]), 137 ([ord(DR)]) 138 ); 139 140 141 procedure CheckPassed(passed:boolean); 142 begin 143 if passed then 144 WriteLn('Success.') 145 else 146 begin 147 WriteLn('Failure.'); 148 Halt(1); 149 Err:=true; 150 end; 151 end; 152 153 procedure SetTestEqual; 154 { FPC_SET_COMP_SETS } 155 var 156 op2list :set of tasmopint; 157 oplist: set of tasmopint; 158 passed : boolean; 159 Begin 160 Write('Normal Set == Normal Set test...'); 161 passed := true; 162 op2list:=[]; 163 oplist:=[]; 164 if not (oplist=op2list) then 165 passed := false; 166 if not (constset1[2] = constset2[2]) then 167 passed := false; 168 if (constset1[1] = constset2[2]) then 169 passed := false; 170 if not (constset1[1] = [ord(A_MOVE),ord(A_FTST),ord(A_CPSAVE)]) then 171 passed := false; 172 CheckPassed(passed); 173 end; 174 175 procedure SetTestNotEqual; 176 { FPC_SET_COMP_SETS } 177 var 178 op2list :set of tasmopint; 179 oplist: set of tasmopint; 180 passed : boolean; 181 Begin 182 Write('Normal Set <> Normal Set test...'); 183 passed := true; 184 op2list:=[]; 185 oplist:=[]; 186 if not (oplist=op2list) then 187 passed := false; 188 if (constset1[2] <> constset2[2]) then 189 passed := false; 190 if not (constset1[1] <> constset2[2]) then 191 passed := false; 192{ if ( [ord(A_ADD)] <> [ord(A_ADD)] ) then optimized out. 193 passed := false; 194 if ( [ord(A_BLE)..ord(A_BPL)] <> [ord(A_BLE)..ord(A_BPL)] ) then 195 passed := false; } 196 if (constset1[1] <> [ord(A_MOVE),ord(A_FTST),ord(A_CPSAVE)]) then 197 passed := false; 198 CheckPassed(passed); 199 end; 200 201 procedure SetTestLt; 202 var 203 op2list :set of tasmopint; 204 oplist: set of tasmopint; 205 passed : boolean; 206 begin 207 Write('Normal Set <= Normal Set test...'); 208 passed := true; 209 if constset1[1] <= constset2[2] then 210 passed := false; 211 oplist := []; 212 op2list := [ord(A_MOVE)]; 213 if op2list <= oplist then 214 passed := false; 215 oplist := [ord(A_MOVE),ord(A_CPRESTORE)..ord(A_CPSAVE)]; 216 if oplist <= op2list then 217 passed := false; 218 CheckPassed(passed); 219 end; 220 221 Procedure SetTestAddOne; 222 { FPC_SET_SET_BYTE } 223 { FPC_SET_ADD_SETS } 224 var 225 op : tasmopint; 226 oplist: set of tasmopint; 227 Begin 228 Write('Set + Set element testing...'); 229 op:=ord(A_LABEL); 230 oplist:=[]; 231 oplist:=oplist+[op]; 232 CheckPassed(oplist = [ord(A_LABEL)]); 233 end; 234 235Procedure SetTestAddTwo; 236{ SET_ADD_SETS } 237var 238 op2list :set of tasmopint; 239 oplist: set of tasmopint; 240Begin 241 Write('Complex Set + Set element testing...'); 242 op2list:=[]; 243 oplist:=[]; 244 oplist:=[ord(A_MOVE)]+[ord(A_JSR)]; 245 op2list:=[ord(A_LABEL)]; 246 oplist:=op2list+oplist; 247 CheckPassed(oplist = [ord(A_MOVE),ord(A_JSR),ord(A_LABEL)]); 248end; 249 250 251 252 253 254Procedure SetTestSubOne; 255{ SET_SUB_SETS } 256var 257 op2list :set of tasmopint; 258 oplist: set of tasmopint; 259 op :tasmopint; 260 passed : boolean; 261Begin 262 Write('Set - Set element testing...'); 263 passed := true; 264 op2list:=[]; 265 oplist:=[]; 266 op := ord(A_TRACS); 267 oplist:=[ord(A_MOVE)]+[ord(A_JSR)]+[op]; 268 op2list:=[ord(A_MOVE)]+[ord(A_JSR)]; 269 oplist:=oplist-op2list; 270 if oplist <> [ord(A_TRACS)] then 271 passed := false; 272 273 oplist:=[ord(A_MOVE)]+[ord(A_JSR)]+[op]; 274 op2list:=[ord(A_MOVE)]+[ord(A_JSR)]; 275 oplist:=op2list-oplist; 276 if oplist <> [] then 277 passed := false; 278 CheckPassed(passed); 279end; 280 281Procedure SetTestSubTwo; 282{ FPC_SET_SUB_SETS } 283const 284 b: tasmopint = (ord(A_BSR)); 285var 286 op2list :set of tasmopint; 287 oplist: set of tasmopint; 288 op : tasmopint; 289 passed : boolean; 290Begin 291 Write('Complex Set - Set element testing...'); 292 op := ord(A_BKPT); 293 passed := true; 294 oplist:=[ord(A_MOVE)]+[ord(A_JSR)]-[op]; 295 op2list:=[ord(A_MOVE)]+[ord(A_JSR)]; 296 if oplist <> op2list then 297 passed := false; 298 oplist := [ord(A_MOVE)]; 299 oplist := oplist - [ord(A_MOVE)]; 300 if oplist <> [] then 301 passed := false; 302 oplist := oplist + [b]; 303 if oplist <> [b] then 304 passed := false; 305 oplist := oplist - [b]; 306 if oplist <> [] then 307 passed := false; 308 CheckPassed(passed); 309end; 310 311 312Procedure SetTestMulSets; 313{ FPC_SET_MUL_SETS } 314var 315 op2list :set of tasmopint; 316 oplist: set of tasmopint; 317 passed : boolean; 318Begin 319 passed := true; 320 Write('Set * Set element testing...'); 321 op2list:=[]; 322 oplist:=[]; 323 oplist:=[ord(A_MOVE)]+[ord(A_JSR)]; 324 op2list:=[ord(A_MOVE)]; 325 oplist:=oplist*op2list; 326 if oplist <> [ord(A_JSR)] then 327 passed := false; 328 oplist := [ord(A_MOVE),ord(A_FTST)]; 329 op2list := [ord(A_MOVE),ord(A_FTST)]; 330 oplist := oplist * op2list; 331 if oplist <> [ord(A_MOVE),ord(A_FTST)] then 332 passed := false; 333 CheckPassed(passed); 334end; 335 336procedure SetTestRange; 337var 338 op2list :set of tasmopint; 339 oplist: set of tasmopint; 340 passed : boolean; 341 op1 : tasmopint; 342 op2 : tasmopint; 343begin 344 passed := true; 345 Write('Range Set + element testing...'); 346 op1 := ord(A_ADD); 347 op2 := ord(A_ASL); 348 oplist := []; 349 oplist := [op1..op2]; 350 if oplist <> constset1[2] then 351 passed := false; 352 CheckPassed(passed); 353end; 354 355procedure SetTestByte; 356var 357 op2list :set of tasmopint; 358 oplist: set of tasmopint; 359 passed : boolean; 360 op1 : tasmopint; 361 op2 : tasmopint; 362 op : tasmopint; 363begin 364 Write('Simple Set + element testing...'); 365 passed := true; 366 op := ord(A_LABEL); 367 oplist := [ord(A_MOVE),op,ord(A_JSR)]; 368 if oplist <> [ord(A_MOVE),ord(A_LABEL),ord(A_JSR)] then 369 passed := false; 370 CheckPassed(passed); 371end; 372 373 374{------------------------------ TESTS FOR SMALL VALUES ---------------------} 375 procedure SmallSetTestEqual; 376 var 377 op2list :set of tsmallenumint; 378 oplist: set of tsmallenumint; 379 passed : boolean; 380 Begin 381 Write('Small Set == Small Set test...'); 382 passed := true; 383 op2list:=[]; 384 oplist:=[]; 385 if not (oplist=op2list) then 386 passed := false; 387 if not (constset3[2] = constset4[2]) then 388 passed := false; 389 if (constset3[1] = constset4[2]) then 390 passed := false; 391 if not (constset3[1] = [ord(DA),ord(DD),ord(DM)]) then 392 passed := false; 393 CheckPassed(passed); 394 end; 395 396 procedure SmallSetTestNotEqual; 397 var 398 op2list :set of tsmallenumint; 399 oplist: set of tsmallenumint; 400 passed : boolean; 401 Begin 402 Write('Small Set <> Small Set test...'); 403 passed := true; 404 op2list:=[]; 405 oplist:=[]; 406 if not (oplist=op2list) then 407 passed := false; 408 if (constset3[2] <> constset4[2]) then 409 passed := false; 410 if not (constset3[1] <> constset4[2]) then 411 passed := false; 412{ if ( [ord(A_ADD)] <> [ord(A_ADD)] ) then optimized out. 413 passed := false; 414 if ( [ord(A_BLE)..ord(A_BPL)] <> [ord(A_BLE)..ord(A_BPL)] ) then 415 passed := false; } 416 if (constset3[1] <> [ord(DA),ord(DD),ord(DM)]) then 417 passed := false; 418 CheckPassed(passed); 419 end; 420 421 procedure SmallSetTestLt; 422 var 423 op2list :set of tsmallenumint; 424 oplist: set of tsmallenumint; 425 passed : boolean; 426 begin 427 Write('Small Set <= Small Set test...'); 428 passed := true; 429 if constset3[1] <= constset4[2] then 430 passed := false; 431 oplist := []; 432 op2list := [ord(DC)]; 433 if op2list <= oplist then 434 passed := false; 435 oplist := [ord(DC),ord(DF)..ord(DM)]; 436 if oplist <= op2list then 437 passed := false; 438 CheckPassed(passed); 439 end; 440 441 Procedure SmallSetTestAddOne; 442 var 443 op : tsmallenumint; 444 oplist: set of tsmallenumint; 445 Begin 446 Write('Small Set + Small Set element testing...'); 447 op:=ord(DG); 448 oplist:=[]; 449 oplist:=oplist+[op]; 450 CheckPassed( oplist = [ord(DG)] ); 451 end; 452 453Procedure SmallSetTestAddTwo; 454var 455 op2list :set of tsmallenumint; 456 oplist: set of tsmallenumint; 457Begin 458 Write('Small Complex Set + Small Set element testing...'); 459 op2list:=[]; 460 oplist:=[]; 461 oplist:=[ord(DG)]+[ord(DI)]; 462 op2list:=[ord(DM)]; 463 oplist:=op2list+oplist; 464 CheckPassed( oplist = [ord(DG),ord(DI),ord(DM)] ); 465end; 466 467 468Procedure SmallSetTestSubOne; 469var 470 op2list :set of tsmallenumint; 471 oplist: set of tsmallenumint; 472 op :tsmallenumint; 473 passed : boolean; 474Begin 475 Write('Small Set - Small Set element testing...'); 476 passed := true; 477 op2list:=[]; 478 oplist:=[]; 479 op := ord(DL); 480 oplist:=[ord(DG)]+[ord(DI)]+[op]; 481 op2list:=[ord(DG)]+[ord(DI)]; 482 oplist:=oplist-op2list; 483 if oplist <> [ord(DL)] then 484 passed := false; 485 486 oplist:=[ord(DG)]+[ord(DI)]+[op]; 487 op2list:=[ord(DG)]+[ord(DI)]; 488 oplist:=op2list-oplist; 489 if oplist <> [] then 490 passed := false; 491 CheckPassed(passed); 492end; 493 494Procedure SmallSetTestSubTwo; 495const 496 b: tsmallenumint = (ord(DH)); 497var 498 op2list :set of tsmallenumint; 499 oplist: set of tsmallenumint; 500 op : tsmallenumint; 501 passed : boolean; 502Begin 503 Write('Small Complex Set - Small Set element testing...'); 504 op := ord(DL); 505 passed := true; 506 oplist:=[ord(DG)]+[ord(DI)]-[op]; 507 op2list:=[ord(DG)]+[ord(DI)]; 508 if oplist <> op2list then 509 passed := false; 510 oplist := [ord(DG)]; 511 oplist := oplist - [ord(DG)]; 512 if oplist <> [] then 513 passed := false; 514 oplist := oplist + [b]; 515 if oplist <> [b] then 516 passed := false; 517 oplist := oplist - [b]; 518 if oplist <> [] then 519 passed := false; 520 CheckPassed(passed); 521end; 522 523 524Procedure SmallSetTestMulSets; 525var 526 op2list : set of tsmallenumint; 527 oplist: set of tsmallenumint; 528 passed : boolean; 529Begin 530 passed := true; 531 Write('Small Set * Small Set element testing...'); 532 op2list:=[]; 533 oplist:=[]; 534 oplist:=[ord(DG)]+[ord(DI)]; 535 op2list:=[ord(DG)]; 536 oplist:=oplist*op2list; 537 if oplist <> [ord(DI)] then 538 passed := false; 539 oplist := [ord(DG),ord(DK)]; 540 op2list := [ord(DG),ord(DK)]; 541 oplist := oplist * op2list; 542 if oplist <> [ord(DG),ord(DK)] then 543 passed := false; 544 CheckPassed(passed); 545end; 546 547procedure SmallSetTestRange; 548var 549 op2list :set of tsmallenumint; 550 oplist: set of tsmallenumint; 551 passed : boolean; 552 op1 : tsmallenumint; 553 op2 : tsmallenumint; 554begin 555 passed := true; 556 Write('Small Range Set + element testing...'); 557 op1 := ord(DB); 558 op2 := ord(DI); 559 oplist := []; 560 oplist := [op1..op2]; 561 if oplist <> constset3[2] then 562 passed := false; 563 CheckPassed(passed); 564end; 565 566procedure SmallSetTestByte; 567var 568 op2list : set of tsmallenumint; 569 oplist: set of tsmallenumint; 570 passed : boolean; 571 op1 : tsmallenumint; 572 op2 : tsmallenumint; 573 op : tsmallenumint; 574begin 575 Write('Small Simple Set + element testing...'); 576 passed := true; 577 op := ord(DD); 578 oplist := [ord(DG),op,ord(DI)]; 579 if oplist <> [ord(DG),ord(DD),ord(DI)] then 580 passed := false; 581 CheckPassed(passed); 582end; 583 584(* 585 586const 587 b: myenum = (ord(dA)); 588var 589 enum: set of myenum; 590 oplist: set of tasmopint; 591 l : word; 592Begin 593 SetTestEqual; 594 SetTestNotEqual; 595{ small sets } 596 enum:=[]; 597 { add } 598 enum:=enum+[ord(da)]; 599 { subtract } 600 enum:=enum-[ord(da)]; 601 if ord(DA) in enum then 602 WriteLn('Found ord(A_LABEL)'); 603 { very large sets } 604 { copy loop test } 605 WRITELN('LARGE SETS:'); 606 oplist := [ord(A_LABEL)]; 607 { secondin test } 608 if ord(A_LABEL) in oplist then 609 WriteLn('TESTING SIMPLE SECOND_IN: PASSED.'); 610 { } 611 oplist:=[]; 612 if ord(A_LABEL) in oplist then 613 WriteLn('SECOND IN FAILED.'); 614{ SecondinSets;} 615 SetSetByte; 616 SetAddSets; 617 SetSubSets; 618 SetCompSets; 619 SetMulSets; 620 WRITELN('SMALL SETS:'); 621 SmallInSets; 622 SmallAddSets; 623 SmallSubSets; 624 SmallCompSets; 625 SmallMulSets; 626 l:=word(ord(A_CPRESTORE)); 627 if l = word(ord(A_CPRESTORE)) then 628 Begin 629 end; 630 631*) 632Begin 633 WriteLn('----------------------- Normal sets -----------------------'); 634 { Normal sets } 635 SetTestEqual; 636 SetTestNotEqual; 637 SetTestAddOne; 638 SetTestAddTwo; 639 SetTestSubOne; 640 SetTestSubTwo; 641 SetTestRange; 642 SetTestLt; 643 SetTestByte; 644 { Small sets } 645 WriteLn('----------------------- Small sets -----------------------'); 646 SmallSetTestEqual; 647 SmallSetTestNotEqual; 648 SmallSetTestAddOne; 649 SmallSetTestAddTwo; 650 SmallSetTestSubOne; 651 SmallSetTestSubTwo; 652 SmallSetTestRange; 653 SmallSetTestLt; 654 SmallSetTestByte; 655 656 if Err then 657 Halt(1); 658end. 659