Код:
PROCEDURE ModOfCodeAddr (adr: Mem.AddrInt (* = INTEGER в стандартном ББ *)): Kernel.Module;
VAR m: Kernel.Module;
BEGIN
(* TODO: Кэшировать *)
m := Kernel.modList;
WHILE (m # NIL) & ~ ((m.code <= adr) & (adr < m.code + m.csize)) DO
m := m.next
END;
RETURN m
END ModOfCodeAddr;
PROCEDURE GetCallMod* (level: INTEGER; OUT mod: Kernel.Module);
VAR ebp, ret: INTEGER;
BEGIN
S.GETREG(5, ebp);
S.GET(ebp + 4, ret);
WHILE level > 0 DO
S.GET(ebp, ebp);
S.GET(ebp + 4, ret);
DEC(level)
END;
mod := ModOfCodeAddr(ret);
END GetCallMod;
PROCEDURE NameOfProcAddr (adr: Mem.AddrInt; OUT m: Kernel.Module; OUT name: ARRAY OF CHAR);
VAR ref, radr: Mem.AddrInt; s: Kernel.Name;
BEGIN
m := NIL; name := "";
Kernel.SearchProcVar(adr, m, adr);
IF m # NIL THEN
IF m.refcnt < 0 THEN
m := NIL
ELSE
ref := m.refs;
REPEAT
Kernel.GetRefProc(ref, radr, s)
UNTIL (radr = 0) OR (adr < radr);
IF adr < radr THEN
name := s$
ELSE
m := NIL
END
END
END
END NameOfProcAddr;
PROCEDURE GetCallProc* (level: INTEGER; OUT mod, proc: ARRAY OF CHAR);
VAR ebp, ret: INTEGER;
m: Kernel.Module;
BEGIN
S.GETREG(5, ebp);
S.GET(ebp + 4, ret);
WHILE level > 0 DO
S.GET(ebp, ebp);
S.GET(ebp + 4, ret);
DEC(level)
END;
NameOfProcAddr(ret, m, proc);
IF m # NIL THEN
mod := m.name$
ELSE
mod := ""
END
END GetCallProc;
Чисто имя модуля - GetCallMod.
С точностью до имени процедуры - GetCallProc.
level = 1 - непосредственно вызывающий уровень, 2 - ещё на уровень выше по стеку и т. д. (лучше было бы, наверное, в минус нумеровать).
Код вырезан из двух модулей, чтобы опубликовать здесь, мелочи могут быть некомпилируемы, но разберётесь.