PageRenderTime 26ms CodeModel.GetById 24ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/compiler/jvm/dbgjasm.pas

https://github.com/slibre/freepascal
Pascal | 202 lines | 134 code | 33 blank | 35 comment | 9 complexity | 8d4cd1db5f8fb41946032e936586f79a MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1{
  2    Copyright (c) 2003-2006 by Peter Vreman, Florian Klaempfl, and Jonas Maebe
  3
  4    This units contains support for Jasmin debug info generation
  5
  6    This program is free software; you can redistribute it and/or modify
  7    it under the terms of the GNU General Public License as published by
  8    the Free Software Foundation; either version 2 of the License, or
  9    (at your option) any later version.
 10
 11    This program is distributed in the hope that it will be useful,
 12    but WITHOUT ANY WARRANTY; without even the implied warranty of
 13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 14    GNU General Public License for more details.
 15
 16    You should have received a copy of the GNU General Public License
 17    along with this program; if not, write to the Free Software
 18    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 19
 20 ****************************************************************************
 21}
 22unit dbgjasm;
 23
 24{$i fpcdefs.inc}
 25
 26interface
 27
 28    uses
 29      cclasses,globtype,
 30      aasmbase,aasmtai,aasmdata,
 31      symbase,symconst,symtype,symdef,symsym,
 32      finput,
 33      DbgBase;
 34
 35    type
 36      { TDebugInfoJasmin }
 37
 38      TDebugInfoJasmin=class(TDebugInfo)
 39      protected
 40        fcurrprocstart,
 41        fcurrprocend: tasmsymbol;
 42
 43        procedure appendsym_localsym(list: TAsmList; sym: tabstractnormalvarsym);
 44
 45        procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
 46        procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
 47        procedure beforeappenddef(list:TAsmList;def:tdef);override;
 48        procedure appendprocdef(list:TAsmList;def:tprocdef);override;
 49      public
 50        procedure inserttypeinfo;override;
 51        procedure insertlineinfo(list:TAsmList);override;
 52      end;
 53
 54implementation
 55
 56    uses
 57      sysutils,cutils,cfileutl,constexp,
 58      version,globals,verbose,systems,
 59      cpubase,cpuinfo,cgbase,paramgr,
 60      fmodule,
 61      defutil,symtable,jvmdef,ppu
 62      ;
 63
 64{****************************************************************************
 65                              TDebugInfoJasmin
 66****************************************************************************}
 67
 68  procedure TDebugInfoJasmin.appendsym_localsym(list: TAsmList; sym: tabstractnormalvarsym);
 69    var
 70      jvar: tai_jvar;
 71      proc: tprocdef;
 72    begin
 73      if tdef(sym.owner.defowner).typ<>procdef then
 74        exit;
 75      if not(sym.localloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
 76        exit;
 77      proc:=tprocdef(sym.owner.defowner);
 78      jvar:=tai_jvar.create(sym.localloc.reference.offset,jvmmangledbasename(sym,true),fcurrprocstart,fcurrprocend);
 79      proc.exprasmlist.InsertAfter(jvar,proc.procstarttai);
 80    end;
 81
 82
 83  procedure TDebugInfoJasmin.appendsym_paravar(list: TAsmList; sym: tparavarsym);
 84    begin
 85      appendsym_localsym(list,sym);
 86    end;
 87
 88
 89  procedure TDebugInfoJasmin.appendsym_localvar(list: TAsmList; sym: tlocalvarsym);
 90    begin
 91      appendsym_localsym(list,sym);
 92    end;
 93
 94
 95  procedure TDebugInfoJasmin.beforeappenddef(list: TAsmList; def: tdef);
 96    begin
 97    end;
 98
 99
100  procedure TDebugInfoJasmin.appendprocdef(list: TAsmList; def: tprocdef);
101    var
102      procstartlabel,
103      procendlabel    : tasmlabel;
104    begin
105      { insert debug information for local variables and parameters, but only
106        for routines implemented in the Pascal code }
107      if not assigned(def.procstarttai) then
108        exit;
109
110      current_asmdata.getlabel(procstartlabel,alt_dbgtype);
111      current_asmdata.getlabel(procendlabel,alt_dbgtype);
112      def.exprasmlist.insertafter(tai_label.create(procstartlabel),def.procstarttai);
113      def.exprasmlist.insertbefore(tai_label.create(procendlabel),def.procendtai);
114
115      fcurrprocstart:=procstartlabel;
116      fcurrprocend:=procendlabel;
117
118      write_symtable_parasyms(list,def.paras);
119      { not assigned for unit init }
120      if assigned(def.localst) then
121        write_symtable_syms(list,def.localst);
122    end;
123
124
125  procedure TDebugInfoJasmin.inserttypeinfo;
126    begin
127      { write all procedures and methods }
128      if assigned(current_module.globalsymtable) then
129        write_symtable_procdefs(nil,current_module.globalsymtable);
130      if assigned(current_module.localsymtable) then
131        write_symtable_procdefs(nil,current_module.localsymtable);
132    end;
133
134  procedure TDebugInfoJasmin.insertlineinfo(list: TAsmList);
135    var
136      currfileinfo,
137      lastfileinfo : tfileposinfo;
138      nolineinfolevel : Integer;
139      currfuncname : pshortstring;
140      hp : tai;
141    begin
142      FillChar(lastfileinfo,sizeof(lastfileinfo),0);
143      hp:=Tai(list.first);
144      nolineinfolevel:=0;
145      while assigned(hp) do
146        begin
147          case hp.typ of
148            ait_function_name :
149              begin
150                currfuncname:=tai_function_name(hp).funcname;
151                list.concat(tai_comment.Create(strpnew('function: '+currfuncname^)));
152              end;
153            ait_force_line :
154              begin
155                lastfileinfo.line:=-1;
156              end;
157            ait_marker :
158              begin
159                case tai_marker(hp).kind of
160                  mark_NoLineInfoStart:
161                    inc(nolineinfolevel);
162                  mark_NoLineInfoEnd:
163                    dec(nolineinfolevel);
164                end;
165              end;
166          end;
167
168          { Java does not support multiple source files }
169          if (hp.typ=ait_instruction) and
170             (nolineinfolevel=0) and
171             (tailineinfo(hp).fileinfo.fileindex=main_module.unit_index) then
172            begin
173              currfileinfo:=tailineinfo(hp).fileinfo;
174
175              { line changed ? }
176              if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
177                begin
178                  { line directive }
179                  list.insertbefore(tai_directive.Create(asd_jline,tostr(currfileinfo.line)),hp);
180                end;
181              lastfileinfo:=currfileinfo;
182            end;
183
184          hp:=tai(hp.next);
185        end;
186    end;
187
188
189{****************************************************************************
190****************************************************************************}
191    const
192      dbg_jasmin_info : tdbginfo =
193         (
194           id     : dbg_jasmin;
195           idtxt  : 'JASMIN';
196         );
197
198
199initialization
200  RegisterDebugInfo(dbg_jasmin_info,TDebugInfoJasmin);
201
202end.