{$R-}    {Range checking off}
{$B-}    {Boolean short circuiting off}
{$S-}    {Stack checking off}
{$I+}    {I/O checking on}
{$N-}    {No numeric coprocessor}
{$V-}    {Relaxed String Checking}
{$M 65500,16384,655360} {Turbo 3 default stack and heap}

                          {UNINLINE7}
(*********  Source code Copyright 1986, by L. David Baldwin   *********)
{
Version 1.1.  Convert to Turbo 4.
}
program Inline_disasm;

Uses
  Crt;

Const
  Tab = 9;
  Signon1 : String[35] = ^M^J'Inline Disassembler, Vers 1.1'^M^J;
  Signon2 : String[40] = '(C) Copyright 1986 by L. David Baldwin'^M^J;

  Ulen=80;
  Symbolleng=28;
  MaxByte=Maxint;
  Tokenleng=7;
  MaxLabels=300;
  PhraseOk=True;
  FirstTab=7;
  SecondTab=15;
Type
  Byteptr=^Byte;
  Ptrrec=Record R,S :Word; end;
  String8=String[8];
  String127=String[127];
  String2=Array[1..2] of Char;
  Filestring=String[64];
  Regstrtype=Array[0..15] of Array[1..2] of Char;
  Segregtype=Array[0..3] of Array[1..2] of Char;

{Packet holds a displacement which may be either in phrase form (symbolic
  expression) or numeric form.  It may be of byte or word size}
  Packet =Record
           Dispsize :(Bytesize,Wordsize);
           case Phrase : Boolean of  {either a numeric or symbollic phrase}
              True   :(S :String[Symbolleng]);
              False  :(Value : Integer);
           end;
  Line = Record  {Disassembled instruction is built up in a 'line'}
          case Boolean of
            True:  (S:String[Ulen]);
            False :(Len : Byte; PCsave : Integer);
           end;
Var
  Ustring : Line;
  Chi,PC,PCstart,PCfinish : Integer;
  NValue :Word;
  Token : String[Tokenleng];
  Pair : String2;
  LCh : Char Absolute Pair;
  UCh     :Char;
  St      :String127;
  Symname:String[Symbolleng];
  EofInf,BytePending,Firsttime,Wd,ToReg,PrefixFl,Wait_Found : Boolean;
  Reg,Mode,Rm : Word;
  Opcode,PendingByte :Byte;
  UsIndex,TIndex,LabelIndx,ErrCount : Integer;
  TextArray : Array[0..MaxByte] of Char;
  Inf,Outf : Text;
  Labels : Array[0..MaxLabels] of Record          {Holds info on needed labels}
             PCvalue : Integer; Found : Boolean;
             end;

Const Opcodes : Array[0..$FF] of Byte = (
   5,5,5,5,5,5,73,71,69,69,69,69,69,69,73,20,
   4,4,4,4,4,4,73,71,86,86,86,86,86,86,73,71,
   6,6,6,6,6,6,24,18,97,97,97,97,97,97,16,19,
   102,102,102,102,102,102,91,0,13,13,13,13,13,13,23,3,
   29,29,29,29,29,29,29,29,21,21,21,21,21,21,21,21,
   73,73,73,73,73,73,73,73,71,71,71,71,71,71,71,71,
   20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,
   49,46,34,41,37,43,35,42,51,48,50,47,38,44,39,45,
   20,20,20,20,98,98,100,100,62,62,62,62,62,54,62,71,
   67,100,100,100,100,100,100,100,8,17,7,99,74,72,84,52,
   62,62,62,62,63,64,14,15,98,98,95,96,57,58,87,88,
   62,62,62,62,62,62,62,62,62,62,62,62,62,62,62,62,
   20,20,80,80,55,53,62,62,20,20,81,81,32,30,31,33,
   20,20,20,20,2,1,20,101,20,20,20,20,20,20,20,20,
   61,60,59,36,28,28,70,70,7,40,40,40,28,28,70,70,
   56,20,79,78,25,12,20,20,9,92,11,94,10,93,20,20);

Const Grp1_2names : Array[0..15] of Byte =
               (98,75,68,66,65,27,22,26,29,21,7,7,40,40,73,75);

Const Shiftnames : Array[0..7] of Byte =(82,83,76,77,89,90,75,85);

