pass_1.pas 9.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit handles the typecheck and node conversion pass
  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 pass_1;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node;
  23. procedure resulttypepass(var p : tnode);
  24. function do_resulttypepass(var p : tnode) : boolean;
  25. procedure firstpass(var p : tnode);
  26. function do_firstpass(var p : tnode) : boolean;
  27. {$ifdef state_tracking}
  28. procedure do_track_state_pass(p:Tnode);
  29. {$endif}
  30. implementation
  31. uses
  32. globtype,systems,cclasses,
  33. cutils,globals,
  34. cgbase,symdef
  35. {$ifdef extdebug}
  36. ,verbose,htypechk
  37. {$endif extdebug}
  38. {$ifdef state_tracking}
  39. ,nstate
  40. {$endif}
  41. ;
  42. {*****************************************************************************
  43. Global procedures
  44. *****************************************************************************}
  45. procedure resulttypepass(var p : tnode);
  46. var
  47. oldcodegenerror : boolean;
  48. oldlocalswitches : tlocalswitches;
  49. oldpos : tfileposinfo;
  50. hp : tnode;
  51. begin
  52. if (p.resulttype.def=nil) then
  53. begin
  54. oldcodegenerror:=codegenerror;
  55. oldpos:=aktfilepos;
  56. oldlocalswitches:=aktlocalswitches;
  57. codegenerror:=false;
  58. aktfilepos:=p.fileinfo;
  59. aktlocalswitches:=p.localswitches;
  60. hp:=p.det_resulttype;
  61. { should the node be replaced? }
  62. if assigned(hp) then
  63. begin
  64. p.free;
  65. { run resulttypepass }
  66. resulttypepass(hp);
  67. { switch to new node }
  68. p:=hp;
  69. end;
  70. aktlocalswitches:=oldlocalswitches;
  71. aktfilepos:=oldpos;
  72. if codegenerror then
  73. begin
  74. include(p.flags,nf_error);
  75. { default to errortype if no type is set yet }
  76. if p.resulttype.def=nil then
  77. p.resulttype:=generrortype;
  78. end;
  79. codegenerror:=codegenerror or oldcodegenerror;
  80. end
  81. else
  82. begin
  83. { update the codegenerror boolean with the previous result of this node }
  84. if (nf_error in p.flags) then
  85. codegenerror:=true;
  86. end;
  87. end;
  88. function do_resulttypepass(var p : tnode) : boolean;
  89. begin
  90. codegenerror:=false;
  91. resulttypepass(p);
  92. do_resulttypepass:=codegenerror;
  93. end;
  94. procedure firstpass(var p : tnode);
  95. var
  96. oldcodegenerror : boolean;
  97. oldlocalswitches : tlocalswitches;
  98. oldpos : tfileposinfo;
  99. hp : tnode;
  100. begin
  101. if not(nf_error in p.flags) then
  102. begin
  103. oldcodegenerror:=codegenerror;
  104. oldpos:=aktfilepos;
  105. oldlocalswitches:=aktlocalswitches;
  106. codegenerror:=false;
  107. aktfilepos:=p.fileinfo;
  108. aktlocalswitches:=p.localswitches;
  109. { determine the resulttype if not done }
  110. if (p.resulttype.def=nil) then
  111. begin
  112. aktfilepos:=p.fileinfo;
  113. aktlocalswitches:=p.localswitches;
  114. hp:=p.det_resulttype;
  115. { should the node be replaced? }
  116. if assigned(hp) then
  117. begin
  118. p.free;
  119. { run resulttypepass }
  120. resulttypepass(hp);
  121. { switch to new node }
  122. p:=hp;
  123. end;
  124. if codegenerror then
  125. begin
  126. include(p.flags,nf_error);
  127. { default to errortype if no type is set yet }
  128. if p.resulttype.def=nil then
  129. p.resulttype:=generrortype;
  130. end;
  131. aktlocalswitches:=oldlocalswitches;
  132. aktfilepos:=oldpos;
  133. codegenerror:=codegenerror or oldcodegenerror;
  134. end;
  135. if not(nf_error in p.flags) then
  136. begin
  137. { first pass }
  138. aktfilepos:=p.fileinfo;
  139. aktlocalswitches:=p.localswitches;
  140. hp:=p.pass_1;
  141. { should the node be replaced? }
  142. if assigned(hp) then
  143. begin
  144. p.free;
  145. { run firstpass }
  146. firstpass(hp);
  147. { switch to new node }
  148. p:=hp;
  149. end;
  150. if codegenerror then
  151. include(p.flags,nf_error)
  152. else
  153. begin
  154. {$ifdef EXTDEBUG}
  155. if (p.expectloc=LOC_INVALID) then
  156. Comment(V_Warning,'Expectloc is not set in firstpass: '+nodetype2str[p.nodetype]);
  157. {$endif EXTDEBUG}
  158. end;
  159. end;
  160. codegenerror:=codegenerror or oldcodegenerror;
  161. aktlocalswitches:=oldlocalswitches;
  162. aktfilepos:=oldpos;
  163. end
  164. else
  165. codegenerror:=true;
  166. end;
  167. function do_firstpass(var p : tnode) : boolean;
  168. begin
  169. codegenerror:=false;
  170. firstpass(p);
  171. {$ifdef state_tracking}
  172. writeln('TRACKSTART');
  173. writeln('before');
  174. writenode(p);
  175. do_track_state_pass(p);
  176. writeln('after');
  177. writenode(p);
  178. writeln('TRACKDONE');
  179. {$endif}
  180. do_firstpass:=codegenerror;
  181. end;
  182. {$ifdef state_tracking}
  183. procedure do_track_state_pass(p:Tnode);
  184. begin
  185. aktstate:=Tstate_storage.create;
  186. p.track_state_pass(true);
  187. aktstate.destroy;
  188. end;
  189. {$endif}
  190. end.
  191. {
  192. $Log$
  193. Revision 1.32 2003-10-01 20:34:49 peter
  194. * procinfo unit contains tprocinfo
  195. * cginfo renamed to cgbase
  196. * moved cgmessage to verbose
  197. * fixed ppc and sparc compiles
  198. Revision 1.31 2003/09/23 17:56:05 peter
  199. * locals and paras are allocated in the code generation
  200. * tvarsym.localloc contains the location of para/local when
  201. generating code for the current procedure
  202. Revision 1.30 2003/04/22 23:50:23 peter
  203. * firstpass uses expectloc
  204. * checks if there are differences between the expectloc and
  205. location.loc from secondpass in EXTDEBUG
  206. Revision 1.29 2002/12/17 22:19:33 peter
  207. * fixed pushing of records>8 bytes with stdcall
  208. * simplified hightree loading
  209. Revision 1.28 2002/09/05 19:28:30 peter
  210. * removed repetitive pass counting
  211. * display heapsize also for extdebug
  212. Revision 1.27 2002/07/19 12:55:27 daniel
  213. * Further developed state tracking in whilerepeatn
  214. Revision 1.26 2002/07/19 11:41:36 daniel
  215. * State tracker work
  216. * The whilen and repeatn are now completely unified into whilerepeatn. This
  217. allows the state tracker to change while nodes automatically into
  218. repeat nodes.
  219. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  220. 'not(a>b)' is optimized into 'a<=b'.
  221. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  222. by removing the notn and later switchting the true and falselabels. The
  223. same is done with 'repeat until not a'.
  224. Revision 1.25 2002/07/14 18:00:44 daniel
  225. + Added the beginning of a state tracker. This will track the values of
  226. variables through procedures and optimize things away.
  227. Revision 1.24 2002/06/16 08:15:54 carl
  228. * commented out uncompilable debug code
  229. Revision 1.23 2002/05/18 13:34:11 peter
  230. * readded missing revisions
  231. Revision 1.22 2002/05/16 19:46:42 carl
  232. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  233. + try to fix temp allocation (still in ifdef)
  234. + generic constructor calls
  235. + start of tassembler / tmodulebase class cleanup
  236. Revision 1.20 2002/04/04 19:06:00 peter
  237. * removed unused units
  238. * use tlocation.size in cg.a_*loc*() routines
  239. Revision 1.19 2002/03/31 20:26:35 jonas
  240. + a_loadfpu_* and a_loadmm_* methods in tcg
  241. * register allocation is now handled by a class and is mostly processor
  242. independent (+rgobj.pas and i386/rgcpu.pas)
  243. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  244. * some small improvements and fixes to the optimizer
  245. * some register allocation fixes
  246. * some fpuvaroffset fixes in the unary minus node
  247. * push/popusedregisters is now called rg.save/restoreusedregisters and
  248. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  249. also better optimizable)
  250. * fixed and optimized register saving/restoring for new/dispose nodes
  251. * LOC_FPU locations now also require their "register" field to be set to
  252. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  253. - list field removed of the tnode class because it's not used currently
  254. and can cause hard-to-find bugs
  255. }