excunmangle.pas

一个异常处理的类

HANDLE_TYPE:
 if c in ['0'..'9'] then   (* enum or class name *)
   begin
     i := 0;
     repeat (* compute length *)
       i := i * 10 + (Ord(c) - Ord('0'));
       c := advance;
     until not(c in ['0'..'9']);

     (* In order to output only the name indicated, we fake
                   the unmangler by making it appear as though there
                   were nothing else left in the string. *)

     p := source;
     for len := i-1 downto 0 do
       begin
         assert(p^ <> #0);
         if (p - srcbase) > CONTENT_LEN then
           begin
             kind := kind or UM_HASHTRUNC;
             raise EFinishUnmangle.Create('');
           end;
         Inc(p);
       end;

  (* Output whether this class name was const or
                   volatile. *)

     if is_const <> 0 then copy_string('const ', 6);
     if is_volatile <> 0 then copy_string('volatile ', 9);

     savechar := (source + i)^;
     (source + i)^ := #0;

     copy_name(False);

     source^ := savechar;

     Exit;
   end;

 savechar := c;

 case c of
   'v': tname := 'void';
   'c': tname := 'char';
   'b': tname := 'wchar_t';
   's': tname := 'short';
   'i': tname := 'int';
   'l': tname := 'long';
   'f': tname := 'float';
   'd': tname := 'double';
   'g': tname := 'long double';
   'j': tname := '__int64';
   'o': tname := 'bool';
   'e': tname := '...';

   'M':    (* member pointer *)
       begin
        name := target;

        (* We call 'copy_type' because it knows how to extract length-prefixed names. *)

        advance;
        copy_type(target, False);

        len := target - name;
        if len > MAXBUFFLEN - 1 then len := MAXBUFFLEN - 1;
        StrLCopy(buff, name, len);
        buff[len] := #0;

        target := name;
       end;

   'r',    (* reference *)
   'p':    (* pointer *)
       begin
        c := advance;

        if c = 'q' then  (* function pointer *)
          begin
           copy_char('(');

           if savechar = 'M' then
             begin
              copy_string(buff, 0);
              copy_class_delimiter;
             end;

           copy_char('*');
           copy_char(')');

           savechar := c;
          end;

        copy_type(start, False);

        case savechar of
          'r': copy_char('&');
          'p':
              begin
               copy_char(' ');
               copy_char('*');
              end;
          'M':
              begin
               copy_char(' ');
               copy_string(buff, 0);
               copy_class_delimiter;
               copy_char('*');
              end;
        end;
       end;

   'a':    (* array *)
       begin
          i := 0;

          repeat
           c := advance();
           dims[i] := '[';
           Inc(i);
           if c = '0' then c := advance; (* 0 size means unspecified *)
           while c <> '$' do (* collect size, up to '$' *)
             begin
               dims[i] := c;
               Inc(i);
               c := advance;
             end;
             assert(c = '$');
             c := advance;
             dims[i] := ']';
             Inc(i);
          until c <> 'a'; (* collect all dimensions *)
          dims[i] := #0;
          copy_type(target, False);
          copy_string(dims, 0);
       end;

   'q':    (* function *)
       begin
          callconv := nil;
          regconv  := nil;

          (* We want the return type first, but find it last. So
                           we emit all but the return type, get the return type,
                           then shuffle to get them in the right place. *)

          while True do
            begin
               if advance <> 'q' then Break;
               case advance of
                 'c': callconv := '__cdecl ';
                 'p': callconv := '__pascal ';
                 'r': callconv := '__fastcall ';
                 'f': callconv := '__fortran ';
                 's': callconv := '__stdcall ';
                 'y': callconv := '__syscall ';
                 'i': callconv := '__interrupt ';
                 'g': regconv  := '__saveregs ';
               end;
            end;

          save_adjqual := adjust_quals;
          adjust_quals := False;

          copy_char('(');
          copy_args('$', False);
          copy_char(')');

          adjust_quals := save_adjqual;

          hasret := Integer(input = '$');
          if (hasret <> 0) then advance;

          if (hasret <> 0) or (callconv <> nil) or (regconv <> nil) then
            copy_return_type(start, callconv, regconv, hasret);
       end;

   else
       raise EFinishUnmangle.Create('Unknown type');
 end; // case

 if tname <> nil then
   begin
      if is_const    <> 0 then copy_string('const ', 6);
      if is_volatile <> 0 then copy_string('volatile ', 9);
      if is_signed   <> 0 then copy_string('signed ', 7);
      if is_unsigned <> 0 then copy_string('unsigned ', 9);

      if (not arglvl) or (savechar <> 'v') then copy_string(tname, 0);

      advance;
   end
 else
   begin
      if is_const <> 0 then copy_string(' const', 6);
      if is_volatile <> 0 then copy_string(' volatile', 9);
   end;
end;
{$HINTS ON}

procedure copy_delphi4args( argsend: Char; tmplargs: Boolean );
var
  c,termchar: char;
  first,i_T_passed: Boolean;
  argsbegin,start: PChar;
begin
 c := input();
 first := True;
 termchar := #0;

 while (c <> #0) and (c <> argsend) do
   begin
     if first then first := False
     else
        begin
          copy_char(',');
          copy_char(' ');
        end;

     argsbegin := source;
     start := target;

     advance;      (* skip the kind character *)

     i_T_passed := False;

     if c = 'T' then
        begin
          copy_string('<type ', 6);
          termchar := '>';
          i_T_passed := True;
        end
     else if c = 'i' then
        if (argsbegin^ = '4') and (StrLComp(argsbegin + 1, 'bool', 4) = 0) then
          begin
            if input = '0' then copy_string('false', 5)
                           else copy_string('true', 4);
            advance;
            i_T_passed := True;
          end;

     if not i_T_passed then
       case c of
         't': copy_type(target, not tmplargs);
         'j',
         'g',
         'e':
             begin
               copy_type(target, not tmplargs);
               target := start;
               assert(input = '$');
               advance();
               copy_until2('$', TMPLCODE);
               if termchar <> #0 then copy_char(termchar);
             end;

         'm':
             begin
               copy_type(target, not tmplargs);
               target := start;
               assert(input = '$');
               advance;
               copy_until1('$');
               copy_class_delimiter;
               copy_char('*');
               copy_until2('$', TMPLCODE);
             end;

         else
               raise EFinishUnmangle.Create('Unknown template arg kind');
       end; // case

     c := input;
     if c <> argsend then
       begin
         assert(c = '$');
         c := advance;
       end;
   end;
end;

procedure copy_args( argsend: Char; tmplargs: Boolean);
var
  c,termchar: Char;
  first,scanned,i_T_passed: Boolean;
  argsbegin,start: PChar;
  startidx,param_index,index: Integer;
  param_table: array[0..PTABLE_LEN-1] of TParamEntry;
begin
 c := input();
 first := True;
 param_index := 0;

 FillChar( param_table, sizeof(TParamEntry) * PTABLE_LEN, 0 );

 while (c <> #0) and (c <> argsend) do
   begin
     if first then first := False
     else
        begin
          copy_char(',');
          copy_char(' ');
        end;

      argsbegin := source;
      startidx  := srcindx;
      start     := target;

      param_table[param_index].targpos := target;

      scanned := False;

      while (c = 'x') or (c = 'w') do
      begin
       scanned := True;
       c := advance;
      end;

      if scanned and (c <> 't') then
      begin
       source  := argsbegin;
       srcindx := startidx;
      end;

      if c <> 't' then copy_type(target, not tmplargs)
      else
        begin
         c := advance;

         if c in ['0'..'9'] then index := Ord(c) - Ord('0')
                            else index := (Ord(c) - Ord('a')) + 10;
         Dec(index);

         assert(param_table[index].targpos <> nil);
         assert(param_table[index].len > 0);

         StrLCopy( buff, param_table[index].targpos, param_table[index].len);
         buff[param_table[index].len] := #0;
         copy_string(buff, 0);
         advance;
        end;

        param_table[param_index].len := target - param_table[param_index].targpos;
        Inc(param_index);

        c := input;

        if tmplargs and (c = '$') then (* non-type template argument *)
        begin
           termchar := #0;

           target := start;

           c := advance;
           advance;

           i_T_passed := False;

           if c = 'T' then
              begin
                copy_string('<type ', 6);
                termchar := '>';
                i_T_passed := True;
              end
           else if c = 'i' then
              if (argsbegin^ = '4') and (StrLComp(argsbegin + 1, 'bool', 4) = 0) then
                begin
                  if input = '0' then copy_string('false', 5)
                                 else copy_string('true', 4);
                  advance;
                  i_T_passed := True;
                end;

           if not i_T_passed then
             case c of
               'j',
               'g',
               'e':
                    begin
                      copy_until1('$');
                      if termchar <> #0 then copy_char(termchar);
                    end;

               'm':
                    begin
                      copy_until1('$');
                      copy_class_delimiter;
                      copy_char('*');
                      copy_until1('$');
                    end;
               else
                    raise EFinishUnmangle.Create('Unknown template arg kind');
             end; // case

           assert(input = '$');
           c := advance;
        end; // if
   end;
end;

{$HINTS OFF}
procedure copy_name( tmplname: Boolean );
label
  AFTER_CASE;
var
  c: Char;
  start: PChar;
  startidx,flags: Integer;
  save_setqual,isDelphi4name: Boolean;
begin
 c := input();
 isDelphi4name := False;

 (* Start outputting the qualifier names and the base name. *)

 while TRUE do
   begin
      if set_qual then basename := target;

      (* Examine the string to see what this is.  Either it's
                       a qualifier name, a member name, a function name, a
                       template name, or a special name.  We wouldn't be
                       here if this were a regular name. *)

      if c in ['0'..'9'] then
        begin
         (* If there's a number at the beginning of a name,
            it could only be a vtable symbol flag. *)

         flags := Ord(c) - Ord('0') + 1;

         vtbl_flags[0] := #0;

         if (flags and $01 <> 0) then StrCat(vtbl_flags, 'huge');

         if (flags and $02 <> 0) then
         begin
          if vtbl_flags[0] <> #0 then strcat(vtbl_flags, ', ');
          strcat(vtbl_flags, 'fastthis');
         end;

         if (flags and $04 <> 0) then
         begin
          if vtbl_flags[0] <> #0 then strcat(vtbl_flags, ', ');
          strcat(vtbl_flags, 'rtti');
         end;

         kind := (kind and not(UM_KINDMASK)) or UM_VTABLE;

         c := advance;
         assert((c = #0) or (c = '$'));
        end;

      case c of
        '@': {QUALIFIER} (* virdef flag or linker proc *)
             begin
               c := advance;
               if c = '$' then
                 begin
                    assert(advance = 'c');
                    assert(advance = 'f');
                    assert(advance = '$');
                    assert(advance = '@');

                    copy_string('__vdflg__ ', 10);
                    advance;
                    copy_name(False);