tnot.pp 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152
  1. {****************************************************************}
  2. { CODE GENERATOR TEST PROGRAM }
  3. {****************************************************************}
  4. { NODE TESTED : secondnot() }
  5. {****************************************************************}
  6. { PRE-REQUISITES: secondload() }
  7. { secondassign() }
  8. {****************************************************************}
  9. { DEFINES: VERBOSE = Write test information to screen }
  10. { FPC = Target is FreePascal compiler }
  11. {****************************************************************}
  12. { REMARKS: }
  13. { }
  14. { }
  15. { }
  16. {****************************************************************}
  17. Program tnot;
  18. {----------------------------------------------------}
  19. { Cases to test: }
  20. { CURRENT NODE (result) }
  21. { - LOC_REGISTER }
  22. { - LOC_FLAGS }
  23. { LEFT NODE (value to complement) }
  24. { possible cases : int64,byte,word,longint }
  25. { boolean }
  26. { - LOC_CREGISTER }
  27. { - LOC_REFERENCE / LOC_MEM }
  28. { - LOC_REGISTER }
  29. { - LOC_FLAGS }
  30. { - LOC_JUMP }
  31. {----------------------------------------------------}
  32. {$IFNDEF FPC}
  33. type smallint = integer;
  34. {$ENDIF}
  35. function getintres : smallint;
  36. begin
  37. getintres := $7F7F;
  38. end;
  39. function getbyteboolval : boolean;
  40. begin
  41. getbyteboolval := TRUE;
  42. end;
  43. procedure test(value, required: longint);
  44. begin
  45. if value <> required then
  46. begin
  47. writeln('Got ',value,' instead of ',required);
  48. halt(1);
  49. end
  50. else
  51. writeln('Passed!');
  52. end;
  53. var
  54. longres : longint;
  55. intres : smallint;
  56. byteboolval : bytebool;
  57. wordboolval : wordbool;
  58. longboolval : longbool;
  59. byteboolres : bytebool;
  60. wordboolres : wordbool;
  61. longboolres : longbool;
  62. {$ifdef fpc}
  63. int64res : int64;
  64. {$endif}
  65. Begin
  66. WriteLn('------------------------------ LONGINT --------------------------------');
  67. { CURRENT NODE: REGISTER }
  68. { LEFT NODE : REFERENCE }
  69. WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
  70. longres := $7F7F7F7F;
  71. longres := not longres;
  72. Write('Value should be $80808080...');
  73. test(longres,$80808080);
  74. { CURRENT NODE : REGISTER }
  75. { LEFT NODE : REGISTER }
  76. WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
  77. longres := not getintres;
  78. Write('Value should be $8080...');
  79. test(longres, $FFFF8080);
  80. WriteLn('----------------------------- BOOLEAN -----------------------------------');
  81. { CURRENT NODE : LOC_REGISTER }
  82. { LEFT NODE : LOC_REFERENCE }
  83. WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
  84. byteboolval := TRUE;
  85. byteboolres := not byteboolval;
  86. Write('Value should be FALSE...');
  87. test(ord(byteboolres),0);
  88. wordboolval := TRUE;
  89. wordboolres := not wordboolval;
  90. Write('Value should be FALSE...');
  91. test(longint(wordboolres),0);
  92. longboolval := TRUE;
  93. longboolres := not longboolval;
  94. Write('Value should be FALSE...');
  95. test(longint(longboolres),0);
  96. { CURRENT NODE : LOC_REGISTER }
  97. { LEFT NODE : LOC_REGISTER }
  98. WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
  99. longboolres := not getbyteboolval;
  100. Write('Value should be FALSE...');
  101. test(longint(longboolres),0);
  102. { CURRENT NODE : LOC_FLAGS }
  103. { LEFT NODE : LOC_FLAGS }
  104. WriteLn('(current) : LOC_FLAGS; (left) : LOC_FLAGS');
  105. intres := 1;
  106. byteboolres := TRUE;
  107. byteboolres:= not ((intres = 1));
  108. Write('Value should be FALSE...');
  109. test(ord(byteboolres),0);
  110. { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
  111. { CURRENT_NODE : LOC_JUMP }
  112. { ???????????????????????}
  113. { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
  114. { CURRENT_NODE : LOC_FLAGS }
  115. { LEFT NODE : <> LOC_FLAGS }
  116. { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
  117. {$IFDEF FPC}
  118. WriteLn('------------------------------ INT64 ----------------------------------');
  119. { CURRENT NODE: REGISTER }
  120. { LEFT NODE : REFERENCE }
  121. WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
  122. int64res := $7F7F7F7F;
  123. int64res := not int64res;
  124. Write('Value should be $80808080...');
  125. test(int64res and $FFFFFFFF,$80808080);
  126. { CURRENT NODE : REGISTER }
  127. { LEFT NODE : REGISTER }
  128. WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
  129. int64res := not (word(getintres));
  130. Write('Value should be $8080...');
  131. test(int64res and $FFFFFFFF,$00008080);
  132. {$ENDIF}
  133. end.