+3 8(066) 185-39-18
fПредмет:
Тип работы:
Курсова робота
К-во страниц:
82
Язык:
Українська
end;
end
else
Write('?');
end;
end;
procedure write_const_info(var name:string; info:const_info_ptr);
var
type_obj : type_def_ptr;
begin
indent;
if (NowEnum<>nil) and ((info^.type_def_ofs<>Ofs(NowEnum^)) or
(Seg(get_unit(info^.type_unit)^.buffer^)<>Seg(NowEnum^))) then
begin
Writeln('*)');
NowEnum:=nil;
last_kind:=init_id;
end;
if (last_kind <> record_id) and (last_kind <> const_id) then
begin
if NowEnum<>nil then
Write('(* ');
writeln('Const');
indent;
last_kind := const_id;
end;
write(oneindent,name,'=',oneindent);
write_const_type(info^.allval,info^.type_unit,info^.type_def_ofs,nil);
writeln(';');
end;
procedure write_unit_info(var name:string; info:unit_ptr; self:boolean);
begin
indent;
if self then
begin
write('Unit',oneindent,name,';');
last_kind := init_id;
end
else
begin
if last_kind = unit_id then
begin
writeln;
write(oneindent,',',name);
end
else
begin
write('Uses',oneindent,name);
last_kind := unit_id;
end;
end;
with info^ do
begin
write(tab,'{ checksum = ',hexword(checksum),'}');
if self then
begin
writeln;
writeln('interface');
end;
end;
end;
procedure write_system_type(var name:string; kind:byte; info:system_info_ptr);
begin
if kind=sys_proc_id then
write('procedure')
else if kind=sys_fn_id then
write('function');
with info^ do
begin
write(oneindent,name,tab,'{ Special index ',hexbyte(addr_ofs));
if flags <> 0 then
write(oneindent,'Flags ',hexbyte(flags)); { What are those flags!!??! }
writeln(' }');
end;
last_kind := kind;
end;
procedure write_general(kind:byte; title,name,suffix:string);
begin
if last_kind <> kind then
begin
writeln(title);
last_kind := kind;
indent;
end;
write(oneindent,name,suffix);
end;
procedure print_obj(obj:obj_ptr);
var
j:word;
obj_info : ^byte_array;
new_entry : list_ptr;
info_len,info_ofs : word;
obj_type : byte;
const
dump_types : set of byte = [];
begin
info_ofs := sizeof(obj_rec)-sizeof(string)+1+length(obj^.name);
obj_info := add_only_offset(obj,info_ofs);
obj_type := obj^.obj_type;
if (obj_type and $80) <> 0 then
begin
if last_kind <> objpriv_id then
begin
dec(indentation);
indent;
inc(indentation);
writeln('private');
last_kind := objpriv_id;
end;
obj_type := obj_type and $7F;
end;
if obj_type in known_types then
begin
if last_kind<>obj_type then
begin
if (obj_type<>const_id) and (NowEnum<>nil) then
begin
if last_kind=const_id then
Writeln('*)');
NowEnum:=nil;
end;
if last_kind=unit_id then
writeln(';');
end;
if obj_type=const_id then
begin
write_const_info(obj^.name,pointer(obj_info));
end
else if obj_type=type_id then
begin
write_type_info(obj^.name,obj,pointer(obj_info));
end
else if obj_type=var_id then
begin
write_var_info(obj^.name,pointer(obj_info));
end
else if obj_type=proc_id then
begin
write_proc_info(obj^.name,pointer(obj_info));
if not (last_kind in [object_id,objpriv_id]) then
last_kind := proc_id;
end
else if (obj_type=sys_proc_id) or (obj_type=sys_fn_id) then
begin
write_system_type(obj^.name,obj_type,pointer(obj_info));
end
else if obj_type=sys_port_id then
begin
write_general(sys_port_id,'type {port array}',obj^.name,':'+oneindent);
if byte_array_ptr(obj_info)^[0]=0 then
writeln('Byte;')
else
writeln('Word;')
end
else if obj_type=sys_mem_id then
begin
write_general(sys_mem_id,'type {memory array}',obj^.name,':'+oneindent);
write_type_def(add_only_offset(buffer,type_info_ptr(obj_info)^.type_def_ofs));
writeln(';');
end
else if obj_type=sys_new_id then
begin
write_general(sys_new_id,'system allocator '+obj^.name+';','',#13#10);