123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292 |
- {
- $Id$
- Copyright (c) 1998-2002 by Florian Klaempfl
- This unit handles the typecheck and node conversion pass
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit pass_1;
- {$i fpcdefs.inc}
- interface
- uses
- node;
- procedure resulttypepass(var p : tnode);
- function do_resulttypepass(var p : tnode) : boolean;
- procedure firstpass(var p : tnode);
- function do_firstpass(var p : tnode) : boolean;
- {$ifdef state_tracking}
- procedure do_track_state_pass(p:Tnode);
- {$endif}
- implementation
- uses
- globtype,systems,cclasses,
- cutils,globals,
- cgbase,symdef
- {$ifdef extdebug}
- ,verbose,htypechk
- {$endif extdebug}
- {$ifdef state_tracking}
- ,nstate
- {$endif}
- ;
- {*****************************************************************************
- Global procedures
- *****************************************************************************}
- procedure resulttypepass(var p : tnode);
- var
- oldcodegenerror : boolean;
- oldlocalswitches : tlocalswitches;
- oldpos : tfileposinfo;
- hp : tnode;
- begin
- if (p.resulttype.def=nil) then
- begin
- oldcodegenerror:=codegenerror;
- oldpos:=aktfilepos;
- oldlocalswitches:=aktlocalswitches;
- codegenerror:=false;
- aktfilepos:=p.fileinfo;
- aktlocalswitches:=p.localswitches;
- hp:=p.det_resulttype;
- { should the node be replaced? }
- if assigned(hp) then
- begin
- p.free;
- { run resulttypepass }
- resulttypepass(hp);
- { switch to new node }
- p:=hp;
- end;
- aktlocalswitches:=oldlocalswitches;
- aktfilepos:=oldpos;
- if codegenerror then
- begin
- include(p.flags,nf_error);
- { default to errortype if no type is set yet }
- if p.resulttype.def=nil then
- p.resulttype:=generrortype;
- end;
- codegenerror:=codegenerror or oldcodegenerror;
- end
- else
- begin
- { update the codegenerror boolean with the previous result of this node }
- if (nf_error in p.flags) then
- codegenerror:=true;
- end;
- end;
- function do_resulttypepass(var p : tnode) : boolean;
- begin
- codegenerror:=false;
- resulttypepass(p);
- do_resulttypepass:=codegenerror;
- end;
- procedure firstpass(var p : tnode);
- var
- oldcodegenerror : boolean;
- oldlocalswitches : tlocalswitches;
- oldpos : tfileposinfo;
- hp : tnode;
- begin
- if not(nf_error in p.flags) then
- begin
- oldcodegenerror:=codegenerror;
- oldpos:=aktfilepos;
- oldlocalswitches:=aktlocalswitches;
- codegenerror:=false;
- aktfilepos:=p.fileinfo;
- aktlocalswitches:=p.localswitches;
- { determine the resulttype if not done }
- if (p.resulttype.def=nil) then
- begin
- aktfilepos:=p.fileinfo;
- aktlocalswitches:=p.localswitches;
- hp:=p.det_resulttype;
- { should the node be replaced? }
- if assigned(hp) then
- begin
- p.free;
- { run resulttypepass }
- resulttypepass(hp);
- { switch to new node }
- p:=hp;
- end;
- if codegenerror then
- begin
- include(p.flags,nf_error);
- { default to errortype if no type is set yet }
- if p.resulttype.def=nil then
- p.resulttype:=generrortype;
- end;
- aktlocalswitches:=oldlocalswitches;
- aktfilepos:=oldpos;
- codegenerror:=codegenerror or oldcodegenerror;
- end;
- if not(nf_error in p.flags) then
- begin
- { first pass }
- aktfilepos:=p.fileinfo;
- aktlocalswitches:=p.localswitches;
- hp:=p.pass_1;
- { should the node be replaced? }
- if assigned(hp) then
- begin
- p.free;
- { run firstpass }
- firstpass(hp);
- { switch to new node }
- p:=hp;
- end;
- if codegenerror then
- include(p.flags,nf_error)
- else
- begin
- {$ifdef EXTDEBUG}
- if (p.expectloc=LOC_INVALID) then
- Comment(V_Warning,'Expectloc is not set in firstpass: '+nodetype2str[p.nodetype]);
- {$endif EXTDEBUG}
- end;
- end;
- codegenerror:=codegenerror or oldcodegenerror;
- aktlocalswitches:=oldlocalswitches;
- aktfilepos:=oldpos;
- end
- else
- codegenerror:=true;
- end;
- function do_firstpass(var p : tnode) : boolean;
- begin
- codegenerror:=false;
- firstpass(p);
- {$ifdef state_tracking}
- writeln('TRACKSTART');
- writeln('before');
- writenode(p);
- do_track_state_pass(p);
- writeln('after');
- writenode(p);
- writeln('TRACKDONE');
- {$endif}
- do_firstpass:=codegenerror;
- end;
- {$ifdef state_tracking}
- procedure do_track_state_pass(p:Tnode);
- begin
- aktstate:=Tstate_storage.create;
- p.track_state_pass(true);
- aktstate.destroy;
- end;
- {$endif}
- end.
- {
- $Log$
- Revision 1.32 2003-10-01 20:34:49 peter
- * procinfo unit contains tprocinfo
- * cginfo renamed to cgbase
- * moved cgmessage to verbose
- * fixed ppc and sparc compiles
- Revision 1.31 2003/09/23 17:56:05 peter
- * locals and paras are allocated in the code generation
- * tvarsym.localloc contains the location of para/local when
- generating code for the current procedure
- Revision 1.30 2003/04/22 23:50:23 peter
- * firstpass uses expectloc
- * checks if there are differences between the expectloc and
- location.loc from secondpass in EXTDEBUG
- Revision 1.29 2002/12/17 22:19:33 peter
- * fixed pushing of records>8 bytes with stdcall
- * simplified hightree loading
- Revision 1.28 2002/09/05 19:28:30 peter
- * removed repetitive pass counting
- * display heapsize also for extdebug
- Revision 1.27 2002/07/19 12:55:27 daniel
- * Further developed state tracking in whilerepeatn
- Revision 1.26 2002/07/19 11:41:36 daniel
- * State tracker work
- * The whilen and repeatn are now completely unified into whilerepeatn. This
- allows the state tracker to change while nodes automatically into
- repeat nodes.
- * Resulttypepass improvements to the notn. 'not not a' is optimized away and
- 'not(a>b)' is optimized into 'a<=b'.
- * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
- by removing the notn and later switchting the true and falselabels. The
- same is done with 'repeat until not a'.
- Revision 1.25 2002/07/14 18:00:44 daniel
- + Added the beginning of a state tracker. This will track the values of
- variables through procedures and optimize things away.
- Revision 1.24 2002/06/16 08:15:54 carl
- * commented out uncompilable debug code
- Revision 1.23 2002/05/18 13:34:11 peter
- * readded missing revisions
- Revision 1.22 2002/05/16 19:46:42 carl
- + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
- + try to fix temp allocation (still in ifdef)
- + generic constructor calls
- + start of tassembler / tmodulebase class cleanup
- Revision 1.20 2002/04/04 19:06:00 peter
- * removed unused units
- * use tlocation.size in cg.a_*loc*() routines
- Revision 1.19 2002/03/31 20:26:35 jonas
- + a_loadfpu_* and a_loadmm_* methods in tcg
- * register allocation is now handled by a class and is mostly processor
- independent (+rgobj.pas and i386/rgcpu.pas)
- * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
- * some small improvements and fixes to the optimizer
- * some register allocation fixes
- * some fpuvaroffset fixes in the unary minus node
- * push/popusedregisters is now called rg.save/restoreusedregisters and
- (for i386) uses temps instead of push/pop's when using -Op3 (that code is
- also better optimizable)
- * fixed and optimized register saving/restoring for new/dispose nodes
- * LOC_FPU locations now also require their "register" field to be set to
- R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
- - list field removed of the tnode class because it's not used currently
- and can cause hard-to-find bugs
- }
|