tccon.pas 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Type checking and register allocation for constants
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit tccon;
  19. interface
  20. uses
  21. tree;
  22. procedure firstrealconst(var p : ptree);
  23. procedure firstfixconst(var p : ptree);
  24. procedure firstordconst(var p : ptree);
  25. procedure firstpointerconst(var p : ptree);
  26. procedure firststringconst(var p : ptree);
  27. procedure firstsetconst(var p : ptree);
  28. procedure firstniln(var p : ptree);
  29. implementation
  30. uses
  31. cobjects,verbose,globals,systems,
  32. symconst,symtable,aasm,types,
  33. hcodegen,pass_1,cpubase;
  34. {*****************************************************************************
  35. FirstRealConst
  36. *****************************************************************************}
  37. procedure firstrealconst(var p : ptree);
  38. begin
  39. if (p^.value_real=1.0) or (p^.value_real=0.0) then
  40. begin
  41. p^.location.loc:=LOC_FPU;
  42. p^.registersfpu:=1;
  43. end
  44. else
  45. p^.location.loc:=LOC_MEM;
  46. end;
  47. {*****************************************************************************
  48. FirstFixConst
  49. *****************************************************************************}
  50. procedure firstfixconst(var p : ptree);
  51. begin
  52. p^.location.loc:=LOC_MEM;
  53. end;
  54. {*****************************************************************************
  55. FirstOrdConst
  56. *****************************************************************************}
  57. procedure firstordconst(var p : ptree);
  58. begin
  59. p^.location.loc:=LOC_MEM;
  60. end;
  61. {*****************************************************************************
  62. FirstPointerConst
  63. *****************************************************************************}
  64. procedure firstpointerconst(var p : ptree);
  65. begin
  66. p^.location.loc:=LOC_MEM;
  67. end;
  68. {*****************************************************************************
  69. FirstStringConst
  70. *****************************************************************************}
  71. procedure firststringconst(var p : ptree);
  72. begin
  73. { if cs_ansistrings in aktlocalswitches then
  74. p^.resulttype:=cansistringdef
  75. else
  76. p^.resulttype:=cshortstringdef; }
  77. case p^.stringtype of
  78. st_shortstring :
  79. p^.resulttype:=cshortstringdef;
  80. st_ansistring :
  81. p^.resulttype:=cansistringdef;
  82. st_widestring :
  83. p^.resulttype:=cwidestringdef;
  84. st_longstring :
  85. p^.resulttype:=clongstringdef;
  86. end;
  87. p^.location.loc:=LOC_MEM;
  88. end;
  89. {*****************************************************************************
  90. FirstSetConst
  91. *****************************************************************************}
  92. procedure firstsetconst(var p : ptree);
  93. begin
  94. p^.location.loc:=LOC_MEM;
  95. end;
  96. {*****************************************************************************
  97. FirstNilN
  98. *****************************************************************************}
  99. procedure firstniln(var p : ptree);
  100. begin
  101. p^.resulttype:=voidpointerdef;
  102. p^.location.loc:=LOC_MEM;
  103. end;
  104. end.
  105. {
  106. $Log$
  107. Revision 1.12 2000-02-09 13:23:07 peter
  108. * log truncated
  109. Revision 1.11 2000/01/07 01:14:45 peter
  110. * updated copyright to 2000
  111. Revision 1.10 1999/09/26 21:30:22 peter
  112. + constant pointer support which can happend with typecasting like
  113. const p=pointer(1)
  114. * better procvar parsing in typed consts
  115. Revision 1.9 1999/09/04 20:52:07 florian
  116. * bug 580 fixed
  117. Revision 1.8 1999/08/04 00:23:38 florian
  118. * renamed i386asm and i386base to cpuasm and cpubase
  119. Revision 1.7 1999/08/03 22:03:29 peter
  120. * moved bitmask constants to sets
  121. * some other type/const renamings
  122. }