+3 8(066) 185-39-18
fПредмет:
Тип роботи:
Курсова робота
К-сть сторінок:
82
Мова:
Українська
writeln;
writeln(blocktype,' blocks');
if base >= limit then
writeln('(none)')
else
begin
if blocktype='Code' then
writeln('Blocknum Bytes Relocrecs Lineinfo Owner')
else
writeln('Blocknum Bytes Relocrecs Owner');
ofs := 0;
while base+ofs < limit do
begin
block := add_only_offset(buffer,base+ofs);
with block^ do
begin
write(hexwordblank(ofs):8,hexwordblank(size):8,
hexwordblank(relocbytes):8,hexwordblank(owner):8,' ');
if blocktype = 'Code' then
write_code_block_name(unit_list[1],ofs)
else if blocktype = 'Const' then
write_const_block_name(owner);
if w1 <> 0 then
write(' w1 = ',hexword(w1));
writeln;
end;
inc(ofs,sizeof(block_rec));
end;
end;
end;
procedure print_code_blocks;
var
base,limit:word;
begin
base := header^.ofs_code_blocks;
limit := header^.ofs_const_blocks;
print_blocks('Code',base,limit);
end;
procedure print_const_blocks;
var
base,limit:word;
begin
base := header^.ofs_const_blocks;
limit := header^.ofs_var_blocks;
print_blocks('Const',base,limit);
end;
procedure print_var_blocks;
var
base,limit:word;
begin
base := header^.ofs_var_blocks;
limit := header^.ofs_dll_list;
print_blocks('Var',base,limit);
end;
procedure print_dll_blocks;
var
base,ofs,limit:word;
block : dll_block_ptr;
begin
writeln;
writeln('DLL exported names list');
base := header^.ofs_dll_list;
limit := header^.ofs_unit_list;
if base >= limit then
writeln('(none)')
else
begin
writeln(' Offset Name');
ofs := 0;
while base+ofs < limit do
begin
block := add_only_offset(buffer,base+ofs);
with block^ do
begin
write(hexwordblank(ofs):8,' ',name);
if w1 <> 0 then
write(' w1= ',hexword(w1));
if w2 <> 0 then
write(' w2= ',hexword(w2));
writeln;
ofs := ofs + 5 + length(name);
end;
end;
end;
end;
procedure print_unit_blocks;
var
base,ofs,limit:word;
block60 : unit_block60_ptr;
block : unit_block_ptr;
li:integer;
begin
writeln;
writeln('Unit list');
base := header^.ofs_unit_list;
limit := header^.ofs_src_name;
if base >= limit then
writeln('(none)')
else
begin
write(' Offset Name');
{$IFNDEF UNIT60}
write(' References');
{$ENDIF}
writeln;
ofs := 0;
while base+ofs < limit do
begin
block := add_only_offset(buffer,base+ofs);
{$IFDEF UNIT60}
with unit_block60_ptr(block)^ do
begin
write(hexwordblank(ofs):8,' ',name);
if w1 <> 0 then
write(' w1 = ',hexword(w1));
writeln;
Inc(ofs, 3 + length(name));
end
{$ELSE}
with block^ do
begin
write(hexwordblank(ofs):8,' ',name);
write('':8-length(name)+4,HexWordAsm(refcount div 4):5);
if refcount mod 4<>0 then
WriteError('unit references not multiple 4 '+HexWord(refcount));
if w1 <> 0 then
write(' w1 = ',hexword(w1));
writeln;
Inc(ofs,5 + length(name));
end;
{$ENDIF}
end;
end;
end;
function unit_name(ofs:word):string;
begin
unit_name := unit_block_ptr(
add_only_offset(buffer,header^.ofs_unit_list+ofs))^.name;
end;
function dll_name(ofs:word):string;
begin
dll_name := dll_block_ptr(
add_only_offset(buffer,header^.ofs_dll_list+ofs))^.name;
end;
function ref_type(rtype:byte):byte;
begin
ref_type := (rtype shr 4) and 3;
end;