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