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