{$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R-,S-,V-,X-}
{$IFDEF VER70}
{$P-,Q-,T-}
{$ENDIF}
{$M 16384,0,655360}

uses
  tpString,
  AVars,
  ACmdLine,
  Table,
  InitAsm,
  InitSym,
  a2srv;

procedure Parse;
  {--  Parse current line of source }
var
  i : Integer;
begin
  LinePtr  :=  1;
  LinePtr2 :=  1;
  _Label   := '';
  _Op      := '';
  _Source  := '';
  _Dest    := '';

  { set EndPtr to end of code, just before comment }
  EndPtr := Pos(';',InpLine) - 1;

  {no comment, set to eol}
  if (EndPtr = -1) then 
    EndPtr := Length(InpLine);

  { no code ? (xreturn) }
  if EndPtr = 0 then 
    exit;

  { convert source code to uppercase }
  I := 1;
  while I <= EndPtr do begin
    if InpLine[I] <> '''' then begin
      InpLine[i] := UpCase(InpLine[i]);
      Inc(I);
    end else begin
      Inc(I);   { skip "'" }
      while (InpLine[I] <> '''') and (I < EndPtr) do
        Inc(I);
      Inc(I);   { skip "'" }
    end;
  end;

  if NOT (InpLine[1] in Delim) then begin { Label }
    GetField;
    _Label := _Fld;
  end;

  { op-code }
  GetField;
  if NOT Found then
    exit;
  _Op := _Fld;
  { save ptr to start of operands }
  OpdPtr := LinePtr;

  { destination operand (if any) }
  GetField;
  if NOT Found then
    exit;
  _Dest := _Fld;

  { source operand (if any) }
  GetField;
  if NOT Found then
    exit;
  _Source := _Fld;
end; { Parse }

