development/compilers/freepascal/compiler/utils/gppc386.pp

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