gppc386.pp 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Pierre Muller
  4. This program allows to run the Makefiles
  5. with the compiler running inside GDB
  6. GDB only stops if there is something special
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  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. You should have received a copy of the GNU General Public License
  16. along with this program; if not, write to the Free Software
  17. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18. ****************************************************************************}
  19. program fpc_with_gdb;
  20. {
  21. This program uses several files :
  22. -- 'gdb4fpc.ini' contains the standard breakpoints (see below)
  23. -- 'gdb.fpc' is an optional file that can contain any other
  24. instruction that GDB should do before starting.
  25. Note that if gdb.fpc is present, no "run" command is
  26. inserted if gdb4fpc.ini is found
  27. but it can be inserted in gdb.fpc itself
  28. }
  29. uses
  30. dos;
  31. const
  32. {$ifdef Unix}
  33. GDBExeName = 'gdbpas';
  34. GDBIniName = '.gdbinit';
  35. DefaultCompilerName = 'ppc386';
  36. {$else}
  37. {$ifdef win32}
  38. GDBExeName = 'gdbpasw.exe';
  39. {$else not win32}
  40. GDBExeName = 'gdbpas.exe';
  41. {$endif win32}
  42. GDBIniName = 'gdb.ini';
  43. DefaultCompilerName = 'ppc386.exe';
  44. {$endif not linux}
  45. { If you add a gdb.fpc file in a given directory }
  46. { GDB will read it; this allows you to add }
  47. { special tests in specific directories PM }
  48. FpcGDBIniName = 'gdb.fpc';
  49. GDBIniTempName = 'gdb4fpc.ini';
  50. var
  51. fpcgdbini : text;
  52. CompilerName,Dir,Name,Ext : String;
  53. GDBError,GDBExitCode,i : longint;
  54. begin
  55. fsplit(paramstr(0),Dir,Name,Ext);
  56. if (length(Name)>3) and (UpCase(Name[1])='G') then
  57. CompilerName:=Copy(Name,2,255)+Ext
  58. else
  59. CompilerName:=DefaultCompilerName;
  60. { support for info functions directly : used in makefiles }
  61. if (paramcount=1) and (pos('-i',Paramstr(1))=1) then
  62. begin
  63. Exec(fsearch(CompilerName,GetEnv('PATH')),Paramstr(1));
  64. exit;
  65. end;
  66. if fsearch(GDBIniTempName,'./')<>'' then
  67. begin
  68. Assign(fpcgdbini,GDBIniTempName);
  69. erase(fpcgdbini);
  70. end;
  71. Assign(fpcgdbini,GdbIniTempName);
  72. Rewrite(fpcgdbini);
  73. Writeln(fpcgdbini,'set language pascal');
  74. Writeln(fpcgdbini,'b SYSTEM_EXIT');
  75. Writeln(fpcgdbini,'cond 1 EXITCODE <> 0');
  76. Writeln(fpcgdbini,'b INTERNALERROR');
  77. Writeln(fpcgdbini,'b HANDLEERRORADDRFRAME');
  78. Writeln(fpcgdbini,'set $_exitcode := -1');
  79. Write(fpcgdbini,'set args');
  80. { this will not work correctly if there are " or '' inside the command line :( }
  81. for i:=1 to Paramcount do
  82. begin
  83. if pos(' ',Paramstr(i))>0 then
  84. Write(fpcgdbini,' "'+ParamStr(i)+'"')
  85. else
  86. Write(fpcgdbini,' '+ParamStr(i));
  87. end;
  88. Writeln(fpcgdbini);
  89. if fsearch(FpcGDBIniName,'./')<>'' then
  90. begin
  91. Writeln(fpcgdbini,'source '+FpcGDBIniName);
  92. end
  93. else
  94. Writeln(fpcgdbini,'run');
  95. Writeln(fpcgdbini,'if ($_exitcode = -1)');
  96. Writeln(fpcgdbini,' echo Program not completed');
  97. Writeln(fpcgdbini,'else');
  98. Writeln(fpcgdbini,' quit');
  99. Writeln(fpcgdbini,'end');
  100. Close(fpcgdbini);
  101. Exec(fsearch(GDBExeName,GetEnv('PATH')),
  102. {$ifdef win32}
  103. '--nw '+
  104. {$endif win32}
  105. '--nx --quiet --command='+GDBIniTempName+' '+CompilerName);
  106. GDBError:=DosError;
  107. GDBExitCode:=DosExitCode;
  108. if (GDBError<>0) or (GDBExitCode<>0) then
  109. begin
  110. Writeln('Error running GDB');
  111. if (GDBError<>0) then
  112. Writeln('DosError = ',GDBError);
  113. if (GDBExitCode<>0) then
  114. Writeln('DosExitCode = ',GDBExitCode);
  115. if GDBExitCode<>0 then
  116. RunError(GDBExitCode)
  117. else
  118. RunError(GDBError);
  119. end
  120. else
  121. Erase(fpcgdbini);
  122. end.
  123. {
  124. $Log$
  125. Revision 1.5 2002-12-06 17:51:11 peter
  126. * merged cdecl and array fixes
  127. Revision 1.4 2002/06/02 09:44:17 marco
  128. * linux
  129. Revision 1.3 2002/05/18 13:34:27 peter
  130. * readded missing revisions
  131. }