Const Immednames : Array[0..7] of Byte = (5,69,4,86,6,97,102,13);

Const Instrnames : Array[0..102] of String[6] = (
'AAA',  'AAD',   'AAM',  'AAS',  'ADC',  'ADD',  'AND',  'CALL', 'CBW',  'CLC',
'CLD',  'CLI',   'CMC',  'CMP',  'CMPSB','CMPSW','CS:',  'CWD',  'DAA',  'DAS',
'DB',   'DEC',   'DIV',  'DS:',  'ES:',  'HLT',  'IDIV', 'IMUL', 'IN',   'INC',
'INT',  'INTO',  'INT 3','IRET', 'JB',   'JBE',  'JCXZ', 'JZ',   'JL',   'JLE',
'JMP',  'JNB',   'JA',   'JNZ',  'JGE',  'JG',   'JNO',  'JPO',  'JNS',  'JO',
'JPE',  'JS',    'LAHF', 'LDS',  'LEA',  'LES',  'LOCK', 'LODSB','LODSW','LOOP',
'LOOPE','LOOPNE','MOV',  'MOVSB','MOVSW','MUL',  'NEG',  'NOP',  'NOT',  'OR',
'OUT',  'POP',   'POPF', 'PUSH', 'PUSHF','???',  'RCL',  'RCR',  'REPE', 'REPNE',
'RET',  'RETF',  'ROL',  'ROR',  'SAHF' ,'SAR',  'SBB',  'SCASB','SCASW','SHL',
'SHR',  'SS:',   'STC',  'STD',  'STI',  'STOSB','STOSW','SUB',  'TEST', 'WAIT',
'XCHG', 'XLAT',  'XOR');


Const   RegStr : Regstrtype = (
                'AX','CX','DX','BX','SP','BP','SI','DI',
                'AL','CL','DL','BL','AH','CH','DH','BH');
        SegRegStr : Segregtype = ('ES','CS','SS','DS');


{-------------OutUstring}
PROCEDURE OutUstring;
Var Tmp : Integer;
begin
(* WriteLn(Ustring.S);      *)
if TIndex < MaxByte-Ulen then
  begin
  Tmp:=Ustring.Len+1;
  Move(Ustring, TextArray[TIndex], Tmp);
  TIndex:=TIndex+Tmp;
  end
else
  begin
  WriteLn('Output Array Overflow');
  Halt(1);
  end;
end;

{-------------Error}
PROCEDURE Error(II :Integer; S :String127);
Var X,Y : Integer;
  NewS : String127;
begin
GotoXY(1,WhereY);
WriteLn(St);
Y:=WhereY;
X:=II-3; if X<1 then X:=1;
GotoXY(X, Y);
Write('^');
if S[0]>#0 then  NewS:='Error, '+S else NewS:='Error';
if X+Ord(NewS[0])>80 then X:=X-Ord(NewS[0]) else X:=X+1;
GotoXY(X,Y);  WriteLn(NewS);
ErrCount:=Succ(ErrCount);
if ErrCount>6 then
  begin
  WriteLn('Excessive Number of Errors');
  Halt(1);
  end;
end;


PROCEDURE ByteErr; Forward;
PROCEDURE NumbyteErr; Forward;
{$I unpars.inc}

{-------------InsrtChr}
PROCEDURE InsrtChr(C :Char);
begin
Ustring.S[UsIndex]:=C;
if Ustring.Len<UsIndex then Ustring.Len:=UsIndex;
UsIndex:=UsIndex+1;
end;

{-------------Comma}
PROCEDURE Comma;
begin  InsrtChr(','); end;

{-------------InsrtSt}
PROCEDURE InsrtSt(S :String127);
Var     K       :Integer;
begin
for K:=1 to Ord(S[0]) do
   begin
   InsrtChr(S[K]);
   end;
end;

Type String4=String[4];
{-------------Hex2}
FUNCTION Hex2(B :Byte): String4;
Const HexDigs :Array[0..15] of Char = '0123456789ABCDEF';
Var Bz :Byte;
begin
Bz:=B and $F;  B:=B Shr 4;
Hex2:=HexDigs[B]+HexDigs[Bz];
end;

