home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / INTRFC62.ZIP / SRCFILES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-06  |  3.7 KB  |  153 lines
  1. unit srcfiles;
  2.  
  3. interface
  4.  
  5. uses dos,globals,util,dump,loader,head;
  6.  
  7. type
  8.   src_file_ptr = ^src_file_rec;
  9.   src_file_rec = record
  10.     filetype : byte;
  11.     w1 : word;
  12.     packed_date : longint;
  13.     filename : string;
  14.   end;
  15.  
  16.   src_line_ptr = ^src_line_rec;
  17.   src_line_rec = record
  18.     owner_ofs,
  19.     src_ofs,
  20.     entry,startline,numlines : word;
  21.   end;
  22.  
  23. procedure print_src_files;
  24. procedure print_src_lines;
  25.  
  26. implementation
  27.  
  28. function tf(w:word):string;  { Time format of a number }
  29. var
  30.   result : string[3];   { Use length 3 in to show errors }
  31. begin
  32.   str(w,result);
  33.   if length(result) = 1 then
  34.     tf := '0'+result
  35.   else
  36.     tf := result;
  37. end;
  38.  
  39. procedure print_src_files;
  40. const
  41.   monthname : array[1..12] of string[9] = ('January','February',
  42.                                             'March','April','May',
  43.                                             'June','July','August',
  44.                                             'September','October',
  45.                                             'November','December');
  46. var
  47.   thisfile : src_file_ptr;
  48.   ofs : word;
  49.   dt : datetime;
  50. begin
  51.   writeln;
  52.   writeln('Source File Records');
  53.   ofs := header^.ofs_src_name;
  54.   while ofs < header^.ofs_line_lengths do
  55.   begin
  56.     thisfile := add_offset(buffer,ofs);
  57.     with thisfile^ do
  58.     begin
  59.       case filetype of
  60.       3 : write('Includes ');
  61.       4 : write('Main src ');
  62.       5 : write('Links to ');
  63.       6 : write('Resource ');
  64.       else
  65.           write('Unknown file type ',filetype,' ');
  66.       end;
  67.       write(filename);
  68.       if packed_date <> 0 then
  69.       begin
  70.         unpacktime(packed_date,dt);
  71.         with dt do
  72.           write(' ':(15-length(filename)),tf(hour),':',tf(min),':',tf(sec),' ',monthname[month],' ',day,', ',year);
  73.       end;
  74.       if w1 <> 0 then
  75.         write(' w1 = ',w1);
  76.       writeln;
  77.       inc(ofs,sizeof(src_file_rec)-255+length(filename));
  78.     end;
  79.   end;
  80. end;
  81.  
  82. procedure print_src_lines;
  83. var
  84.   ofs : word;
  85.   line,i,codeofs : word;
  86.   thisrec : src_line_ptr;
  87.   obj : obj_ptr;
  88.   bytes_per_line : byte_array_ptr;
  89.   name : string;
  90.   src_file : src_file_ptr;
  91.   column : byte;
  92. begin
  93.   writeln;
  94.   writeln('Source Line Numbers');
  95.   column := 1;
  96.   ofs := header^.ofs_line_lengths;
  97.   if ofs = header^.sym_size then
  98.     writeln('(none)')
  99.   else
  100.   begin
  101.     writeln;
  102.     while ofs < header^.sym_size do
  103.     begin
  104.       thisrec := add_offset(buffer,ofs);
  105.       with thisrec^ do
  106.       begin
  107.         if owner_ofs <> 0 then
  108.         begin
  109.           obj := add_offset(buffer,owner_ofs);
  110.           name := obj^.name;
  111.         end
  112.         else
  113.           name := 'initialization code';
  114.         src_file := add_offset(buffer,header^.ofs_src_name+src_ofs);
  115.         writeln('Line number offsets for ',name,' in ',src_file^.filename);
  116.         bytes_per_line := add_offset(thisrec,sizeof(src_line_rec));
  117.         line := 0;
  118.         i := 0;
  119.         column := 0;
  120.         codeofs := entry;
  121.         while line < numlines do
  122.         begin
  123.           if bytes_per_line^[i] > 0 then
  124.           begin
  125.             write(startline+line:6,':',hexword(codeofs):4);
  126.             inc(column);
  127.             if column = 7 then
  128.             begin
  129.               column := 0;
  130.               writeln;
  131.             end;
  132.             if bytes_per_line^[i] >= $80 then
  133.             begin
  134.               inc(codeofs,$100*(bytes_per_line^[i]-$80)
  135.                                +bytes_per_line^[i+1]);
  136.               inc(i);
  137.             end
  138.             else
  139.               inc(codeofs,bytes_per_line^[i]);
  140.           end;
  141.           inc(line);
  142.           inc(i);
  143.         end;
  144.         inc(ofs,sizeof(thisrec^)+i);
  145.       end;
  146.       if column <> 0 then
  147.         writeln;
  148.     end;
  149.   end;
  150. end;
  151.  
  152. end.
  153.