procedure Operand_LookUp;
  {--  Trys to find _Target in Sym table. If there, sets
       Found TRUE, & TablePtr to its' position }
var
  No, Val1, Val2, SymType : Word;
  Name : String;
begin
  { scan table for symbol }
  for TablePtr := 1 to NumSym do begin
    No := STP^.Get(TablePtr,Val1,Val2,SymType,Name);
    if Name = _Target then begin
      Found := TRUE;
      exit;
    end;
  end;

  { failure exit point }
  Found := FALSE;
end; { Operand_LookUp }

procedure NewEntry;
  {--  Adds new symbol to sym table with default attributes.
       (may be changed by pseudo-ops) }
var
  W : Word;
begin
  _Target := _Label;
  Operand_LookUp;
  if Found then begin
    WriteError(DuplicateDefinition+_Label);
    exit;
  end;

  { not found, check if table full -> error }
  if NumSym >= MaxSym then begin
    WriteError(TooManySymbols);
    exit;
  end;

  { make new entry }
  W := STP^.Put(Loctr,0,_Near,_Label);
end; { NewEntry }

procedure Test_Number;
  {--  Trys to interpret _Target as a number. If successful, sets Found
       TRUE, NumVal to its' value and NumType to its' type. }
var
  _TN : String;
  tnl : byte absolute _TN;
  i   : byte;
  code: Integer;
begin
  Found   := FALSE;
  NumType := 0;
  _TN := _Target;

  { hex number ? }
  if _TN[tnl] = 'H' then begin
    dec(tnl); { lop off H }
    { scan for non-hex digits }
    for i:= 1 to tnl do
      if Pos(_TN[i],HexDigits) = 0 then
        exit;
    Val('$'+_TN,NumVal,code);
  end else begin { decimal number (!!! or $Hex(PAS-style)) ? }
    Val(_TN, NumVal, code);
    if code <> 0 then exit;
  end;
  Found := TRUE;
  if NumVal < 255 then
    NumType := _Immed16 or _Immed8
  else
    NumType := _Immed16;
end; { Test_Number }

procedure MemRef;
  {--  Trys to interpret _Target as a direct mem. ref. If successful,
       sets Found TRUE, & MemAddr to the address referenced. }
var
  _MR : string;
  mrl : byte absolute _MR;
  W, Val2, SymType : word;
  Name : String;
label
  Success, Failure;
begin
   Found := FALSE;
  _MR := _Target; { save copy }

  if (_MR[1] <> '[') or (_MR[mrl] <> ']') then
    exit;

  _Target := Copy(_MR, 2, mrl-2); { strip off brackets }

  { try to interpret as addr }
  Test_Number; { might be number }
  if Found then begin
    MemAddr := NumVal;
    goto Success;
  end else begin
    Operand_LookUp;
    if NOT Found then
      goto Failure;
    W := STP^.Get(TablePtr,MemAddr,Val2,SymType,Name);
    if (SymType and _Immed16 <> 0) then
      goto Failure;
  end;

Failure: { failure exit }
  Found := FALSE;
Success: { successful exit }
  _Target := _MR;
end; { MemRef }

procedure Test_Offset;
  {--  Tryes to interpret _Target as an offset operand. If successful, set
       Found, set OffsetType _Immed16, and TargVal1 to the label's offset. }
var
  _OS : string;
  osl : byte absolute _OS;
  Val1, Val2, SymType, W : Word;
  Name : String;
label
  Success;
begin
  _OS := _Target;
  if Copy(_OS,1,7) <> 'OFFSET(' then begin
    Found := False;
    exit;
  end;
  if Pass = 1 then
    goto Success;
  _Target := Copy(_Target,8,osl-8); { isolate label }
  Operand_LookUp; { look it up }
  W := STP^.Get(TablePtr,Val1,Val2,SymType,Name);
  if NOT (Found and (SymType AND ( _Mem or _Near) <> 0)) then begin
    WriteError(IllegalArgument);
    OffsetVal := 0;
    goto Success;
  end;
  OffsetVal := Val1;

Success:
  Found := TRUE;
  OffsetType := _Immed16;
  _Target := _OS;
end; { Test_Offset }

procedure Parse_disp_off_reg;
  {--  Trys to parse _Target as an offset off a register. If successful,
       sets Found TRUE, set NeedOffset to the offset's type and Offset to
       its' value. }
var
  _PDOR : string;
  pdorl : byte absolute _PDOR;
  _Ptr   : Integer;
  Val1, Val2, SymType, W : Word;
  Name : String;
label
  Success, Failure, Parse_disp;
begin
  _PDOR := _Target; { save copy }

  { special case }
  if _Target = '[BP]' then begin
    RegVal := 6;
    NeedOffset := _Immed8;
    Offset := 0;
    goto Success;
  end;

  { parse reg spec. }
  { set ptr to candidate }
  _Ptr := Pos('[',_Target);
  if _Ptr <= 1 then
    goto Failure;
  _Reg := Copy(_PDOR,_Ptr,255); { isolate candidate }

  { valid reg. spec ? }
  if _Reg = '[BP]' then begin
    RegVal := 6;
    goto Parse_disp;
  end;
  _Target := _Reg;
  Operand_LookUp;
  W := STP^.Get(TablePtr,Val1,Val2,SymType,Name);
  if NOT Found or (SymType <> _MemReg) then
    goto Failure;
  RegVal := Val1; { save reg value }
Parse_disp:
  { now parse disp }
  _Disp := Copy(_PDOR,1,_Ptr-1);
  _Target := _Disp;
  { might be symbol... }
  Operand_LookUp; { valid disp ? }
  W := STP^.Get(TablePtr,Val1,Val2,SymType,Name);
  if Found then { symbol }
    if ((SymType AND (_Immed16 OR _Immed8)) <> 0) then begin
        NeedOffset := SymType;
        Offset := Val1;
        goto Success;
    end;
  {...or number }
  Test_Number;
  if Found then begin
    NeedOffset := NumType;
    Offset := NumVal;
    goto Success;
  end;
  {...or offset }
  Test_Offset;
  if Found then begin
    NeedOffset := OffsetType;
    Offset := OffsetVal;
    goto Success;
  end;
Failure: { failure exit }
  Found := FALSE;
Success: { successful exit }
  _Target := _PDOR;
end; { Parse_disp_off_reg }

procedure Test_Char;
  {--  Tryes to interpret _Target as a char. }
begin
  Found := FALSE;
  if ((Length(_Target) <> 3) or (_Target[1] <>'''') or (_Target[3]<>'''')) then
    exit;
  Found := TRUE;
  CharVal := Ord(_Target[2]);
end; { Test_Char }

procedure Type_Operand;
  {--  Sets TargType to reflect _Target's type. Sets TargVal1 to its'
       value. If the operand is a register, sets TargVal2 to its' val2.
       If an offset appears, NeedOffset gets the its' type, and Offset
       its' value. }
var
  Val1, Val2, SymType, W : Word;
  Name : String;
begin
  { any operand ? }
  if Length(_Target) <= 0 then begin
    TargType := _None;
    exit;
  end;

  Operand_LookUp; { in sym table ? }
  W := STP^.Get(TablePtr,Val1,Val2,SymType,Name);
  if Found then begin
    TargType := SymType;
    TargVal1 := Val1;
    if TablePtr <= PreDef then
      TargVal2 := Val2;
    exit;
  end;

  Test_Number; { number ? }
  if Found then begin
    TargType := NumType;
    TargVal1 := NumVal;
    exit;
  end;

  MemRef; { direct mem. ref ? }
  if Found then begin
    TargType := _Mem;
    TargVal1 := MemAddr;
    exit;
  end;

  { offset off register ? }
  Parse_disp_off_reg;
  if Found then begin
    TargType := _MemReg;
    TargVal1 := RegVal;
    exit;
  end;

  { offset ? }
  Test_Offset;
  if Found then begin
    TargType := OffsetType;
    TargVal1 := OffsetVal;
    exit;
  end;

  { character ? }
  Test_Char;
  if Found then begin
    TargType := _Immed8 OR _Immed16;
    TargVal1 := CharVal;
    exit;
  end;

  { string ? }
  if _Target[1] = '''' then begin
    TargType := _String;
    exit;
  end;

  { Not found... Assume near label or mem ref. (error on pass 2) }
  if Pass = 2 then
    WriteError(UndefinedSymbol+_Target);

  TargType := _Near OR _Mem;
end; { Type_Operand }

procedure Lookup_Op;
  {--  given op-code in _Op, & operand types in dType & SType, tryes to
       find op in opcode table. If successful, sets Found TRUE, & opptr to
       its' position. }
var
  Move : Integer;
  St   : Integer;
  OpName : String;
  W, Code_, DType_, SType_, Flags_ : Word;
begin
  { binary search for good starting pt. }
  Move := NumOp;
  St := Round(Move / 2);
  while Move >=2 do begin
    Move := Round(Move / 2);
    W := ATP^.Get(St,Code_,OpName,DType_,SType_,Flags_);
    If _Op >  OpName then
      St := St + Move
    else
      St := St - Move;
    if St < 1 then St := 1;
    if St > NumOp then
      St := NumOp;
  end;

  { scan for entry matching all 3 fields }
  for OpPtr := St to NumOp do begin
    W := ATP^.Get(OpPtr,Code_,OpName,DType_,SType_,Flags_);
    if OpName > _Op then begin
      Found := FALSE; { failed }
      exit;
    end;
    if (OpName = _Op) and (SType_ AND SType <> 0) and (DType_ AND DType <> 0) then begin
      Found := TRUE;  { found ! (and valid) }
      exit;
    end;
  end;

  { failure }
  Found := FALSE;
end; { Lookup_Op }

procedure Op_Type;
  {--  Desides between word and byte ops }
begin
  if ((DType OR SType) AND (_Reg16 OR _Acum16 OR _Seg OR _CS) <> 0) then begin
    _Word := TRUE;
    exit;
  end;

  if (((DType OR SType) AND (_Reg8 OR _Acum8) <> 0) or (_Op[Length(_Op)]='B')) then begin
    _Word := FALSE;
    exit;
  end;

  _Word := TRUE; { by default ?? }
end; { Op_Type }

procedure Build_Opcode;
  {--  Builds opcode, stores it in obj. Increments objlength. }
var
  R : word;
begin
  ObjLen := ObjLen + 1;
  Obj[ObjLen] := ATP^.Opcode(OpPtr);

  { add reg. field if requested }
  if (Flag AND _AddReg) <> 0 then begin
    { segment reg. }
    if (DType AND (_Seg OR _CS)) <> 0 then
      R := DVal2
    else begin
      if (Flag AND _Direction) <> 0 then
        R := Round(SVal2 / 8)
      else
        R := Round(DVal2 / 8);
    end;
    Obj[ObjLen] := Obj[ObjLen] + R;
  end;

  { auto word bit ? }
  if (Flag AND _AutoW) <> 0 then begin
    if _Word then
      Obj[ObjLen] := Obj[ObjLen] + 1;
  end;

  { auto count bit ? }
  if (Flag AND _AutoC) <> 0 then begin
    if (SType AND _CL) <> 0 then
      Obj[ObjLen] := Obj[ObjLen] + 2;
  end;
end; { Build_Opcode }

procedure Hi_Low;
  {--  Splits 16 bit number in NumLow, into two
       byte-sized components in NumHigh and NumLow }
begin
  NumHigh := Hi(NumLow);
  NumLow  := Lo(NumLow);
end; { Hi_Low }

procedure Build_Mem_Addr;
  {--  Builds a memory address word. }
begin
  if DType = _Mem then
    NumLow := DVal1
  else
    NumLow := Sval1;

  { build word }
  Hi_Low;
  ObjLen := ObjLen + 2;
  Obj[ObjLen - 1] := NumLow;
  Obj[ObjLen] := NumHigh;
end; { Build_Mem_Addr }

procedure Build_ModeByte;
  {--  Given direction flag, memreg values in DVal1 and SVal1 and
       reg values in DVal2 and SVal2, builds an addressing mode byte.
       If necessary, also builds displacement byte(s). }
var
  M : word;
begin
  ObjLen := ObjLen + 1;

  { special case: direct mem addressing ? }
  if ((DType OR SType) AND _Mem) <> 0 then begin
    if DType = _Mem then
      M := SVal2
    else
      M := DVal2;
    Obj[ObjLen] := 6 + M;
    Build_Mem_Addr;
    exit;
  end;

  { normal mode byte }
  { operands in normal or reverce order ? }
  if (Flag AND _Direction) <> 0 then
    M := SVal1 + DVal2
  else
    M := DVal1 + SVal2;
  Obj[ObjLen] := M;

  { offset bytes ? }
  if NeedOffset <> _None then begin
    if not ((Offset > 127) or (Offset < -128)) then begin
      { 8 bit disp. }
      Obj[ObjLen] := Obj[ObjLen] + 64; { set mod field }
      if Offset < 0 then { crunch neg. Offset to 8 bits }
        Offset := Offset AND $00FF;
      ObjLen := ObjLen + 1;
      Obj[ObjLen] := Offset;
    end else begin
      { 16 bit disp }
      Obj[ObjLen] := Obj[ObjLen] + 128; { set mod field }
      ObjLen := ObjLen + 2;
      { cinvert to hi/low form }
      NumLow := Offset;
      Hi_Low;
      Obj[ObjLen-1] := NumLow;
      Obj[ObjLen] := NumHigh;
    end;
  end;
end; { Build_ModeByte }

procedure Build_Ext;
  {--  Builds an opcode extension byte. The ext. val is
       extracted from bits 3-5 of the Flag word. }
var
  Ext : word;
begin
  Ext := Flag and $0038;
  if (Flag AND _Direction) <> 0 then
    DVal2 := Ext
  else
    SVal2 := Ext;
  Build_ModeByte;
end; { Build_Ext }

procedure Build_Disp8;
  {--  Calculates the disp. from the present loc to the loc given as
       an operand. Prints erro message if disp exceedes 127 }
var
  D : Integer;
begin
  D := DVal1 - Loctr; { calculate disp. }

  { check size }
  if Abs(D) >= 128 then begin
    D := 0;
    if Pass = 2 then
      WriteError(TooFarForShortJump);
  end;

  { if neg. crunch to 8 bits }
  if D < 0 then
    D := D AND $00FF;

  { build obj code }
  ObjLen := ObjLen + 1;
  Obj[ObjLen] := D;
end; { Build_Disp8 }

procedure Build_Disp16;
  {--  Builds 16 bits displacement. Prints error msg. for negative
       jumps not on CALL ops. }
var
  D : Integer;
begin
  D := DVal1 - Loctr;  { calculate disp. }
  if ((_Op = 'JMP') and (D <= 128)) then
    WriteWarning(CouldUseJMPS);

(*
  { legal ? }
  if not ((D >= 0) or (_Op='CALL')) then begin
    D := 0;
    if Pass = 2 then
      WriteError(IllegalReverseJump);
  end;
*)

  { build obj. code }
  NumLow := Word(D);
  Hi_Low;
  ObjLen := ObjLen + 2;
  Obj[ObjLen-1] := NumLow;
  Obj[ObjLen] := NumHigh
end; { Build_Disp16 }

procedure Build_Immed8;
  {--  Buids byte of immediate data. }
  procedure Immed8;
    {--  Internal procedure }
  begin
    if NOT ((IVal <= 255) and (IVal >= 0)) then begin
      IVal := 0;
      if Pass = 2 then
        WriteError(DataTooLong);
    end;
    ObjLen := ObjLen + 1;
    Obj[ObjLen] := IVal;
  end; { Immed8 }
begin
  if DType and _Immed8 <> 0 then begin
    IVal := Integer(DVal1);
    Immed8;
  end;
  if SType and _Immed8 <> 0 then begin
    IVal := Integer(SVal1);
    Immed8;
  end;
end; { Build_Immed8 }

procedure Build_Immed16;
  {--  Build word(s) or immediate data. }
  procedure Immed16;
    {--  Internal procedure }
  begin
    NumLow := Word(IVal);
    Hi_Low;
    ObjLen := ObjLen + 2;
    Obj[ObjLen-1] := NumLow;
    Obj[ObjLen] := NumHigh;
  end; { Immed16 }
begin
  if (DType AND _Immed16) <> 0 then begin
    IVal := Integer(DVal1);
    Immed16;
  end;
  if (SType AND _Immed16) <> 0 then begin
    IVal := Integer(Sval1);
    Immed16;
  end;
end; { Build_Immed16 }

procedure Mach_Op;
  {--  Updates loctr based on op length. On pass 2, generates
       machine code. }
var
  Code : Word;
begin
  Op_Type;

  { opcode }
  Loctr := Loctr + 1;
  if Pass = 2 then
    Build_Opcode;

  { 2nd op byte ? }
  Code := ATP^.OpCode(OpPtr);
  if (code = $D5) or (code = $D4) then begin
    loctr := loctr + 1;
    if Pass = 2 then begin
      ObjLen := ObjLen + 1;
      Obj[ObjLen] := $0A;
    end;
  end;

  { room for m. byte disp. (must go here, modebyte modifies offset }
  if NeedOffset <> _None then begin
    if (NeedOffset AND _Immed8) <> 0 then
      Loctr := Loctr + 1
    else
      Loctr := Loctr + 2;
  end;

  { if direct addr. mode byte, leave room for address }
  if (Flag AND (_NeedModeByte OR _NeedExt)) <> 0 then
    if ((DType OR SType) AND _Mem) <> 0 then
      Loctr := Loctr + 2;

  { extension byte ? }
  if (Flag and _NeedExt) <> 0 then begin
    Loctr := Loctr + 1;
    if Pass = 2 then
      Build_Ext;
  end;

  { mode byte ? }
  if (Flag AND _NeedModeByte) <> 0 then begin
    Loctr := Loctr + 1;
    if Pass = 2 then
      Build_ModeByte;
  end;

  { 8 bit disp. ? }
  if (Flag AND _NeedDisp8) <> 0 then begin
    Loctr := Loctr + 1;
    if Pass = 2 then
      Build_Disp8;
  end;

  { 16 bit disp. ? }
  if (Flag AND _NeedDisp16) <> 0 then begin
    Loctr := Loctr + 2;
    if Pass = 2 then
      Build_Disp16;
  end;

  { immediate byte ? }
  if (Flag AND _NeedImmed8) <> 0 then begin
    Loctr := Loctr + 1;
    if Pass = 2 then
      Build_Immed8;
  end;
  if (NOT (_Word) and ((Flag AND _NeedImmed) <> 0)) then begin
    Loctr := Loctr + 1;
    if Pass = 2 then
      Build_Immed8;
  end;

  { immediate word(s) ? }
  if _Word and ((Flag AND _NeedImmed) <> 0) then begin
    if DType = _Immed16 then
      Loctr := Loctr + 4
    else
      Loctr := Loctr + 2;
    if Pass = 2 then
      Build_Immed16;
  end;

  { mem. addr. ? }
  if (Flag AND _NeedMem) <> 0 then begin
    Loctr := Loctr + 2;
    if Pass = 2 then
      Build_Mem_Addr;
  end;
end; { Mach_Op }

procedure EQU;
  {--  Handles EQU pseudo-op. }
begin
  if _Label = '' then begin
    if Pass = 2 then
      WriteError(equWithoutSymbol);
  end;
  if Pass = 2 then
    exit;

  if DType <> (_Near OR _Mem) then begin
    with STP^.SPtr^[NumSym]^ do begin
      Val1 := DVal1;
      SymType := DType;
      exit;
    end;
  end else begin
    { pass 1 default if not found }
    WriteError(equWithForwardRef);
  end;
end; { EQU }

procedure ORG;
  {--  Handles ORG pseudo-op. }
begin
  Loctr := DVal1; { set loctr to new value }
end; { ORG }

procedure DB;
  {--  Handles db pseudo-op. }
label
  WExit;

  procedure Build_Byte;
    {--  build byte }
  begin
    ObjLen := ObjLen + 1;
    Obj[ObjLen] := NumVal;
  end; { Build_Byte }
  procedure Build_Stg;
    {--  build string }
  var
    I : Integer;
  begin
    _Fld := Copy(_Fld,2,Length(_Fld)-2); { strip off  "'"s }
    for I := 1 to Length(_Fld) do begin
      ObjLen := ObjLen + 1;
      Obj[ObjLen] := Ord(_Fld[I]);
    end;
  end; { Build_Stg }

begin { DB }
  if Pass = 1 then begin
    { label ? -> set type to mem }
    if _Label <> '' then
      STP^.SPtr^[NumSym]^.SymType := _Mem;
  end;

  { scan operand area, building obj. code }
  LinePtr := OpdPtr;
  LinePtr2 := OpdPtr;
  while LinePtr < EndPtr do begin
    GetField; { get operand }
    if not Found then
      goto WExit;
    { branch for byte value or string }
    _Target := _Fld;
    Test_Number;
    if Found OR ((NumType AND _Immed8) <> 0) then begin
      Build_Byte;
    end else begin
      if _Fld[Length(_Fld)] <> '''' then begin
        if Pass = 2 then
          WriteError(UnrecognizedOperand+' '+_Fld);
      end else begin
        Build_Stg;
      end;
    end;
  end; { while }
WExit:
  Loctr := Loctr + ObjLen;
end; { DB }

procedure DS;
  {--  Handles ds pseudo-op. }
var
  I : Word;
  B : byte;
begin
  DSFlag := TRUE;
  if Pass = 1 then { skip type setting second time }
    if _Label <> '' then { label ? -> set type to _mem }
      STP^.SPtr^[NumSym]^.SymType := _Mem;

  { set output code }
  if (SType AND _Immed8) <> 0 then
    DSVal := SVal1
  else
    DSVal := 0;

  { on pass 2, generate obj. code directly }
  if Pass = 2 then
    for I := 1 to DVal1 do begin
      B := Lo(DSVal);
      blockwrite(OutFile,B,1);
    end;

  { advance loctr, update BytesGen }
  Loctr := Loctr + DVal1;
  BytesGen := BytesGen + DVal1;
end; { DS }

procedure PROC;
  {--  Handles proc pseudo-op. }
begin
  if StkTop < MaxStk then begin
    { push new proc type for returns }
    StkTop := StkTop + 1;
    ProcType[StkTop] := DType;
  end else begin
    if Pass = 1 then
      exit;
    WriteError(ProcsNestedTooDeeply);
  end;
end; { PROC }

procedure ENDP;
  {--  Pops proc stack. }
begin
  if StkTop > 0 then begin
    StkTop := StkTop - 1;
  end else begin
    if Pass = 1 then
      exit;
    WriteError(ENDPwithoutPROC);
  end;
end; { ENDP }

procedure Pseudo_Op;
  {--  Branches to routines to handle each pseudo op using
       the value field as an index. }
begin
  case ATP^.OpCode(OpPtr) of
    1 : EQU;
    2 : ORG;
    3 : DB;
    4 : DS;
    5 : PROC;
    6 : ENDP;
  end; { case }
end; { Pseudo_Op }

procedure Update_Loctr;
  {--  Decodes operations & advances loctr.
       On pass 2 generates machine code.}
begin
  { set operand types & values }
  { destination operand }
  _Target := _Dest;

  Type_Operand;
  DType := TargType;
  DVal1 := TargVal1;
  DVal2 := TargVal2;

  { source operand }
  if _Op = 'RET' then begin
    { special case : RET op }
    SType := ProcType[StkTop];
  end else begin
    { normal source }
    _Target := _Source;
    Type_Operand;
    SType := TargType;
    SVal1 := TargVal1;
    SVal2 := TargVal2;
  end;

  { find op in op table (not there : error) }
  _Target := _Op;
  Lookup_Op;
  if NOT Found then begin
    if Pass = 1 then
      exit;
    WriteError(SyntaxError+_Op+' DType:'+HexW(DType)+' SType:'+HexW(SType));
    if ((_Acum8 OR _Acum16 OR _Reg8 OR _Seg OR _CS) AND (DType OR SType)) <> 0 then
      exit;
    if ((SType AND (_None OR _Immed8 OR _Immed16)) = 0) then
      exit;
    if Pos(_Op[Length(_Op)],'BW') <> 0 then
      exit;
    WriteWarning(SpecifyWordOrByteOperation);
  end;

  { found: }
  Flag := ATP^.APtr^[OpPtr]^.Flags;

  { branch for matc ops & pseudo-ops to update loctr }
  if ((Flag AND _MachOp) <> 0) then
    Mach_Op
  else
    Pseudo_Op;
end; { Update_Loctr }

procedure PassOne;
  {--  add user-defined symbols to sym table  }
begin
  Pass  :=    1;
  Loctr := $100;    { 0..255 reserved for p.s. prefix }
  LineNum :=  0;

  while NOT eof(Infile) do begin
    GetLine;
    Parse;

    { if label, enter in sym table }
    if _Label <> '' then
      NewEntry;

    { if op, decode, & update loctr }
    if _Op <>  '' then
      Update_Loctr;
    ProgressReport;
  end;
end; { PassOne }

procedure Pass2Init;
  {--  Initialize for pass two }
begin
{  Close(InFile); }
  Reset(InFile);
  Pass := 2;
  Loctr := 256;
  LineNum := 0;
  BytesGen := 0;
end; { Pass2Init }

procedure Check_Phase;
  {--  Label value same both passes ? }
begin
  if _Op = 'EQU' then
    exit;
  _Target := _Label;
  Operand_Lookup;

  if (STP^.SPtr^[TablePtr]^.SymType AND (_Near OR _Mem)) = 0 then
    exit;

  if STP^.SPtr^[TablePtr]^.Val1 = Loctr then
    exit;

  WriteError(PhaseError);
end; { Check_Phase }

procedure OutputCodeAndListing;
  {--  Outputs code and listing line, given code in
       Obj[ObjLen] }
var
  H,I : Word;
  B   : Byte;
begin
  BytesGen := BytesGen + ObjLen; { update number of bytes generated }
  if DSFlag then
    H := Loctr - DVal1
  else
    H := Loctr - ObjLen;
  WriteLst(LeftPad(Long2Str(LineNum),7));

  WriteLst('  '+Pad(HexW(H),6));

  I := 1;
  while (I <= 6) and (I <= ObjLen) do begin
    B := Lo(Obj[I]);
    blockwrite(OutFile,B,1);
    WriteLst(HexB(B));
    Inc(I);
  end;

  { source; truncate if necessary }
  if I <= 4 then 
    WriteLst(^I);
  WriteLst(^I+' '+Copy(InpLine,1,LWidth - 26));

  { rest of code }
  while I <= ObjLen do begin
    if (I mod 7) = 0 then
      WriteLst(^M^J^I'+');
    B := Lo(Obj[I]);
    blockwrite(OutFile,B,1);
    WriteLst(HexB(B));
    Inc(I);
  end;

  WriteLst(^M^J);
end; { OutputCodeAndListing }

procedure PassTwo;
  {--  Generates code and listing }
begin
  Pass2Init;

  while not eof(InFile) do begin
    GetLine; { get line, initialize }
    Parse; { parse line }
    if _Label <> '' then
      Check_Phase;

    if _Op <> '' then
      Update_Loctr;

    OutputCodeAndListing;
    ProgressReport;
  end;
end; { PassTwo }

procedure FinalProc;
  {--  Cleanup }
begin
  if StkTop > 0 then
    WriteError(MissingENDP);
  WriteFinal;

end; { FinalProc }

begin
  Initialize;
  PassOne;

  PassTwo;

  FinalProc;

  CloseFiles;
end.
