API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Oct 20th, 2013
91
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 12.87 KB | None | 0 0
raw download clone embed print report
  1. Index: fpdbgclasses.pp
  2. ===================================================================
  3. --- fpdbgclasses.pp (revision 43291)
  4. +++ fpdbgclasses.pp (working copy)
  5. @@ -37,7 +37,7 @@
  6.  
  7. uses
  8. {$ifdef windows}
  9. - Windows, FpImgReaderWinPE,
  10. + Windows,
  11. {$endif}
  12. Classes, Maps, FpDbgUtil, FpDbgWinExtra, FpDbgLoader, LazLoggerBase, LazClasses;
  13.  
  14. @@ -68,6 +68,12 @@
  15. end;
  16. {$endif}
  17.  
  18. + TDbgSymbolType = (
  19. + stNone,
  20. + stValue, // The symbol has a value (var, field, function, procedure (value is address of func/proc, so it can be called)
  21. + stType // The Symbol is a type (including proc/func declaration / without DW_AT_low_pc)
  22. + );
  23. +
  24. TDbgSymbolKind = (
  25. skNone, // undefined type
  26. // skUser, // userdefined type, this sym refers to another sym defined elswhere
  27. @@ -113,7 +119,7 @@
  28. TDbgSymbolFlags = set of TDbgSymbolFlag;
  29.  
  30. TDbgSymbolField = (
  31. - sfName, sfKind
  32. + sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize
  33. );
  34. TDbgSymbolFields = set of TDbgSymbolField;
  35.  
  36. @@ -121,14 +127,22 @@
  37.  
  38. TDbgSymbol = class(TRefCountedObject)
  39. private
  40. + FEvaluatedFields: TDbgSymbolFields;
  41. +
  42. + // Cached fields
  43. FName: String;
  44. FKind: TDbgSymbolKind;
  45. + FSymbolType: TDbgSymbolType;
  46. FAddress: TDbgPtr;
  47. + FSize: Integer;
  48.  
  49. - FEvaluatedFields: TDbgSymbolFields;
  50. - function GetKind: TDbgSymbolKind;
  51. + function GetSymbolType: TDbgSymbolType; inline;
  52. + function GetKind: TDbgSymbolKind; inline;
  53. function GetName: String;
  54. + function GetSize: Integer;
  55. + function GetAddress: TDbgPtr;
  56. protected
  57. + // NOT cached fields
  58. function GetPointedToType: TDbgSymbol; virtual;
  59.  
  60. function GetChild(AIndex: Integer): TDbgSymbol; virtual;
  61. @@ -139,23 +153,31 @@
  62. function GetLine: Cardinal; virtual;
  63. function GetParent: TDbgSymbol; virtual;
  64. function GetReference: TDbgSymbol; virtual;
  65. - function GetSize: Integer; virtual;
  66. -
  67. + protected
  68. + // Cached fields
  69. procedure SetName(AValue: String);
  70. procedure SetKind(AValue: TDbgSymbolKind);
  71. + procedure SetSymbolType(AValue: TDbgSymbolType);
  72. + procedure SetAddress(AValue: TDbgPtr);
  73. + procedure SetSize(AValue: Integer);
  74.  
  75. procedure KindNeeded; virtual;
  76. procedure NameNeeded; virtual;
  77. + procedure SymbolTypeNeeded; virtual;
  78. + procedure AddressNeeded; virtual;
  79. + procedure SizeNeeded; virtual;
  80. + //procedure Needed; virtual;
  81. public
  82. constructor Create(const AName: String);
  83. constructor Create(const AName: String; AKind: TDbgSymbolKind; AAddress: TDbgPtr);
  84. destructor Destroy; override;
  85. // Basic info
  86. - property Name: String read GetName;
  87. - property Kind: TDbgSymbolKind read GetKind;
  88. + property Name: String read GetName;
  89. + property SymbolType: TDbgSymbolType read GetSymbolType;
  90. + property Kind: TDbgSymbolKind read GetKind;
  91. // Memory; Size is also part of type (byte vs word vs ...)
  92. - property Address: TDbgPtr read FAddress;
  93. - property Size: Integer read GetSize;
  94. + property Address: TDbgPtr read GetAddress;
  95. + property Size: Integer read GetSize; // In Bytes
  96. // Location
  97. property FileName: String read GetFile;
  98. property Line: Cardinal read GetLine;
  99. @@ -905,9 +927,16 @@
  100. inherited Destroy;
  101. end;
  102.  
  103. +function TDbgSymbol.GetAddress: TDbgPtr;
  104. +begin
  105. + if not(sfiAddress in FEvaluatedFields) then
  106. + AddressNeeded;
  107. + Result := FAddress;
  108. +end;
  109. +
  110. function TDbgSymbol.GetKind: TDbgSymbolKind;
  111. begin
  112. - if not(sfKind in FEvaluatedFields) then
  113. + if not(sfiKind in FEvaluatedFields) then
  114. KindNeeded;
  115. Result := FKind;
  116. end;
  117. @@ -914,26 +943,58 @@
  118.  
  119. function TDbgSymbol.GetName: String;
  120. begin
  121. - if not(sfName in FEvaluatedFields) then
  122. + if not(sfiName in FEvaluatedFields) then
  123. NameNeeded;
  124. Result := FName;
  125. end;
  126.  
  127. +function TDbgSymbol.GetSize: Integer;
  128. +begin
  129. + if not(sfiSize in FEvaluatedFields) then
  130. + SizeNeeded;
  131. + Result := FSize;
  132. +end;
  133. +
  134. +function TDbgSymbol.GetSymbolType: TDbgSymbolType;
  135. +begin
  136. + if not(sfiSymType in FEvaluatedFields) then
  137. + SymbolTypeNeeded;
  138. + Result := FSymbolType;
  139. +end;
  140. +
  141. function TDbgSymbol.GetPointedToType: TDbgSymbol;
  142. begin
  143. Result := nil;
  144. end;
  145.  
  146. +procedure TDbgSymbol.SetAddress(AValue: TDbgPtr);
  147. +begin
  148. + FAddress := AValue;
  149. + Include(FEvaluatedFields, sfiAddress);
  150. +end;
  151. +
  152. procedure TDbgSymbol.SetKind(AValue: TDbgSymbolKind);
  153. begin
  154. FKind := AValue;
  155. - Include(FEvaluatedFields, sfKind);
  156. + Include(FEvaluatedFields, sfiKind);
  157. end;
  158.  
  159. +procedure TDbgSymbol.SetSymbolType(AValue: TDbgSymbolType);
  160. +begin
  161. + FSymbolType := AValue;
  162. + Include(FEvaluatedFields, sfiSymType);
  163. +end;
  164. +
  165. +procedure TDbgSymbol.SetSize(AValue: Integer);
  166. +begin
  167. + FSize := AValue;
  168. + Include(FEvaluatedFields, sfiSize);
  169. +end;
  170. +
  171. procedure TDbgSymbol.SetName(AValue: String);
  172. begin
  173. FName := AValue;
  174. - Include(FEvaluatedFields, sfName);
  175. + Include(FEvaluatedFields, sfiName);
  176. end;
  177.  
  178. function TDbgSymbol.GetChild(AIndex: Integer): TDbgSymbol;
  179. @@ -976,11 +1037,6 @@
  180. Result := nil;
  181. end;
  182.  
  183. -function TDbgSymbol.GetSize: Integer;
  184. -begin
  185. - Result := 0;
  186. -end;
  187. -
  188. procedure TDbgSymbol.KindNeeded;
  189. begin
  190. SetKind(skNone);
  191. @@ -991,6 +1047,21 @@
  192. SetName('');
  193. end;
  194.  
  195. +procedure TDbgSymbol.SymbolTypeNeeded;
  196. +begin
  197. + SetSymbolType(stNone);
  198. +end;
  199. +
  200. +procedure TDbgSymbol.AddressNeeded;
  201. +begin
  202. + SetAddress(0);
  203. +end;
  204. +
  205. +procedure TDbgSymbol.SizeNeeded;
  206. +begin
  207. + SetSize(0);
  208. +end;
  209. +
  210. {$ifdef windows}
  211. { TDbgBreak }
  212.  
  213. Index: fpdbgdwarf.pas
  214. ===================================================================
  215. --- fpdbgdwarf.pas (revision 43291)
  216. +++ fpdbgdwarf.pas (working copy)
  217. @@ -526,6 +526,8 @@
  218. //function GetSize: Integer; override;
  219. property TypeInfo: TDbgDwarfTypeIdentifier read GetTypeInfo;
  220. property InformationEntry: TDwarfInformationEntry read FInformationEntry;
  221. +
  222. + procedure Init; virtual;
  223. class function GetSubClass(ATag: Cardinal): TDbgDwarfIdentifierClass;
  224. public
  225. class function CreateSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfIdentifier;
  226. @@ -540,6 +542,7 @@
  227. TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ...
  228. protected
  229. procedure KindNeeded; override;
  230. + procedure Init; override;
  231. public
  232. property TypeInfo;
  233. end;
  234. @@ -595,6 +598,7 @@
  235. function GetIsPointerType: Boolean; virtual;
  236. function GetIsStructType: Boolean; virtual;
  237. function GetStructTypeInfo: TDbgDwarfIdentifierStructure; virtual;
  238. + procedure Init; override;
  239. public
  240. class function CreateTybeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier;
  241. property TypeInfo;
  242. @@ -685,6 +689,8 @@
  243. function StateMachineValid: Boolean;
  244. protected
  245. procedure KindNeeded; override;
  246. + procedure SizeNeeded; override;
  247. +
  248. function GetChild(AIndex: Integer): TDbgSymbol; override;
  249. function GetColumn: Cardinal; override;
  250. function GetCount: Integer; override;
  251. @@ -693,7 +699,6 @@
  252. function GetLine: Cardinal; override;
  253. function GetParent: TDbgSymbol; override;
  254. // function GetReference: TDbgSymbol; override;
  255. - function GetSize: Integer; override;
  256. public
  257. constructor Create(ACompilationUnit: TDwarfCompilationUnit; AInfo: PDwarfAddressInfo; AAddress: TDbgPtr); overload;
  258. destructor Destroy; override;
  259. @@ -1218,6 +1223,12 @@
  260. SetKind(t.Kind);
  261. end;
  262.  
  263. +procedure TDbgDwarfValueIdentifier.Init;
  264. +begin
  265. + inherited Init;
  266. + SetSymbolType(stValue);
  267. +end;
  268. +
  269. { TDbgDwarfIdentifierArray }
  270.  
  271. procedure TDbgDwarfIdentifierArray.KindNeeded;
  272. @@ -1473,6 +1484,12 @@
  273. Result := nil;
  274. end;
  275.  
  276. +procedure TDbgDwarfTypeIdentifier.Init;
  277. +begin
  278. + inherited Init;
  279. + SetSymbolType(stType);
  280. +end;
  281. +
  282. function TDbgDwarfTypeIdentifier.GetIsBaseType: Boolean;
  283. begin
  284. Result := False;
  285. @@ -1869,6 +1886,11 @@
  286. SetName(AName);
  287. end;
  288.  
  289. +procedure TDbgDwarfIdentifier.Init;
  290. +begin
  291. + //
  292. +end;
  293. +
  294. class function TDbgDwarfIdentifier.GetSubClass(ATag: Cardinal): TDbgDwarfIdentifierClass;
  295. begin
  296. case ATag of
  297. @@ -1910,6 +1932,7 @@
  298. FInformationEntry.AddReference;
  299.  
  300. inherited Create(AName);
  301. + Init;
  302. end;
  303.  
  304. constructor TDbgDwarfIdentifier.Create(AName: String;
  305. @@ -1920,6 +1943,7 @@
  306. FInformationEntry.AddReference;
  307.  
  308. inherited Create(AName, AKind, AAddress);
  309. + Init;
  310. end;
  311.  
  312. destructor TDbgDwarfIdentifier.Destroy;
  313. @@ -2774,11 +2798,6 @@
  314. Result:=inherited GetParent;
  315. end;
  316.  
  317. -function TDbgDwarfProcSymbol.GetSize: Integer;
  318. -begin
  319. - Result := FAddressInfo^.EndPC - FAddressInfo^.StartPC;
  320. -end;
  321. -
  322. function TDbgDwarfProcSymbol.StateMachineValid: Boolean;
  323. var
  324. SM1, SM2: TDwarfLineInfoStateMachine;
  325. @@ -2830,6 +2849,11 @@
  326. SetKind(skProcedure);
  327. end;
  328.  
  329. +procedure TDbgDwarfProcSymbol.SizeNeeded;
  330. +begin
  331. + SetSize(FAddressInfo^.EndPC - FAddressInfo^.StartPC);
  332. +end;
  333. +
  334. { TDbgDwarf }
  335.  
  336. constructor TDbgDwarf.Create(ALoader: TDbgImageLoader);
  337. Index: fppascalparser.pas
  338. ===================================================================
  339. --- fppascalparser.pas (revision 43291)
  340. +++ fppascalparser.pas (working copy)
  341. @@ -598,13 +598,11 @@
  342. if FDbgType = nil then
  343. exit;
  344.  
  345. - if FDbgType is TDbgDwarfValueIdentifier then
  346. - Result := TDbgDwarfValueIdentifier(FDbgType).TypeInfo
  347. - else
  348. - if FDbgType is TDbgDwarfTypeIdentifier then
  349. - Result := FDbgType
  350. - else
  351. - Result := nil; // Todo handled by typecast operator // maybe wrap in TTypeOf class?
  352. + case FDbgType.SymbolType of
  353. + stValue: Result := TDbgDwarfValueIdentifier(FDbgType).TypeInfo;
  354. + stType: Result := FDbgType;
  355. + else Result := nil;
  356. + end;
  357.  
  358. if Result <> nil then
  359. Result.AddReference;
  360. @@ -614,7 +612,7 @@
  361. begin
  362. if FDbgType = nil then
  363. FDbgType := FExpression.GetDbgTyeForIdentifier(GetText);
  364. - Result := (FDbgType <> nil) and (FDbgType is TDbgDwarfTypeIdentifier);
  365. + Result := (FDbgType <> nil) and (FDbgType.SymbolType = stType);
  366. end;
  367.  
  368. destructor TFpPascalExpressionPartIdentifer.Destroy;
  369. @@ -1446,13 +1444,13 @@
  370.  
  371. tmp := Items[0].ResultType;
  372. // Todo unit
  373. - if (tmp <> nil) and (tmp is TDbgDwarfTypeIdentifier) and
  374. + if (tmp <> nil) and (tmp.SymbolType = stType) and
  375. (TDbgDwarfTypeIdentifier(tmp).IsStructType)
  376. then begin
  377. struct := TDbgDwarfTypeIdentifier(tmp).StructTypeInfo;
  378. tmp := struct.MemberByName[Items[1].GetText];
  379.  
  380. - if (tmp <> nil) and (tmp is TDbgDwarfValueIdentifier) then begin
  381. + if (tmp <> nil) and (tmp.SymbolType = stValue) then begin
  382. Result := TDbgDwarfValueIdentifier(tmp).TypeInfo;
  383. Result.AddReference;
  384. end;
  385. Index: test/FpTest.lpi
  386. ===================================================================
  387. --- test/FpTest.lpi (revision 43291)
  388. +++ test/FpTest.lpi (working copy)
  389. @@ -42,7 +42,7 @@
  390. <PackageName Value="FCL"/>
  391. </Item4>
  392. </RequiredPackages>
  393. - <Units Count="3">
  394. + <Units Count="4">
  395. <Unit0>
  396. <Filename Value="FpTest.lpr"/>
  397. <IsPartOfProject Value="True"/>
  398. @@ -54,10 +54,15 @@
  399. <UnitName Value="TestPascalParser"/>
  400. </Unit1>
  401. <Unit2>
  402. + <Filename Value="..\..\..\debugger\fpgdbmidebugger.pp"/>
  403. + <IsPartOfProject Value="True"/>
  404. + <UnitName Value="FpGdbmiDebugger"/>
  405. + </Unit2>
  406. + <Unit3>
  407. <Filename Value="testtypeinfo.pas"/>
  408. <IsPartOfProject Value="True"/>
  409. <UnitName Value="TestTypeInfo"/>
  410. - </Unit2>
  411. + </Unit3>
  412. </Units>
  413. </ProjectOptions>
  414. <CompilerOptions>
  415. Index: test/testpascalparser.pas
  416. ===================================================================
  417. --- test/testpascalparser.pas (revision 43291)
  418. +++ test/testpascalparser.pas (working copy)
  419. @@ -376,6 +376,22 @@
  420. TestExpr([0,0,0], TFpPascalExpressionPartIdentifer, 'f', 0);
  421. TestExpr([0,1], TFpPascalExpressionPartIdentifer, 'a', 0);
  422.  
  423. + CreateExpr('@f(a)(b)', True);
  424. + TestExpr([], TFpPascalExpressionPartOperatorAddressOf, '@', 1);
  425. + TestExpr([0], TFpPascalExpressionPartBracketArgumentList, '(', 2);
  426. + TestExpr([0,0], TFpPascalExpressionPartBracketArgumentList, '(', 2);
  427. + TestExpr([0,0,0], TFpPascalExpressionPartIdentifer, 'f', 0);
  428. + TestExpr([0,0,1], TFpPascalExpressionPartIdentifer, 'a', 0);
  429. + TestExpr([0,1], TFpPascalExpressionPartIdentifer, 'b', 0);
  430. +
  431. + CreateExpr('f(a)(b)^', True);
  432. + TestExpr([], TFpPascalExpressionPartOperatorDeRef, '^', 1);
  433. + TestExpr([0], TFpPascalExpressionPartBracketArgumentList, '(', 2);
  434. + TestExpr([0,0], TFpPascalExpressionPartBracketArgumentList, '(', 2);
  435. + TestExpr([0,0,0], TFpPascalExpressionPartIdentifer, 'f', 0);
  436. + TestExpr([0,0,1], TFpPascalExpressionPartIdentifer, 'a', 0);
  437. + TestExpr([0,1], TFpPascalExpressionPartIdentifer, 'b', 0);
  438. +
  439. finally
  440. CurrentTestExprObj.Free;
  441. end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!