home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 001-099 / ff024.lzh / Modula-2 / m2 / ObjDump.MOD < prev    next >
Encoding:
Text File  |  1986-05-11  |  7.8 KB  |  299 lines
  1. (********************************************************************************
  2.  
  3. Name         : ObjDump.MOD
  4. Version      : 1.0
  5. Purpose      : decode Amiga object files
  6. Author       : cn/ms
  7. Modified     : 9.4.86 14:30 ms
  8. Comment      : ported from cn's basic program and extended with dec68k
  9.  
  10. ********************************************************************************)
  11.  
  12. MODULE ObjDump;
  13.  
  14. FROM SYSTEM     IMPORT ADR, LONG, WORD;
  15. FROM InOut      IMPORT OpenOutput, CloseOutput, 
  16.                        ReadString, WriteHex, WriteString, Write, WriteLn;
  17. FROM FileSystem IMPORT File, Response,
  18.                        Lookup, Close, ReadWord, ReadChar, Length;
  19. FROM dec68k     IMPORT Decode;
  20.                 IMPORT TerminalBase;
  21.  
  22. CONST cr=15C; esc=33C; can=30C; csi=233C;
  23.  
  24. VAR obj: File;
  25.     ch: CHAR;
  26.     lo, hi, pc, decLen: CARDINAL;
  27.     filename, st: ARRAY [0..63] OF CHAR;
  28.     lc, hunk:  LONGCARD;
  29.  
  30. PROCEDURE GetChar(VAR ch: CHAR);
  31. BEGIN
  32.   IF pc<decLen THEN
  33.     ReadChar(obj, ch);
  34.     INC(pc);
  35.   ELSE
  36.     ch:=0C
  37.   END
  38. END GetChar;
  39.  
  40. PROCEDURE GetWord(VAR w: WORD);
  41. VAR ch1, ch2: CHAR;
  42. BEGIN
  43.   GetChar(ch1);
  44.   GetChar(ch2);
  45.   w:=WORD(256*ORD(ch1)+ORD(ch2));
  46. END GetWord;
  47.  
  48. PROCEDURE GetLong(VAR lc: LONGCARD);
  49. VAR hi, lo: CARDINAL;
  50. BEGIN
  51.   ReadWord(obj, hi);
  52.   ReadWord(obj, lo);
  53.   IF (obj.res#done) OR obj.eof THEN
  54.     lc:=0D
  55.   ELSE
  56.     lc:=LONG(hi, lo)
  57.   END
  58. END GetLong;
  59.  
  60. PROCEDURE PrintName(len: CARDINAL);
  61. VAR trick:RECORD CASE :INTEGER OF
  62.                  | 1: lc: LONGCARD
  63.                  | 2: st: ARRAY [0..3] OF CHAR
  64.                  END
  65.           END;
  66.      i: CARDINAL;
  67. BEGIN
  68.   WITH trick DO
  69.     IF len#0 THEN
  70.       FOR i:=1 TO len DO
  71.         GetLong(lc);
  72.         WriteString(st)
  73.       END
  74.     ELSE
  75.       WriteString('no name')
  76.     END
  77.   END
  78. END PrintName;
  79.  
  80. PROCEDURE DecodeBlock;
  81. VAR i: CARDINAL; lc: LONGCARD;
  82. BEGIN
  83.   GetLong(lc);
  84.   WriteHex(lc, 8);
  85.   pc:=0; decLen:=SHORT(SHIFT(lc, 2)); (* #bytes *)
  86.   WriteLn;
  87.   WHILE pc<decLen DO
  88.     WriteHex(pc, 4); Decode(GetWord)
  89.   END
  90. END DecodeBlock;
  91.  
  92. PROCEDURE DataBlock;
  93. VAR i: CARDINAL; lc: LONGCARD;
  94. BEGIN
  95.   GetLong(lc);
  96.   WriteHex(lc, 8);
  97.   FOR i:=1 TO SHORT(lc) DO
  98.     GetLong(lc)
  99.   END
  100. END DataBlock;
  101.  
  102. PROCEDURE Relocation;
  103. VAR lc: LONGCARD;
  104.     i, len: CARDINAL;
  105. BEGIN
  106.   LOOP
  107.     GetLong(lc);
  108.     IF lc=0D THEN EXIT END;
  109.     len:=SHORT(lc);
  110.     GetLong(lc);
  111.     WriteLn; WriteString('hunk: '); WriteHex(lc, 8);
  112.     FOR i:=0 TO len-1 DO
  113.       WriteLn; WriteHex(i, 3); Write(':'); GetLong(lc); WriteHex(lc, 8);
  114.     END
  115.   END
  116. END Relocation;
  117.  
  118. PROCEDURE External;
  119. VAR type, len, i: CARDINAL;
  120.     lc: LONGCARD;
  121. BEGIN
  122.   LOOP
  123.     GetLong(lc);
  124.     IF lc=0D THEN EXIT END;
  125.     type:=SHORT(SHIFT(lc, -24));
  126.     len:=SHORT(lc);
  127.     WriteLn;
  128.     IF type=0 THEN
  129.       WriteString('ext_symb: ');
  130.       GetLong(lc); PrintName(SHORT(lc)); WriteString('   ');
  131.       GetLong(lc); WriteHex(lc, 8);
  132.     ELSIF type=1 THEN
  133.       WriteString('ext_def: '); PrintName(len); WriteString('   ');
  134.       GetLong(lc); WriteHex(lc, 8)
  135.     ELSIF type=2 THEN
  136.       WriteString('ext_abs: '); PrintName(len); WriteString('   ');
  137.       GetLong(lc); WriteHex(lc, 8)
  138.     ELSIF type=3 THEN
  139.       WriteString('ext_res: '); PrintName(len); WriteString('   ');
  140.       GetLong(lc); WriteHex(lc, 8)
  141.     ELSIF type=129  THEN
  142.       WriteString('ext_ref32: '); PrintName(len);
  143.       GetLong(lc); len:=SHORT(lc);
  144.       FOR i:=0 TO len-1 DO
  145.         WriteLn; WriteHex(i, 3); Write(':'); GetLong(lc); WriteHex(lc, 8)
  146.       END;
  147.     ELSIF type=130  THEN
  148.       WriteString('ext_common: '); PrintName(len);
  149.       GetLong(lc); WriteLn; WriteString('common block size: '); WriteHex(lc, 8);
  150.       GetLong(lc); len:=SHORT(lc);
  151.       FOR i:=0 TO len-1 DO
  152.         WriteLn; WriteHex(i, 3); Write(':'); GetLong(lc); WriteHex(lc, 8)
  153.       END;
  154.     ELSIF type=131  THEN
  155.       WriteString('ext_ref16: '); PrintName(len);
  156.       GetLong(lc); len:=SHORT(lc);
  157.       FOR i:=0 TO len-1 DO
  158.         WriteLn; WriteHex(i, 3); Write(':'); GetLong(lc); WriteHex(lc, 8)
  159.       END;
  160.     ELSIF type=132 THEN
  161.       WriteString('ext_ref8: '); PrintName(len);
  162.       GetLong(lc); len:=SHORT(lc);
  163.       FOR i:=0 TO len-1 DO
  164.         WriteLn; WriteHex(i, 3); Write(':'); GetLong(lc); WriteHex(lc, 8)
  165.       END;
  166.     ELSE
  167.       WriteString('unknown external reference type')
  168.     END
  169.   END
  170. END External;
  171.  
  172. PROCEDURE Symbols;
  173. VAR lc: LONGCARD;
  174. BEGIN
  175.   LOOP
  176.     GetLong(lc);
  177.     IF lc=0D THEN EXIT END;
  178.     WriteLn;
  179.     PrintName(SHORT(lc)); WriteString('   '); GetLong(lc); WriteHex(lc, 8)
  180.   END
  181. END Symbols;
  182.  
  183. PROCEDURE Debug;
  184. BEGIN
  185.   DataBlock;
  186. END Debug;
  187.  
  188. PROCEDURE Header;
  189. VAR lc, f, l: LONGCARD;
  190.     len, i: CARDINAL;
  191. BEGIN
  192.   LOOP
  193.     GetLong(lc);
  194.     IF lc=0D THEN EXIT END;
  195.     WriteLn; PrintName(SHORT(lc))
  196.   END;
  197.   WriteLn;
  198.   GetLong(lc); WriteString('table size: '); WriteHex(lc, 8); WriteLn;
  199.   GetLong(f); WriteString('first hunk: '); WriteHex(f, 8); WriteLn;
  200.   GetLong(l); WriteString('last  hunk: '); WriteHex(l, 8); WriteLn;
  201.   WriteString('hunk sizes:');
  202.   FOR i:=0 TO SHORT(l-f) DO
  203.     GetLong(lc); WriteLn; WriteHex(i, 3); Write(':'); WriteHex(lc, 8)
  204.   END
  205. END Header;
  206.  
  207. PROCEDURE Overlay;
  208. BEGIN
  209.   DataBlock
  210. END Overlay;
  211.    
  212. PROCEDURE WriteHunk(hunk: LONGCARD);
  213. BEGIN
  214.   IF hunk=999D THEN
  215.     WriteString('hunk_unit: '); GetLong(lc); PrintName(SHORT(lc)); WriteLn
  216.   ELSIF hunk=1000D THEN
  217.     WriteString('hunk_name: '); GetLong(lc); PrintName(SHORT(lc)); WriteLn
  218.   ELSIF hunk=1001D THEN
  219.     WriteString('hunk_code: '); DecodeBlock; (* WriteLn *)
  220.   ELSIF hunk=1002D THEN
  221.     WriteString('hunk_data: '); DataBlock; WriteLn
  222.   ELSIF hunk=1003D THEN
  223.     WriteString('hunk_bss: '); GetLong(lc); WriteHex(lc, 8); WriteLn
  224.   ELSIF hunk=1004D THEN
  225.     WriteString('hunk_reloc32: '); Relocation; WriteLn
  226.   ELSIF hunk=1005D THEN
  227.     WriteString('hunk_reloc16: '); Relocation; WriteLn
  228.   ELSIF hunk=1006D THEN
  229.     WriteString('hunk_reloc8: '); Relocation; WriteLn
  230.   ELSIF hunk=1007D THEN
  231.     WriteString('hunk_ext: '); External; WriteLn
  232.   ELSIF hunk=1008D THEN
  233.     WriteString('hunk_symbol: '); Symbols; WriteLn
  234.   ELSIF hunk=1009D THEN
  235.     WriteString('hunk_debug: '); Debug; WriteLn
  236.   ELSIF hunk=1010D THEN
  237.     WriteString('hunk_end'); WriteLn; WriteLn
  238.   ELSIF hunk=1011D THEN
  239.     WriteString('hunk_header: '); Header; WriteLn
  240.   ELSIF hunk=1012D THEN
  241.     WriteString('hunk_overlay: '); Overlay; WriteLn
  242.   ELSIF hunk=1013D THEN
  243.     WriteString('hunk_break'); WriteLn
  244.   ELSE
  245.     WriteString('no hunk: '); WriteHex(hunk, 8); WriteLn
  246.   END;
  247. END WriteHunk;
  248.  
  249. BEGIN
  250.   WriteString('ObmDump              Version 1.0  9.4.86/ms'); WriteLn;
  251.   WriteString('======='); WriteLn; WriteLn;
  252.   LOOP
  253.     WriteString('in> '); ReadString(filename);
  254.     IF filename[0]#0C THEN
  255.       Lookup(obj, filename, FALSE);
  256.       IF obj.res=done THEN  WriteLn;
  257.         OpenOutput('DEC');
  258.         WriteString('ObmDump: '); WriteString(filename); WriteLn; WriteLn;
  259.         Length(obj, hi, lo);
  260.         IF obj.res#done THEN
  261.           WriteString('f.res#done  !!!'); WriteLn
  262.         END;
  263.         WriteString('File is '); WriteHex(LONG(hi, lo), 8);
  264.         WriteString(' bytes long'); WriteLn;
  265.         LOOP
  266.           GetLong(hunk);
  267.           TerminalBase.StandardBusyRead(ch);
  268.           IF ch#0C THEN
  269.             st:='xxx?: esc to exit, other key to continue';
  270.             st[0]:=csi; st[1]:='7'; st[2]:='m';
  271.             TerminalBase.StandardWrite(ADR(st), 40D);
  272.             REPEAT
  273.               TerminalBase.BusyRead(ch);
  274.             UNTIL ch#0C;
  275.             st[0]:=csi; st[1]:='0'; st[2]:='m';
  276.             st[3]:=cr; st[4]:=csi; st[5]:='K';
  277.             TerminalBase.StandardWrite(ADR(st), 6);
  278.             IF ch=esc THEN
  279.               EXIT
  280.             END
  281.           END;
  282.           IF obj.eof OR (obj.res#done) THEN
  283.             EXIT
  284.           ELSE 
  285.             WriteHunk(hunk)
  286.           END
  287.         END;
  288.         CloseOutput;
  289.         Close(obj)
  290.       ELSE
  291.         WriteString(' --- not opend'); WriteLn
  292.       END
  293.     ELSE
  294.       WriteString(' --- no file'); WriteLn;
  295.       EXIT
  296.     END
  297.   END
  298. END ObjDump.
  299.