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

   1 type
   2   trtabrec=record
   3     name : string[12];
   4     idx  : longint;
   5   end;
   6
   7 const
   8   trtab : array[0..10] of trtabrec=(
   9     (name:'general';idx:1000),
  10     (name:'scan';idx:2000),
  11     (name:'parser';idx:3000),
  12     (name:'type';idx:4000),
  13     (name:'sym';idx:5000),
  14     (name:'cg';idx:6000),
  15     (name:'asmr';idx:7000),
  16     (name:'asmw';idx:8000),
  17     (name:'exec';idx:9000),
  18     (name:'unit';idx:10000),
  19     (name:'option';idx:11000)
  20   );
  21
  22 var
  23   t,f : text;
  24   s,hs : string;
  25   i,j,k : longint;
  26 begin
  27   assign(t,paramstr(1));
  28   reset(t);
  29   assign(f,'errorm.msg');
  30   rewrite(f);
  31   while not eof(t) do
  32    begin
  33      readln(t,s);
  34      if (s<>'') and not(s[1] in ['#','%']) then
  35       begin
  36         if copy(s,1,11)='option_info' then
  37          delete(s,1,13)
  38         else
  39         if copy(s,1,2)='ol' then
  40          delete(s,1,6)
  41         else
  42         for i:=0 to 10 do
  43          if Copy(s,1,length(trtab[i].name))=trtab[i].name then
  44           begin
  45             j:=pos('=',s);
  46             if j>0 then
  47              begin
  48                inc(j);
  49                if s[j] in ['0'..'9'] then
  50                 begin
  51                   k:=j;
  52                   while (s[k] in ['0'..'9']) do
  53                    inc(k);
  54                   if s[k]='_' then
  55                    inc(k);
  56                   delete(s,j,k-j);
  57                 end;
  58                str(trtab[i].idx,hs);
  59                while length(hs)<5 do
  60                 hs:='0'+hs;
  61                hs:=hs+'_';
  62                inc(trtab[i].idx);
  63                insert(hs,s,j);
  64              end;
  65             break;
  66           end;
  67       end;
  68      writeln(f,s);
  69    end;
  70   close(f);
  71   close(t);
  72   erase(t);
  73   rename(f,paramstr(1));
  74 end.
  75