Program Assembler(Input,Ouput);
{
9900 Family Assembler (C) Copyright 1986 Diomidis D. Spinellis
Beta release V1.10A

More information on the object code format, the mnemonics,
addressing modes, and the assembler instructions can be found
in the following publications :
  9900 Family Systems design and data book
  9900 Family data book
  Software development
  Editor Assembler manual TI-99/4A
which are all publications of Texas Instruments Inc.

Note : The symbol table is implemented as a binary tree data structure
using pointers and therefore the maximum number of symbols is only
limited by the amount of heap memory.
}
{The following notes for the compiler should be turned passive ('-') when the
testing phase is finished. During testing they should be acive ('+')}
{$U-}
{$R-}
{
The following codes have been used for the format of commands:
1 : Arithmetic
2 : Jump
3 : Logical
4 : CRU
5 : Shift
6 : Programme
7 : Control ; also NOP and RT
8 : Immediate two operand e.g. LI R5,>83E0
9 : Multiply
11 : DEF
12 : REF
13 : IDT
14 : BYTE
15 : DATA
16 : EVEN
17 : BSS
18 : Immediate one operand e.g. LWPI >83E0
19 : EQU
20 : END
21 : TEXT
22 : TITL
}
Const
  LineLength = 80;
  SymbolLength = 8;
  MnemonicLength = 4;
  MaxNumberOfMnemonic = 100;
  MaxTokens = 10;

Type
  LineType = String[LineLength];
  SymbolKind = (ExternalS,EquateS,LabelS,CharacterS,HexS,DecS,SeparatorS,Assm,
                Unknown);
  SymbolNameType = String[SymbolLength];
  FnameType = string[64];
  ExtensionType = string[3];
  MnemonicType = String[MnemonicLength];
  RelocationType = (Absolut,Relocatable);
  SymbolEntryPoint = ^ SymbolEntry;
  SymbolEntry = Record
    Name : SymbolNameType;
    Value : Integer;
    Valid : Boolean;
    Reloc : RelocationType;
    Kind  : SymbolKind;
    Left,Right : SymbolEntryPoint;
  end;
  InstructionType = Record
    Mnemonic : MnemonicType;
    OpCode : Integer;
    Format : Integer;
  end;
  TermType = Record
    Value : Integer;
    RegValue : Integer;
    Mode : 0..3;
    Valid : Boolean;
    RegReloc : RelocationType;
    ValReloc : RelocationType;
    Kind : SymbolKind;
    Name : SymbolNameType;
  end;
  FourDigits = String[4];
  RecordType = String[13];
  ListType = (DisplayLineValue,DisplayNothing,
               DisplayLineNoValue,DisplayValueNoLine);
  TokenEntry = Record
    Value : Integer;
    Name : SymbolNameType;
    Reloc : RelocationType;
    Kind : SymbolKind;
  end;
  TokenArrayType = Array[1..MaxTokens] of TokenEntry;


Var
  SourceFile,ObjectFile,ListFile : Text;
  Line,CommonLine,Title : LineType;
  PC,LC,OC : Integer;
  Pass,ExpressionValue : Integer;
  SuppressErrors,SymbolList,GenerateObject,GenerateList : Boolean;
  SymbolStart : SymbolEntryPoint;
  ErrorNumber,WarningNumber : Integer;
  Instruction : InstructionType;
  InstructionEntry : array [1..MaxNumberOfMnemonic] of InstructionType;
  NumberOfMnemonic : Integer;
  SecondTagField : string[6];
  idt : String[8];
  Checksum,ObjectRecords,ObjectChars,ByteValue : Integer;
  ForceEnd : Boolean;
  ByteValuePending : Boolean;
  ListLine,PageNumber : Integer;
  EndOfSource : Boolean;
  LabelName : SymbolNameType;

function DefaultExtension(Fname : FnameType ; Extension : ExtensionType)
                                                                  : FnameType;
begin
  if pos('.',Fname)=0 then
    DefaultExtension:=Concat(Fname,'.',Extension)
  else
    DefaultExtension:=Fname;
end;

function RemoveExtension(Fname : FnameType) : FnameType;
begin
  if pos('.',Fname)<>0 then
    RemoveExtension:=Copy(Fname,1,Pos('.',Fname)-1)
  else
    RemoveExtension:=Fname;
end;

procedure OpenFiles;
var
  Fname,GenFname,SpecFname : FnameType;
begin
  Writeln('9900 Assembler Version 1.10A');
  Writeln('(C) Copyright 1986 Diomidis D. Spinellis');
  Write('Input file [.A99]:');
  ReadLn(Fname);
  Fname:=DefaultExtension(Fname,'A99');
  GenFname:=RemoveExtension(Fname);
  Assign(SourceFile,Fname);
  Reset(SourceFile);
  SpecFname:=DefaultExtension(GenFname,'O99');
  Write('Output file [',SpecFname,']:');
  ReadLn(Fname);
  If Fname='' then
    Fname:=SpecFname
  else
    Fname:=DefaultExtension(Fname,'O99');
  Assign(ObjectFile,Fname);
  Rewrite(ObjectFile);
  SpecFname:=DefaultExtension(GenFname,'LST');
  Write('List file [',SpecFname,']:');
  ReadLn(Fname);
  If Fname='' then
    Fname:=SpecFname
  else
    Fname:=DefaultExtension(Fname,'LST');
  Assign(ListFile,Fname);
  Rewrite(ListFile);
end;

procedure CloseFiles;
begin
  Close(SourceFile);
  Close(ObjectFile);
  Close(ListFile);
end;

procedure InitVars;
begin
  PC:=0;
  LC:=0;
  OC:=1;
  ErrorNumber:=0;
  WarningNumber:=0;
  CheckSum:=0;
  ObjectRecords:=1;
  ByteValuePending:=False;
  ObjectChars:=13;
  ListLine:=0;
  PageNumber:=0;
  ForceEnd:=False;
  EndOfSource:=False;
end;

Procedure ConvertUppercase(var line : LineType);
var
  i : Integer;
  NewLine : LineType;
  InQuotes : Boolean;
