home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / INTRFC62.ZIP / INTRFC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-05  |  4.1 KB  |  139 lines
  1. program intrfc;
  2. {  Prints out the information contained in a TPU file  }
  3.  
  4. uses
  5.   test1,nametype,util,globals,loader,head,blocks,namelist,srcfiles,code,
  6.         reloc,dump,params;
  7.  
  8. var
  9.   i,j,t:word;
  10.   result : word;
  11.   this_unit : obj_ptr;
  12.   tpu_size : longint;
  13.   main_list : list_ptr;
  14. begin
  15.   writeln('INTRFC version 1.32.  Written by D.J. Murdoch.');
  16.  
  17.   parse_params;
  18.  
  19.   writeln('Dump of file ',unitname,'.TPU');
  20.  
  21.   { Try to find whether this is for TP 6.0 or TPW 1.0 so that
  22.     we know which library to look in.  Very little of the rest of the
  23.     code depends on this decision. }
  24.  
  25.   read_file(unitname+'.tpu',pointer(header),0,sizeof(header_rec));
  26.   if header = nil then
  27.     read_file('TURBO.TPL',pointer(header),0,sizeof(header_rec));
  28.   if header = nil then
  29.     read_file('TPW.TPL',pointer(header),0,sizeof(header_rec));
  30.   if header = nil then
  31.     syntax_exit('Error:  can''t find unit '+unitname+'.tpu, TURBO.TPL, or TPW.TPL.')
  32.   else
  33.   begin
  34.     if windows in header^.flags then
  35.       tpl_name := 'TPW.TPL';
  36.     dispose(header);
  37.   end;
  38.  
  39.   read_file(tpl_name,pointer(tpl_buffer),0,65535);
  40.   if tpl_buffer = nil then
  41.     read_file(uses_path+tpl_name,pointer(tpl_buffer),0,65535);
  42.   if tpl_buffer <> nil then
  43.   begin
  44.     got_tpl := true;
  45.     tpl_size := last_file_size;
  46.   end
  47.   else
  48.   begin
  49.     got_tpl := false;
  50.     writeln('Warning:  ',tpl_name,' not found.');
  51.   end;
  52.  
  53.   num_known := 0;
  54.   fillchar(unit_list,sizeof(unit_list),0);
  55.   add_unit(unitname,nil);
  56.   if not unit_list[1]^.has_symbols then
  57.     syntax_exit('');
  58.  
  59.   buffer := unit_list[1]^.buffer;
  60.   header := normalize(buffer);
  61.  
  62.   {Make this unit refer to itself}
  63.   this_unit := add_offset(buffer,header^.ofs_this_unit);
  64.   unit_ptr(add_offset(this_unit,length(this_unit^.name)+4))^.target := 1;
  65.  
  66.   add_referenced_units;
  67.  
  68.   with header^ do
  69.     begin
  70.       code_ofs  := roundup(sym_size,16);
  71.       const_ofs := code_ofs + roundup(code_size,16);
  72.       reloc_ofs := const_ofs + roundup(const_size,16);
  73.       vmt_ofs   := reloc_ofs + roundup(reloc_size,16);
  74.       tpu_size := longint(roundup(sym_size,16))
  75.                  +longint(roundup(code_size,16))
  76.                  +longint(roundup(const_size,16))
  77.                  +longint(roundup(reloc_size,16))
  78.                  +longint(roundup(vmt_size,16));
  79.     end;
  80.  
  81.  
  82.   hash_table := add_offset(buffer,header^.ofs_hashtable);
  83.   if do_implementation in active_options then
  84.     hash_table := add_offset(buffer,header^.ofs_full_hash);
  85.  
  86.   {Build main object list}
  87.  
  88.   build_list(main_list,buffer,hash_table);
  89.   unit_list[1]^.obj_list := main_list;
  90.  
  91.   { Now print it }
  92.   in_function := false;
  93.   indentation := 0;
  94.   if do_header in active_options then
  95.     print_header;
  96.   if [do_name_list,do_implementation]*active_options <> [] then
  97.     print_name_list(main_list);
  98.   if do_src_files in active_options then
  99.     print_src_files;
  100.   if do_src_lines in active_options then
  101.     print_src_lines;
  102.   if do_entry_pts in active_options then
  103.     print_entries;
  104.   if do_code_blocks in active_options then
  105.     print_code_blocks;
  106.   if do_const_blocks in active_options then
  107.     print_const_blocks;
  108.   if do_var_blocks in active_options then
  109.     print_var_blocks;
  110.   if do_dll_blocks in active_options then
  111.     print_dll_blocks;
  112.   if do_unit_blocks in active_options then
  113.     print_unit_blocks;
  114.   if do_code in active_options then
  115.   begin
  116.     read_file(unit_list[1]^.path,pointer(code_buf),code_ofs,header^.code_size);
  117.     print_dump(code_seg);
  118.     freemem(code_buf,header^.code_size);
  119.   end;
  120.   if do_const in active_options then
  121.   begin
  122.     read_file(unit_list[1]^.path,pointer(code_buf),const_ofs,header^.const_size);
  123.     print_dump(const_seg);
  124.     freemem(code_buf,header^.const_size);
  125.   end;
  126.   if do_reloc in active_options then
  127.   begin
  128.     read_file(unit_list[1]^.path,pointer(reloc_buf),reloc_ofs,header^.reloc_size);
  129.     print_reloc(code_seg);
  130.     freemem(reloc_buf,header^.reloc_size);
  131.   end;
  132.   if do_vmt in active_options then
  133.   begin
  134.     read_file(unit_list[1]^.path,pointer(reloc_buf),vmt_ofs,header^.vmt_size);
  135.     print_reloc(const_seg);
  136.     freemem(reloc_buf,header^.vmt_size);
  137.   end;
  138. end.
  139.