llvmpi.pas 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100
  1. {
  2. Copyright (c) 2016 by Jonas Maebe
  3. Information about the current procedure that is being compiled
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit llvmpi;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cclasses,
  22. aasmbase,
  23. procinfo,
  24. cpupi;
  25. type
  26. tllvmprocinfo = class(tcpuprocinfo)
  27. private
  28. fexceptlabelstack: tfplist;
  29. public
  30. constructor create(aparent: tprocinfo); override;
  31. destructor destroy; override;
  32. procedure pushexceptlabel(lab: TAsmLabel);
  33. { returns true if there no more exception labels on the stack }
  34. function popexceptlabel(lab: TAsmLabel): boolean;
  35. function CurrExceptLabel: TAsmLabel;
  36. end;
  37. implementation
  38. uses
  39. globtype,verbose,systems,
  40. symtable;
  41. constructor tllvmprocinfo.create(aparent: tprocinfo);
  42. begin
  43. inherited;
  44. fexceptlabelstack:=tfplist.create;
  45. end;
  46. destructor tllvmprocinfo.destroy;
  47. begin
  48. if fexceptlabelstack.Count<>0 then
  49. Internalerror(2016121301);
  50. fexceptlabelstack.free;
  51. inherited;
  52. end;
  53. procedure tllvmprocinfo.pushexceptlabel(lab: TAsmLabel);
  54. begin
  55. fexceptlabelstack.add(lab);
  56. end;
  57. function tllvmprocinfo.popexceptlabel(lab: TAsmLabel): boolean;
  58. begin
  59. if CurrExceptLabel<>lab then
  60. internalerror(2016121302);
  61. fexceptlabelstack.count:=fexceptlabelstack.count-1;
  62. result:=fexceptlabelstack.count=0;
  63. end;
  64. function tllvmprocinfo.CurrExceptLabel: TAsmLabel; inline;
  65. begin
  66. result:=TAsmLabel(fexceptlabelstack.last);
  67. if not assigned(result) then
  68. internalerror(2016121703);
  69. end;
  70. begin
  71. if not assigned(cprocinfo) then
  72. begin
  73. writeln('Internalerror 2018052005');
  74. halt(1);
  75. end;
  76. cprocinfo:=tllvmprocinfo;
  77. end.