begin
  InQuotes:=False;
  NewLine:='';
  For i:=1 to Length(Line) do
  begin
    If Copy(Line,i,1)=chr(39) {'} then
      InQuotes:=not InQuotes;
    If InQuotes then
      NewLine:=Concat(NewLine,Copy(Line,i,1))
    else
      NewLine:=Concat(NewLine,UpCase(Copy(Line,i,1)));
  end;
  Line:=NewLine;
end;

function Padd(a : Integer) : FourDigits;
var
  buffer : string[8];
begin
  Str(A,buffer);
  Padd:=Copy(Concat('0000',buffer),Length(Buffer)+1,4);
end;

Procedure List(S : LineType);
Const
  LinesPerPage = 60;
Begin
  If GenerateList then
  begin
    If ListLine=0 then
    begin
      PageNumber:=PageNumber+1;
      ListLine:=0;
      WriteLn(ListFile,Chr(12));
      WriteLn(ListFile,
'9900 Family Assembler (C) 1986 D. Spinellis                     Page ',
      Padd(PageNumber));
      WriteLn(ListFile,Title);
      WriteLn(ListFile,'');
    end;
    WriteLn(ListFile,S);
    ListLine:=ListLine+1;
    If ListLine=LinesPerPage then
      ListLine:=0;
  end;
end;

function Hex(A: Integer) : FourDigits;

  function HexDigit(A : Integer) : Char;
  begin
    HexDigit:=Copy('0123456789ABCDEF',A+1,1);
  end;

begin
  Hex:=Concat(
    HexDigit((A shr 12) and $f),
    HexDigit((A shr 8) and $f),
    HexDigit((A shr 4) and $f),
    HexDigit(A and $f));
end;

procedure ReportError(ErrorMessage : LineType);
begin
  If not SuppressErrors then
  begin
    WriteLn('Line : ',Padd(LC),' [',Line,']');
    WriteLn('**** Error : ',ErrorMessage);
    ErrorNumber:=ErrorNumber+1;
  end;
end;

procedure ReportWarning(WarningMessage : LineType);
begin
  If not SuppressErrors then
  begin
    WriteLn('Line : ',Padd(LC),' [',Line,']');
    WriteLn('**** Warning : ',WarningMessage);
    WarningNumber:=WarningNumber+1;
  end;
end;

procedure CharacterizeSymbol(Name : SymbolNameType ; Value : Integer;
          Valid :Boolean; Reloc : RelocationType; Kind : SymbolKind);
var
  found : Boolean;
  Point,LastPoint,Position : SymbolEntryPoint;
begin
  If Pass=1 then
    Valid:=False;
  found:=False;
  Point:=SymbolStart;
  while (Point<>NIL) and not found do
    if Point^.Name=Name then
      Found:=True
    else
      if Name > Point^.Name then
        Point:=Point^.Right
      else
        Point:=Point^.Left;
  if not found then
  begin
    New(Position);
    If Position=NIL then
      ReportError('Symbol table overflow');
    Point:=SymbolStart;
    While Point<>NIL do
    begin
      LastPoint:=Point;
      If Name > Point^.Name then
        Point:=Point^.Right
      else
        Point:=Point^.Left;
    end;
    If Name > LastPoint^.Name then
      LastPoint^.Right:=Position
    else
      LastPoint^.Left:=Position;
    Position^.Name:=Name;
    Position^.Left:=NIL;
    Position^.Right:=NIL;
  end
  else
    Position:=Point;
  If Position^.Valid and
     (Value<>Position^.Value) then
      ReportError(Concat('Redefinition of Symbol ',
      Position^.Name,' from ',
      Hex(Position^.Value),' to ',Hex(Value)));
  Position^.Value:=Value;
  Position^.Valid:=Valid;
  Position^.Reloc:=Reloc;
  Position^.Kind:=Kind;
end;

procedure GenerateLabel(var Line : Linetype);
{Will remove the label from the line and add it to the  symbol table}
begin
  ConvertUppercase(Line);
  If Copy(Line,1,1)<>' ' then {Label exists}
  begin
    LabelName:=Copy(Copy(Line,1,Pos(' ',Line)-1),1,SymbolLength);
    CharacterizeSymbol(LabelName,PC,False,Relocatable,LabelS);
    {Labels become valid only after the directive is proved that it does no
    change their value i.e. it is not an EQU directive. This is done in the
    ObjectProcess procedure}
    Line:=Copy(Line,Pos(' ',Line),LineLength);
  end
  else
    LabelName:='$'; {For no label $ is imlied so it is a nice place holder}
  While Copy(line,1,1)=' ' do
    Line:=Copy(Line,2,LineLength);
end;

procedure Decode(var Line : LineType; var Instruction : InstructionType ) ;
{Will remove the instruction from the line update Instruction }
var
  Mnemonic : MnemonicType;
  i : integer;
begin
  Mnemonic:=Copy(Line,1,Pos(' ',Line)-1);
  i:=1;
  While (InstructionEntry[i].Mnemonic<>Mnemonic) and (i<=NumberOfMnemonic) do
    i:=i+1;
  If i<=NumberOfMnemonic then
  begin
    Instruction.OpCode:=InstructionEntry[i].OpCode;
    Instruction.Format:=InstructionEntry[i].Format;
  end
  else
  begin
    ReportError('Unrecognizable mnemonic or assembler instruction');
  end;
  Line:=Copy(Line,Pos(' ',Line),LineLength);
  While Copy(line,1,1)=' ' do
    Line:=Copy(Line,2,LineLength);
end;

Function SmartPos(What : Char ; Where : LineType) : Integer;
{Works like pos but does not count characters inside quotes}
var
  i : Integer;
  InQuotes,Found : Boolean;
  c : Char;
begin
  InQuotes:=False;
  Found:=False;
  i:=1;
  While (i<=Length(Where)) and not Found do
  begin
    c:=Copy(Where,i,1);
    If c=chr(39) then
      InQuotes:=Not InQuotes;
    If (c=What) and not InQuotes then
      Found:=True
    else
      i:=i+1;
  end;
  If Found then
    SmartPos:=i
  else
    SmartPos:=0;
end;

Procedure Tokenize(Line : LineType ; Var TokenArray : TokenArrayType ;
                   Var LastToken : Integer);
{Will break the line into tokens}
var
  i : Integer;
  c : Char;
  InQuotes : Boolean;
begin
  LastToken:=1;
  InQuotes:=False;
  Line:=Concat(line,' ');
  Line:=Concat(Copy(line,1,SmartPos(' ',line)-1),' ');
  {Line will have one and only one space at its end}
  TokenArray[LastToken].Name:='';
  for i:=1 to length(Line) do
  begin
    c:=Copy(Line,i,1);
    if c=chr(39) then
      InQuotes:=not InQuotes;
    if (c in ['*','+','-','/','@','(',')',' ']) and (not InQuotes) and
          (length(TokenArray[LastToken].Name)>0) then
    begin
      LastToken:=LastToken+1;
      TokenArray[LastToken].Name:='';
    end;
    TokenArray[LastToken].Name:=Concat(TokenArray[LastToken].Name,c);
    if (c in ['*','+','-','/','@','(',')',' ']) and (not InQuotes) then
    begin
      LastToken:=LastToken+1;
      TokenArray[LastToken].Name:='';
    end;
  end;
  LastToken:=LastToken-2;
  If LastToken<1 then
    LastToken:=1; {To avoid run time errors}
end;

Procedure EvaluateToken(var Token : TokenEntry);
var
  c : Char;
  i : Integer;
  found : Boolean;
  Point : SymbolEntryPoint;

  function HexValue(c : Char) : Integer;
  begin
    HexValue:=Pos(c,'0123456789ABCDEF')-1;
  end;

begin
  SymbolStart^.Value:=PC;
  Token.Value:=0;
  Token.Kind:=Unknown;
  Token.Reloc:=Absolut;
  c:=Copy(Token.Name,1,1);
  if c=chr(39) then {Character Token , Absolute}
  begin
    Token.Value:=ord(Copy(Token.Name,2,1));
    If Copy(Token.Name,3,1)<>chr(39) then {Must be a 2 char const}
    begin
      Token.Value:=(Token.Value shl 8) or ord(Copy(Token.Name,3,1));
      If Copy(Token.Name,4,1)<>chr(39) then
        ReportError(Concat('Closing quote expected in ',Token.Name));
    end;
    Token.Reloc:=Absolut;
    Token.Kind:=CharacterS;
  end
  else if c='>' then {Hexadecimal}
  begin
    Token.Value:=0;
    for i:=2 to length(Token.Name) do
    begin
      c:=Copy(Token.Name,i,1);
      if not (c in ['0'..'9','A'..'F']) then
        ReportError(Concat('Invalid character in hexadecimal constant ',
                             Token.Name));
      Token.Value:=(Token.Value shl 4) or HexValue(c);
    end;
    Token.Reloc:=Absolut;
    Token.Kind:=HexS;
  end
  else if (c in ['A'..'Z','$']) then {Symbol}
  begin
    Point:=SymbolStart;
    Found:=False;
    While (Point<>NIL) and not found do
      if Token.Name=Point^.Name then
        found:=True
      else
        if Token.Name > Point^.Name then
          Point:=Point^.Right
        else
          Point:=Point^.Left;
    if not found then
      ReportError(Concat('Unknown Symbol ',Token.Name))
    else
    begin
      Token.Value:=Point^.Value;
      Token.Reloc:=Point^.Reloc;
      Token.Kind:=Point^.Kind;
    end;
  end
  else if (c in ['0'..'9']) then {Number}
  begin
    Token.Value:=0;
    for i:=1 to length(Token.Name) do
    begin
      c:=Copy(Token.Name,i,1);
      if not (c in ['0'..'9']) then
        ReportError(Concat('Invalid character in decimal constant ',
                             Token.Name));
      Token.Value:=(Token.Value * 10) + (Ord(c)-Ord('0'));
    end;
    Token.Reloc:=Absolut;
    Token.Kind:=DecS;
  end
  else
    Token.Kind:=SeparatorS;
end;

procedure EvaluateTerm(Line : LineType; var Result : TermType) ;
var
  i : Integer;
  a : Integer;
  ValidTerm : Boolean;
  c : Char;
  Part : LineType;
  OpenPos,ClosePos : Integer;
  TokenArray : TokenArrayType;
  TempReloc : Integer;
  LastToken : Integer;

  Function Eval(Start,Stop : Integer; Var Reloc : Integer) : Integer;
  var
    i,a,sign : Integer;
    RelocValue : Integer;
  begin
    if (TokenArray[Start].Name='-') then
    begin {Unary minus}
      Sign:=-1;
      Start:=Start+1;
    end
    else
      Sign:=1;
    a:=TokenArray[start].value*sign;
    If TokenArray[start].Reloc=Relocatable then
      Reloc:=1
    else
      Reloc:=0;
    i:=start+2;
    while i<=Stop do
    begin
      If TokenArray[i].Reloc=Relocatable then
        RelocValue:=1
      else
        RelocValue:=0;
      case  TokenArray[i-1].Name of
        '+' :
        begin
          a:=a+TokenArray[i].Value;
          Reloc:=Reloc + RelocValue;
        end;
        '-' :
        begin
          a:=a-TokenArray[i].Value;
          Reloc:=Reloc - RelocValue;
        end;
        '*' :
        begin
          a:=a*TokenArray[i].Value;
          If (RelocValue=1) or (Reloc=1) then
            ReportError('Multiplication using relocatable value');
        end;
        '/' :
        begin
          a:=a div TokenArray[i].Value;
          If (RelocValue=1) or (Reloc=1) then
            ReportError('Division using relocatable value');
        end;
      end;
      i:=i+2;
    end;
    Eval:=a;
    {Acording to the 9900 family systems design data book the number of
    additions and subtractions of relocatable values must differ at most
    by one}
    If Reloc=-1 then
      Reloc:=1;
    if not ( (Reloc=0) or (Reloc=1) ) then
      ReportError('Invalid use of relocatable values');
  end;

  Function TokenPos(C : Char) : Integer;
  var
    i : Integer;
    found : Boolean;
  begin
    i:=1;
    Found:=False;
    While (i<=LastToken) and not found do
      if TokenArray[i].Name=C then
        Found:=True
      else
        i:=i+1;
    if not found then
      i:=0;
  end;

begin
  ValidTerm:=True;
  Tokenize(Line,TokenArray,LastToken);
  For i:=1 to LastToken do
    If Length(TokenArray[i].Name)>0 then
      EvaluateToken(TokenArray[i]);
  OpenPos:=Pos('(',Line);
  ClosePos:=Pos(')',Line);
  If (OpenPos=0) <> (ClosePos=0) then
    ValidTerm:=False;
  TempReloc:=0; {All terms are at the start non relocatable}
  Result.Value := 0;
  Result.RegValue :=0;
  Result.Mode :=0;
  Result.Valid := False;
  Result.RegReloc := Absolut;
  Result.ValReloc := Absolut;
  Result.Kind := Unknown;
  Result.Name := '';
  If ValidTerm Then
    if (TokenArray[1].Name='*') and (TokenArray[LastToken].Name='+') then
    begin {*Rn+ Mode}
      Result.RegValue:=Eval(2,LastToken-1,TempReloc);
      If TempReloc=0 then
        Result.RegReloc:=Absolut
      else
        Result.RegReloc:=Relocatable;
      Result.Mode:=3;
      Result.Kind:=TokenArray[2].Kind;
      Result.Name:=TokenArray[2].Name;
    end
    else if TokenArray[1].Name='*' then
    begin {*Rn Mode}
      Result.RegValue:=Eval(2,LastToken,TempReloc);
      If TempReloc=0 then
        Result.RegReloc:=Absolut
      else
        Result.RegReloc:=Relocatable;
      Result.Mode:=1;
      Result.Kind:=TokenArray[2].Kind;
      Result.Name:=TokenArray[2].Name;
    end
    else if (TokenArray[1].Name='@') and (OpenPos<>0) and (ClosePos<>0) then
    begin {@NUM(Rn) Mode}
      Result.Value:=Eval(2,TokenPos('(')-1,TempReloc);
      If TempReloc=0 then
        Result.ValReloc:=Absolut
      else
        Result.ValReloc:=Relocatable;
      Result.RegValue:=Eval(TokenPos('(')+1,TokenPos(')')-1,TempReloc);
      If TempReloc=0 then
        Result.RegReloc:=Absolut
      else
        Result.RegReloc:=Relocatable;
      Result.Mode:=2;
      Result.Kind:=TokenArray[2].Kind;
      Result.Name:=TokenArray[2].Name;
    end
    else if TokenArray[1].Name='@' then
    begin {@NUM Mode}
      Result.Value:=Eval(2,LastToken,TempReloc);
      If TempReloc=0 then
        Result.ValReloc:=Absolut
      else
        Result.ValReloc:=Relocatable;
      Result.RegValue:=0;
      Result.Mode:=2;
      Result.Kind:=TokenArray[2].Kind;
      Result.Name:=TokenArray[2].Name;
    end
    else
    begin {Rn Mode}
      Result.RegValue:=Eval(1,LastToken,TempReloc);
      If TempReloc=0 then
        Result.RegReloc:=Absolut
      else
        Result.RegReloc:=Relocatable;
      Result.Mode:=0;
      Result.Kind:=TokenArray[1].Kind;
      Result.Name:=TokenArray[1].Name;
    end;
  If ValidTerm then
    Result.Valid:=True
  else
  begin
    Result.Value:=0;
    Result.RegValue:=0;
    Result.RegReloc:=Absolut;
    Result.ValReloc:=Absolut;
    Result.Valid:=False;
  end;
{*************************************************************
  WriteLn('Value     =',Hex(Result.Value));
  WriteLn('RegValue  =',Hex(Result.RegValue));
  WriteLn('Mode      =',Result.Mode);
  WriteLn('Valid     =',Result.Valid);
  Write(  'RegReloc  =');
  case Result.Regreloc of
    absolut : WriteLn('Absolute');
    Relocatable : WriteLn('Relocatable');
  end;
  Write(  'ValReloc  =');
  case Result.Valreloc of
    absolut : WriteLn('Absolute');
    Relocatable : WriteLn('Relocatable');
  end;}
end;

Procedure SplitLine(Line : LineType;var  A,B : TermType);
{Will take the last part of a line and will attempt to split it into two terms}
var
  i,CommaPos,SpacePos : Integer;
begin
  Line:=Concat(line,' ');
  CommaPos:=SmartPos(',',Line);
  SpacePos:=SmartPos(' ',Line);
  If CommaPos<>0 then
  begin
    EvaluateTerm(Copy(Line,1,CommaPos-1),A);
    EvaluateTerm(Copy(Line,CommaPos+1,SpacePos-CommaPos-1),B);
  end
  else
  begin
    EvaluateTerm(Copy(line,1,SpacePos-1),A);
    B.Value:=0;
    B.Valid:=False;
  end;
end;

function Min(A,B : Integer) : Integer;
begin
  If A<B then
    Min:=A
  else
    Min:=B;
end;

procedure CalculateChecksum(Rec : RecordType);
var
  i : Integer;
begin
  for i:=1 to length(Rec) do
    Checksum:=Checksum+ord(Copy(Rec,i,1));
end;

Function Space(A : Integer) : LineType;
var
  Buffer : LineType;
  i : Integer;
begin
  Buffer:='';
  for i:=1 to A do
    Buffer:=Concat(Buffer,' ');
  Space:=Buffer;
end;

procedure AddRecord(Rec : RecordType);
const
  AcountChecksum = '7';
  IgnoreChecksum = '8';
  MaxObjectChars=55;
begin
  If GenerateObject then
  begin
    if (Objectchars>=MaxObjectChars) or ForceEnd then
    begin
      ObjectChars:=ObjectChars+6;
      Write(ObjectFile,IgnoreChecksum,Hex($ffff-CheckSum+1),'F',
        Space(80-ObjectChars-4),Padd(OC)); {TI uses no LF or CR}
      CheckSum:=0;
      If Length(Rec)>0 then {Check if not a dummy eof record}
        Write(ObjectFile,'A',Hex(PC));
      CalculateChecksum(Concat('A',Hex(PC)));
      OC:=OC+1;
      ObjectRecords:=0;
      ObjectChars:=5;
    end;
    Write(ObjectFile,Rec);
    ObjectChars:=ObjectChars+Length(Rec);
    CalculateChecksum(Rec);
    ObjectRecords:=ObjectRecords+1;
  end;
end;

procedure AddObj(Tag,Value : Integer; ListOrder : ListType);
begin
  If ByteValuePending and ((Tag=$b) or (Tag=$c)) then {Data words start on even}
  begin
    ByteValuePending:=False;
    AddRecord(Concat('B',Hex(ByteValue shl 8)));
    PC:=PC+1;
  end;
  case ListOrder of
    DisplayLineValue :
      List(Concat(Padd(lc),' ',Hex(PC),' ',Hex(Value),'  ',CommonLine));
    DisplayLineNoValue:
      List(Concat(Padd(lc),' ',Hex(PC),'       ',CommonLine));
    DisplayValueNoLine :
      If tag=$c then
        List(Concat('     ',Hex(PC),' ',Hex(Value),chr(39)))
      else
        List(Concat('     ',Hex(PC),' ',Hex(Value)));
    DisplayNothing :
      ;
  end;
  case Tag of
    0: {Programme start}
      AddRecord(Concat('0',Hex(Value),copy(concat(idt,'        '),1,8)));
    2: {Relocatable entry address}
      AddRecord(Concat('2',Hex(Value)));
    3: {External reference}
      AddRecord(Concat('3',Hex(Value),
                       Copy(Concat(SecondTagField,'      '),1,6)));
    5: {Relocatable external definition}
      AddRecord(Concat('5',Hex(Value),
                       Copy(Concat(SecondTagField,'      '),1,6)));
    6: {Absolute external definition}
      AddRecord(Concat('6',Hex(Value),
                       Copy(Concat(SecondTagField,'      '),1,6)));
    $a: {Relocatable load address}
    begin
      AddRecord(Concat('A',Hex(Value)));
      PC:=Value;
    end;
    $b: {Absolute Data}
    begin
      AddRecord(Concat('B',Hex(Value)));
      PC:=PC+2;
    end;
    $c: {Relocatable data}
    begin
      AddRecord(Concat('C',Hex(Value)));
      PC:=PC+2;
    end;
    $f: {Dummy tag signifies EOF}
    begin
      ForceEnd:=True;
      AddRecord('');
    end;
    $1b: {Byte}
    begin
      If ByteValuePending then
      begin
        ByteValuePending:=False;
        AddRecord(Concat('B',Hex(Value or (ByteValue shl 8))));
      end
      else
      begin
        ByteValuePending:=True;
        ByteValue:=Value;
      end;
      PC:=PC+1;
    end;
    $2b: {Even}
    begin
      If ByteValuePending then
      begin
        ByteValuePending:=False;
        AddRecord(Concat('B',Hex(ByteValue shl 8)));
        PC:=PC+1;
      end;
    end;
  end;
end;

Procedure ObjectProcess(Opcode,Format:Integer; A,B:TermType; Line:LineType);
Const
  Valid = True;
  InValid = False;
var
  Displacement : Integer;
  TempLine : LineType;
  TermResult : TermType;
  i : Integer;
  First : Boolean;
begin
  If (Format in [1,2,3,4,5,6,8,9]) then
  begin
    If A.Kind=ExternalS Then
      CharacterizeSymbol(A.Name,PC+2,InValid,Relocatable,ExternalS);
    If B.Kind=ExternalS then
      If A.Mode=2 then
        CharacterizeSymbol(B.Name,PC+4,InValid,Relocatable,ExternalS)
      else
        CharacterizeSymbol(B.Name,PC+2,InValid,Relocatable,ExternalS);
    end;
  If (format<>19) and (LabelName<>'$') then  {Characterize label if not EQU}
  begin
     CharacterizeSymbol(LabelName,PC,Valid,Relocatable,LabelS);
  end;
  case format of
    1 : {Arithmetic}
    begin
       If not A.Valid then
        ReportError('Invalid source operand');
      If not B.Valid then
        ReportError('Invalid destination operand');
      If (A.RegValue>15) or (B.RegValue>15) then
        ReportError('Bad register value');
      AddObj($b,OpCode or (A.RegValue and $f) or (A.Mode shl 4)
        or ((B.RegValue and $f) shl 6) or (B.Mode shl 10),DisplayLineValue);
      if A.Mode=2 then
        Case A.ValReloc of
          Relocatable : AddObj($c,A.Value,DisplayValueNoLine);
          Absolut : AddObj($b,A.Value,DisplayValueNoLine);
        end;
      if B.Mode=2 then
        Case B.ValReloc of
          Relocatable : AddObj($c,B.Value,DisplayValueNoLine);
          Absolut : AddObj($b,B.Value,DisplayValueNoLine);
        end;
    end;
    2 : {Jump}
    begin
      If not A.Valid  then
        ReportError('Invalid jump label');
      If A.Mode<>0 then
        ReportError('Invalid jump operand type');
      If B.Valid then
        ReportWarning('Too many operands');
      Displacement:=(A.RegValue-PC-2) DIV 2;
      If (Displacement>127) or (Displacement<-128) then
        ReportError('Out of range jump');
      AddObj($b,OpCode or (Displacement and $ff),DisplayLineValue);
    end;
    3,9 : {Logical, MPY DIV XOP}
    begin
      If not A.Valid then
        ReportError('Invalid source operand');
      If (not B.Valid) or (B.Mode<>0) then
        ReportError('Invalid register operand');
      If (A.RegValue>15) or (B.RegValue>15) then
        ReportError('Bad register value');
      AddObj($b,OpCode or (A.RegValue and $f) or (A.Mode shl 4)
        or ((B.RegValue and $f) shl 6),DisplayLineValue );
      if A.Mode=2 then
        Case A.ValReloc of
          Relocatable : AddObj($c,A.Value,DisplayValueNoLine);
          Absolut : AddObj($b,A.Value,DisplayValueNoLine);
        end;
    end;
    4 : {CRU}
    begin
      If not A.Valid then
        ReportError('Invalid source operand');
      If (not B.Valid) or (B.Mode<>0) then
        ReportError('Invalid count operand');
      If (A.RegValue>15) then
        ReportError('Bad register value');
      If (B.RegValue>15) then
        ReportError('Bad count value');
      AddObj($b,OpCode or (A.RegValue and $f) or (A.Mode shl 4)
        or ((B.RegValue and $f) shl 6),DisplayLineValue );
      if A.Mode=2 then
        Case A.ValReloc of
          Relocatable : AddObj($c,A.Value,DisplayValueNoLine);
          Absolut : AddObj($b,A.Value,DisplayValueNoLine);
        end;
    end;
    5: {Shift}
    begin
      If (not A.Valid) or (A.Mode<>0) then
        ReportError('Invalid register operand');
      If (not B.Valid) or (B.Mode<>0) then
        ReportError('Invalid count operand');
      If (A.RegValue>15) then
        ReportError('Bad register value');
      If (B.RegValue>15) then
        ReportError('Bad count value');
      AddObj($b,OpCode or (A.RegValue and $f) or (A.Mode shl 4)
        or ((B.RegValue and $f) shl 6),DisplayLineValue );
    end;
    6: {Programme}
    begin
      If not A.Valid then
        ReportError('Invalid source operand');
      If A.RegValue>15 then
        ReportError('Bad register value');
      If B.Valid then
        ReportWarning('Too many operands');
      AddObj($b,OpCode or (A.RegValue and $f) or (A.Mode shl 4),
             DisplayLineValue);
      if A.Mode=2 then
        Case A.ValReloc of
          Relocatable : AddObj($c,A.Value,DisplayValueNoLine);
          Absolut : AddObj($b,A.Value,DisplayValueNoLine);
        end;
    end;
    7: {Control}
    begin
      AddObj($b,OpCode,DisplayLineValue);
    end;
    8: {Immediate (two operand) }
    begin
      If (not A.Valid) or (A.Mode<>0) then
        ReportError('Invalid register operand');
      If (not B.Valid) or (B.Mode<>0) then
        ReportError('Invalid number operand');
      If (A.RegValue>15) then
        ReportError('Bad register value');
      AddObj($b,OpCode or (A.RegValue and $f),DisplayLineValue);
      Case B.RegReloc of
        Relocatable : AddObj($c,B.RegValue,DisplayValueNoLine);
        Absolut : AddObj($b,B.RegValue,DisplayValueNoLine);
      end;
    end;
    18: {Immediate one opearand}
    begin
      If (not A.Valid) or (A.Mode<>0) then
        ReportError('Invalid number operand');
      If B.Valid then
        ReportWarning('Too many operands');
      AddObj($b,OpCode,DisplayLineValue );
      Case A.RegReloc of
        Relocatable : AddObj($c,A.RegValue,DisplayValueNoLine);
        Absolut : AddObj($b,A.RegValue,DisplayValueNoLine);
      end;
    end;
    11: {DEF}
    begin
      Line:=Copy(Line,1,Pos(' ',Line));
      Line:=Concat(Line,'  , '); {In order to force end tokenization}
      While Copy(Line,1,1)<>' ' do
      begin
        TempLine:=Copy(Line,1,Min(Min(Pos(' ',Line),Pos(',',Line))-1,6));
        EvaluateTerm(TempLine,TermResult);
        If (TermResult.Mode<>0) or (not TermResult.Valid) then
          ReportError('Invalid value');
        SecondTagField:=TempLine;
        case TermResult.RegReloc of
          Relocatable : AddObj($5,TermResult.RegValue,DisplayNothing);
          Absolut : AddObj($6,TermResult.RegValue,DisplayNothing);
        end;
        Line:=Copy(Line,Min(Pos(',',Line),Pos(' ',Line))+1,255);
      end;
      List(Concat(Padd(LC),'            ',CommonLine));
    end;
    12: {REF}
    begin
      Line:=Copy(Line,1,Pos(' ',Line));
      Line:=Concat(Line,'  , '); {In order to force end tokenization}
      While Copy(Line,1,1)<>' ' do
      begin
        TempLine:=Copy(Line,1,Min(Min(Pos(' ',Line),Pos(',',Line))-1,6));
        Line:=Copy(Line,Min(Pos(',',Line),Pos(' ',Line))+1,255);
        CharacterizeSymbol(TempLine,0,InValid,Absolut,ExternalS);
      end;
      List(Concat(Padd(LC),'            ',CommonLine));
    end;
    13 : {IDT}
    begin
      If Copy(Line,1,1)<>chr(39) {'} then
        ReportError('No open quote after IDT');
      Line:=Copy(Line,2,255);
      if Pos(chr(39),Line) > 9 then
        ReportWarning('IDT length more than 8 characters');
      if Pos(chr(39),Line)=0 then
        ReportError('Closing quote expected');
      idt:=Copy(Line,1,Min(8,Pos(chr(39),Line)-1));
      List(Concat(Padd(LC),'            ',CommonLine));
    end;
    14 : {Byte}
    begin
      Line:=Copy(Line,1,Pos(' ',Line));
      Line:=Concat(Line,'  , '); {In order to force end tokenization}
      First:=True;
      While Copy(Line,1,1)<>' ' do
      begin
        TempLine:=Copy(Line,1,Min(Min(Pos(' ',Line),Pos(',',Line))-1,6));
        EvaluateTerm(TempLine,TermResult);
        If (TermResult.Mode<>0) or (Not TermResult.Valid) then
          ReportError('Invalid value');
        If TermResult.RegValue>$ff then
        begin
          ReportWarning('Value exceeds byte length');
          TermResult.RegValue:=TermResult.RegValue and $ff;
        end;
        If TermResult.RegReloc=Relocatable then
          ReportWarning('Relocatable byte definition');
        If First then
          AddObj($1b,TermResult.RegValue,DisplayLineValue)
        else
          AddObj($1b,TermResult.RegValue,DisplayValueNoLine);
        First:=False;
        Line:=Copy(Line,Min(Pos(',',Line),Pos(' ',Line))+1,255);
      end;
    end;
    15 : {Data}
    begin
      Line:=Copy(Line,1,Pos(' ',Line));
      Line:=Concat(Line,'  , '); {In order to force end tokenization}
      First:=True;
      While Copy(Line,1,1)<>' ' do
      begin
        TempLine:=Copy(Line,1,Min(Min(Pos(' ',Line),Pos(',',Line))-1,6));
        EvaluateTerm(TempLine,TermResult);
        If (TermResult.Mode<>0) or (not TermResult.Valid) then
          ReportError('Invalid value');
        If First then
          case TermResult.RegReloc of
            Relocatable : AddObj($c,TermResult.RegValue,DisplayLineValue);
            Absolut : AddObj($b,TermResult.RegValue,DisplayLineValue);
          end
        else
          case TermResult.RegReloc of
            Relocatable : AddObj($c,TermResult.RegValue,DisplayValueNoLine);
            Absolut : AddObj($b,TermResult.RegValue,DisplayValueNoLine);
          end;
        Line:=Copy(Line,Min(Pos(',',Line),Pos(' ',Line))+1,255);
      end;
    end;
    16 : {Even}
    begin
      AddObj($2b,0,DisplayLineNoValue);
    end;
    17 : {BSS}
    begin
      if (not A.Valid) or (A.Mode<>0) then
        ReportError('Invalid BSS length');
      if B.Valid then
        ReportWarning('Too many operands');
      If A.RegReloc=Relocatable then
        ReportWarning('BSS on relocatable result');
      AddObj($a,PC+A.RegValue,DisplayLineNoValue);
    end;
    19 : {EQU}
    begin
      if (not A.Valid) or (A.Mode<>0) then
        ReportError('Invalid EQU operand');
      if B.Valid then
        ReportWarning('Too many operands');
      CharacterizeSymbol(LabelName,A.RegValue,
                         A.Valid and (A.Mode=0),A.RegReloc,EquateS);
      List(Concat(Padd(LC),'      ',Hex(A.RegValue),'  ',CommonLine));
    end;
    20 : {End}
    begin
      If A.Valid and (A.Mode<>0) then
        ReportError('Invalid entry address');
      If A.Valid and (A.Mode=0) then
        AddObj($2,A.RegValue,DisplayNothing);
      List(Concat(Padd(LC),'            ',CommonLine));
      EndOfSource:=True;
    end;
    21 : {Text}
    begin
      If Copy(Line,1,1)<>chr(39) {'} then
        ReportError('No open quote after TEXT');
      Line:=Copy(Line,2,255);
      if Pos(chr(39),Line)=0 then
        ReportError('Closing quote expected');
      for i:=1 to pos(chr(39),Line)-1 do
        If i=1 then
          AddObj($1b,ord(Copy(Line,i,1)),DisplayLineValue)
        else
          AddObj($1b,ord(Copy(Line,i,1)),DisplayValueNoLine);
    end;
    22 : {TITL}
    begin
      If Copy(Line,1,1)<>chr(39) {'} then
        ReportError('No open quote after TITL');
      Line:=Copy(Line,2,255);
      if Pos(chr(39),Line)=0 then
        ReportError('Closing quote expected');
      Title:=Copy(Line,1,Pos(chr(39),Line)-1);
      List(Concat(Padd(LC),'            ',CommonLine));
    end;
  end;
end;

procedure Process(Line : LineType);
var
  i : integer;
  Intruction : InstructionType;
  A,B : TermType;
begin
  If (Copy(Line,1,1)='*') then {process only if not remark}
    List(Concat(Padd(LC),'            ',CommonLine))
  else
  begin
    Line:=Concat(Line,' '); {Needed by most routines as an eoln marker}
    GenerateLabel(Line);
    If Length(Line)=0 then
      List(Concat(Padd(lc),' ',Hex(PC),'       ',CommonLine));
    If Length(Line)>0 then
    begin
      Decode(Line,Instruction);
      If not (Instruction.Format in [7,12,13,16,21,22,11,14,15]) then
        SplitLine(Line,A,B);
      {Some instructions e.g. TITL need no evaluation) }
      ObjectProcess(Instruction.OpCode,Instruction.Format,A,B,Line);
    end;
  end;
end;

procedure AddRefs;
  procedure WalkThrough(Point : SymbolEntryPoint);
  begin
    if Point^.Left <> NIL then
      WalkThrough(Point^.Left);
    If Point^.Kind=ExternalS then
    begin
      SecondTagField:=Copy(Concat(Point^.Name,'      '),1,6);
      AddObj($3,Point^.Value,DisplayNothing);
    end;
    If Point^.Right <> NIL then
      WalkThrough(Point^.Right);
  end;
begin
  WalkThrough(SymbolStart);
end;

procedure InitTable;
Const
  Valid = True;
var
  i : Integer;
begin
InstructionEntry[1].Mnemonic:='A';
InstructionEntry[1].OpCode:=$A000;
InstructionEntry[1].Format:=1;
InstructionEntry[2].Mnemonic:='AB';
InstructionEntry[2].OpCode:=$B000;
InstructionEntry[2].Format:=1;
InstructionEntry[3].Mnemonic:='ABS';
InstructionEntry[3].OpCode:=$0740;
InstructionEntry[3].Format:=6;
InstructionEntry[4].Mnemonic:='AI';
InstructionEntry[4].OpCode:=$0220;
InstructionEntry[4].Format:=8;
InstructionEntry[5].Mnemonic:='ANDI';
InstructionEntry[5].OpCode:=$0240;
InstructionEntry[5].Format:=8;
InstructionEntry[6].Mnemonic:='B';
InstructionEntry[6].OpCode:=$0440;
InstructionEntry[6].Format:=6;
InstructionEntry[7].Mnemonic:='BL';
InstructionEntry[7].OpCode:=$0680;
InstructionEntry[7].Format:=6;
InstructionEntry[8].Mnemonic:='BLWP';
InstructionEntry[8].OpCode:=$0400;
InstructionEntry[8].Format:=6;
InstructionEntry[9].Mnemonic:='C';
InstructionEntry[9].OpCode:=$8000;
InstructionEntry[9].Format:=1;
InstructionEntry[10].Mnemonic:='CB';
InstructionEntry[10].OpCode:=$9000;
InstructionEntry[10].Format:=1;
InstructionEntry[11].Mnemonic:='CI';
InstructionEntry[11].OpCode:=$0280;
InstructionEntry[11].Format:=8;
InstructionEntry[12].Mnemonic:='CKOF';
InstructionEntry[12].OpCode:=$03C0;
InstructionEntry[12].Format:=7;
InstructionEntry[13].Mnemonic:='CKON';
InstructionEntry[13].OpCode:=$03A0;
InstructionEntry[13].Format:=7;
InstructionEntry[14].Mnemonic:='CLR';
InstructionEntry[14].OpCode:=$04C0;
InstructionEntry[14].Format:=6;
InstructionEntry[15].Mnemonic:='COC';
InstructionEntry[15].OpCode:=$2000;
InstructionEntry[15].Format:=3;
InstructionEntry[16].Mnemonic:='CZC';
InstructionEntry[16].OpCode:=$2400;
InstructionEntry[16].Format:=3;
InstructionEntry[17].Mnemonic:='DEC';
InstructionEntry[17].OpCode:=$0600;
InstructionEntry[17].Format:=6;
InstructionEntry[18].Mnemonic:='DECT';
InstructionEntry[18].OpCode:=$0640;
InstructionEntry[18].Format:=6;
InstructionEntry[19].Mnemonic:='DIV';
InstructionEntry[19].OpCode:=$3C00;
InstructionEntry[19].Format:=9;
InstructionEntry[20].Mnemonic:='IDLE';
InstructionEntry[20].OpCode:=$0340;
InstructionEntry[20].Format:=7;
InstructionEntry[21].Mnemonic:='INC';
InstructionEntry[21].OpCode:=$0580;
InstructionEntry[21].Format:=6;
InstructionEntry[22].Mnemonic:='INCT';
InstructionEntry[22].OpCode:=$05C0;
InstructionEntry[22].Format:=6;
InstructionEntry[23].Mnemonic:='INV';
InstructionEntry[23].OpCode:=$0540;
InstructionEntry[23].Format:=6;
InstructionEntry[24].Mnemonic:='JEQ';
InstructionEntry[24].OpCode:=$1300;
InstructionEntry[24].Format:=2;
InstructionEntry[25].Mnemonic:='JGT';
InstructionEntry[25].OpCode:=$1500;
InstructionEntry[25].Format:=2;
InstructionEntry[26].Mnemonic:='JH';
InstructionEntry[26].OpCode:=$1B00;
InstructionEntry[26].Format:=2;
InstructionEntry[27].Mnemonic:='JHE';
InstructionEntry[27].OpCode:=$1400;
InstructionEntry[27].Format:=2;
InstructionEntry[28].Mnemonic:='JL';
InstructionEntry[28].OpCode:=$1A00;
InstructionEntry[28].Format:=2;
InstructionEntry[29].Mnemonic:='JLE';
InstructionEntry[29].OpCode:=$1200;
InstructionEntry[29].Format:=2;
InstructionEntry[30].Mnemonic:='JLT';
InstructionEntry[30].OpCode:=$1100;
InstructionEntry[30].Format:=2;
InstructionEntry[31].Mnemonic:='JMP';
InstructionEntry[31].OpCode:=$1000;
InstructionEntry[31].Format:=2;
InstructionEntry[32].Mnemonic:='JNC';
InstructionEntry[32].OpCode:=$1700;
InstructionEntry[32].Format:=2;
InstructionEntry[33].Mnemonic:='JNE';
InstructionEntry[33].OpCode:=$1600;
InstructionEntry[33].Format:=2;
InstructionEntry[34].Mnemonic:='JNO';
InstructionEntry[34].OpCode:=$1900;
InstructionEntry[34].Format:=2;
InstructionEntry[35].Mnemonic:='JOC';
InstructionEntry[35].OpCode:=$1800;
InstructionEntry[35].Format:=2;
InstructionEntry[36].Mnemonic:='JOP';
InstructionEntry[36].OpCode:=$1C00;
InstructionEntry[36].Format:=2;
InstructionEntry[37].Mnemonic:='LDCR';
InstructionEntry[37].OpCode:=$3000;
InstructionEntry[37].Format:=4;
InstructionEntry[38].Mnemonic:='LI';
InstructionEntry[38].OpCode:=$0200;
InstructionEntry[38].Format:=8;
InstructionEntry[39].Mnemonic:='LIMI';
InstructionEntry[39].OpCode:=$0300;
InstructionEntry[39].Format:=18;
InstructionEntry[40].Mnemonic:='LREX';
InstructionEntry[40].OpCode:=$03E0;
InstructionEntry[40].Format:=7;
InstructionEntry[41].Mnemonic:='LWPI';
InstructionEntry[41].OpCode:=$02E0;
InstructionEntry[41].Format:=18;
InstructionEntry[42].Mnemonic:='MOV';
InstructionEntry[42].OpCode:=$C000;
InstructionEntry[42].Format:=1;
InstructionEntry[43].Mnemonic:='MOVB';
InstructionEntry[43].OpCode:=$D000;
InstructionEntry[43].Format:=1;
InstructionEntry[44].Mnemonic:='MPY';
InstructionEntry[44].OpCode:=$3800;
InstructionEntry[44].Format:=9;
InstructionEntry[45].Mnemonic:='NEG';
InstructionEntry[45].OpCode:=$0500;
InstructionEntry[45].Format:=6;
InstructionEntry[46].Mnemonic:='ORI';
InstructionEntry[46].OpCode:=$0260;
InstructionEntry[46].Format:=8;
InstructionEntry[47].Mnemonic:='RSET';
InstructionEntry[47].OpCode:=$0360;
InstructionEntry[47].Format:=7;
InstructionEntry[48].Mnemonic:='RTWP';
InstructionEntry[48].OpCode:=$0380;
InstructionEntry[48].Format:=7;
InstructionEntry[49].Mnemonic:='S';
InstructionEntry[49].OpCode:=$6000;
InstructionEntry[49].Format:=1;
InstructionEntry[50].Mnemonic:='SB';
InstructionEntry[50].OpCode:=$7000;
InstructionEntry[50].Format:=1;
InstructionEntry[51].Mnemonic:='SB0';
InstructionEntry[51].OpCode:=$1D00;
InstructionEntry[51].Format:=2;
InstructionEntry[52].Mnemonic:='SBZ';
InstructionEntry[52].OpCode:=$1E00;
InstructionEntry[52].Format:=2;
InstructionEntry[53].Mnemonic:='SETO';
InstructionEntry[53].OpCode:=$0700;
InstructionEntry[53].Format:=6;
InstructionEntry[54].Mnemonic:='SLA';
InstructionEntry[54].OpCode:=$0A00;
InstructionEntry[54].Format:=5;
InstructionEntry[55].Mnemonic:='SOC';
InstructionEntry[55].OpCode:=$E000;
InstructionEntry[55].Format:=1;
InstructionEntry[56].Mnemonic:='SOCB';
InstructionEntry[56].OpCode:=$F000;
InstructionEntry[56].Format:=1;
InstructionEntry[57].Mnemonic:='SRA';
InstructionEntry[57].OpCode:=$0800;
InstructionEntry[57].Format:=5;
InstructionEntry[58].Mnemonic:='SRC';
InstructionEntry[58].OpCode:=$0B00;
InstructionEntry[58].Format:=5;
InstructionEntry[59].Mnemonic:='SRL';
InstructionEntry[59].OpCode:=$0900;
InstructionEntry[59].Format:=5;
InstructionEntry[60].Mnemonic:='STCR';
InstructionEntry[60].OpCode:=$3400;
InstructionEntry[60].Format:=4;
InstructionEntry[61].Mnemonic:='STST';
InstructionEntry[61].OpCode:=$02C0;
InstructionEntry[61].Format:=18;
InstructionEntry[62].Mnemonic:='STWP';
InstructionEntry[62].OpCode:=$02A0;
InstructionEntry[62].Format:=18;
InstructionEntry[63].Mnemonic:='SWPB';
InstructionEntry[63].OpCode:=$06C0;
InstructionEntry[63].Format:=6;
InstructionEntry[64].Mnemonic:='SZC';
InstructionEntry[64].OpCode:=$4000;
InstructionEntry[64].Format:=1;
InstructionEntry[65].Mnemonic:='SZCB';
InstructionEntry[65].OpCode:=$5000;
InstructionEntry[65].Format:=1;
InstructionEntry[66].Mnemonic:='TB';
InstructionEntry[66].OpCode:=$1F00;
InstructionEntry[66].Format:=2;
InstructionEntry[67].Mnemonic:='X';
InstructionEntry[67].OpCode:=$0480;
InstructionEntry[67].Format:=6;
InstructionEntry[68].Mnemonic:='XOP';
InstructionEntry[68].OpCode:=$2C00;
InstructionEntry[68].Format:=9;
InstructionEntry[69].Mnemonic:='XOR';
InstructionEntry[69].OpCode:=$2800;
InstructionEntry[69].Format:=3;
InstructionEntry[70].Mnemonic:='DEF';
InstructionEntry[70].OpCode:=$0000;
InstructionEntry[70].Format:=11;
InstructionEntry[71].Mnemonic:='IDT';
InstructionEntry[71].OpCode:=$0000;
InstructionEntry[71].Format:=13;
InstructionEntry[72].Mnemonic:='BYTE';
InstructionEntry[72].OpCode:=$0000;
InstructionEntry[72].Format:=14;
InstructionEntry[73].Mnemonic:='DATA';
InstructionEntry[73].OpCode:=$0000;
InstructionEntry[73].Format:=15;
InstructionEntry[74].Mnemonic:='EVEN';
InstructionEntry[74].OpCode:=$0000;
InstructionEntry[74].Format:=16;
InstructionEntry[75].Mnemonic:='BSS';
InstructionEntry[75].OpCode:=$0000;
InstructionEntry[75].Format:=17;
InstructionEntry[76].Mnemonic:='EQU';
InstructionEntry[76].OpCode:=$0000;
InstructionEntry[76].Format:=19;
InstructionEntry[77].Mnemonic:='END';
InstructionEntry[77].OpCode:=$0000;
InstructionEntry[77].Format:=20;
InstructionEntry[78].Mnemonic:='TEXT';
InstructionEntry[78].OpCode:=$0000;
InstructionEntry[78].Format:=21;
InstructionEntry[79].Mnemonic:='RT';
InstructionEntry[79].OpCode:=$045B;
InstructionEntry[79].Format:=7;
InstructionEntry[80].Mnemonic:='NOP';
InstructionEntry[80].OpCode:=$1000;
InstructionEntry[80].Format:=7;
InstructionEntry[81].Mnemonic:='TITL';
InstructionEntry[81].OpCode:=0000;
InstructionEntry[81].Format:=22;
InstructionEntry[82].Mnemonic:='REF';
InstructionEntry[82].OpCode:=0000;
InstructionEntry[82].Format:=12;
NumberOfMnemonic:=82;
New(SymbolStart);
SymbolStart^.Name:='$';
SymbolStart^.Value:=0;
SymbolStart^.Reloc:=Relocatable;
SymbolStart^.Left:=NIL;
SymbolStart^.Right:=NIL;
SymbolStart^.Kind:=Assm;
SymbolStart^.Valid:=True;
{The rest of the registers should resemble a binary tree}
CharacterizeSymbol('R7',7,Valid,Absolut,Assm);
CharacterizeSymbol('R3',3,Valid,Absolut,Assm);
CharacterizeSymbol('R11',11,Valid,Absolut,Assm);
CharacterizeSymbol('R1',1,Valid,Absolut,Assm);
CharacterizeSymbol('R5',5,Valid,Absolut,Assm);
CharacterizeSymbol('R9',9,Valid,Absolut,Assm);
CharacterizeSymbol('R14',14,Valid,Absolut,Assm);
CharacterizeSymbol('R0',0,Valid,Absolut,Assm);
CharacterizeSymbol('R2',2,Valid,Absolut,Assm);
CharacterizeSymbol('R4',4,Valid,Absolut,Assm);
CharacterizeSymbol('R6',6,Valid,Absolut,Assm);
CharacterizeSymbol('R8',8,Valid,Absolut,Assm);
CharacterizeSymbol('R10',10,Valid,Absolut,Assm);
CharacterizeSymbol('R13',13,Valid,Absolut,Assm);
CharacterizeSymbol('R15',15,Valid,Absolut,Assm);
CharacterizeSymbol('R12',12,Valid,Absolut,Assm);
idt:='';
Title:='';
end;

Procedure DisplaySymbolTable;
var
  Symbol,WholeLine : LineType;
  SymbolsWritten : Integer;

  procedure WalkThrough(Point : SymbolEntryPoint);
  begin
    if Point^.Left <> NIL then
      WalkThrough(Point^.Left);
    Symbol:='';
    case Point^.Reloc of
      Relocatable : Symbol:=chr(39);
      Absolut : Symbol:=' ';
    end;
    case Point^.Kind of
      ExternalS : Symbol:=Concat(Symbol,'E ');
      EquateS : Symbol:=Concat(Symbol,'= ');
      LabelS : Symbol:=Concat(Symbol,'L ');
      Assm : Symbol:=Concat(Symbol,'A ');
    end;
    If SymbolsWritten=4 then
    begin
      List(WholeLine);
      WholeLine:='';
      SymbolsWritten:=0;
    end;
    WholeLine:=Concat(WholeLine,Symbol,Copy(Concat(Point^.Name,Space(6)),1,6),
    '  ',Hex(Point^.Value),'    ');
    SymbolsWritten:=SymbolsWritten+1;
    If Point^.Right <> NIL then
      WalkThrough(Point^.Right);
  end;

begin
  ListLine:=0;
  SymbolsWritten:=0;
  WholeLine:='';
  WalkThrough(SymbolStart);
  If WholeLine<>'' then
    List(WholeLine);
end;

begin
  SuppressErrors:=True;
  GenerateObject:=False;
  GenerateList:=False;
  InitTable;
  OpenFiles;
  InitVars;
  Pass:=1;
  repeat
    if Eof(SourceFile) then
      EndOfSource:=True
    else
    begin
      ReadLn(SourceFile,Line);
      Line:=Copy(Line,1,60);
      Process(Line);
    end;
  until EndOfSource;
  SuppressErrors:=False;
  GenerateObject:=True;
  GenerateList:=True;
  AddObj(0,PC,DisplayNothing);
  Reset(SourceFile);
  InitVars;
  Pass:=2;
  AddObj($a,PC,DisplayNothing);
  Repeat
    If Eof(SourceFile) then
    begin
      ReportError('EOF reached unexpectedly');
      EndOfSource:=True;
    end
    else
    begin
      ReadLn(SourceFile,Line);
      Line:=Copy(Line,1,60);
      LC:=LC+1;
      CommonLine:=Line;
      Process(Line);
    end;
  until EndOfSource;
  AddRefs;
  AddObj($f,0,DisplayNothing); {Signify end of assembly}
  Line:=':        9900 Assembler D. Spinellis iAPX86 V. 1.10A';
  Line:=Concat(Line,Space(80-Length(Line)-4),Padd(OC));
  Write(ObjectFile,Line);
  OC:=OC+1;
  Write(ObjectFile,':',Space(75),Padd(OC));
  DisplaySymbolTable;
  List('');
  List(Concat(Padd(WarningNumber), ' Warnings'));
  List(Concat(Padd(ErrorNumber),' Errors'));
  WriteLn('');
  WriteLn('End of assembly');
  WriteLn(Padd(WarningNumber), ' Warnings');
  WriteLn(Padd(ErrorNumber),' Errors');
  CloseFiles;
end.