+3 8(066) 185-39-18
fПредмет:
Тип роботи:
Курсова робота
К-сть сторінок:
82
Мова:
Українська
style="text-align: justify;"> end
{$IFNDEF UNIT60}
else if obj_type=sys_openstr_id then
begin
write_general(sys_openstr_id,'system open string type:'+obj^.name+';','',#13#10);
end
{$ENDIF}
else if obj_type=unit_id then
begin
write_unit_info(obj^.name,pointer(obj_info),
obj_ofs(obj) = header^.ofs_this_unit)
end;
end
else
begin
WriteError('Unknown kind '+DecWord(obj_type)+oneindent+obj^.name+
' with info at '+hexword(obj_ofs(obj_info)));
last_kind := obj_type;
end;
if obj_type in dump_types then
begin
for j:=0 to 15 do
write(hexword(obj_ofs(obj_info)+j):5);
for j:=0 to 15 do
write(hexbyte(obj_info^[j]):5);
for j:=16 to 31 do
write(hexword(obj_ofs(obj_info)+j):5);
for j:=16 to 31 do
write(hexbyte(obj_info^[j]):5);
end;
end;
procedure print_name_list(obj_list:list_ptr);
var
obj : obj_ptr;
current : list_ptr;
bytes : ^byte_array;
j : integer;
begin
last_kind := init_id;
current := obj_list;
while current^.offset < $ffff do
begin
obj := add_only_offset(buffer,current^.offset);
print_obj(obj);
current := current^.next;
end;
end;
{blocks->}
procedure print_entries;
var
block:entry_pt_ptr;
base,limit,ofs : word;
dll : dll_block_ptr;
unknown_flags : entry_flags;
begin
writeln;
writeln('Entry records');
base := header^.ofs_entry_pts;
limit := header^.ofs_code_blocks;
if base>=limit then
writeln('(none)')
else
begin
writeln(' Proc Code block:offset');
ofs := 0;
while base+ofs<limit do
begin
block := add_only_offset(buffer,base+ofs);
with block^ do
begin
write(hexwordblank(ofs):8);
if ent_from_dll in flags then { external from dll }
begin
dll := add_only_offset(buffer,header^.ofs_dll_list+code_block);
write(dll^.name:12,'.');
if ent_by_name in flags then
begin
dll := add_only_offset(buffer,header^.ofs_dll_list+offset);
write(dll^.name);
if length(dll^.name)<=2 then
write(tab);
end
else
write(offset,tab);
end
else
write(hexwordblank(block^.code_block):12,':',
hexword(block^.offset));
if ent_exported in flags then
write(' exported')
else
write(' ');
write(tab,find_proc_with_entry(unit_list[1],ofs));
unknown_flags:=flags-[ent_from_dll,ent_by_name,ent_exported];
if unknown_flags<>[] then
WriteError(' Unrecognized code entry flags: '+hexbyte(byte(unknown_flags)));
if w1 <> 0 then
write('w1 = ',hexword(w1));
if b1 <> 0 then
write('b1 = ',hexbyte(b1));
writeln;
end;
inc(ofs,sizeof(block^));
end;
end;
end;
procedure write_code_block_name(in_unit:unit_list_ptr;blocknum:word);
var
block:entry_pt_ptr;
base,limit,ofs : word;
s:string;
begin
{ find entry proc }
base:=header^.ofs_entry_pts;
limit := header^.ofs_code_blocks;
ofs := 0;
while base+ofs<limit do
begin
block := add_only_offset(buffer,base+ofs);
if (block^.code_block=blocknum) and not (ent_from_dll in block^.flags) then
begin
{ find obj which own block^.entry (ofs) }
write(' ',find_proc_with_entry(unit_list[1],ofs));
end;
inc(ofs,sizeof(entry_pt_rec));
end;
end;
procedure write_const_block_name(info_ofs : word);
var
obj : obj_ptr;
begin
if info_ofs = 0 then
exit;
obj := find_type_or_proc(unit_list[1],info_ofs);
if obj <> nil then
write(obj^.name)
else
write('obj',hexword(info_ofs));
end;
procedure print_blocks(const blocktype:string; base,limit:word);
var
ofs : word;
block : block_ptr;
begin