home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / INTRFC62.ZIP / HEAD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-02  |  3.5 KB  |  115 lines
  1. unit head;
  2. { Header declarations and dumper }
  3. interface
  4.  
  5. uses globals,util,dump;
  6.  
  7. type
  8.   unit_flags = set of (ieee_reals,overlays,windows,f8,moveable,f20,preload,f80,
  9.                        f100,f200,f400,f800,discardable,f2000,f4000,f8000);
  10. type
  11.   header_ptr = ^header_rec;
  12.   header_rec = record
  13.     file_id: array[0..3] of char; { 0-3 }
  14.     i4,                           { 4-5 }
  15.     i6,                           { 6-7 }
  16.     ofs_this_unit,                { 8-9 }
  17.     ofs_hashtable,                { A-B }
  18.     ofs_entry_pts,                { C-D }
  19.     ofs_code_blocks,              { E-F }
  20.     ofs_const_blocks,             {10-11}
  21.     ofs_var_blocks,               {12-13}
  22.     ofs_dll_list,                 {14-15}
  23.     ofs_unit_list,                {16-17}
  24.     ofs_src_name,                 {18-19}
  25.     ofs_line_lengths,             {1A-1B}
  26.     sym_size,                     {1C-1D}
  27.     code_size,                    {1E-1F}
  28.     const_size,                   {20-21}
  29.     reloc_size,                   {22-23}
  30.     vmt_size,                     {24-25}
  31.     var_size,                     {26-27}
  32.     ofs_full_hash: word;          {28-29}
  33.     flags : unit_flags;           {2A-2B}
  34.     other : array[$2C..$3F] of byte; {2C-3F}
  35.   end;
  36.  
  37. var
  38.   header : ^header_rec;
  39.  
  40. procedure print_header;
  41.  
  42. implementation
  43.  
  44. procedure print_header;
  45. var
  46.   i:integer;
  47.   new_flags : unit_flags;
  48. begin
  49.   with header^ do
  50.   begin
  51.     writeln('file_id:':20,file_id);
  52.     writeln('i4:':20,hexword2(i4));
  53.     writeln('i6:':20,hexword2(i6));
  54.     writeln('ofs_this_unit:':20,hexword2(ofs_this_unit));
  55.     writeln('ofs_hashtable:':20,hexword2(ofs_hashtable));
  56.     writeln('ofs_entry_pts:':20,hexword2(ofs_entry_pts));
  57.     writeln('ofs_code_blocks:':20,hexword2(ofs_code_blocks));
  58.     writeln('ofs_const_blocks:':20,hexword2(ofs_const_blocks));
  59.     writeln('ofs_var_blocks:':20,hexword2(ofs_var_blocks));
  60.     writeln('ofs_dll_list:':20,hexword2(ofs_dll_list));
  61.     writeln('ofs_unit_list:':20,hexword2(ofs_unit_list));
  62.     writeln('ofs_src_name:':20,hexword2(ofs_src_name));
  63.     writeln('ofs_line_lengths:':20,hexword2(ofs_line_lengths));
  64.     writeln('sym_size:':20,hexword2(sym_size));
  65.     writeln('code_size:':20,hexword2(code_size));
  66.     writeln('const_size:':20,hexword2(const_size));
  67.     writeln('reloc_size:':20,hexword2(reloc_size));
  68.     writeln('vmt_size:':20,hexword2(vmt_size));
  69.     writeln('var_size:':20,hexword2(var_size));
  70.     writeln('ofs_full_hash:':20,hexword2(ofs_full_hash));
  71.     write('flags:':20);
  72.     if ieee_reals in flags then
  73.       write('N+':4)
  74.     else
  75.       write('N-':4);
  76.     new_flags := flags - [ieee_reals];
  77.     writeln;
  78.     if windows in flags then
  79.     begin
  80.       write('TPW options $C:':20);
  81.       if moveable in flags then
  82.         write('Moveable ')
  83.       else
  84.         write('Fixed ');
  85.       if preload in flags then
  86.         write('Preload ')
  87.       else
  88.         write('Demandload ');
  89.       if discardable in flags then
  90.         write('Discardable ')
  91.       else
  92.         write('Permanent ');
  93.       new_flags := flags - [windows,moveable,preload,discardable];
  94.     end
  95.     else
  96.     begin
  97.       write('TP for DOS options:':20);
  98.       if overlays in flags then
  99.         write('O+':4)
  100.       else
  101.         write('O-':4);
  102.       new_flags := flags - [overlays];
  103.     end;
  104.     if new_flags <> [] then
  105.       write('unknown flags ',hexword(word(new_flags)));
  106.     writeln;
  107.  
  108.     writeln('Other:');
  109.     dumpbytes(header^,$2c,$3f-$2b);
  110.     writeln;
  111.   end;
  112. end;
  113.  
  114. end.
  115.