+3 8(066) 185-39-18
fПредмет:
Тип роботи:
Курсова робота
К-сть сторінок:
82
Мова:
Українська
style="text-align: justify;"> if (def^.type_type=3) and (def^.hash_ofs<>0) then { object }
begin
build_list(obj_list2,buffer,add_only_offset(buffer,def^.hash_ofs));
lastlen:=length(lname);
lname:=lname+obj^.name+'.';
fpe(obj_list2,proc_list);
lname[0]:=char(lastlen);
destroy_list(obj_list2);
end;
end
end
else if ((obj^.obj_type and $7f) = proc_id) then
begin
Insert(lname+obj^.name,obj_info^.entry_ofs);
if (obj_info^.local_hash<>0) then
begin
build_list(obj_list2,buffer,add_only_offset(buffer,obj_info^.local_hash));
lastlen:=length(lname);
lname:=lname+obj^.name+'.';
fpe(obj_list2,proc_list);
lname[0]:=char(lastlen);
destroy_list(obj_list2);
end;
end;
current := current^.next;
end;
end;
end;
begin
with in_unit^ do
begin
if (obj_list = nil) and (buffer <> nil) then
build_list(obj_list,buffer,add_only_offset(buffer,header_ptr(buffer)^.ofs_hashtable));
end;
buffer:=in_unit^.buffer;
in_unit^.proc_list:=nil;
lname:='';
fpe(in_unit^.obj_list,in_unit^.proc_list);
end;
function find_proc_with_entry(in_unit:unit_list_ptr;entry:word):string;
var
act:proc_list_ptr;
begin
if entry=0 then
begin
find_proc_with_entry:='Startup code';
exit;
end;
find_proc_with_entry := '';
with in_unit^ do
begin
if (proc_list = nil) and (buffer <> nil) then
make_proc_list_entry(in_unit);
end;
act:=in_unit^.proc_list;
while act<>nil do
begin
if act^.entry=entry then
begin
find_proc_with_entry:=act^.name^;
break;
end;
act:=act^.next;
end;
end;
function find_name(unit_rec:unit_list_ptr;info_ofs:word):string;
{ Unreliable way to get a name from a pointer to its info }
var
i:word;
fname:string;
begin
with unit_rec^ do
begin
if buffer <> nil then
for i:=info_ofs-2 downto 0 do
if i+buffer^[i]+1 = info_ofs then
begin
move(buffer^[i],fname[0],buffer^[i]+1);
find_name := fname;
exit;
end;
end;
find_name := '';
end;
procedure write_var_type(type_unit,type_def_ofs:word);
var
type_obj : obj_ptr;
unit_ptr : unit_list_ptr;
begin
if type_unit > 0 then
begin
unit_ptr := get_unit(type_unit);
with unit_ptr^ do
begin
if buffer <> nil then
begin
type_obj := find_type(unit_ptr,type_def_ofs);
if type_obj <> nil then
write(type_obj^.name)
else
write_type_def(add_only_offset(buffer,type_def_ofs));
end
else
write(name,'.ofs',type_def_ofs);
end;
end
else
WriteError('type_unit not found');
end;
procedure write_var_info(var name:string; info:var_info_ptr);
var
orig_unit:unit_list_ptr;
f : var_flags;
begin
indent;
with info^ do
begin
if not (last_kind in [object_id,objpriv_id,record_id]) then
begin
f := flags*[const_flag,local,referenced,const_arg];
if f = [] then
write_general(var_id,'var',name,':'+oneindent)
else if f = [const_flag] then
write_general(const_id,'const',name,':'+oneindent)
else if f = [const_flag,local] then
write_general(var_id,'var',name,':'+oneindent)
else if f = [local] then
write_general(local_id,'local var',name,':'+oneindent)
else if f = [local,referenced] then
write_general(referenced_id,'referenced var',name,':'+oneindent)
else if f = [local,referenced,const_arg] then
write_general(refconst_id,'referenced const',name,':'+oneindent)
else
WriteError(' var flags = '+hexbyte(byte(flags))+oneindent);
end
else
write(name,':',oneindent);
write_var_type(type_unit,type_def_ofs);
if absolute in flags then
begin
write(' absolute ');
orig_unit