home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / disasm / deb2asm.pqs / deb2asm.pas
Pascal/Delphi Source File  |  1987-07-22  |  38KB  |  1,121 lines
  1. 22-Jul-87 11:43:42-PDT,38122;000000000001
  2. Return-Path: <@wiscvm.wisc.edu:KRANENBU@HLERUL5.BITNET>
  3. Received: FROM WISCVM.WISC.EDU BY C.ISI.EDU WITH TCP ; 22 Jul 87 11:41:41 PDT
  4. Received: from HLERUL5.BITNET by wiscvm.wisc.edu ; Wed, 22 Jul 87 13:38:55 CDT
  5. Date:     Fri, 17 Jul 87 15:39 N
  6. From:     <KRANENBU%HLERUL5.BITNET@wiscvm.wisc.edu>
  7. Subject:  Deb2asm
  8. To:       info-ibmpc-request@c.isi.edu
  9. X-Original-To:  "info-ibmpc-request@c.isi.edu", KRANENBURG
  10.  
  11. I would like to contribute the appended program DEB2ASM to the library.
  12. DEB2ASM converts a disassembly output from the DOS DEBUG program to a more
  13. regular and (hopefully) more legible format. The source is in TURBO pascal
  14. and is packaged with an I/O -include- file. You will need SORT.BOX
  15. (Borland Turbo Toolbox) or provide your own sorting routine.
  16.  
  17. The program produces labels from the hexadecimal offsets (both code-labels
  18. and variables) appearing in debugger output and constructs a cross-reference
  19. table with declarations of variables in the format:
  20.  
  21.      V_XXXX    LABEL    <TYPE> ; R_XXXX, R_XXXX, ...
  22.  
  23.      where <TYPE> is BYTE, WORD or DWORD
  24.      and the R_XXXX's are the locations where the variable
  25.      occurs in the code.
  26.  
  27. Usage of a memory location as more than one type (referenced both as a
  28. BYTE and as a WORD for instance) results in multiple entries in the this table.
  29.  
  30. However, segment declarations are not generated and intersegment references are
  31. not detected (this is an invitation, of cause).
  32.  
  33. Useful for deciphering ROM's of which the manufacturer failed to publish a
  34. proper listing (for instance my PARADISE Graphics card, which makes improper
  35.  use of the NMI line (IOCHK) on my PC).
  36.  
  37. I also managed to regenerate the missing part of the AT BIOS Listing this way
  38. (PC-AT Technical Reference, POST6 routine). I never saw a supplement from IBM
  39. here.
  40. If anyone is interested (and if it is not illegal) I can also post it as an
  41. example of the ouput generated by Deb2asm.
  42.  
  43. Please let me know,
  44.  
  45. P. Kranenburg. (KRANENBU@HLERUL5.BITNET).
  46.  
  47. ---------- include file IO.INC ---- CUT HERE FOR IO.INC -------------
  48.  procedure WriteHex(B: byte);
  49.   const
  50.      Hex: ARRAY [0 .. 15] OF CHAR = '0123456789ABCDEF';
  51.   var
  52.      i: integer;
  53.   begin
  54.     for i:= 1 downto 0 do
  55.        write(Hex[((B shr (i shl 2)) and $000F)])
  56.   end;
  57.  procedure WritelnHex(B: byte);
  58.   begin
  59.     WriteHex(B);
  60.     writeln
  61.   end;
  62.  procedure WriteHexInt(N: integer);
  63.   begin
  64.     WriteHex(N shr 8);
  65.     WriteHex(N and $00FF)
  66.   end;
  67.  procedure WritelnHexInt(N: integer);
  68.   begin
  69.     WriteHex(N shr 8);
  70.     WritelnHex(N and $00FF)
  71.   end;
  72.  procedure WriteAddress(N, M: integer);
  73.   begin
  74.     WriteHexInt(N);
  75.     Write(':');
  76.     WriteHexInt(M)
  77.   end;
  78.  procedure HexString(var Str; N: INTEGER);
  79.   const
  80.      Hex: ARRAY [0 .. 15] OF CHAR = '0123456789ABCDEF';
  81.   var
  82.      i: byte;
  83.   begin
  84.     for i:= 0 to Mem[Seg(Str):Ofs(Str)] - 1 do
  85.       Mem[Seg(Str):(Ofs(Str)+Mem[Seg(Str):Ofs(Str)]-i)] :=
  86.       Ord(Hex[((N shr (i shl 2)) and $000F)])
  87.   end;
  88.  
  89.  procedure WriteDouble(High, Low: INTEGER);
  90.  type
  91.    LongInt = ARRAY [0..3] OF BYTE;
  92.  const
  93.    Divisors : ARRAY [0..9] OF LongInt    = ( (  0,   0,   0,   1),
  94.                                              (  0,   0,   0,  $A),
  95.                                              (  0,   0,   0, $64),
  96.                                              (  0,   0,   3, $E8),
  97.                                              (  0,   0, $27, $10),
  98.                                              (  0,   1, $86, $A0),
  99.                                              (  0,  $F, $42, $40),
  100.                                              (  0, $98, $96, $80),
  101.                                              (  5, $F5, $E1,   0),
  102.                                              ($3B, $9A, $CA,   0)  );
  103.  var
  104.    i, j       : INTEGER;
  105.    CharOffset,
  106.    Digit      : BYTE;
  107.    Rep        : ARRAY [0..9] OF CHAR;
  108.    Number     : LongInt absolute Low;
  109.    OldNumber  : LongInt;
  110.    stop       : BOOLEAN;
  111.  begin
  112.    CharOffset := Ord(' ');
  113.    OldNumber := Number;
  114.    Rep := '          ';
  115.    for i:=9 downto 0 do begin
  116.      Digit := 0;
  117.      Number := OldNumber;
  118.      stop := false;
  119.      repeat
  120.        (* subtract Divisor from TestNumber *)
  121.         for j:=0 to 3 do begin
  122.           Number[j] := Number[j] - Divisors[i][3-j];
  123.           if (Number[j] > OldNumber[j]) AND (j<>3) then
  124.               Number[j+1] := number[j+1] - 1;
  125.         end;
  126.        if (Number[3] <= OldNumber[3]) then begin
  127.          Digit := succ(Digit);
  128.          CharOffset := Ord('0');
  129.          OldNumber := Number
  130.        end
  131.        else stop := true;
  132.      until stop;
  133.      Rep[9-i] := Chr(CharOffset+Digit);
  134.    end;
  135.    Write(Rep)
  136.  end;
  137.  
  138. procedure ComOut(var par);
  139. const
  140.   WriteCommand = 1;
  141. var
  142.   regs: RECORD
  143.          AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER
  144.         END;
  145.   B : BYTE absolute par;
  146. begin
  147.   with Regs do begin
  148.     AX := (WriteCommand shl 8) + B;
  149.     DX := 0;
  150.     Intr($14, Regs);
  151.   end
  152. end;
  153.  
  154.  
  155. procedure BlockRead (var f: file; var buffer; var n: integer);
  156. const
  157.   readfunction = $3F;
  158.  
  159. var
  160.   regs: RECORD
  161.          AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER
  162.         END;
  163.  
  164. begin
  165.   with Regs do begin
  166.     AX := (readfunction shl 8);
  167.     BX := MemW[Seg(f):Ofs(f)];
  168.     CX := n;
  169.     DX := Ofs(buffer);
  170.     DS := Seg(buffer);
  171.     Intr($21, Regs);
  172.     if (Flags and $0001) = 1 then begin
  173.        write('I/O Error ');
  174.        writeHex(AX shr 8);
  175.        writeln (' during BlockRead');
  176.      end
  177.     else
  178.      n := AX
  179.   end;
  180. end;
  181.  
  182. function FileSize (var f: file): INTEGER;
  183. const
  184.   seekfunction      = $42;
  185.   from_begin    = 0;
  186.   from_current  = 1;
  187.   from_end      = 2;
  188.  
  189. var
  190.   regs: RECORD
  191.          AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER
  192.         END;
  193.   CurrentFilePointer_low,
  194.   CurrentFilePointer_high : INTEGER;
  195.  
  196. begin
  197.   with Regs do begin
  198.     AX := (seekfunction shl 8) + from_current;
  199.     BX := MemW[Seg(f):Ofs(f)];   (* handle ! *)
  200.     CX := 0;       (* offset-high *)
  201.     DX := 0;       (* offset-low  *)
  202.     Intr($21, Regs);
  203.     if (Flags and $0001) = 1 then begin
  204.        write('I/O Error ');
  205.        writeHex(AX shr 8);
  206.        writeln (' during FileSize');
  207.      end;
  208.     CurrentFilePointer_low := AX;
  209.     CurrentFilePointer_high := DX;
  210.     (* determine file size *)
  211.     AX := (seekfunction shl 8) + from_end;
  212.     BX := MemW[Seg(f):Ofs(f)];   (* handle ! *)
  213.     CX := 0;       (* offset-high *)
  214.     DX := 0;       (* offset-low  *)
  215.     Intr($21, Regs);
  216.     if (Flags and $0001) = 1 then begin
  217.        write('I/O Error ');
  218.        writeHex(AX shr 8);
  219.        writeln (' during FileSize');
  220.      end;
  221.     FileSize := AX;
  222.     (* restore FilePointer *)
  223.     AX := (seekfunction shl 8) + from_begin;
  224.     BX := MemW[Seg(f):Ofs(f)];   (* handle ! *)
  225.     CX := CurrentFilePointer_high;
  226.     DX := CurrentFilePointer_low;
  227.     Intr($21, Regs);
  228.     if (Flags and $0001) = 1 then begin
  229.        write('I/O Error ');
  230.        writeHex(AX shr 8);
  231.        writeln (' during FileSize');
  232.      end;
  233.   end
  234. end;
  235.  
  236.  
  237. procedure BlockWrite (var f: file; var b; var n: integer);
  238. const
  239.   writefunction = $40;
  240.  
  241. var
  242.   regs: RECORD
  243.          AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER
  244.         END;
  245.  
  246. begin
  247.   with Regs do begin
  248.     AX := (writefunction shl 8);
  249.     BX := MemW[Seg(f):Ofs(f)];
  250.     CX := n;
  251.     DX := Ofs(b);
  252.     DS := Seg(b);
  253.     Intr($21, Regs);
  254.     if (Flags and $0001) = 1 then begin
  255.        write('I/O Error ');
  256.        writeHex(AX shr 8);
  257.        writeln (' during BlockWrite');
  258.      end
  259.   end;
  260. end;
  261.  
  262. procedure Open(var f: file; VAR Name);
  263. const
  264.  OpenFunction = $3D;
  265.  OpenMode = 128; (* read only *)
  266.  
  267. var
  268.   FName: STRING [255] ABSOLUTE Name;
  269.   regs: RECORD
  270.          AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER
  271.         END;
  272.  
  273. begin
  274.   FName := FName + chr (0);
  275.   with Regs do begin
  276.     AX := (OpenFunction shl 8) + OpenMode;
  277.     DX := Ofs (FName) + 1;
  278.     DS := Seg (FName);
  279.     Intr($21, Regs);
  280.     MemW [Seg (f) : Ofs (f)] := AX;
  281.     if (Flags and $0001) = 1 then begin
  282.        write('I/O Error ');
  283.        writeHex(AX shr 8);
  284.        writeln (' during Reset');
  285.      end
  286.  end
  287. end;
  288.  
  289. ----------- start of source ---- CUT HERE FOR DEB2ASM.PAS -------------
  290. (*                                                              *)
  291. (*   DEB2ASM takes disassembly listings from DOS DEBUG and      *)
  292. (*   produces more legible assembly-style listing including     *)
  293. (*   a cross-reference table.                                   *)
  294. (*                                                              *)
  295. (*   author:          P. Kranenburg                             *)
  296. (*                    University of Leiden, Holland             *)
  297. (*                    KRANENBU@HLERUL5.BITNET                   *)
  298. (*                                                              *)
  299. (*   source:          TURBO pascal                              *)
  300. (*   includes files:  SORT.BOX  from TURBO TOOLBOX              *)
  301. (*                    IO.INC I/O routines                       *)
  302. (*                                                              *)
  303. (*   input:           file with disassembly output from DEBUG   *)
  304. (*                    default extension .DEB                    *)
  305. (*   output:          default extension .DBO                    *)
  306. (*                                                              *)
  307. (*                                                              *)
  308. (*   Labels appear in the form  L_XXXX (where XXXX is           *)
  309. (*   the hexadecimal value according to the DEBUG-output        *)
  310. (*                                                              *)
  311. (*   Variables take the form  V_XXXXT                           *)
  312. (*   where XXXX is again a hex value and T is the type          *)
  313. (*       either B, W or D (for BYTE, WORD and DWORD)            *)
  314. (*                                                              *)
  315. (*   In the cross-reference table the variables appear in       *)
  316. (*   one or more entries as:                                    *)
  317. (*                                                              *)
  318. (*     V_XXXX    LABEL    <TYPE> ; R_XXXX, R_XXXX, ...          *)
  319. (*                                                              *)
  320. (*   where <TYPE> is BYTE, WORD or DWORD                        *)
  321. (*   and the R_XXXX's are the locations where the variable      *)
  322. (*   occurs in the code                                         *)
  323. (*                                                              *)
  324. (*                                                              *)
  325. (*   The code has in places be optimized for speed:             *)
  326. (*     - use of GOTO's to break out of loops                    *)
  327. (*     - avoidance of STRING compares                           *)
  328. (*       ie.          case STR[1]                               *)
  329. (*                       'L': if STR='LOOP' then ...            *)
  330. (*                       'J': if STR='JMP'  then ...   etc.     *)
  331. (*                        ...                                   *)
  332. (*                                                              *)
  333. (*       in stead of: if STR='LOOP' then ...                    *)
  334. (*                    else if STR='JMP' then ...                *)
  335. (*                                                              *)
  336. (*  Note: constants appearing in disassembly are not            *)
  337. (*        converted to decimal nor suffixed with an 'H'         *)
  338. (*                                                              *)
  339.  
  340. const
  341.   blank     = ' ';
  342.   tab       = #9;
  343.   comma     = ',';
  344.   colon     = ':';
  345.   semicolon = ';';
  346.  
  347. type
  348.   STR4  = STRING[4];
  349.   STR5  = STRING[5];
  350.   STR6  = STRING[6];
  351.   STR12 = STRING[12];
  352.   STR18 = STRING[18];
  353.   STR80 = STRING[80];
  354.   ReferenceTypes = (None, B, W, D, N, F);
  355.   ParseTypes = RECORD
  356.                  Offset       : STR4;
  357.                  HexCode      : STR12;
  358.                  OpCode       : STR6;
  359.                  Operand1,
  360.                  Operand2     : STR12;
  361.                  Comment      : BYTE;   (* position where comment starts *)
  362.                  TypeOverride : ReferenceTypes
  363.                END;
  364.  
  365. var
  366.   f_in, f_out : text[$2000];
  367.   Line        : STR80;
  368.   LineCount,
  369.   CharPos     : INTEGER;
  370.   FileName    : STR80;
  371.   FileExt     : BOOLEAN;
  372.   Rep         : ARRAY [ReferenceTypes] OF STR5;
  373.   ParsedLine  : ParseTypes;
  374.  
  375. (*$I <path>\io.inc *)
  376. (*$I <path>\sort.box *)
  377.  
  378.   const
  379.    SymbolTableSize = 2000;
  380.  
  381.   type
  382.    TableEntry = RECORD
  383.                   offset,
  384.                   reference : INTEGER;
  385.                   reftype   : ReferenceTypes;
  386.                   position  : BYTE
  387.                 END;
  388.  
  389.  
  390.   var
  391.    SymbolTable,
  392.    AuxTable      : ARRAY [0 .. SymbolTableSize] OF TableEntry;
  393.  
  394.    Current_SymbolTable_Index,
  395.    Symbol_Table_Length,
  396.    SortInputIndex,
  397.    SortOutputIndex,
  398.    SortStatus                  : INTEGER;
  399.  
  400.  
  401. (* TOOLBOX SORT interface *)
  402.  
  403.   procedure Inp;
  404.   begin
  405.     while SortInputIndex < Symbol_Table_Length do begin
  406.       SortRelease(SymbolTable[SortInputIndex]);
  407.       SortInputIndex := succ(SortInputIndex)
  408.     end;
  409.   end;
  410.  
  411.   procedure Outp;
  412.   begin
  413.     while (NOT SortEOS) AND (SortOutputIndex <= Symbol_Table_Length) do begin
  414.       SortReturn(AuxTable[SortOutputIndex]);
  415.       SortOutputIndex := succ(SortOutputIndex) ;
  416.     end;
  417.   end;
  418.  
  419.   function Less;
  420.   var
  421.     Entry1 : TableEntry absolute X;
  422.     Entry2 : TableEntry absolute Y;
  423.   begin
  424.     if Entry1.reference = Entry2.reference then
  425.       Less := Ord(Entry1.reftype) < Ord(Entry2.reftype)
  426.     else (* compare the Entries as unsigned integers *)
  427.         if ((Entry1.reference XOR Entry2.reference) AND $8000) = 0 then
  428.            Less := Entry1.reference < Entry2.reference
  429.         else if (Entry1.reference AND $8000)= $8000 then Less := false
  430.                                                     else Less := true;
  431.   end;
  432.  
  433.  
  434.  
  435.   procedure StoreReference(_Offset, _Label: INTEGER; _RefType: ReferenceTypes;
  436.                            _position: BYTE);
  437.  
  438.   (* This procedure keeps a table of locations referenced *)
  439.   (* including the type of reference                      *)
  440.  
  441.   begin
  442.    (* if _RefType = N then begin
  443.       write('label at ');
  444.       writeHexInt(_Offset); write('  value: ');
  445.       writeHexInt(_Label);
  446.     end else begin
  447.       write('var ref at ');
  448.       writeHexInt(_Offset); write('  to location ');
  449.       writehexint(_Label);
  450.       write('  type: ', rep[_RefType]);
  451.     end;
  452.    *)
  453.     with SymbolTable[Current_SymbolTable_Index] do begin
  454.       offset  := _Offset;
  455.       reference  := _Label;
  456.       reftype := _RefType;
  457.       position := _position
  458.     end;
  459.     Current_SymbolTable_Index := succ(Current_SymbolTable_Index);
  460.     if Current_SymbolTable_Index = SymbolTableSize then begin
  461.       writeln(' SymbolTable overflow ..., program halted');
  462.       halt
  463.     end;
  464.   end;
  465.  
  466.  
  467.     procedure ParseLine(var Result: ParseTypes);
  468.     (* Parses one line of disassembly output *)
  469.     label
  470.       EndParseLine;
  471.  
  472.     type
  473.       CharSet = SET OF CHAR;
  474.  
  475.     const
  476.       U : CharSet = [#0 .. #$FF];
  477.  
  478.     var
  479.       j, k : INTEGER;
  480.  
  481.       procedure SkipBT;   (* Skip blanks and tabs *)
  482.       label
  483.        EndSkip;
  484.       begin
  485.          while CharPos <= Ord(Line[0]) do begin
  486.            case Line[CharPos] of
  487.              blank: CharPos := succ(CharPos);
  488.              tab:   CharPos := succ(CharPos)
  489.              else   goto EndSkip
  490.            end
  491.          end;
  492.       EndSkip: end;
  493.       procedure SkipBTC;   (* Skip blanks, tabs and commas *)
  494.       label
  495.        EndSkip;
  496.       begin
  497.          while CharPos <= Ord(Line[0]) do begin
  498.            case Line[CharPos] of
  499.              blank: CharPos:=succ(CharPos);
  500.              comma: CharPos:=succ(CharPos);
  501.              tab:   CharPos:=succ(CharPos)
  502.              else goto EndSkip
  503.            end
  504.          end;
  505.       EndSkip: end;
  506.       procedure SkipUBT;
  507.       label
  508.        EndSkip;
  509.       begin
  510.         (* Structered code was:                                             *)
  511.         (*                                                                  *)
  512.         (* while (Line[CharPos] IN U-[blank,tab,semicolon]) do              *)
  513.         (*   CharPos:=succ(CharPos)                                         *)
  514.         (* while ( (Line[CharPos] <> blank) AND (Line[CharPos] <> tab)      *)
  515.         (*        AND (Line[CharPos] <> semicolon) )                        *)
  516.         (*        AND (CharPos <= Length(Line)) do CharPos:= succ(CharPos); *)
  517.  
  518.          while CharPos <= Ord(Line[0]) do begin
  519.            case Line[CharPos] of
  520.              blank:     goto EndSkip;
  521.              tab:       goto EndSkip;
  522.              semicolon: goto EndSkip
  523.              else       CharPos := succ(CharPos)
  524.            end
  525.          end;
  526.       EndSkip: end;
  527.       procedure SkipUBTC;
  528.       label
  529.        EndSkip;
  530.       begin
  531.         (* !! Structered code was:                                       *)
  532.         (*                                                               *)
  533.         (* while (     (Line[CharPos] <> blank)                          *)
  534.         (*         AND (Line[CharPos] <> tab)                            *)
  535.         (*         AND (Line[CharPos] <> comma)                          *)
  536.         (*         AND (Line[CharPos] <> semicolon)                      *)
  537.         (*         AND (CharPos <= Length(Line)       )  do              *)
  538.         (*  CharPos:= succ(CharPos);                                     *)
  539.  
  540.          while CharPos <= Ord(Line[0]) do begin
  541.            case Line[CharPos] of
  542.              blank:     goto EndSkip;
  543.              comma:     goto EndSkip;
  544.              tab:       goto EndSkip;
  545.              semicolon: goto EndSkip
  546.              else       CharPos := succ(CharPos)
  547.            end
  548.          end;
  549.       EndSkip: end;
  550.  
  551.       function Stop: BOOLEAN;
  552.       begin
  553.         (* code was:   Stop :=    (Line[CharPos]=semicolon)           *)
  554.         (*                     OR (CharPos > Length(Line)  )          *)
  555.         (* remark: this function should perhaps be inline             *)
  556.  
  557.         if CharPos > Ord(Line[0]) then Stop := true
  558.         else if Line[CharPos] = semicolon then begin
  559.                                            Stop := true;
  560.                                            Result.Comment := CharPos
  561.                                          end
  562.              else Stop := false
  563.       end;
  564.  
  565.       function Appropriate: BOOLEAN;
  566.       (* Find out whether the current line should be parsed *)
  567.       var
  568.         k: INTEGER;
  569.       begin
  570.         CharPos := 1;
  571.         if (Length(Line)<5) OR (Line[1]='-') then Appropriate := false
  572.         else begin
  573.           k := 1;
  574.           while NOT (Line[k] IN [colon, semicolon]) AND (k<6) do k:= succ(k);
  575.           if Line[k] <> semicolon then begin
  576.             Appropriate := true;
  577.             if Line[k] = colon then begin
  578.               CharPos := k + 1;
  579.             end
  580.           end else begin
  581.             Appropriate := false;
  582.             Result.Comment := k
  583.           end
  584.         end
  585.       end;
  586.  
  587.  
  588.     begin (* ParseLine *)
  589.       with Result do begin
  590.         TypeOverride := None;
  591.         Offset[0]    := Chr(0);
  592.         HexCode[0]   := Chr(0);
  593.         OpCode[0]    := Chr(0);
  594.         Operand1[0]  := Chr(0);
  595.         Operand2[0]  := Chr(0);
  596.         Comment := Ord(Line[0]) + 1;
  597.  
  598.         if NOT Appropriate then goto EndParseLine;
  599.  
  600.         SkipBT; if Stop then goto EndParseLine;
  601.         k := CharPos;
  602.         SkipUBT;
  603.       (*  Offset := Copy(Line, k, CharPos-k); *)
  604.         Offset[0] := Chr(CharPos-k);
  605.         Move(Line[k], Offset[1], CharPos-k);
  606.  
  607.         SkipBT; if Stop then goto EndParseLine;
  608.         k := CharPos;
  609.         SkipUBT;
  610.         (* HexCode := Copy(Line, k, CharPos-k); *)
  611.         HexCode[0] := Chr(CharPos-k);
  612.         Move(Line[k], HexCode[1], CharPos-k);
  613.  
  614.  
  615.         SkipBT; if Stop then goto EndParseLine;
  616.         k := CharPos;
  617.         SkipUBT;
  618.       (*  OpCode := Copy(Line, k, CharPos-k); *)
  619.         OpCode[0] := Chr(CharPos-k);
  620.         Move(Line[k], OpCode[1], CharPos-k);
  621.  
  622.         SkipBT; if Stop then goto EndParseLine;
  623.         (* at first operand *)
  624.         k := CharPos;
  625.         SkipUBTC;
  626.       (*  Operand1 := Copy(Line, k, CharPos-k); *)
  627.         Operand1[0] := Chr(CharPos-k);
  628.         Move(Line[k], Operand1[1], CharPos-k);
  629.         case Operand1[1] of
  630.         'B': if Operand1 = 'BYTE' then begin
  631.                TypeOverride := B;
  632.                SkipBT; if Stop then goto EndParseLine;
  633.                SkipUBT;
  634.                SkipBT; if Stop then goto EndParseLine;
  635.                k := CharPos;
  636.                SkipUBTC;
  637.              (*  Operand1 := Copy(Line, k, CharPos-k); *)
  638.                Operand1[0] := Chr(CharPos-k);
  639.                Move(Line[k], Operand1[1], CharPos-k);
  640.              end;
  641.         'W': if Operand1 = 'WORD'  then begin
  642.                TypeOverride := W;
  643.                SkipBT; if Stop then goto EndParseLine;
  644.                SkipUBT;
  645.                SkipBT; if Stop then goto EndParseLine;
  646.                k := CharPos;
  647.                SkipUBTC;
  648.              (*  Operand1 := Copy(Line, k, CharPos-k); *)
  649.                Operand1[0] := Chr(CharPos-k);
  650.                Move(Line[k], Operand1[1], CharPos-k);
  651.              end;
  652.         'D': if Operand1 = 'DWORD' then begin
  653.                TypeOverride := D;
  654.                SkipBT; if Stop then goto EndParseLine;
  655.                SkipUBT;
  656.                SkipBT; if Stop then goto EndParseLine;
  657.                k := CharPos;
  658.                SkipUBTC;
  659.              (*  Operand1 := Copy(Line, k, CharPos-k); *)
  660.                Operand1[0] := Chr(CharPos-k);
  661.                Move(Line[k], Operand1[1], CharPos-k);
  662.              end;
  663.         'F': if Operand1 = 'FAR'   then begin
  664.                TypeOverride := F;
  665.                SkipBT; if Stop then goto EndParseLine;
  666.                k := CharPos;
  667.                SkipUBTC;
  668.              (*  Operand1 := Copy(Line, k, CharPos-k); *)
  669.                Operand1[0] := Chr(CharPos-k);
  670.                Move(Line[k], Operand1[1], CharPos-k);
  671.              end;
  672.         end;
  673.         SkipBTC; if Stop then goto EndParseLine;
  674.         (* second operand *)
  675.         k := CharPos;
  676.         SkipUBTC;
  677.       (*  Operand2 := Copy(Line, k, CharPos-k); *)
  678.         Operand2[0] := Chr(CharPos-k);
  679.         Move(Line[k], Operand2[1], CharPos-k);
  680.         (* check for type override operators *)
  681.         case Operand2[1] of
  682.         'B': if Operand2 = 'BYTE' then begin
  683.                TypeOverride := B;
  684.                SkipBT; if Stop then goto EndParseLine;
  685.                SkipUBT;
  686.                SkipBT; if Stop then goto EndParseLine;
  687.                k := CharPos;
  688.                SkipUBTC;
  689.              (*  Operand2 := Copy(Line, k, CharPos-k); *)
  690.                Operand2[0] := Chr(CharPos-k);
  691.                Move(Line[k], Operand2[1], CharPos-k);
  692.              end;
  693.         'W': if Operand2 = 'WORD'  then begin
  694.                 TypeOverride := W;
  695.                 SkipBT; if Stop then goto EndParseLine;
  696.                 SkipUBT;
  697.                 SkipBT; if Stop then goto EndParseLine;
  698.                k := CharPos;
  699.                SkipUBTC;
  700.              (*  Operand2 := Copy(Line, k, CharPos-k); *)
  701.                Operand2[0] := Chr(CharPos-k);
  702.                Move(Line[k], Operand2[1], CharPos-k);
  703.              end;
  704.         'D': if Operand2 = 'DWORD' then begin
  705.                 TypeOverride := D;
  706.                 SkipBT; if Stop then goto EndParseLine;
  707.                 SkipUBT;
  708.                 SkipBT; if Stop then goto EndParseLine;
  709.                k := CharPos;
  710.                SkipUBTC;
  711.              (*  Operand2 := Copy(Line, k, CharPos-k); *)
  712.                Operand2[0] := Chr(CharPos-k);
  713.                Move(Line[k], Operand2[1], CharPos-k);
  714.              end;
  715.         'F': if Operand2 = 'FAR'   then begin
  716.                TypeOverride := F;
  717.                SkipBT; if Stop then goto EndParseLine;
  718.                k := CharPos;
  719.                SkipUBTC;
  720.              (*  Operand2 := Copy(Line, k, CharPos-k); *)
  721.                Operand2[0] := Chr(CharPos-k);
  722.                Move(Line[k], Operand2[1], CharPos-k);
  723.              end
  724.         end
  725.       end;
  726.     EndParseLine: end;
  727.  
  728.  
  729.   procedure Pass1;
  730.   var
  731.     _Offset,
  732.     _Label, _Mem,
  733.     Status         : INTEGER;
  734.  
  735.   function OperandType(var Operand: STR12): ReferenceTypes;
  736.   begin
  737.     case Operand[2] of
  738.      'X': case Operand[1] of
  739.             'A': OperandType := W;
  740.             'B': OperandType := W;
  741.             'C': OperandType := W;
  742.             'D': OperandType := W
  743.           end;
  744.     'S':  case Operand[1] of
  745.             'C': OperandType := W;
  746.             'D': OperandType := W;
  747.             'E': OperandType := W;
  748.             'S': OperandType := W
  749.           end;
  750.     'L': case Operand[1] of
  751.            'A': OperandType := B;
  752.            'B': OperandType := B;
  753.            'C': OperandType := B;
  754.            'D': OperandType := B
  755.          end;
  756.     'H': case Operand[1] of
  757.            'A': OperandType := B;
  758.            'B': OperandType := B;
  759.            'C': OperandType := B;
  760.            'D': OperandType := B
  761.          end;
  762.     'I': case Operand[1] of
  763.            'S': OperandType := W;
  764.            'D': OperandType := W
  765.          end;
  766.     'P': case Operand[1] of
  767.            'B': OperandType := W;
  768.            'S': OperandType := W
  769.          end
  770.    end (* case *)
  771.   end;
  772.  
  773.   procedure MemoryOperand(var Operand, OperandX: STR12; Position: BYTE;
  774.                                                  ExplicitType: ReferenceTypes);
  775.   begin
  776.     if (Ord(Operand[0])=6) then begin
  777.      if (Operand[1] = '[') AND (Operand[6] = ']') then begin
  778.        Val ( '$'+Copy(Operand, 2, 4), _Mem, Status);
  779.        if Status = 0 then begin (* valid 4 digit hex number *)
  780.          case ExplicitType of
  781.            N: ExplicitType := W; (* indirect jump or call *)
  782.            F: ExplicitType := D  (* far indirect jump or call *)
  783.          end;
  784.          if (ExplicitType <> None) then
  785.            StoreReference (_Offset, _Mem, ExplicitType, Position)
  786.          else
  787.            StoreReference (_Offset, _Mem, OperandType(OperandX), Position);
  788.        end  (* valid memory operand *)
  789.      end   (* [,] *)
  790.     end  (* length = 6 *)
  791.   end;
  792.  
  793.   begin (* Pass 1 *)
  794.     gotoXY(1,25); Write('Pass 1  , Line ');
  795.     LineCount := 0;
  796.     while NOT EOF(f_in) do begin
  797.       readln(f_in, Line);
  798.       LineCount := succ(LineCount);
  799.       if (LineCount and $000F) = 0 then begin
  800.          gotoXY(16,25);
  801.          write(LineCount:3)
  802.       end;
  803.       ParseLine(ParsedLine);
  804.       with ParsedLine do begin
  805.          (****
  806.            gotoxy(12,wherey);writeln(offset,'|','|',opcode,'|',
  807.                                    operand1,'|',operand2,'|');
  808.           ****)
  809.         Val ( '$'+Offset, _Offset, Status);
  810.         if Status = 0 then begin
  811.          Status := -1;
  812.          (* check for opcodes with CODE_LABEL operands *)
  813.          case OpCode[1] of
  814.             'J': begin
  815.                    Val ( '$'+Operand1, _Label, Status);
  816.                    if Status <> 0 then begin
  817.                      if (OpCode = 'JMP') AND (TypeOverride=None) then
  818.                        TypeOverride := N;   (* try indirect NEAR jump *)
  819.                    end
  820.                  end;
  821.             'C': if OpCode = 'CALL' then begin
  822.                    Val ( '$'+Operand1, _Label, Status);
  823.                    if (Status <> 0) AND (Operand1[5]=':') then begin
  824.                      Val('$'+Copy(Operand1, 6, 4), _Label, Status);
  825.                      if Status = 0 then StoreReference (_Offset, _Label, F, 1);
  826.                      Status := -1;
  827.                    end
  828.                  end;
  829.             'L': if (OpCode = 'LOOP')  OR
  830.                     (OpCode = 'LOOPZ') OR (OpCode = 'LOOPNZ')
  831.                    then Val ( '$'+Operand1, _Label, Status);
  832.             'P': if OpCode = 'PUSH' then TypeOverride := W
  833.                  else if OpCode = 'POP' then TypeOverride := W;
  834.          end (* case *);
  835.          if Status = 0 then begin (* valid near label *)
  836.            StoreReference (_Offset, _Label, N, 1)
  837.          end;
  838.  
  839.          MemoryOperand(Operand1, Operand2, 1, TypeOverride);
  840.          MemoryOperand(Operand2, Operand1, 2, TypeOverride);
  841.  
  842.         end (* valid offset *)
  843.       end (* with ParsedLine *)
  844.     end (* while *);
  845.     gotoXY(16,25); write(LineCount:3);
  846.   end (* Pass 1 *);
  847.  
  848.  
  849.   procedure Pass2;
  850.   type
  851.     PrefixTypes = (NoPrefix, REP, REPZ, REPNZ, LOCK, CS, DS, ES, SS);
  852.   var
  853.     k, _Offset,
  854.     NextOffset,
  855.     NextRef,
  856.     Status      : INTEGER;
  857.     Prefix      : PrefixTypes;
  858.     ASMLine     : STR80;
  859.  
  860.   function TestPrefix: BOOLEAN;
  861.   var
  862.     HexByte, Status: INTEGER;
  863.   begin
  864.     case ParsedLine.OpCode[3] of  (* test for prefix opcodes *)
  865.       ':', 'P', 'C' : begin
  866.           Val('$'+ParsedLine.HexCode, HexByte, Status);
  867.           case HexByte of
  868.            $2E: begin Prefix := CS;    TestPrefix := true end;
  869.            $26: begin Prefix := ES;    TestPrefix := true end;
  870.            $3E: begin Prefix := DS;    TestPrefix := true end;
  871.            $36: begin Prefix := SS;    TestPrefix := true end;
  872.            $F2: begin Prefix := REPNZ; TestPrefix := true end;
  873.            $F3: begin Prefix := REPZ;  TestPrefix := true end;
  874.            $F0: begin Prefix := LOCK;  TestPrefix := true end;
  875.            else TestPrefix := false
  876.           end
  877.       end
  878.       else TestPrefix := false
  879.     end;
  880.   end;
  881.  
  882.   begin (* Pass 2 *)
  883.     gotoXY(1,25); Write('Pass 2  , Line ');
  884.     NextOffset := 0;
  885.     NextRef := 0;
  886.     Prefix := NoPrefix;
  887.     LineCount := 0;
  888.     while NOT EOF(f_in) do begin
  889.       readln(f_in, Line);
  890.       LineCount := succ(LineCount);
  891.       if (LineCount and $000F) = 0 then begin
  892.          gotoXY(16,25);
  893.          write(LineCount:3)
  894.       end;
  895.  
  896.       ParseLine(ParsedLine);
  897.  
  898.       if NOT TestPrefix then begin
  899.         with ParsedLine do begin
  900.           if (Prefix = REPZ) OR (Prefix = REPNZ) then begin
  901.             if (Opcode[1] IN ['M', 'L', 'S']) AND (Ord(OpCode[0])<>0) then
  902.               Prefix := REP
  903.           end;
  904.         Val ( '$'+Offset, _Offset, Status);
  905.         if Status = 0 then begin
  906.          if _Offset = SymbolTable[NextOffset].offset then begin
  907.            case SymbolTable[NextOffset].reftype of
  908.              N:     begin
  909.                       Move(Operand1[1], Operand1[3], 4);
  910.                       Operand1[0] := succ(succ(Operand1[0]));
  911.                       Operand1[1] := 'L';
  912.                       Operand1[2] := '_';
  913.                     end;
  914.              B,W,D: begin
  915.                       if SymbolTable[NextOffset].position = 1 then begin
  916.                         Operand1[1] := 'V';
  917.                         Operand1[6] := '_';
  918.                       end else begin
  919.                         Operand2[1] := 'V';
  920.                         Operand2[6] := '_';
  921.                       end
  922.                     end;
  923.            end;
  924.            NextOffset := succ(NextOffset);
  925.          end;
  926.          while AuxTable[NextRef].reference < _Offset do
  927.             NextRef := succ(NextRef);
  928.          while _Offset = AuxTable[NextRef].reference do begin
  929.            case AuxTable[NextRef].reftype of
  930.              N:     begin
  931.                       Writeln(f_out, '  L_'+ Offset+':');
  932.                     end;
  933.              B:     begin
  934.                       Writeln(f_out, '  V_'+ Offset+tab+'DB', tab, '?');
  935.                     end;
  936.              W:     begin
  937.                       Writeln(f_out, '  V_'+ Offset+tab+'DW', tab, '?');
  938.                     end;
  939.              D:     begin
  940.                       Writeln(f_out, '  V_'+ Offset+tab+'DD', tab, '?');
  941.                     end;
  942.  
  943.            end;
  944.            repeat NextRef:=succ(NextRef)
  945.            until (AuxTable[NextRef].reftype <> AuxTable[NextRef-1].reftype) OR
  946.                  (_Offset <> AuxTable[NextRef].reference) OR
  947.                  (NextRef >= Symbol_Table_Length);
  948.          end;
  949.          if Offset[0] <> Chr(0) then begin
  950.          write(f_out, tab, tab);
  951.          case Prefix of
  952.           REP:  begin
  953.                   write(f_out, 'REP ');
  954.                   Prefix := NoPrefix
  955.                 end;
  956.           REPZ: begin
  957.                   write(f_out, 'REPZ ');
  958.                   Prefix := NoPrefix
  959.                 end;
  960.           REPNZ:begin
  961.                   write(f_out, 'REPNZ ');
  962.                   Prefix := NoPrefix
  963.                 end;
  964.           LOCK: begin
  965.                   write(f_out, 'LOCK ');
  966.                   Prefix := NoPrefix
  967.                 end;
  968.          end;
  969.          write(f_out, OpCode, tab);
  970.          if Ord(Operand1[0]) > 2 then begin
  971.            case TypeOverride of
  972.             None: ;
  973.             B   : write(f_out, 'BYTE PTR ');
  974.             W   : write(f_out, 'WORD PTR ');
  975.             D   : write(f_out, 'DWORD PTR ');
  976.             F   : write(f_out, 'FAR PTR ');
  977.            end;
  978.            case Prefix of
  979.              NoPrefix: ;
  980.               CS: begin write(f_out, 'CS:'); Prefix := NoPrefix end;
  981.               ES: begin write(f_out, 'ES:'); Prefix := NoPrefix end;
  982.               SS: begin write(f_out, 'SS:'); Prefix := NoPrefix end;
  983.               DS: begin write(f_out, 'DS:'); Prefix := NoPrefix end;
  984.            end;
  985.          end;
  986.          write(f_out, Operand1);
  987.          if Operand2[0]<>Chr(0) then begin
  988.              write(f_out, ', ');
  989.          if Ord(Operand2[0]) > 2 then begin
  990.            case TypeOverride of
  991.             None: ;
  992.             B   : write(f_out, 'BYTE PTR ');
  993.             W   : write(f_out, 'WORD PTR ');
  994.             D   : write(f_out, 'DWORD PTR ');
  995.             F   : write(f_out, 'FAR PTR ');
  996.            end;
  997.            case Prefix of
  998.             NoPrefix: ;
  999.               CS: begin write(f_out, 'CS:'); Prefix := NoPrefix end;
  1000.               ES: begin write(f_out, 'ES:'); Prefix := NoPrefix end;
  1001.               SS: begin write(f_out, 'SS:'); Prefix := NoPrefix end;
  1002.               DS: begin write(f_out, 'DS:'); Prefix := NoPrefix end;
  1003.            end;
  1004.          end;
  1005.              write(f_out, Operand2);
  1006.          end
  1007.          else write(f_out, tab);
  1008.          end;
  1009.          if Comment <= Ord(Line[0]) then
  1010.            writeln(f_out, tab, Copy(Line, comment, Ord(Line[0])+1-comment))
  1011.          else
  1012.            writeln(f_out)
  1013.         end (* valid offset *)
  1014.       end (* with *)
  1015.       end
  1016.       end;
  1017.     gotoXY(16,25); write(LineCount:3);
  1018.   end (* Pass2 *);
  1019.  
  1020.   procedure CrossRefList;
  1021.   var
  1022.     OffsetStr, RefStr: STR4;
  1023.     k: INTEGER;
  1024.  
  1025.   begin
  1026.     writeln(f_out, '    *******   writing cross reference listing  ******');
  1027.     writeln(f_out);
  1028.     CharPos:= 0;
  1029.     while CharPos<= (symbol_table_length-1) do begin
  1030.       with AuxTable[CharPos] do begin
  1031.         OffsetStr[0] := Chr(4); RefStr[0] := Chr(4);
  1032.         HexString(OffsetStr, reference);
  1033.         HexString(RefStr, offset);
  1034.         case reftype of
  1035.         (*   N: Write(f_out, 'L_', OffsetStr, 'N', tab, 'LABEL', tab, 'NEAR',
  1036.                            '  ; R_', RefStr);
  1037.          *)
  1038.            B: Write(f_out, 'V_', OffsetStr, 'B', '    ', 'LABEL', tab, 'BYTE',
  1039.                            tab, '; R_', RefStr);
  1040.            W: Write(f_out, 'V_', OffsetStr, 'W', '    ', 'LABEL', tab, 'WORD',
  1041.                            tab, '; R_', RefStr);
  1042.            D: Write(f_out, 'V_', OffsetStr, 'D', '    ', 'LABEL', tab, 'DWORD',
  1043.                            tab, '; R_', RefStr);
  1044.            F: Write(f_out, 'L_', OffsetStr, 'F', '    ', 'LABEL', tab, 'FAR',
  1045.                            tab, '; R_', RefStr);
  1046.         end;
  1047.    (*
  1048.         writehexint(reference);write('  ');
  1049.         writehexint(offset);write('  ');
  1050.         write(rep[reftype]);write('  ');
  1051.         writeln(position:2);
  1052.    *)
  1053.         CharPos:=succ(CharPos);
  1054.         k := 1;
  1055.         while (reftype = AuxTable[CharPos].reftype) AND
  1056.               (reference = AuxTable[CharPos].reference) AND
  1057.               (CharPos<= Symbol_Table_Length - 1)
  1058.         do begin
  1059.           if reftype <> N then begin
  1060.             HexString(RefStr, AuxTable[CharPos].offset);
  1061.             if k = 5 then begin
  1062.                             k:=0;
  1063.                             writeln(f_out);
  1064.                             write(f_out, tab,tab,tab,tab, '; R_', RefStr) end
  1065.                      else write(f_out, ' ,R_', RefStr);
  1066.             k := succ(k)
  1067.           end;
  1068.           CharPos:= succ(CharPos)
  1069.         end;
  1070.         if reftype <> N then writeln(f_out);
  1071.       end;
  1072.     end;
  1073.     writeln(f_out);
  1074.   end;
  1075.  
  1076. begin
  1077.   rep[none]:='NONE';
  1078.   rep[B]:='BYTE';rep[W]:='WORD';rep[D]:='DWORD';
  1079.   rep[N]:='NEAR';rep[F]:='FAR';
  1080.   Current_SymbolTable_Index:= 0;
  1081.   write('Enter filename: '); readln(FileName);
  1082.   FileExt := false;
  1083.   for CharPos:=1 to Length(FileName) do FileExt := FileName[CharPos] = '.';
  1084.  
  1085.   if FileExt then assign(f_in, FileName)
  1086.              else assign(f_in, FileName+'.DEB');
  1087.  
  1088.   (* start pass 1 *)
  1089.   reset(f_in);
  1090.   Pass1;
  1091.   Symbol_Table_Length := Current_SymbolTable_Index;
  1092.   Current_SymbolTable_Index := 0;
  1093.   Writeln;
  1094.   Writeln(Symbol_Table_Length, ' symbols');
  1095.   (* Sort symboltable *)
  1096.  
  1097.   SortInputIndex := 0;
  1098.   SortOutputIndex := 0;
  1099.   Writeln('Sorting symboltable ...');
  1100.   SortStatus := TurboSort(SizeOf(TableEntry));
  1101.   if SortStatus <> 0 then writeln('Error ', SortStatus:2, ' during sorting');
  1102.  
  1103.   if FileExt then begin
  1104.     CharPos:= 1;
  1105.     while FileName[CharPos] <> '.' do CharPos:= succ(CharPos);
  1106.     FileName := copy(FileName, 1, pred(CharPos));
  1107.   end;
  1108.   assign(f_out, FileName+'.DBO');
  1109.   rewrite(f_out);
  1110.   Writeln('Writing cross-reference');
  1111.   CrossRefList;
  1112.  
  1113.   (* start pass 2 *)
  1114.   reset(f_in);
  1115.   Pass2;
  1116.   close(f_out);
  1117.   close(f_in)
  1118. end.
  1119.  
  1120. -------------------- end --------------
  1121.