{-------------Hex4}
FUNCTION Hex4(W :Integer): String4;
begin Hex4:=Hex2(Hi(W))+Hex2(Lo(W)); end;

{-------------Insrthx2}
PROCEDURE Insrthx2(B :Byte);
begin
InsrtChr('$');
InsrtSt(Hex2(B));
end;

{-------------Insrthx4}
PROCEDURE Insrthx4(W :Word);
begin
InsrtChr('$');
InsrtSt(Hex4(W));
end;

{-------------InsrtDisp}
PROCEDURE InsrtDisp(Disp : Packet);
begin
with Disp do
  if not Phrase then
    begin
    if (Dispsize=Bytesize)  then
       begin
       if Value and $80 <>0 then
          begin
          InsrtChr('-');  {turn into negative number}
          Value:=-(Value or $FF00);
          end
       else InsrtChr('+');
       Insrthx2(Lo(Value));
       end
    else
       Insrthx4(Value);
    end
  else InsrtSt(S);
end;

{-------------FormLabel}
FUNCTION FormLabel(N : Integer): String8;
Var S : String8;
begin
Str(N,S);
FormLabel:='X'+S;
end;

{-------------OutLabel}
PROCEDURE OutLabel(N : Integer);

  PROCEDURE AddLabel(N : Integer);
  Var I : Integer; Fnd : Boolean;
  begin
  Fnd:=False;   {only add label if it isn't already there}
  I:=0;
  while (I<LabelIndx) and not Fnd do
    begin Fnd:=Labels[I].PCvalue=N;  I:=Succ(I); end;
  if not Fnd then
    if LabelIndx<=MaxLabels then
      with Labels[LabelIndx] do
        begin
        PCvalue:=N;
        Found:=False;   {will try to find it later}
        LabelIndx:=Succ(LabelIndx);
        end;
  end;
begin
AddLabel(N);
InsrtSt(FormLabel(N));
end;

{-------------ByteErr}
PROCEDURE ByteErr;
begin
Error(Chi,'Byte Exp');
Next;  {pass it by}
PC:=Succ(PC);
end;

{-------------NumbyteErr}
PROCEDURE NumbyteErr;
begin
Error(Chi,'Numerical Byte Exp');
Next;  {pass it by}
PC:=Succ(PC);
end;

{-------------ShortJump}
PROCEDURE ShortJump;
{the short jump instructions}
Var Pk : Packet;
    Vl : Word;
begin
if not GetByte(Pk,PhraseOk) then ByteErr;
if (Opcode=$EB) then InsrtSt('SHORT ');
with Pk do
  if not Phrase then
    begin
    Vl:=Value;
    if (Vl and $80 <>0) then Vl:=Vl or $FF00;  {sign extend}
    Vl:=Vl+PC;
    OutLabel(Vl);
    end
  else InsrtDisp(Pk);
end;

{-------------IntraSeg}
PROCEDURE IntraSeg;
{the intrasegment direct jumps and calls}
Var Pk : Packet;
begin
GetWord(Pk);
InsrtSt('NEAR ');
if not Pk.Phrase then OutLabel(Pk.Value+PC)
  else InsrtDisp(Pk);
end;

{-------------InterSeg}
PROCEDURE InterSeg;
{the intersegment direct jumps and calls}
Var Segm,Ofst : Packet;
begin
GetWord(Ofst);  GetWord(Segm);
InsrtSt('FAR ');
InsrtDisp(Segm); InsrtSt(':'); InsrtDisp(Ofst);
end;

{-------------MovImToReg}
PROCEDURE MovImToReg;
{the move immediate to a reg such as mov bl,12 }
Var Disp : Packet;
begin
Reg:=(Opcode and $F) Xor 8;
InsrtSt(RegStr[Reg]);  Comma;
if (Opcode and 8)<>0 {word} then
    GetWord(Disp)
else
    if not GetByte(Disp,PhraseOk) then ByteErr;
InsrtDisp(Disp);
end;

{-------------DoMem}
PROCEDURE DoMem(Disp : Packet);
Type  Rptype=Array[0..7] of String[5];
Const Regphrase : Rptype = (
         'BX+SI','BX+DI','BP+SI','BP+DI','SI','DI','BP','BX');

begin
if Mode=3 then
   begin        {its a reg}
   if not Wd then Rm:=Rm+8;
   InsrtSt(RegStr[Rm]);
   end
else
   begin        {its a memory}
   InsrtChr('[');
   if (Rm=6) and (Mode=0) then
      InsrtDisp(Disp)
   else
      begin     {need a register phrase}
      InsrtSt(Regphrase[Rm]);
      if Mode<>0 then
         begin
         if (Disp.Dispsize=Wordsize) or Disp.Phrase then InsrtChr('+');
         InsrtDisp(Disp);
         end;
      end;
   InsrtChr(']');
   end;
end;

{-------------DoReg}
PROCEDURE DoReg;
begin
if not Wd then Reg:=Reg+8;
InsrtSt(RegStr[Reg]);
end;

{-------------ReadModeByte}
PROCEDURE ReadModeByte(Var Disp : Packet);
{read the mode byte and sort out the various parts.  read the
 displacement byte or word if req'D}
Var Modebyte : Byte;
    Pk : Packet;
begin
if not GetByte(Pk, not PhraseOk) then NumbyteErr;
Modebyte:=Lo(Pk.Value);
Rm:=Modebyte and 7;
Mode:=(Modebyte and $C0) div 64;
Reg:=(Modebyte and $38) div 8;
if (Mode=0) and (Rm=6) or (Mode=2) then
   GetWord(Disp)        {get address or 16 bit disp}
else if Mode=1 then     {its a 8 bit displ}
   if not GetByte(Disp, PhraseOk) then ByteErr;
end;

{-------------MemSeg}
PROCEDURE MemSeg;
{move seg reg to/from mem/reg}
Var Disp : Packet;
begin
ToReg:=(Opcode and 2)<>0;
Wd:=True;
ReadModeByte(Disp);
Reg:=Reg and 3; {0..3}
if ToReg then
   begin InsrtSt(SegRegStr[Reg]);  Comma; DoMem(Disp);  end
else
   begin DoMem(Disp); Comma; InsrtSt(SegRegStr[Reg]); end;
end;

{-------------ImedToAc}
PROCEDURE ImedToAc;     {do the immediates to ac}
Var Disp : Packet;
begin
Wd:=(Opcode and 1)<>0;
Reg:=0;         {ax or al}
if Wd then
   GetWord(Disp)
else
   if not GetByte(Disp, PhraseOk) then ByteErr;
DoReg; Comma;
if Wd or Disp.Phrase then InsrtDisp(Disp)
  else Insrthx2(Lo(Disp.Value));  {no sign}
end;

{-------------Immed}
PROCEDURE Immed;        {add reg/mem,12   xor reg/mem,1234}
Var     Signext :Boolean;
        D1,D2 : Packet;
begin
Wd:=(Opcode and 1)<>0;
Signext:=((Opcode and 2)<>0) and (Opcode<=$83);{mov does not have sign ext}
ReadModeByte(D1);
if Opcode<=$83 then     {mov has name output already}
   InsrtSt(Instrnames[Immednames[Reg]]);
UsIndex:=SecondTab;
if Wd and not Signext then
  GetWord(D2)
else
  if not GetByte(D2, PhraseOk) then ByteErr;
if Mode<>3 then
   begin
   if Wd then InsrtSt('WORD PTR ')
   else InsrtSt('BYTE PTR ');
   end;
DoMem(D1); Comma;
InsrtDisp(D2);
end;

{$I flpt.inc}

{-------------DoShift}
PROCEDURE DoShift;      {do the shift and rotate instr}
Var Pk : Packet;
begin
Wd:=(Opcode and 1)<>0;
ReadModeByte(Pk);
InsrtSt(Instrnames[Shiftnames[Reg]]);
UsIndex:=SecondTab;
if Mode<>3 then
   begin
   if Wd then InsrtSt('WORD PTR ')
   else InsrtSt('BYTE PTR ');
   end;
DoMem(Pk); Comma;
if (Opcode and 2)<>0 then
   InsrtSt('CL') else InsrtSt('1');
end;

{-------------DoGroup1_2}
PROCEDURE DoGroup1_2;   {f6,f7,fe,ff}
Var Pk : Packet;
begin
Wd:=(Opcode and 1)<>0;
ReadModeByte(Pk);
if (Opcode and 8)<>0 then Reg:=Reg+8;   {reg is ptr to name in this case}
if (Opcode=$FE) then if (Reg>=$A) then
   Reg:=$F;     {no call, jmp, push of bytes}
InsrtSt(Instrnames[Grp1_2names[Reg]]);
UsIndex:=SecondTab;
if (Reg=$A) or (Reg=$C) then InsrtSt('NEAR ')
else if (Reg=$B) or (Reg=$D) then InsrtSt('FAR ')
else if (Mode<>3) then if (Reg<>$E) {push}  then
   begin
   if Wd then InsrtSt('WORD PTR ')
   else InsrtSt('BYTE PTR ');
   end;
DoMem(Pk);
if Reg=0 then
   begin        {test}
   Comma;
   if Wd then begin GetWord(Pk); InsrtDisp(Pk); end
   else
     begin
     if not GetByte(Pk, PhraseOk) then ByteErr;
     if Pk.Phrase then InsrtDisp(Pk)
     else Insrthx2(Lo(Pk.Value));       {no sign}
     end;
   end;
end;

{-------------MemToReg}
PROCEDURE MemToReg;
{lds,les,lea}
Var Pk : Packet;
begin
Wd:=True; ToReg:=True;
ReadModeByte(Pk);
DoReg; Comma;
DoMem(Pk);
end;

{-------------MemAccum}
PROCEDURE MemAccum;
{handle mov ac,[1234] , cmp ac,[5678] etc}
Var Disp : Packet;
begin
Wd:=(Opcode and 1)<>0;
ToReg:=(Opcode and 2)=0;        {note the difference in sense}
Reg:=0; {will be ax or al}
GetWord(Disp);
Rm:=6; Mode:=0;         {for displacement only}
if ToReg then
   begin DoReg; Comma; DoMem(Disp); end
else
   begin DoMem(Disp); Comma; DoReg; end;
end;

{-------------MregMreg}
PROCEDURE MregMreg;
{do the mem/reg, mem/reg instructions, such as mov bx,[bp+1234]
 or add [bx],dx }
Var Pk : Packet;
begin
Wd:=(Opcode and 1)<>0;
ToReg:=(Opcode and 2)<>0;
ReadModeByte(Pk);
if ToReg then
   begin DoReg; Comma; DoMem(Pk); end
else
   begin DoMem(Pk); Comma; DoReg; end;
end;

{-------------Rep_lock}
PROCEDURE Rep_lock;     {do lock, repe, repne,wait, and seg overrides}
begin
PrefixFl:=True;
OutUstring;
end;

{-------------UnAssem1}
PROCEDURE UnAssem1;
{unassemble one line of code (or two if preceeded by a seg instruction)
 output the unassembled line in ustring.}
Label 10;
Const
  Dolater : set of Byte = [$9B,$F6,$F7,$FE,$FF,$D0..$D3,$D8..$DF,$80..$83];
Var
  Pk : Packet;
  Err : Boolean;
    PROCEDURE InsByte;
    Var Pk1 : Packet;
    begin
    if not GetByte(Pk1, PhraseOk) then ByteErr;
    if Pk1.Phrase then InsrtDisp(Pk1) else Insrthx2(Lo(Pk1.Value));
    end;
begin
Wait_Found:=False;
repeat
  PrefixFl:=False;      {set true later if a segm overide instr found}
  Ustring.Len:=0;
  FillChar(Ustring.S[1], Ulen, ' ');     {clear ustring}
  Ustring.PCsave:=PC;
  repeat
    Err:=not GetByte(Pk, not PhraseOk);
    if Err then begin NumbyteErr; Next; end;
    Opcode:=Pk.Value;
  until not Err;
  UsIndex:=FirstTab;
  if not (Opcode in Dolater) then
    begin       {most items have opcode name output now}
    InsrtSt(Instrnames[Opcodes[Opcode]]);
    UsIndex:=SecondTab;
    end;
  case Opcode of
        $27,$2F,$37,$3F,
        $90,$98,$99,$9C..$9F,$AA..$AF,$A4..$A7,
        $C3,$CB,$CC,$CE,$CF,$D7,$F4,$F5,
        $F8..$FD        :;      {opcode only}

        $26,$36,$2E,$3E,                {seg overide inst}
        $F0,$F2,$F3     :Rep_lock;      {lock, repe, repne}

        $40..$5F,
        $91..$97        :begin
                         InsrtSt(RegStr[Opcode and 7]); {push,pop,xchg
                                                             inc,dec}
                         if Opcode>=$91 then
                           InsrtSt(',AX');      {xchg}
                         end;

        0..3,8..$B,$10..$13,$18..$1B,
        $20..$23,$28..$2B,$30..$33,$38..$3B,$84..$87,
        $88..$8B        :MregMreg;
  
        $B0..$BF        :MovImToReg;    {mov cx,1234 etc.}
        
        $70..$7F,$E0..$E3,
        $EB             :ShortJump;

        $E8,$E9         :IntraSeg;
        
        $EA,$9A         :InterSeg;
        
        6,7,$E,$16,$17,$1E,$1F
                        :begin          {seg, push-pop seg}
                         Reg:=(Opcode div 8) and 3;
                         InsrtSt(SegRegStr[Reg]);
                         end;
        $4,$5,$C,$D,$14,$15,$1C,$1D,$24,$25,$2C,$2D,$34,$35,$3C,$3D,
        $A8,$A9         :ImedToAc;

        $A0..$A3        :MemAccum;      {mov ac,[1234] }

        $C4,$C5,$8D     :MemToReg;      {les,lds,lea}
        
        $CD             :InsByte;       {int n}
        
        $EE,$EF         :begin  {out dx,ac}
                         Wd:=True; Reg:=2;
                         DoReg;
10:                      Comma;
                         Wd:=(Opcode and 1)<>0;
                         Reg:=0;        {ax or al}
                         DoReg;
                         end;
 
        $E4,$E5,$EC,$ED :begin  {in ac, dx or port}
                         Wd:=(Opcode and 1)<>0;
                         Reg:=0;
                         DoReg;
                         Comma;
                         if (Opcode>=$EC) then
                            begin Wd:=True; Reg:=2; DoReg; end
                         else InsByte;
                         end;

        $E6,$E7         :begin  {out port,ac}
                         InsByte;
                         GOTO 10;
                         end;

        $8C,$8E         :MemSeg;        {segment, reg instr}

        $F6,$F7,$FE,$FF :DoGroup1_2;

        $D0..$D3        :DoShift;

        $80..$83,$C6,$C7:Immed;

        $8F             :begin
                         Wd:=True;      {pop reg/mem}
                         ReadModeByte(Pk);
                         DoMem(Pk);
                         end;
        $C2,$CA         :begin GetWord(Pk);InsrtDisp(Pk); end;     {ret n}
        $D4,$D5         :begin                           {aam,aad}
                         if not GetByte(Pk,PhraseOk) then ByteErr;
                         if not Pk.Phrase then
                           if Pk.Value<>$A then Insrthx2(Lo(Pk.Value));
                         end;

        $9B             :{WAIT - look to see if it preceeds a Fl Point instr}
                         if((Sy=Wordsy) or (Sy=Bytesy)) and (Lo(NValue)>=$D8)
                            and (Lo(NValue)<=$DF) then
                              begin Wait_Found:=True; PrefixFl:=True; end
                              else InsrtSt(Instrnames[Opcodes[$9B]]);
                                        {plain wait}
        $DA,$DE         :Da_de;
        $D8,$DC         :D8_dc;
        $D9             :D9;
        $DB             :Db;
        $DD             :Dd;
        $DF             :Df;

     else  Insrthx2(Opcode);       {for db (databyte)}
     end;       {case}
until PrefixFl=False;
OutUstring;
end;

{-------------Chk_IOerror}
FUNCTION Chk_IOerror(S : Filestring): Integer;
Var IOerr : Integer;
begin
IOerr := IOResult;
if (IOerr = 2) or (IOerr = 3) then WriteLn('Can''t find ', S)
else if IOerr <> 0 then WriteLn('I/O Error ', Hex4(IOerr));
Chk_IOerror := IOerr;
end;

{-------------PromptForInput}
PROCEDURE PromptForInput;
Var
  InName,Name : Filestring;
  Err : Integer;
begin
{$I-}
repeat
  Write('Inline Object Filename [.OBJ]: '); ReadLn(InName);
  if InName='' then Halt;
  DefaultExtension('OBJ', InName, Name);
  Assign(Inf, InName); Reset(Inf);
  Err:=Chk_IOerror(InName);
  if Err>1 then Halt(1);
until Err=0;

Write('Assembly Language Source Filename [', Name, '.ASM]: '); ReadLn(InName);
if InName='' then InName:=Name;   {Use the same name}
DefaultExtension('ASM',InName,Name);
Assign(Outf, InName);
Rewrite(Outf);
if Chk_IOerror(InName)<>0 then Halt(1);
{$I+}
end;

{-------------CommandInput}
PROCEDURE CommandInput;
Var
  InName,Name : Filestring;

  PROCEDURE DoHelp;
  begin
  Halt;
  end;

begin
InName:=ParamStr(1);
if Pos('?', InName)<>0 then DoHelp;
DefaultExtension('OBJ', InName, Name);
{$I-}
Assign(Inf, InName);
Reset(Inf);
if Chk_IOerror(InName)<>0 then Halt(1);
if ParamCount>=2 then InName:=ParamStr(2)
  else InName:=Name;             {Use the old name}
DefaultExtension('ASM',InName,Name);
Assign(Outf, InName);
Rewrite(Outf);
if Chk_IOerror(InName)<>0 then Halt(1);
{$I+}
end;

{-------------ReportLabelErrors}
PROCEDURE ReportLabelErrors;
Var I : Integer;
begin
if LabelIndx>MaxLabels then
  WriteLn('Number of labels exceeds array capacity');
for I:=0 to LabelIndx-1 do
  with Labels[I] do
    if not Found then
      if (PCvalue<PCstart) or (PCvalue>PCfinish) then
        WriteLn('Label ',FormLabel(PCvalue),' is out of Inline code range')
      else
        WriteLn('Label ',FormLabel(PCvalue),' cannot be found');
end;

{-------------WriteToFile}
PROCEDURE WriteToFile;
Var
  P : ^Line;
  Px : Ptrrec Absolute P;
  I,Tmp : Integer;
  LB : String8;

  FUNCTION FindLabel(N : Integer): Boolean;
  Var I : Integer;  Fnd : Boolean;
  begin
  Fnd:=False; I:=0;
  while (I<LabelIndx) and not Fnd do
    begin Fnd:=Labels[I].PCvalue=N;  I:=Succ(I); end;
  if Fnd then Labels[I-1].Found:=True;
  FindLabel:=Fnd;
  end;
begin
P:=Addr(TextArray);
I:=0;
while I < TIndex do  {tindex now is index to last useful byte +1}
  begin
  with P^ do
    begin
    if FindLabel(PCsave) then
      begin    {put it into textarray}
      LB:=FormLabel(PCsave)+':';  {in string form}
      Move(LB[1], S[1], Ord(LB[0]));
      end
    else PCsave:=$2020;      {replace integer by 2 spaces}
    WriteLn(Outf,S);
    Tmp:=Len+1;
    end;
  I:=I+Tmp;
  Px.R:=Px.R+Tmp;
  end;
end;

{-------------MAIN}
begin
WriteLn(Signon1,Signon2);
ErrCount:=0;
PC:=0;  BytePending:=False;  Firsttime:=True;
if ParamCount >= 1 then CommandInput else PromptForInput;
EofInf:=False;
St[0]:=#0;  Chi:=1;  {get the reading started}
GetCh;
GetToken;
while not EofInf do
  if Token='INLINE' then
    begin
    TIndex:=0;   {index into TextArray}
    PCstart:=PC; LabelIndx:=0;
    if not Firsttime then
      WriteLn(Outf,'NEW');
    Next;
    if Sy=Lparn then Next;
    while (Sy<>Rparn) and not EofInf do UnAssem1;
    if Sy=Rparn then GetToken;
    Firsttime:=False;
    PCfinish:=PC;
    Ustring.S:='        ';  {Provide for possible label at the end}
    Ustring.PCsave:=PC;
    OutUstring;
    WriteToFile;   {TextArray to outf, adding labels as req'd}
    ReportLabelErrors;
    end
  else GetToken;
Close(Inf);
Close(Outf);
end.
