123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432 |
- {
- Copyright (c) 1998-2006 by Florian Klaempfl
- This unit implements an abstract asmoutput class for all processor types
- 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.
- ****************************************************************************
- }
- { @abstract(This unit implements an abstract asm output class for all processor types)
- This unit implements an abstract assembler output class for all processors, these
- are then overriden for each assembler writer to actually write the data in these
- classes to an assembler file.
- }
- unit aasmdata;
- {$i fpcdefs.inc}
- interface
- uses
- cutils,cclasses,
- globtype,globals,systems,
- cpuinfo,cpubase,
- cgbase,cgutils,
- symtype,
- aasmbase,ogbase;
- type
- { Type of AsmLists. The order is important for the layout of the
- information in the .o file. The stabs for the types must be defined
- before they can be referenced and therefor they need to be written
- first (PFV) }
- TAsmListType=(
- al_start,
- al_stabs,
- al_procedures,
- al_globals,
- al_const,
- al_typedconsts,
- al_rotypedconsts,
- al_threadvars,
- al_imports,
- al_exports,
- al_resources,
- al_rtti,
- al_dwarf,
- al_dwarf_info,
- al_dwarf_abbrev,
- al_dwarf_line,
- al_picdata,
- al_resourcestrings,
- al_end
- );
- const
- AsmListTypeStr : array[TAsmListType] of string[24] =(
- 'al_begin',
- 'al_stabs',
- 'al_procedures',
- 'al_globals',
- 'al_const',
- 'al_typedconsts',
- 'al_rotypedconsts',
- 'al_threadvars',
- 'al_imports',
- 'al_exports',
- 'al_resources',
- 'al_rtti',
- 'al_dwarf',
- 'al_dwarf_info',
- 'al_dwarf_abbrev',
- 'al_dwarf_line',
- 'al_picdata',
- 'al_resourcestrings',
- 'al_end'
- );
- type
- TAsmList = class(tlinkedlist)
- constructor create;
- function empty : boolean;
- function getlasttaifilepos : pfileposinfo;
- end;
- TAsmCFI=class
- public
- constructor create;virtual;
- destructor destroy;override;
- procedure generate_code(list:TAsmList);virtual;
- procedure start_frame(list:TAsmList);virtual;
- procedure end_frame(list:TAsmList);virtual;
- procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);virtual;
- procedure cfa_restore(list:TAsmList;reg:tregister);virtual;
- procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);virtual;
- procedure cfa_def_cfa_offset(list:TAsmList;ofs:longint);virtual;
- end;
- TAsmCFIClass=class of TAsmCFI;
- TAsmData = class
- private
- { Symbols }
- FAsmSymbolDict : TFPHashObjectList;
- FAltSymbolList : TFPObjectList;
- FNextAltNr : longint;
- FNextLabelNr : array[TAsmLabeltype] of longint;
- { Call Frame Information for stack unwinding}
- FAsmCFI : TAsmCFI;
- public
- name,
- realname : string[80];
- NextVTEntryNr : longint;
- { Assembler lists }
- AsmLists : array[TAsmListType] of TAsmList;
- CurrAsmList : TAsmList;
- constructor create(const n:string);
- destructor destroy;override;
- { asmsymbol }
- function DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
- function RefAsmSymbol(const s : string) : TAsmSymbol;
- function GetAsmSymbol(const s : string) : TAsmSymbol;
- { create new assembler label }
- procedure getlabel(out l : TAsmLabel;alt:TAsmLabeltype);
- procedure getjumplabel(out l : TAsmLabel);
- procedure getaddrlabel(out l : TAsmLabel);
- procedure getdatalabel(out l : TAsmLabel);
- { generate an alternative (duplicate) symbol }
- procedure GenerateAltSymbol(p:TAsmSymbol);
- procedure ResetAltSymbols;
- property AsmSymbolDict:TFPHashObjectList read FAsmSymbolDict;
- property AsmCFI:TAsmCFI read FAsmCFI;
- end;
- var
- CAsmCFI : TAsmCFIClass;
- current_asmdata : TAsmData;
- implementation
- uses
- verbose,
- aasmtai;
- {$ifdef MEMDEBUG}
- var
- memasmsymbols,
- memasmcfi,
- memasmlists : TMemDebug;
- {$endif MEMDEBUG}
- {*****************************************************************************
- TAsmCFI
- *****************************************************************************}
- constructor TAsmCFI.create;
- begin
- end;
- destructor TAsmCFI.destroy;
- begin
- end;
- procedure TAsmCFI.generate_code(list:TAsmList);
- begin
- end;
- procedure TAsmCFI.start_frame(list:TAsmList);
- begin
- end;
- procedure TAsmCFI.end_frame(list:TAsmList);
- begin
- end;
- procedure TAsmCFI.cfa_offset(list:TAsmList;reg:tregister;ofs:longint);
- begin
- end;
- procedure TAsmCFI.cfa_restore(list:TAsmList;reg:tregister);
- begin
- end;
- procedure TAsmCFI.cfa_def_cfa_register(list:TAsmList;reg:tregister);
- begin
- end;
- procedure TAsmCFI.cfa_def_cfa_offset(list:TAsmList;ofs:longint);
- begin
- end;
- {*****************************************************************************
- TAsmList
- *****************************************************************************}
- constructor TAsmList.create;
- begin
- inherited create;
- { make sure the optimizer won't remove the first tai of this list}
- insert(tai_marker.create(mark_BlockStart));
- end;
- function TAsmList.empty : boolean;
- begin
- { there is always a mark_BlockStart available,
- see TAsmList.create }
- result:=(count<=1);
- end;
- function TAsmList.getlasttaifilepos : pfileposinfo;
- var
- hp : tlinkedlistitem;
- begin
- getlasttaifilepos := nil;
- if assigned(last) then
- begin
- { find the last file information record }
- if not (tai(last).typ in SkipLineInfo) then
- getlasttaifilepos:=@tailineinfo(last).fileinfo
- else
- { go through list backwards to find the first entry
- with line information
- }
- begin
- hp:=tai(last);
- while assigned(hp) and (tai(hp).typ in SkipLineInfo) do
- hp:=hp.Previous;
- { found entry }
- if assigned(hp) then
- getlasttaifilepos:=@tailineinfo(hp).fileinfo
- end;
- end;
- end;
- {****************************************************************************
- TAsmData
- ****************************************************************************}
- constructor TAsmData.create(const n:string);
- var
- alt : TAsmLabelType;
- hal : TAsmListType;
- begin
- inherited create;
- realname:=n;
- name:=upper(n);
- { symbols }
- FAsmSymbolDict:=TFPHashObjectList.create(true);
- FAltSymbolList:=TFPObjectList.Create(false);
- { labels }
- FNextAltNr:=1;
- for alt:=low(TAsmLabelType) to high(TAsmLabelType) do
- FNextLabelNr[alt]:=1;
- { AsmLists }
- CurrAsmList:=TAsmList.create;
- for hal:=low(TAsmListType) to high(TAsmListType) do
- AsmLists[hal]:=TAsmList.create;
- { PIC data }
- if (target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
- AsmLists[al_picdata].concat(tai_directive.create(asd_non_lazy_symbol_pointer,''));
- { CFI }
- FAsmCFI:=CAsmCFI.Create;
- end;
- destructor TAsmData.destroy;
- var
- hal : TAsmListType;
- begin
- { Symbols }
- {$ifdef MEMDEBUG}
- memasmsymbols.start;
- {$endif}
- FAltSymbolList.free;
- FAsmSymbolDict.free;
- {$ifdef MEMDEBUG}
- memasmsymbols.stop;
- {$endif}
- { CFI }
- {$ifdef MEMDEBUG}
- memasmcfi.start;
- {$endif}
- FAsmCFI.free;
- {$ifdef MEMDEBUG}
- memasmcfi.stop;
- {$endif}
- { Lists }
- {$ifdef MEMDEBUG}
- memasmlists.start;
- {$endif}
- for hal:=low(TAsmListType) to high(TAsmListType) do
- AsmLists[hal].free;
- CurrAsmList.free;
- {$ifdef MEMDEBUG}
- memasmlists.stop;
- {$endif}
- end;
- function TAsmData.DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
- var
- hp : TAsmSymbol;
- begin
- hp:=TAsmSymbol(FAsmSymbolDict.Find(s));
- if assigned(hp) then
- begin
- { Redefine is allowed, but the types must be the same. The redefine
- is needed for Darwin where the labels are first allocated }
- if (hp.bind<>AB_EXTERNAL) then
- begin
- if (hp.bind<>_bind) and
- (hp.typ<>_typ) then
- internalerror(200603261);
- end;
- hp.typ:=_typ;
- hp.bind:=_bind;
- end
- else
- begin
- { Not found, insert it. }
- hp:=TAsmSymbol.create(AsmSymbolDict,s,_bind,_typ);
- end;
- result:=hp;
- end;
- function TAsmData.RefAsmSymbol(const s : string) : TAsmSymbol;
- begin
- result:=TAsmSymbol(FAsmSymbolDict.Find(s));
- if not assigned(result) then
- result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE);
- end;
- function TAsmData.GetAsmSymbol(const s : string) : TAsmSymbol;
- begin
- result:=TAsmSymbol(FAsmSymbolDict.Find(s));
- end;
- procedure TAsmData.GenerateAltSymbol(p:TAsmSymbol);
- begin
- if not assigned(p.altsymbol) then
- begin
- p.altsymbol:=p.getaltcopy(AsmSymbolDict,FNextAltNr);
- FAltSymbolList.Add(p);
- end;
- end;
- procedure TAsmData.ResetAltSymbols;
- var
- i : longint;
- begin
- for i:=0 to FAltSymbolList.Count-1 do
- TAsmSymbol(FAltSymbolList[i]).altsymbol:=nil;
- FAltSymbolList.Clear;
- end;
- procedure TAsmData.getlabel(out l : TAsmLabel;alt:TAsmLabeltype);
- begin
- l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt],alt);
- inc(FNextLabelNr[alt]);
- end;
- procedure TAsmData.getjumplabel(out l : TAsmLabel);
- begin
- l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt_jump],alt_jump);
- inc(FNextLabelNr[alt_jump]);
- end;
- procedure TAsmData.getdatalabel(out l : TAsmLabel);
- begin
- l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt_data],alt_data);
- inc(FNextLabelNr[alt_data]);
- end;
- procedure TAsmData.getaddrlabel(out l : TAsmLabel);
- begin
- l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt_addr],alt_addr);
- inc(FNextLabelNr[alt_addr]);
- end;
- initialization
- {$ifdef MEMDEBUG}
- memasmsymbols:=TMemDebug.create('AsmSymbols');
- memasmsymbols.stop;
- memasmcfi:=TMemDebug.create('AsmCFI');
- memasmcfi.stop;
- memasmlists:=TMemDebug.create('AsmLists');
- memasmlists.stop;
- {$endif MEMDEBUG}
- CAsmCFI:=TAsmCFI;
- finalization
- {$ifdef MEMDEBUG}
- memasmsymbols.free;
- memasmcfi.free;
- memasmlists.free;
- {$endif MEMDEBUG}
- end.
|