diff --git a/compiler/aarch64/agcpugas.pas b/compiler/aarch64/agcpugas.pas
index 523e279f53..131793c709 100644
--- a/compiler/aarch64/agcpugas.pas
+++ b/compiler/aarch64/agcpugas.pas
@@ -30,7 +30,7 @@ unit agcpugas;
uses
globtype,systems,
- aasmtai,aasmbase,
+ aasmtai,aasmdata,aasmbase,
assemble,aggas,
cpubase,cpuinfo;
@@ -50,10 +50,12 @@ unit agcpugas;
TAArch64ClangGASAssembler=class(TGNUassembler)
private
function TargetStr:String;
+ procedure TransformSEHDirectives(list:TAsmList);
protected
function sectionflags(secflags:TSectionFlags):string;override;
public
function MakeCmdLine:TCmdStr; override;
+ procedure WriteAsmList; override;
constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
end;
@@ -72,7 +74,7 @@ unit agcpugas;
implementation
uses
- cutils,globals,verbose,
+ cutils,cclasses,globals,verbose,
aasmcpu,
itcpugas,
cgbase,cgutils;
@@ -121,6 +123,442 @@ unit agcpugas;
end;
+ procedure TAArch64ClangGASAssembler.TransformSEHDirectives(list:TAsmList);
+
+ function convert_unwinddata(list:tasmlist):tdynamicarray;
+
+ procedure check_offset(ofs,max:dword);
+ begin
+ if ((ofs and $7)<>0) or (ofs>max) then
+ internalerror(2020041210);
+ end;
+
+ procedure check_reg(reg:tregister;rt:TRegisterType;min:TSuperRegister);
+ begin
+ if (getregtype(reg)<>rt) or (getsupreg(reg)<min) then
+ internalerror(2020041211);
+ end;
+
+ procedure writebyte(b:byte); inline;
+ begin
+ result.write(b,sizeof(b));
+ end;
+
+ procedure writeword(w:word);
+ begin
+ w:=NtoBE(w);
+ result.write(w,sizeof(w));
+ end;
+
+ procedure writedword(dw:dword);
+ begin
+ dw:=NtoBE(dw);
+ result.write(dw,sizeof(dw));
+ end;
+
+ const
+ min_int_reg = 19;
+ min_mm_reg = 8;
+ var
+ hp : tai;
+ seh : tai_seh_directive absolute hp;
+ begin
+ result:=tdynamicarray.create(0);
+ hp:=tai(list.last);
+ while assigned(hp) do
+ begin
+ if hp.typ<>ait_seh_directive then
+ internalerror(2020041502);
+ case seh.kind of
+ ash_stackalloc:
+ begin
+ if (seh.data.offset and $f)<>0 then
+ internalerror(2020041207);
+ if seh.data.offset<((1 shl 5)*16) then
+ writebyte(byte(seh.data.offset shr 4))
+ else if seh.data.offset<((1 shl 11)*16) then
+ writeword($C000 or word(seh.data.offset shr 4))
+ else if seh.data.offset<((1 shl 24)*16) then
+ writedword($E0000000 or (seh.data.offset shr 4))
+ else begin
+ writeln(hexstr(seh.data.offset,8));
+ internalerror(2020041209);
+ end;
+ end;
+ ash_addfp:
+ begin
+ check_offset(seh.data.offset,(1 shl 7)*8);
+ writeword($E200 or (seh.data.offset shr 3));
+ end;
+ ash_setfp:
+ writebyte($E1);
+ ash_nop:
+ writebyte($E3);
+ ash_savefplr:
+ begin
+ check_offset(seh.data.offset,504);
+ writebyte($40 or (seh.data.offset shr 3));
+ end;
+ ash_savefplr_x:
+ begin
+ check_offset(seh.data.offset,512);
+ writebyte($80 or (seh.data.offset shr 3)-1);
+ end;
+ ash_savereg:
+ begin
+ check_offset(seh.data.offset,504);
+ check_reg(seh.data.reg,R_INTREGISTER,min_int_reg);
+ writeword($C000 or ((getsupreg(seh.data.reg)-min_int_reg) shl 6) or (seh.data.offset shr 3));
+ end;
+ ash_savereg_x:
+ begin
+ check_offset(seh.data.offset,256);
+ check_reg(seh.data.reg,R_INTREGISTER,min_int_reg);
+ writeword($C400 or ((getsupreg(seh.data.reg)-min_int_reg) shl 5) or ((seh.data.offset shr 3)-1));
+ end;
+ ash_saveregp:
+ begin
+ check_offset(seh.data.offset,504);
+ check_reg(seh.data.reg,R_INTREGISTER,min_int_reg);
+ writeword($C800 or ((getsupreg(seh.data.reg)-min_int_reg) shl 6) or (seh.data.offset shr 3));
+ end;
+ ash_saveregp_x:
+ begin
+ check_offset(seh.data.offset,512);
+ check_reg(seh.data.reg,R_INTREGISTER,min_int_reg);
+ writeword($CC00 or ((getsupreg(seh.data.reg)-min_int_reg) shl 6) or ((seh.data.offset shr 3)-1));
+ end;
+ ash_savefreg:
+ begin
+ check_offset(seh.data.offset,504);
+ check_reg(seh.data.reg,R_MMREGISTER,min_mm_reg);
+ writeword($DC00 or ((getsupreg(seh.data.reg)-min_mm_reg) shl 6) or (seh.data.offset shr 3));
+ end;
+ ash_savefreg_x:
+ begin
+ check_offset(seh.data.offset,256);
+ check_reg(seh.data.reg,R_MMREGISTER,min_mm_reg);
+ writeword($CE00 or ((getsupreg(seh.data.reg)-min_mm_reg) shl 5) or ((seh.data.offset shr 3)-1));
+ end;
+ ash_savefregp:
+ begin
+ check_offset(seh.data.offset,504);
+ check_reg(seh.data.reg,R_MMREGISTER,min_mm_reg);
+ writeword($D800 or ((getsupreg(seh.data.reg)-min_mm_reg) shl 6) or (seh.data.offset shr 3));
+ end;
+ ash_savefregp_x:
+ begin
+ check_offset(seh.data.offset,512);
+ check_reg(seh.data.reg,R_MMREGISTER,min_mm_reg);
+ writeword($DA00 or ((getsupreg(seh.data.reg)-min_int_reg) shl 6) or ((seh.data.offset shr 3)-1));
+ end;
+ else
+ internalerror(2020041503);
+ end;
+ hp:=tai(hp.previous);
+ end;
+ end;
+
+ var
+ unwinddata : tdynamicarray;
+
+ procedure writebyte(b:byte);
+ begin
+ unwinddata.write(b,sizeof(b));
+ end;
+
+ var
+ hp,hpnext,hpdata : tai;
+ seh : tai_seh_directive absolute hp;
+ lastsym : tai_symbol;
+ lastsec : tai_section;
+ inprologue,
+ inhandlerdata,
+ deleteai : boolean;
+ totalcount,
+ instrcount,
+ datacount : sizeint;
+ handlername : tsymstr;
+ handlerflags : byte;
+ handlerdata : array of tai;
+ handlerdataidx : sizeint;
+ handlerdatacount : tai;
+ sehlist,
+ tmplist : TAsmList;
+ xdatasym : tasmsymbol;
+ unwindread,
+ unwindrec : longword;
+ begin
+ if not assigned(list) then
+ exit;
+
+ tmplist:=nil;
+ sehlist:=nil;
+ lastsec:=nil;
+ instrcount:=0;
+ datacount:=0;
+ unwinddata:=nil;
+ inhandlerdata:=false;
+ inprologue:=false;
+ handlerdata:=nil;
+ handlerdataidx:=0;
+ handlerdatacount:=nil;
+
+ hp:=tai(list.first);
+ while assigned(hp) do
+ begin
+ deleteai:=false;
+ case hp.typ of
+ ait_section:
+ begin
+ if assigned(sehlist) then
+ begin
+ if assigned(lastsec) and (tai_section(hp).name^=lastsec.name^) then
+ begin
+ { this section was only added due to the now removed SEH data }
+ deleteai:=true;
+ dec(list.section_count);
+ end
+ else
+ internalerror(2020041214);
+ end
+ else
+ lastsec:=tai_section(hp);
+
+ if assigned(tmplist) then
+ begin
+ list.insertListBefore(hp,tmplist);
+ tmplist.free;
+ tmplist:=nil;
+ end;
+ end;
+ ait_symbol:
+ begin
+ if tai_symbol(hp).is_global then
+ lastsym:=tai_symbol(hp);
+ end;
+ ait_instruction:
+ if assigned(sehlist) then
+ inc(instrcount);
+ ait_const:
+ if assigned(sehlist) then
+ inc(datacount,tai_const(hp).size);
+ ait_seh_directive:
+ begin
+ if not assigned(sehlist) and (seh.kind<>ash_proc) then
+ internalerror(2020041208);
+ { most seh directives are removed }
+ deleteai:=true;
+ case seh.kind of
+ ash_proc:
+ begin
+ if not assigned(lastsec) then
+ internalerror(2020041203);
+ datacount:=0;
+ instrcount:=0;
+ handlerflags:=0;
+ handlername:='';
+ sehlist:=tasmlist.create;
+ inprologue:=true;
+ end;
+ ash_endproc:
+ begin
+ if not assigned(sehlist) then
+ internalerror(2020041501);
+ if assigned(tmplist) then
+ internalerror(2020041302);
+ if not assigned(lastsym) then
+ internalerror(2020041303);
+ if inprologue then
+ cgmessage(asmw_e_missing_endprologue);
+
+ unwinddata:=convert_unwinddata(sehlist);
+
+ writebyte($E4);
+
+ { fill up with NOPs }
+ while unwinddata.size mod 4<>0 do
+ writebyte($E3);
+
+ { note: we can pass Nil here, because in case of a LLVM
+ backend this whole code shouldn't be required
+ anyway }
+ xdatasym:=current_asmdata.DefineAsmSymbol('xdata_'+lastsec.name^,AB_LOCAL,AT_DATA,nil);
+
+ tmplist:=tasmlist.create;
+ new_section(tmplist,sec_pdata,lastsec.name^,0);
+ tmplist.concat(tai_const.Create_rva_sym(lastsym.sym));
+ tmplist.concat(tai_const.Create_rva_sym(xdatasym));
+
+ new_section(tmplist,sec_rodata,xdatasym.name,0);
+ tmplist.concat(tai_symbol.Create(xdatasym,0));
+
+ tmplist.concat(tai_comment.Create(strpnew('instr: '+tostr(instrcount)+', data: '+tostr(datacount)+', unwind: '+tostr(unwinddata.size))));
+
+ {$ifdef EXTDEBUG}
+ comment(V_Debug,'got section: '+lastsec.name^);
+ comment(V_Debug,'got instructions: '+tostr(instrcount));
+ comment(V_Debug,'got data: '+tostr(datacount));
+ comment(V_Debug,'got unwinddata: '+tostr(unwinddata.size));
+ {$endif EXTDEBUG}
+
+ if datacount mod 4<>0 then
+ cgmessage(asmw_e_seh_invalid_data_size);
+
+ totalcount:=datacount div 4+instrcount;
+
+ { splitting to multiple pdata/xdata sections is not yet
+ supported, so 1 MB is our limit for now }
+ if totalcount>(1 shl 18) then
+ comment(V_Error,'Function is larger than 1 MB which is not supported for SEH currently');
+
+ unwindrec:=min(totalcount,(1 shl 18)-1);
+ if handlerflags<>0 then
+ unwindrec:=unwindrec or (1 shl 20);
+
+ { currently we only have one epilog, so E needs to be
+ set to 1 and epilog scope index needs to be 0, no
+ matter if we require the extension for the unwinddata
+ or not }
+ unwindrec:=unwindrec or (1 shl 21);
+
+ if unwinddata.size div 4<=31 then
+ unwindrec:=unwindrec or ((unwinddata.size div 4) shl 27);
+
+ { exception record headers }
+ tmplist.concat(tai_const.Create_32bit(unwindrec));
+ if cs_asm_source in init_settings.globalswitches then
+ tmplist.concat(tai_comment.create(strpnew(hexstr(unwindrec,8))));
+
+ if unwinddata.size div 4>31 then
+ begin
+ { once we're able to split a .pdata entry this can be
+ removed as well }
+ if unwinddata.size div 4>255 then
+ comment(V_Error,'Too many unwind codes for SEH');
+ unwindrec:=(unwinddata.size div 4) shl 16;
+ tmplist.concat(tai_const.create_32bit(unwindrec));
+ if cs_asm_source in init_settings.globalswitches then
+ tmplist.concat(tai_comment.create(strpnew(hexstr(unwindrec,8))));
+ end;
+
+ { unwind codes }
+ unwinddata.seek(0);
+ while unwinddata.pos<unwinddata.size do
+ begin
+ unwinddata.read(unwindrec,sizeof(longword));
+ tmplist.concat(tai_const.Create_32bit(unwindrec));
+ if cs_asm_source in init_settings.globalswitches then
+ tmplist.concat(tai_comment.create(strpnew(hexstr(unwindrec,8))));
+ end;
+ unwinddata.free;
+
+ if handlerflags<>0 then
+ begin
+ tmplist.concat(tai_const.Create_rva_sym(current_asmdata.RefAsmSymbol(handlername,AT_FUNCTION,false)));
+ if length(handlerdata)>0 then
+ begin
+ tmplist.concat(handlerdatacount);
+ for handlerdataidx:=0 to high(handlerdata) do
+ tmplist.concat(handlerdata[handlerdataidx]);
+ end;
+ end;
+
+ handlerdata:=nil;
+
+ sehlist.free;
+ sehlist:=nil;
+ end;
+ ash_endprologue:
+ inprologue:=false;
+ ash_handler:
+ begin
+ handlername:=seh.data.name^;
+ handlerflags:=seh.data.flags;
+ end;
+ ash_handlerdata:
+ begin
+ if handlername='' then
+ cgmessage(asmw_e_handlerdata_no_handler);
+ hpdata:=tai(hp.next);
+ if not assigned(hpdata) or (hpdata.typ<>ait_const) or (tai_const(hpdata).consttype<>aitconst_32bit) then
+ internalerror(2020041215);
+ handlerdatacount:=hpdata;
+ setlength(handlerdata,tai_const(hpdata).value*4);
+ handlerdataidx:=0;
+ hpnext:=tai(hpdata.next);
+ list.remove(hpdata);
+ hpdata:=hpnext;
+ while (handlerdataidx<length(handlerdata)) and assigned(hpdata) do
+ begin
+ if (hpdata.typ<>ait_const) or not (tai_const(hpdata).consttype in [aitconst_32bit,aitconst_rva_symbol]) then
+ internalerror(2020041212);
+ handlerdata[handlerdataidx]:=hpdata;
+ inc(handlerdataidx);
+ hpnext:=tai(hpdata.next);
+ list.remove(hpdata);
+ hpdata:=hpnext;
+ end;
+ if handlerdataidx<length(handlerdata) then
+ internalerror(2020041213);
+ end;
+ ash_stackalloc,
+ ash_addfp,
+ ash_setfp,
+ ash_nop,
+ ash_savefplr,
+ ash_savefplr_x,
+ ash_savereg,
+ ash_savereg_x,
+ ash_saveregp,
+ ash_saveregp_x,
+ ash_savefreg,
+ ash_savefreg_x,
+ ash_savefregp,
+ ash_savefregp_x:
+ begin
+ if not assigned(sehlist) then
+ internalerror(2020041504);
+ if not inprologue then
+ internalerror(2020041505);
+ hpdata:=hp;
+ hp:=tai(hp.previous);
+ list.Remove(hpdata);
+ sehlist.concat(hpdata);
+ { don't delete this }
+ deleteai:=false;
+ end;
+ else
+ internalerror(2020041206);
+ end;
+ end;
+ else
+ { ignore }
+ ;
+ end;
+
+ if deleteai then
+ begin
+ hpnext:=tai(hp.next);
+ list.remove(hp);
+ hp.free;
+ hp:=hpnext;
+ end
+ else
+ hp:=tai(hp.next);
+ end;
+
+ if assigned(sehlist) then
+ internalerror(2020041205);
+
+ if assigned(tmplist) then
+ begin
+ list.concatlist(tmplist);
+ tmplist.free;
+ end;
+ end;
+
+
function TAArch64ClangGASAssembler.sectionflags(secflags:TSectionFlags):string;
begin
Result:=inherited sectionflags(secflags);
@@ -140,6 +578,19 @@ unit agcpugas;
end;
+ procedure TAArch64ClangGASAssembler.WriteAsmList;
+ begin
+ { clang does not support all the directives we need, so we need to
+ manually transform them to pdata/xdata records }
+ if target_info.system=system_aarch64_win64 then
+ begin
+ TransformSEHDirectives(current_asmdata.AsmLists[al_pure_assembler]);
+ TransformSEHDirectives(current_asmdata.AsmLists[al_procedures]);
+ end;
+ inherited WriteAsmList;
+ end;
+
+
{****************************************************************************}
{ Helper routines for Instruction Writer }
{****************************************************************************}