1 {
2     Copyright (c) 2011 by Free Pascal development team
3 
4     Support for win64 unwind data
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 }
22 unit win64unw;
23 
24 {$i fpcdefs.inc}
25 
26 interface
27 
28 uses
29   cclasses,globtype,aasmbase,aasmdata,aasmtai,cgbase,ogbase;
30 
31 type
32   TWin64CFI=class
33   private
34     FFrameOffs, FFrameReg: Integer;
35     FFlags: Integer;
36     FHandler: TObjSymbol;
37     FCount: Integer;
38     FElements:TLinkedList;
39     FFrameStartSym:TObjSymbol;
40     FFrameStartSec:TObjSection;
41     FXdataSym:TObjSymbol;
42     FXdataSec:TObjSection;
43     FPrologueEndPos:aword;
44     FPrologueEndSeen:Boolean;
45     FName: pshortstring;
46     procedure AddElement(objdata:TObjData;aCode,aInfo:Integer;aOffs:dword);
47   public
48     constructor create;
49     destructor destroy;override;
50     procedure generate_prologue_data(objdata:TObjData);
51     procedure start_frame(objdata:TObjData; const name: string);
52     procedure end_frame(objdata:TObjData);
53     procedure end_prologue(objdata:TObjData);
54     procedure push_reg(objdata:TObjData;reg:tregister);
55     procedure save_reg(objdata:TObjData;reg:tregister;ofs:dword);
56     procedure save_xmm(objdata:TObjData;reg:tregister;ofs:dword);
57     procedure set_frame(objdata:TObjData; reg:tregister;ofs:dword);
58     procedure stack_alloc(objdata:TObjData;ofs:dword);
59     procedure switch_to_handlerdata(objdata:TObjData);
60   end;
61 
62 
63 implementation
64 
65 uses
66   cutils,globals,verbose,cpubase;
67 
68 const
69   UWOP_PUSH_NONVOL     = 0;  { info = register number }
70   UWOP_ALLOC_LARGE     = 1;  { no info, alloc size in next 2 slots }
71   UWOP_ALLOC_SMALL     = 2;  { info = size of allocation / 8 - 1 }
72   UWOP_SET_FPREG       = 3;  { no info, FP = RSP + UNWIND_INFO.FPRegOffset*16 }
73   UWOP_SAVE_NONVOL     = 4;  { info = register number, offset in next slot }
74   UWOP_SAVE_NONVOL_FAR = 5;  { info = register number, offset in next 2 slots }
75   UWOP_SAVE_XMM        = 6;
76   UWOP_SAVE_XMM_FAR    = 7;
77   UWOP_SAVE_XMM128     = 8;  { info = XMM reg number, offset in next slot }
78   UWOP_SAVE_XMM128_FAR = 9;  { info = XMM reg number, offset in next 2 slots }
79   UWOP_PUSH_MACHFRAME  = 10; { info = 0: no error-code, 1: error-code }
80 
81   UNW_FLAG_EHANDLER    = $01; { exceptiion handler }
82   UNW_FLAG_UHANDLER    = $02; { termination handler }
83   UNW_FLAG_FHANDLER    = UNW_FLAG_EHANDLER or UNW_FLAG_UHANDLER;
84   UNW_FLAG_CHAININFO   = $04; { mutually exclusive with the above }
85 
86 
87 type
88   tai_seh_directive_x64=class(tai_seh_directive)
89     procedure generate_code(objdata:TObjData);override;
90   end;
91 
92   TPrologueElement=class(TLinkedListItem)
93   public
94     opcode: Integer;  { =(info shl 4) or code }
95     ofs: dword;
96     addr: aword;
97   end;
98 
99 var
100   current_unw: TWin64Cfi;
101 
EncodeRegnull102 function EncodeReg(r: TRegister): integer;
103 begin
104   case r of
105     NR_RAX: result:=0;
106     NR_RCX: result:=1;
107     NR_RDX: result:=2;
108     NR_RBX: result:=3;
109     NR_RSP: result:=4;
110     NR_RBP: result:=5;
111     NR_RSI: result:=6;
112     NR_RDI: result:=7;
113     NR_R8:  result:=8;
114     NR_R9:  result:=9;
115     NR_R10: result:=10;
116     NR_R11: result:=11;
117     NR_R12: result:=12;
118     NR_R13: result:=13;
119     NR_R14: result:=14;
120     NR_R15: result:=15;
121   else
122     InternalError(2011072305);
123   end;
124 end;
125 
EncodeXMMnull126 function EncodeXMM(r: TRegister): integer;
127 begin
128   if getregtype(r)=R_MMREGISTER then
129     result:=getsupreg(r)
130   else
131     InternalError(2011072308);
132 end;
133 
134 
135 { TWin64CFI }
136 
137 constructor TWin64CFI.create;
138 begin
139   inherited create;
140   FElements:=TLinkedList.Create;
141 end;
142 
143 destructor TWin64CFI.destroy;
144 begin
145   FElements.Free;
146   stringdispose(FName);
147   inherited destroy;
148 end;
149 
150 procedure TWin64CFI.AddElement(objdata:TObjData;aCode,aInfo:Integer;aOffs:dword);
151 var
152   el:TPrologueElement;
153 begin
154   el:=TPrologueElement.Create;
155   FElements.concat(el);
156   el.opcode:=(aInfo shl 4) or aCode;
157   el.ofs:=aOffs;
158   el.addr:=objdata.CurrObjSec.Size;
159 
160   { a single element may occupy 1,2 or 3 word-sized slots }
161   case aCode of
162     UWOP_ALLOC_LARGE:
163       Inc(FCount,2+ord(aInfo<>0));
164 
165     UWOP_SAVE_NONVOL_FAR,
166     UWOP_SAVE_XMM128_FAR:
167       Inc(FCount,3);
168 
169     UWOP_SAVE_NONVOL,
170     UWOP_SAVE_XMM128:
171       Inc(FCount,2);
172 
173   else
174     inc(FCount);
175   end;
176 end;
177 
178 { Changes objdata.CurrObjSec to .xdata, so generation of
179   handler data may continue }
180 procedure TWin64CFI.generate_prologue_data(objdata:TObjData);
181 var
182   hp: TPrologueElement;
183   uwcode: array [0..1] of byte;
184   uwdata: array [0..3] of byte;
185   zero: word;
186 begin
187   if FCount>255 then
188     InternalError(2011072301);
189   if not FPrologueEndSeen then
190     CGMessage(asmw_e_missing_endprologue);
191   if (FPrologueEndPos-FFrameStartSym.address) > 255 then
192     CGMessage(asmw_e_prologue_too_large);
193   if codegenerror then
194     exit;
195 
196   FXdataSec:=objdata.createsection('.xdata.n_'+lower(FName^),4,[oso_data,oso_load]);
197   FXdataSym:=objdata.symboldefine('$unwind$'+FName^,AB_GLOBAL,AT_DATA);
198   uwdata[0]:=(FFlags shl 3) or 1;
199   uwdata[1]:=FPrologueEndPos-FFrameStartSym.address;
200   uwdata[2]:=FCount;
201   { Offset is multiple of 16, so it is already shifted into correct position }
202   uwdata[3]:=FFrameOffs or FFrameReg;
203   objdata.writebytes(uwdata,4);
204 
205   { write elements in reverse order (offset descending) }
206   hp:=TPrologueElement(FElements.Last);
207   while Assigned(hp) do
208     begin
209       uwcode[0]:=hp.addr-FFrameStartSym.address;
210       uwcode[1]:=hp.opcode;
211       objdata.writebytes(uwcode,2);
212       case hp.opcode and $0F of
213     UWOP_PUSH_NONVOL,
214     UWOP_ALLOC_SMALL,
215     UWOP_SET_FPREG,
216     UWOP_PUSH_MACHFRAME: ;  { These have no extra data }
217 
218     UWOP_ALLOC_LARGE:
219       if (hp.opcode and $F0)<>0 then
220             objdata.writebytes(hp.ofs,4)
221           else
222             objdata.writebytes(hp.ofs,2);
223 
224     UWOP_SAVE_NONVOL_FAR,
225     UWOP_SAVE_XMM128_FAR:
226       objdata.writebytes(hp.ofs,4);
227 
228     UWOP_SAVE_NONVOL,
229     UWOP_SAVE_XMM128:
230           objdata.writebytes(hp.ofs,2);
231       else
232         InternalError(2011072302);
233       end;
234 
235       hp:=TPrologueElement(hp.Previous);
236     end;
237   { pad with zeros to dword boundary }
238   zero:=0;
239   if odd(FCount) then
240     objdata.writebytes(zero,2);
241   if Assigned(FHandler) then
242     objdata.writereloc(0,sizeof(longint),FHandler,RELOC_RVA);
243 end;
244 
245 procedure TWin64CFI.start_frame(objdata:TObjData;const name:string);
246 begin
247   if assigned(FName) then
248     internalerror(2011072306);
249   FName:=stringdup(name);
250   FFrameStartSym:=objdata.symbolref(name);
251   FFrameStartSec:=objdata.CurrObjSec;
252   FCount:=0;
253   FFrameReg:=0;
254   FFrameOffs:=0;
255   FPrologueEndPos:=0;
256   FPrologueEndSeen:=false;
257   FHandler:=nil;
258   FXdataSec:=nil;
259   FXdataSym:=nil;
260   FFlags:=0;
261 end;
262 
263 procedure TWin64CFI.switch_to_handlerdata(objdata:TObjData);
264 begin
265   if not assigned(FName) then
266     internalerror(2011072310);
267 
268   if FHandler=nil then
269     CGMessage(asmw_e_handlerdata_no_handler);
270 
271   if FXdataSec=nil then
272     generate_prologue_data(objdata)
273   else
274     objdata.SetSection(FXdataSec);
275 end;
276 
277 procedure TWin64CFI.end_frame(objdata:TObjData);
278 var
279   pdatasec:TObjSection;
280 begin
281   if not assigned(FName) then
282     internalerror(2011072307);
283 
284   if FXdataSec=nil then
285     generate_prologue_data(objdata);
286 
287   if not codegenerror then
288     begin
289       pdatasec:=objdata.createsection(sec_pdata,lower(FName^));
290       objdata.writereloc(0,4,FFrameStartSym,RELOC_RVA);
291       objdata.writereloc(FFrameStartSec.Size,4,FFrameStartSym,RELOC_RVA);
292       objdata.writereloc(0,4,FXdataSym,RELOC_RVA);
293       { restore previous state }
294       objdata.SetSection(FFrameStartSec);
295       { create a dummy relocation, so pdata is not smartlinked away }
296       FFrameStartSec.AddSectionReloc(0,pdatasec,RELOC_NONE);
297     end;
298   FElements.Clear;
299   FFrameStartSym:=nil;
300   FHandler:=nil;
301   FXdataSec:=nil;
302   FXdataSym:=nil;
303   FFlags:=0;
304   stringdispose(FName);
305 end;
306 
307 procedure TWin64CFI.end_prologue(objdata:TObjData);
308 begin
309   if not assigned(FName) then
310     internalerror(2011072312);
311   FPrologueEndPos:=objdata.CurrObjSec.Size;
312   FPrologueEndSeen:=true;
313 end;
314 
315 procedure TWin64CFI.push_reg(objdata:TObjData;reg:tregister);
316 begin
317   AddElement(objdata,UWOP_PUSH_NONVOL,EncodeReg(reg),0);
318 end;
319 
320 procedure TWin64CFI.save_reg(objdata:TObjData;reg:tregister;ofs:dword);
321 var
322   info: Integer;
323 begin
324   info:=EncodeReg(reg);
325   if ((ofs and 7) = 0) and (ofs<=$ffff*8) then
326     AddElement(objdata,UWOP_SAVE_NONVOL,info,ofs shr 3)
327   else
328     AddElement(objdata,UWOP_SAVE_NONVOL_FAR,info,ofs);
329 end;
330 
331 procedure TWin64CFI.save_xmm(objdata:TObjData;reg:tregister;ofs:dword);
332 var
333   info: Integer;
334 begin
335   info:=EncodeXMM(reg);
336   if ((ofs and 15)=0) and (ofs<=$ffff*16) then
337     AddElement(objdata,UWOP_SAVE_XMM128, info, ofs shr 4)
338   else
339     AddElement(objdata,UWOP_SAVE_XMM128_FAR, info, ofs);
340 end;
341 
342 procedure TWin64CFI.set_frame(objdata:TObjData;reg:tregister;ofs:dword);
343 var
344   info: Integer;
345 begin
346   info:=EncodeReg(reg);
347   if FFrameReg<>0 then
348     InternalError(2011072303);
349   if info=0 then                 { frame register cannot be RAX }
350     InternalError(2011072304);
351   if (ofs>240) or ((ofs and 15)<>0) then
352     InternalError(2011072310);
353   FFrameReg:=info;
354   FFrameOffs:=ofs;
355   { !! looks like docs aren't correct and info should be set to register }
356   AddElement(objdata,UWOP_SET_FPREG,0,0);
357 end;
358 
359 procedure TWin64CFI.stack_alloc(objdata:TObjData;ofs:dword);
360 begin
361   if ((ofs and 7)=0) and (ofs<=128) then
362     AddElement(objdata,UWOP_ALLOC_SMALL,(ofs-8) shr 3,0)
363   else if ((ofs and 7) = 0) and (ofs<=$ffff * 8) then
364     AddElement(objdata,UWOP_ALLOC_LARGE,0,ofs shr 3)
365   else
366     AddElement(objdata,UWOP_ALLOC_LARGE,1,ofs);
367 end;
368 
369 procedure tai_seh_directive_x64.generate_code(objdata:TObjData);
370 begin
371   case kind of
372     ash_proc:
373       current_unw.start_frame(objdata,data.name^);
374     ash_endproc:
375       current_unw.end_frame(objdata);
376     ash_endprologue:
377       current_unw.end_prologue(objdata);
378     ash_handler:
379       begin
380         current_unw.FHandler:=objdata.symbolref(data.name^);
381         current_unw.FFlags:=data.flags;
382       end;
383     ash_handlerdata:
384       current_unw.switch_to_handlerdata(objdata);
385     ash_eh,ash_32,ash_no32: ; { these are not for x86_64 }
386     ash_setframe:
387       current_unw.set_frame(objdata,data.reg,data.offset);
388     ash_stackalloc:
389       current_unw.stack_alloc(objdata,data.offset);
390     ash_pushreg:
391       current_unw.push_reg(objdata,data.reg);
392     ash_savereg:
393       current_unw.save_reg(objdata,data.reg,data.offset);
394     ash_savexmm:
395       current_unw.save_xmm(objdata,data.reg,data.offset);
396     ash_pushframe: {TBD};
397   end;
398 end;
399 
400 
401 initialization
402   cai_seh_directive:=tai_seh_directive_x64;
403   current_unw:=TWin64CFI.Create;
404 finalization
405   current_unw.Free;
406 end.
407 
408