From 698f9e8da82ec86cd774ce1949745f9fb78c7420 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Wed, 21 Sep 2016 19:41:37 +0200 Subject: [PATCH] add a global deamangler --- lazproj/coedit.lpi | 6 +- lazproj/coedit.lpr | 2 +- src/ce_ddemangle.pas | 128 ++++++++++++++++++++++++++++++++++++++++++ src/ce_dubproject.pas | 2 - src/ce_gdb.pas | 11 ++-- src/ce_messages.pas | 95 ++----------------------------- 6 files changed, 145 insertions(+), 99 deletions(-) create mode 100644 src/ce_ddemangle.pas diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi index 30c314cd..33a2b207 100644 --- a/lazproj/coedit.lpi +++ b/lazproj/coedit.lpi @@ -241,7 +241,7 @@ - + @@ -515,6 +515,10 @@ + + + + diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr index 4050e720..a857383c 100644 --- a/lazproj/coedit.lpr +++ b/lazproj/coedit.lpr @@ -12,7 +12,7 @@ uses ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject, ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, ce_lcldragdrop, ce_stringrange, ce_dlangmaps, ce_projgroup, ce_projutils, ce_d2synpresets, - ce_dastworx, ce_dbgitf; + ce_dastworx, ce_dbgitf, ce_ddemangle; {$R *.res} diff --git a/src/ce_ddemangle.pas b/src/ce_ddemangle.pas new file mode 100644 index 00000000..14ea8066 --- /dev/null +++ b/src/ce_ddemangle.pas @@ -0,0 +1,128 @@ +unit ce_ddemangle; + +{$I ce_defines.inc} + +interface + +uses + Classes, SysUtils, process, forms, + ce_processes, ce_common; + +type + + TCEDDemangler = class + private + fActive: boolean; + fDone: boolean; + fProc: TCEProcess; + fList, fOut: TStringList; + procedure procOutput(sender: TObject); + procedure init; + public + constructor create; + destructor destroy; override; + procedure demangle(const value: string); + property output: TStringList read fList; + property active: boolean read fActive; + end; + +// TODO-cWindows: test the demangler under Windows + +// demangle a D name +function demangle(const value: string): string; +// demangle a list of D names +procedure demangle(values, output: TStrings); + +implementation + +var + demangler: TCEDDemangler; + +constructor TCEDDemangler.create; +begin + init; + fList := TStringList.Create; + fOut := TStringList.Create; +end; + +destructor TCEDDemangler.destroy; +begin + fProc.Terminate(0); + fProc.Free; + fOut.Free; + fList.Free; + inherited; +end; + +procedure TCEDDemangler.init; +begin + if assigned(fProc) and fProc.Running then + exit; + fProc.free; + fProc := TCEProcess.create(nil); + fProc.Executable:= exeFullName('ddemangle' + exeExt); + fProc.Options:= [poUsePipes]; + fProc.OnReadData:=@procOutput; + fProc.ShowWindow:= swoHIDE; + fProc.execute; + fActive := true; +end; + +procedure TCEDDemangler.demangle(const value: string); +var + i: integer = 0; +begin + init; + fDone := false; + fProc.Input.Write(value[1], value.length); + fProc.Input.WriteByte(10); + while not fDone do + begin + Application.ProcessMessages; + i += 1; + if i = high(integer) then + i := 0; + end; +end; + +procedure TCEDDemangler.procOutput(sender: TObject); +begin + fProc.getFullLines(fOut); + if fOut.Count <> 0 then + fList.Add(fOut[0]); + fDone := true; +end; + +function demangle(const value: string): string; +begin + if demangler.active then + begin + demangler.output.Clear; + demangler.demangle(value); + if demangler.output.Count <> 0 then + result := demangler.output[0] + else + result := value; + end + else result := value; +end; + +procedure demangle(values, output: TStrings); +var + value: string; +begin + if demangler.active then + begin + for value in values do + demangler.demangle(value); + output.AddStrings(demangler.output); + demangler.output.Clear; + end + else output.AddStrings(values); +end; + +initialization + demangler := TCEDDemangler.create; +finalization + demangler.Free; +end. diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas index e704eec6..2fd49c51 100644 --- a/src/ce_dubproject.pas +++ b/src/ce_dubproject.pas @@ -1094,8 +1094,6 @@ begin end; {$ENDREGION} -{$ENDREGION --------------------------------------------------------------------} - {$REGION Miscellaneous DUB free functions --------------------------------------} function sdl2json(const filename: string): TJSONObject; var diff --git a/src/ce_gdb.pas b/src/ce_gdb.pas index 62167d59..ee13ea85 100644 --- a/src/ce_gdb.pas +++ b/src/ce_gdb.pas @@ -9,7 +9,8 @@ uses PropEdits, GraphPropEdits, RTTIGrids, Dialogs, ExtCtrls, Menus, Buttons, StdCtrls, process, fpjson, ce_common, ce_interfaces, ce_widget, ce_processes, ce_observer, ce_synmemo, - ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf; + ce_sharedres, ce_stringrange, ce_dsgncontrols, ce_dialogs, ce_dbgitf, + ce_ddemangle; type @@ -533,7 +534,7 @@ begin str := fProj.outputFilename; if not str.fileExists then exit; - // TODO-cDBG: detect finish event and notifiy the observers. + // TODO-cGDB: detect finish event and notifiy the observers. subjDebugStart(fSubj, self as ICEDebugger); // gdb process killGdb; @@ -543,7 +544,7 @@ begin fgdb.Parameters.Add(str); fgdb.Parameters.Add('--interpreter=mi'); fGdb.OnReadData:= @gdboutQuiet; - fGdb.OnTerminate:= @gdboutQuiet; + fGdb.OnTerminate:= @gdboutJsonize; fgdb.execute; // file:line breakpoints storeObserversBreakpoints; @@ -571,8 +572,8 @@ begin gdbCommand('break _d_array_bounds'); gdbCommand('break _d_arraybounds'); gdbCommand('break _d_switch_error'); - fGdb.OnReadData := @gdboutJsonize; gdbCommand('-gdb-set mi-async on'); + fGdb.OnReadData := @gdboutJsonize; // launch gdbCommand('run'); end; @@ -915,7 +916,7 @@ begin // TODO-cGDB: demangle function name. val := obj.Find('func'); if val.isNotNil then - func:= val.AsString; + func:= demangle(val.AsString); val := obj.Find('addr'); if val.isNotNil then addr := val.AsInt64; diff --git a/src/ce_messages.pas b/src/ce_messages.pas index cce53084..3bc2bfa9 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -7,7 +7,7 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, EditBtn, lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, math, - TreeFilterEdit, Buttons, process, GraphType, fgl, + TreeFilterEdit, Buttons, process, GraphType, fgl,ce_ddemangle, ce_writableComponent, ce_common, ce_synmemo, ce_interfaces, ce_observer, ce_processes, ce_sharedres, ce_stringrange, ce_dsgncontrols; @@ -22,7 +22,6 @@ type TMessageData = record ctxt: TCEAppMessageCtxt; data: Pointer; - demangled: boolean; end; TCEMessagesOptions = class(TWritableLfmTextComponent) @@ -82,7 +81,6 @@ type procedure TreeFilterEdit1ButtonClick(Sender: TObject); private fEditorMessagePos: TCEEditorMessagePos; - fDemanglerAvailable: boolean; fMsgColors: array[TCEAppMessageKind] of TColor; fProjCompile: boolean; fActAutoSel: TAction; @@ -99,15 +97,11 @@ type fAutoSelect: boolean; fSingleClick: boolean; fastDisplay: boolean; - fDemangler: TCEProcess; fOptions: TCEMessagesOptions; fOptionsBackup: TCEMessagesOptions; fBtns: array[TCEAppMessageCtxt] of TToolButton; - fToDemangle: TStringList; - fToDemangleObjs: TFPList; fFiltering: boolean; function itemShouldBeVisible(item: TTreeNode; aCtxt: TCEAppMessageCtxt): boolean; - procedure demanglerOutput(sender: TObject); procedure filterMessages(aCtxt: TCEAppMessageCtxt); procedure clearOutOfRangeMessg; procedure actDemangleExecute(Sender: TObject); @@ -124,8 +118,6 @@ type procedure selCtxtClick(Sender: TObject); function iconIndex(aKind: TCEAppMessageKind): Integer; procedure handleMessageClick(Sender: TObject); - procedure callDemangler; - procedure freeDemangler; // procedure setColorError(value: TColor); procedure setColorInfo(value: TColor); @@ -332,9 +324,6 @@ begin fOptions.AssignTo(self); end; // - fToDemangle := TStringList.Create; - fToDemangleObjs:= TFPList.Create; - // EntitiesConnector.addObserver(self); EntitiesConnector.addSingleService(self); end; @@ -342,9 +331,6 @@ end; destructor TCEMessagesWidget.destroy; begin fEditorMessagePos.Free; - fToDemangle.Free; - FreeAndNil(fToDemangleObjs); - freeDemangler; fOptions.saveToFile(getCoeditDocPath + optname); EntitiesConnector.removeObserver(self); inherited; @@ -363,12 +349,6 @@ var begin if node.data.isNotNil then Dispose(PMessageData(Node.Data)); - if fToDemangleObjs.isNotNil then - begin - i := fToDemangleObjs.IndexOf(node); - if i <> -1 then if i < fToDemangleObjs.Count then - fToDemangleObjs.Items[i] := nil; - end; end; procedure TCEMessagesWidget.ListKeyDown(Sender: TObject; var Key: Word; @@ -576,8 +556,11 @@ begin end; procedure TCEMessagesWidget.actDemangleExecute(Sender: TObject); +var + i: integer; begin - callDemangler; + for i:= 0 to List.SelectionCount-1 do + list.Selections[i].Text := demangle(list.Selections[i].Text); end; procedure TCEMessagesWidget.actAutoSelExecute(Sender: TObject); @@ -786,7 +769,6 @@ begin dt := new(PMessageData); dt^.data := aData; dt^.ctxt := aCtxt; - dt^.demangled:=false; if fAutoSelect then if fCtxt <> aCtxt then fBtns[aCtxt].Click; if fastDisplay then @@ -844,73 +826,6 @@ end; {$ENDREGION} {$REGION Messages --------------------------------------------------------------} -procedure TCEMessagesWidget.callDemangler; -var - dat: PMessageData; - i: integer; - str: string; -const - toolname = 'ddemangle' + exeExt; -begin - fDemanglerAvailable:= exeInSysPath(toolname); - if not fDemanglerAvailable then - exit; - // - fDemangler := TCEProcess.Create(nil); - fDemangler.Executable := exeFullName(toolname); - fDemangler.OnTerminate:= @demanglerOutput; - fDemangler.Options:= [poUsePipes]; - fDemangler.ShowWindow:= swoHIDE; - fToDemangle.Clear; - fToDemangleObjs.Clear; - for i := 0 to list.Items.Count-1 do - begin - if not list.Items.Item[i].Selected then continue; - dat := PMessageData(list.Items.Item[i].Data); - if dat^.demangled then continue; - dat^.demangled := true; - str := list.Items.Item[i].Text; - if str.isEmpty then continue; - fToDemangleObjs.add(list.Items.Item[i]); - fToDemangle.Add(str); - end; - if fToDemangle.Count > 0 then - begin - fDemangler.Execute; - for i := 0 to fToDemangle.Count-1 do - begin - str := fToDemangle[i] + LineEnding; - fDemangler.Input.Write(str[1], str.length); - end; - fDemangler.CloseInput; - end; -end; - -procedure TCEMessagesWidget.demanglerOutput(sender: TObject); -var - itm: TTreeNode; - i: integer; -begin - fToDemangle.LoadFromStream(fDemangler.OutputStack); - for i := 0 to fToDemangleObjs.Count -1 do - begin - itm := TTreeNode(fToDemangleObjs.Items[i]); - if itm.isNil then continue; - itm.Text := fToDemangle[i]; - end; - freeDemangler; -end; - -procedure TCEMessagesWidget.freeDemangler; -begin - if fDemangler.isNil then - exit; - // - if fDemangler.Active then - fDemangler.Terminate(0); - FreeAndNil(fDemangler); -end; - procedure TCEMessagesWidget.updateLoop; begin if fastDisplay then