📄 excunmangle.pas
字号:
kind := kind or UM_VIRDEF_FLAG;
end
else
begin
copy_string('__linkproc__ ', 13);
copy_name(False);
kind := kind or UM_LINKER_PROC;
end;
Exit;
end;
'%': {TMPLCODE} (* template name *)
begin
c := advance;
if (c = 'S') or (c = 'D') then
if (StrLComp(source, 'Set$', 4) <> 0) or
(StrLComp(source, 'DynamicArray$', 13) <> 0) or
(StrLComp(source, 'SmallString$', 12) <> 0) or
(StrLComp(source, 'DelphiInterface$', 16) <> 0) then isDelphi4name := True;
(* Output the base name of the template. We use
'copy_name' instead of 'copy_until', since
this could be a template constructor name,
for example. *)
copy_name(True);
assert(input = ARGLIST);
advance();
if (target - 1)^ = '<' then copy_char(' ');
copy_char('<');
(* Copy the template arguments over. Also, save
the 'set_qual' variable, since we don't want
to mix up the status of the currently known
qualifier name with a name from a template
argument, for example. *)
save_setqual := set_qual;
set_qual := False;
if isDelphi4name then copy_delphi4args(TMPLCODE, True)
else copy_args(TMPLCODE, True);
set_qual := save_setqual;
if (target - 1)^ = '>' then copy_char(' ');
copy_char('>');
assert(input = TMPLCODE);
advance();
if input <> QUALIFIER then kind := kind or UM_TEMPLATE;
end;
'$': {ARGLIST} (* special name, or arglist *)
begin
if tmplname then Exit;
c := advance;
if c = 'x' then
begin
c := advance;
if (c = 'p') or (c = 't') then
begin
assert(advance = ARGLIST);
advance;
copy_string('__tpdsc__ ', 10);
copy_type(target, False);
kind := (kind and not(UM_KINDMASK)) or UM_TPDSC;
Exit;
end
else
raise EFinishUnmangle.Create('What happened?');
end;
if c = 'b' then
begin
c := advance;
start := source;
startidx := srcindx;
if ((c = 'c') or (c = 'd')) and (advance = 't') and (advance = 'r') then
begin
(* The actual outputting of the name will happen outside of this function,
to be sure that we don't include any special name characters. *)
//dimus - need one more advance here to skip last special name char
advance;
if c = 'c' then kind := (kind and (not UM_KINDMASK)) or UM_CONSTRUCTOR
else kind := (kind and (not UM_KINDMASK)) or UM_DESTRUCTOR;
goto AFTER_CASE;
end;
source := start;
srcindx := startidx;
copy_string('operator ', 9);
start := target;
copy_until1(ARGLIST);
target^ := #0;
target := start;
copy_op(start);
kind := (kind and (not UM_KINDMASK)) or UM_OPERATOR;
end
else if c = 'o' then
begin
advance;
copy_string('operator ', 9);
save_setqual := set_qual;
set_qual := False;
copy_type(target, False);
set_qual := save_setqual;
assert(input = ARGLIST);
kind := (kind and (not UM_KINDMASK)) or UM_CONVERSION;
end
else if c = 'v' then
begin
c := advance;
if c = 's' then
begin
c := advance;
assert( (c = 'f') or (c = 'n') );
advance;
copy_string('__vdthk__', 9);
kind := (kind and (not UM_KINDMASK)) or UM_VRDF_THUNK;
end
else if c = 'c' then
begin
c := advance;
assert(c = '1');
c := advance;
assert(c = '$');
c := advance;
copy_string('__thunk__ [', 11);
kind := (kind and (not UM_KINDMASK)) or UM_THUNK;
copy_char(c);
copy_char(',');
while True do
begin
c := advance;
if c <> '$' then copy_char(c) else Break;
end;
copy_char(',');
while True do
begin
c := advance;
if c <> '$' then copy_char(c) else Break;
end;
copy_char(',');
while True do
begin
c := advance;
if c <> '$' then copy_char(c) else Break;
end;
copy_char(']');
advance; (* skip last '$' *)
Exit;
end;
end // else if c = 'v' then
else
raise EFinishUnmangle.Create('Unknown special name');
end;
'_':
begin
start := source;
startidx := srcindx;
if advance = '$' then
begin
c := advance;
(* At the moment there are five kind of special names:
frndl FL friend list
chtbl CH catch handler table
odtbl DC object destructor table
thrwl TL throw list
ectbl ECT exception context table
*)
copy_char('_');
copy_char('_');
case (Word(source[0]) shl 8) or Word(source[1]) of
$464c: (* FL *)
begin
copy_string('frndl', 5);
kind := kind or UM_FRIEND_LIST;
end;
$4348: (* CH *)
begin
copy_string('chtbl', 5);
kind := kind or UM_CTCH_HNDL_TBL;
end;
$4443: (* DC *)
begin
copy_string('odtbl', 5);
kind := kind or UM_OBJ_DEST_TBL;
end;
$544c: (* TL *)
begin
copy_string('thrwl', 5);
kind := kind or UM_THROW_LIST;
end;
$4543: (* EC(T) *)
begin
copy_string('ectbl', 5);
kind := kind or UM_EXC_CTXT_TBL;
end;
end; // case
copy_char('_');
copy_char('_');
copy_char(' ');
while (c >= 'A') and (c <= 'Z') do c := advance;
assert(c = '$');
assert(advance = '@');
advance;
copy_name(False);
Exit;
end;
source := start;
srcindx := startidx;
copy_until2(QUALIFIER, ARGLIST);
end;
else (* qualifier, member, plain *) // case
copy_until2(QUALIFIER, ARGLIST);
end; // big "case c of"
AFTER_CASE:
(* If we're processing a template name, then '$' is allowed to end the name. *)
c := input;
assert( (c = #0) or (c = QUALIFIER) or (c = ARGLIST) );
if c = QUALIFIER then
begin
c := advance;
if set_qual then
begin
prevqual := qualend;
qualend := target;
end;
copy_class_delimiter;
if c = #0 then kind := (kind and (not UM_KINDMASK)) or UM_VTABLE;
end
else
break; // out of big "while TRUE"
end; // while TRUE
end;
{$HINTS ON}
{ --------------------------- Main function body ------------------------- }
{$HINTS OFF}
label
NOT_PASCAL,FINISH;
var
c: Char;
p: PChar;
i,len: Integer;
start: PChar;
begin
assert(maxlen <= MAXBUFFLEN);
(* Quick check to see whether this name is even mangled or not. *)
if src = nil then
begin
Result := UM_NOT_MANGLED;
Exit;
end;
if dest = nil then
begin
Result := UM_ERROR;
Exit;
end;
if src^ <> '@' then
begin
StrLCopy(dest, src, maxlen);
dest[maxlen - 1] := #0;
Result := UM_NOT_MANGLED;
Exit;
end;
(* All mangled names begin with an '@' character. *)
srcbase := src;
Inc(src); (* skip the initial '@' *)
srcindx := 1;
(* Slightly ugly code for turning an uppercase pascal name into a
lowercase equivalent. *)
len := StrLen(src);
p := src;
for i := 0 to len-1 do
if (p^ >= 'a') and (p^ <= 'z') then goto NOT_PASCAL
else Inc(p);
StrLower( src );
NOT_PASCAL:
(* This is at LEAST a member name, if not a fully mangled
template or function name. So, begin outputting the
subnames. We set up the pointers in globals so that we don't
have to pass everything around all the time. *)
kind := UM_UNKNOWN;
source := src;
prevqual := nil;
qualend := nil;
basename := nil;
base_end := nil;
set_qual := True;
target := dest;
targbase := dest;
targend := targbase + (maxlen - 1);
(* If anyone long jumps, it means a hash code was reached, the
destination buffer reached its end, or the source buffer
was terminated. *)
try
(* Start outputting the qualifier names and the base name. *)
namebase := target;
copy_name(False);
set_qual := False;
base_end := target;
if ((kind and UM_KINDMASK) = UM_TPDSC) or ((kind and UM_SPECMASK) <> 0) then
begin
p := StrScan(namebase, ' ');
namebase := p + 1;
end;
if ((kind and UM_KINDMASK) = UM_CONSTRUCTOR) or ((kind and UM_KINDMASK) = UM_DESTRUCTOR) then
begin
if (kind and UM_KINDMASK) = UM_DESTRUCTOR then copy_char('~');
if prevqual = nil then start := namebase
else start := prevqual + 2;
len := qualend - start;
StrLCopy(buff, start, len);
buff[len] := #0;
copy_string(buff, len);
end;
(* If there's a function argument list, copy it over in expanded
form. *)
if (input = ARGLIST) and doArgs then (* function args *)
begin
c := advance;
assert( (c = 'q') or (c = 'x') or (c = 'w') );
(* Output the function parameters, and return type in
the case of template function specializations. *)
set_qual := False;
adjust_quals := True;
copy_type(namebase, False);
if (kind and UM_KINDMASK) = UM_UNKNOWN then kind := kind or UM_FUNCTION;
end
else if (kind and UM_KINDMASK) = UM_UNKNOWN then kind := kind or UM_DATA
else if vtbl_flags[0] <> #0 then
begin
copy_char(' ');
copy_char('(');
copy_string(vtbl_flags, 0);
copy_char(')');
end;
except
(* If we reached this exit point because the target did not contain enough space,
or a hash code was reached, then output a trailer to let the user know that there
was more data in the source string. *)
if source^ <> #0 then
begin
if target + 3 < targend then
begin
copy_char('.');
copy_char('.');
copy_char('.');
end
else
begin
Dec(target); target^ := '.';
Dec(target); target^ := '.';
Dec(target); target^ := '.';
end;
end;
end;
FINISH:
(* Put some finishing touches on the kind of this entity. *)
if qualend <> nil then kind := kind or UM_QUALIFIED;
(* Put a terminator on the target. *)
target^ := #0;
(* If the user wanted the qaulifier and base name saved, then do it now. *)
if (kind and UM_ERRMASK) = 0 then
begin
if qualP <> nil then
begin
qualP^ := #0;
if (qualend <> nil) and (qualend <> nil) then
begin
len := qualend - namebase;
StrLCopy(qualP, namebase, len);
qualP[len] := #0;
end;
end;
if baseP <> nil then
begin
baseP^ := #0;
if (basename <> nil) and (base_end <> nil) then
begin
len := base_end - basename;
StrLCopy(baseP, basename, len);
baseP[len] := #0;
end;
end;
end;
Result := kind;
end;
{$HINTS ON}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -